Arg.align: optionally use '\t' as alignment separator

Arg.align now optionally uses the tab character '\t' to separate the "unaligned"
and "aligned" parts of the documentation string. If tab is not present, then
space is used as a fallback. Allows to have spaces in the unaligned part, which
is useful for Tuple options.

Author: nojb

Changes

@@ -61,6 +61,11 @@ Working version
 
 - Resurrect tabulation boxes in module Format. Rewrite/extend documentation
   of tabulation boxes.
+- PR#7515, GPR#1147: Arg.align now optionally uses the tab character '\t' to
+  separate the "unaligned" and "aligned" parts of the documentation string. If
+  tab is not present, then space is used as a fallback. Allows to have spaces in the
+  unaligned part, which is useful for Tuple options.
+  (Nicolas Ojeda Bar, review by ...)
 
 ### Compiler user-interface and warnings:
 

stdlib/arg.ml

@@ -304,20 +304,32 @@ let parse_expand l f msg =
 
 let 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
+  let rec loop sep n =
+    if n >= len then sep, len
+    else if s.[n] = sep then loop sep (n+1)
+    else sep, n
   in
-  try loop (String.index s ' ')
-  with Not_found -> len
+  match String.index s '\t' with
+  | n -> loop '\t' n
+  | exception Not_found ->
+      begin match String.index s ' ' with
+      | n -> loop ' ' n
+      | exception Not_found -> ' ', len
+      end
 
 
 let max_arg_len cur (kwd, spec, doc) =
   match spec with
   | Symbol _ -> max cur (String.length kwd)
-  | _ -> max cur (String.length kwd + second_word doc)
+  | _ -> max cur (String.length kwd + snd (second_word doc))
+
 
+let sub_subst s n sep =
+  let last_sep = ref (-1) in
+  let f i =
+    if s.[i] = sep && (!last_sep < 0 || !last_sep = i-1) then (last_sep := i; ' ') else s.[i]
+  in
+  String.init n f
 
 let add_padding len ksd =
   match ksd with
@@ -326,18 +338,18 @@ let add_padding len ksd =
        * run through [usage] or [parse]. *)
       ksd
   | (kwd, (Symbol _ as spec), msg) ->
-      let cutcol = second_word msg in
+      let sep, cutcol = second_word msg in
       let spaces = String.make ((max 0 (len - cutcol)) + 3) ' ' in
-      (kwd, spec, "\n" ^ spaces ^ msg)
+      (kwd, spec, "\n" ^ spaces ^ sub_subst msg (String.length msg) sep)
   | (kwd, spec, msg) ->
-      let cutcol = second_word msg in
+      let sep, cutcol = second_word msg in
       let kwd_len = String.length kwd in
       let diff = len - kwd_len - cutcol in
       if diff <= 0 then
-        (kwd, spec, msg)
+        (kwd, spec, sub_subst msg (String.length msg) sep)
       else
         let spaces = String.make diff ' ' in
-        let prefix = String.sub msg 0 cutcol in
+        let prefix = sub_subst msg cutcol sep in
         let suffix = String.sub msg cutcol (String.length msg - cutcol) in
         (kwd, spec, prefix ^ spaces ^ suffix)
 

stdlib/arg.mli

@@ -168,14 +168,13 @@ val usage_string : (key * spec * doc) list -> usage_msg -> string
     if provided with the same parameters. *)
 
 val align: ?limit: int -> (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 aligned on the next line.
-    @param limit options with keyword and message longer than
-    [limit] will not be used to compute the alignment.
-*)
+(** Align the documentation strings by inserting spaces at the first alignment
+    separator (tab or, if tab is not found, space), according to the length of
+    the keyword.  Use a alignment separator as the first character in a doc
+    string if you want to align the whole string.  The doc strings corresponding
+    to [Symbol] arguments are aligned on the next line.
+    @param limit options with keyword and message longer than [limit] will not
+    be used to compute the alignment. *)
 
 val current : int ref
 (** Position (in {!Sys.argv}) of the argument being processed.  You can

testsuite/tests/lib-arg/testarg.ml

@@ -187,3 +187,18 @@ let test_expand spec argv reference =
 
 test_expand (expand1@spec) args1 expected1;;
 test_expand (expand2@spec) args2 expected2;;
+
+let test_align () =
+  let spec =
+    [
+      "-foo", Arg.String ignore, "FOO Do foo with FOO";
+      "-bar", Arg.Tuple [Arg.String ignore; Arg.String ignore], "FOO BAR\tDo bar with FOO and BAR";
+      "-cha", Arg.Unit ignore, " Another option";
+      "-sym", Arg.Symbol (["a"; "b"], ignore), "\ty\tfoo";
+      "-sym2", Arg.Symbol (["a"; "b"], ignore), "x bar";
+    ]
+  in
+  print_endline (Arg.usage_string (Arg.align spec) "")
+;;
+
+test_align ();;

testsuite/tests/lib-arg/testarg.reference

@@ -0,0 +1,11 @@
+
+  -foo FOO     Do foo with FOO
+  -bar FOO BAR Do bar with FOO and BAR
+  -cha         Another option
+  -sym {a|b}
+               y	foo
+  -sym2 {a|b}
+             x bar
+  -help        Display this list of options
+  --help       Display this list of options
+