PR#2297, suite

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@6384 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

2 files changed, 55 insertions, 5 deletions

diff --git a/stdlib/arg.ml b/stdlib/arg.ml
index 5ed20e1c4..9514b9557 100644
--- a/stdlib/arg.ml
+++ b/stdlib/arg.ml
@@ -70,13 +70,24 @@ let print_spec buf (key, spec, doc) =
   | _ -> bprintf buf "  %s %s\n" key doc
 ;;
 
+let help_action () = raise (Stop (Unknown "-help"));;
+
+let add_help speclist =
+  let add1 =
+    try ignore (assoc3 "-help" speclist); []
+    with Not_found ->
+            ["-help", Unit help_action, " Display this list of options"]
+  and add2 =
+    try ignore (assoc3 "--help" speclist); []
+    with Not_found ->
+            ["--help", Unit help_action, " Display this list of options"]
+  in
+  speclist @ (add1 @ add2)
+;;
+
 let usage_b buf speclist errmsg =
   bprintf buf "%s\n" errmsg;
-  List.iter (print_spec buf) speclist;
-  try ignore (assoc3 "-help" speclist)
-  with Not_found -> bprintf buf "  -help   Display this list of options\n";
-  try ignore (assoc3 "--help" speclist)
-  with Not_found -> bprintf buf "  --help  Display this list of options\n";
+  List.iter (print_spec buf) (add_help speclist);
 ;;
 
 let usage speclist errmsg =
@@ -202,3 +213,35 @@ let parse l f msg =
   | Bad msg -> eprintf "%s" msg; exit 2;
   | Help msg -> printf "%s" msg; exit 0;
 ;;
+
+let rec second_word s =
+  let len = String.length s in
+  let rec loop n =
+    if n >= len then len
+    else if s.[n] = ' ' then loop (n+1)
+    else n
+  in
+  try loop (String.index s ' ')
+  with Not_found -> len
+;;
+
+let max_arg_len cur (kwd, _, doc) =
+  max cur (String.length kwd + second_word doc)
+;;
+
+let add_padding len ksd =
+  match ksd with
+  | (_, Symbol _, _) -> ksd
+  | (kwd, spec, msg) ->
+      let cutcol = second_word msg in
+      let spaces = String.make (len - String.length kwd - cutcol) ' ' in
+      let prefix = String.sub msg 0 cutcol in
+      let suffix = String.sub msg cutcol (String.length msg - cutcol) in
+      (kwd, spec, prefix ^ spaces ^ suffix)
+;;
+
+let align speclist =
+  let completed = add_help speclist in
+  let len = List.fold_left max_arg_len 0 completed in
+  List.map (add_padding len) completed
+;;
diff --git a/stdlib/arg.mli b/stdlib/arg.mli
index 52324d084..8203e8313 100644
--- a/stdlib/arg.mli
+++ b/stdlib/arg.mli
@@ -120,6 +120,13 @@ val usage : (key * spec * doc) list -> usage_msg -> unit
     {!Arg.parse} prints in case of error.
     [speclist] and [usage_msg] are the same as for [Arg.parse]. *)
 
+val align: (key * spec * doc) list -> (key * spec * doc) list;;
+(** Align the documentation strings by inserting spaces at the first
+    space, according to the length of the keyword.  Use a
+    space as the first character in a doc string if you want to
+    align the whole string.  The doc strings corresponding to
+    [Symbol] arguments are not aligned. *)
+
 val current : int ref
 (** Position (in {!Sys.argv}) of the argument being processed.  You can
     change this value, e.g. to force {!Arg.parse} to skip some arguments.