Initial work on command line completions

completion/bash-completion.sh

@@ -0,0 +1,25 @@
+_NAME() {
+  local prefix="${COMP_WORDS[COMP_CWORD]}"
+  COMP_WORDS[COMP_CWORD]="+cmdliner_complete:${COMP_WORDS[COMP_CWORD]}"
+  local line="env COMP_RUN=1 ${COMP_WORDS[@]}"
+  while read type; do
+    if [[ $type == 'dir' ]] && (type compopt &> /dev/null); then
+      if [[ $prefix != -* ]]; then
+        COMPREPLY+=( $(compgen -d "$prefix") )
+      fi
+    elif [[ $type == 'file' ]] && (type compopt &> /dev/null); then
+      if [[ $prefix != -* ]]; then
+        COMPREPLY+=( $(compgen -f "$prefix") )
+      fi
+    elif [[ $type == 'item' ]]; then
+      read value;
+      read _doc;
+      COMPREPLY+=($value)
+    fi
+  done < <(eval $line)
+  return 0
+}
+_NAME_setup() {
+  complete -F _NAME NAME
+}
+_NAME_setup;

completion/zsh-completion.sh

@@ -0,0 +1,50 @@
+# This is a template zsh script which defines a completion function for a
+# cmdliner based program.
+#
+# The NAME is the program name, should be replaced when eval'ing this script,
+# for example:
+#
+#   eval "$(cat set-zsh-completion.sh | sed 's/NAME/myprog/g')"
+# 
+# The script:
+#
+# 1. Invokes the program with no arguments but COMP_CWORD, COMP_NWORD and
+# COMP_WORD# envrironment variables set, where # is the number from 1 to
+# COMP_NWORD, the COMP_CWORD designates the position where completion is
+# requested.
+# 
+# 2. It expects the output on stdout from the program where each three lines
+# are:
+#
+#   item
+#   COMPLETION
+#   DESCRIPTION
+#
+# or a single line (to activate filename completion):
+#
+#   file
+#
+# or a single line (to activate directory completion):
+#
+#   dir
+
+function _NAME {
+  words[CURRENT]="+cmdliner_complete:${words[CURRENT]}"
+  local line="env COMP_RUN=1 ${(@)words}"
+  local -a completions
+  response=("${(@f)$(eval $line)}")
+  for t key desc in ${response}; do
+    if [[ "$t" == "item" ]]; then
+      completions+=("$key":"$desc")
+    elif [[ "$t" == "dir" ]]; then
+      _path_files -/
+    elif [[ "$t" == "file" ]]; then
+      _path_files -f
+    fi
+  done
+  if [ -n "$completions" ]; then
+    _describe -V unsorted completions -U
+  fi
+}
+
+compdef _NAME NAME

src/cmdliner.mli

@@ -898,7 +898,9 @@ module Arg : sig
 
   val info :
     ?deprecated:string -> ?absent:string -> ?docs:string -> ?docv:string ->
-    ?doc:string -> ?env:Cmd.Env.info -> string list -> info
+    ?doc:string -> ?env:Cmd.Env.info -> 
+    ?complete:[ `Complete_custom of unit -> (string * string) list | `Complete_dir | `Complete_file ] ->
+    string list -> info
   (** [info docs docv doc env names] defines information for
       an argument.
       {ul

src/cmdliner_arg.mli

@@ -37,7 +37,9 @@ type 'a t = 'a Cmdliner_term.t
 type info
 val info :
   ?deprecated:string -> ?absent:string -> ?docs:string -> ?docv:string ->
-  ?doc:string -> ?env:env -> string list -> info
+  ?doc:string -> ?env:env -> 
+  ?complete:[ `Complete_custom of unit -> (string * string) list | `Complete_dir | `Complete_file ] ->
+  string list -> info
 
 val ( & ) : ('a -> 'b) -> 'a -> 'b
 

src/cmdliner_base.ml

@@ -80,8 +80,9 @@ let pp_lines ppf s =
   in
   loop 0 s
 
+let is_space = function ' ' | '\n' | '\r' | '\t' -> true | _ -> false
+
 let pp_tokens ~spaces ppf s = (* collapse white and hint spaces (maybe) *)
-  let is_space = function ' ' | '\n' | '\r' | '\t' -> true | _ -> false in
   let i_max = String.length s - 1 in
   let flush start stop = pp_str ppf (String.sub s start (stop - start + 1)) in
   let rec skip_white i =

src/cmdliner_base.mli

@@ -58,3 +58,4 @@ val t4 :
   ('a * 'b * 'c * 'd) conv
 
 val env_bool_parse : bool parser
+val is_space : char -> bool

src/cmdliner_cline.ml

@@ -87,6 +87,18 @@ let hint_matching_opt optidx s =
   | true, [] -> [short_opt]
   | true, l -> if List.mem short_opt l then l else short_opt :: l
 
+let complete_prefix = "+cmdliner_complete:"
+
+let maybe_complete_token s =
+  if String.starts_with ~prefix:complete_prefix s
+  then
+    let drop = String.length complete_prefix in
+    Some (String.sub s drop (String.length s - drop))
+  else None
+
+exception Completion_requested of 
+  string * [ `Opt of Cmdliner_info.Arg.t | `Arg of Cmdliner_info.Arg.t | `Any ]
+
 let parse_opt_args ~peek_opts optidx cl args =
   (* returns an updated [cl] cmdline according to the options found in [args]
      with the trie index [optidx]. Positional arguments are returned in order
@@ -109,8 +121,11 @@ let parse_opt_args ~peek_opts optidx cl args =
               | [] -> None, args
               | v :: rest -> if is_opt v then None, args else Some v, rest
           in
+          (match Option.bind value maybe_complete_token with
+          | Some prefix -> raise (Completion_requested (prefix, `Opt a))
+          | None ->
           let arg = O ((k, name, value) :: opt_arg cl a) in
-          loop errs (k + 1) (Amap.add a arg cl) pargs args
+          loop errs (k + 1) (Amap.add a arg cl) pargs args)
       | `Not_found when peek_opts -> loop errs (k + 1) cl pargs args
       | `Not_found ->
           let hints = hint_matching_opt optidx s in
@@ -129,11 +144,14 @@ let parse_opt_args ~peek_opts optidx cl args =
 
 let take_range start stop l =
   let rec loop i acc = function
-  | [] -> List.rev acc
+  | [] -> `Range (List.rev acc)
   | v :: vs ->
+      match maybe_complete_token v with
+      | Some prefix -> `Complete prefix
+      | None ->
       if i < start then loop (i + 1) acc vs else
       if i <= stop then loop (i + 1) (v :: acc) vs else
-      List.rev acc
+      `Range (List.rev acc)
   in
   loop 0 [] l
 
@@ -159,7 +177,11 @@ let process_pos_args posidx cl pargs =
       | Some n -> pos rev (Cmdliner_info.Arg.pos_start apos + n - 1)
       in
       let start, stop = if rev then stop, start else start, stop in
-      let args = take_range start stop pargs in
+      let args = 
+        match take_range start stop pargs with
+        | `Range args -> args
+        | `Complete prefix -> raise (Completion_requested (prefix, `Arg a))
+      in
       let max_spec = max stop max_spec in
       let cl = Amap.add a (P args) cl in
       let misses = match Cmdliner_info.Arg.is_req a && args = [] with
@@ -169,17 +191,30 @@ let process_pos_args posidx cl pargs =
       loop misses cl max_spec al
   in
   let misses, cl, max_spec = loop [] cl (-1) posidx in
-  if misses <> [] then Error (Cmdliner_msg.err_pos_misses misses, cl) else
+  let consume_excess () =
+    match take_range (max_spec + 1) last pargs with
+    | `Range args -> args
+    | `Complete prefix -> raise (Completion_requested (prefix, `Any))
+  in
+  if misses <> [] then (
+    let _ : string list = consume_excess () in
+    Error (Cmdliner_msg.err_pos_misses misses, cl)) else
   if last <= max_spec then Ok cl else
-  let excess = take_range (max_spec + 1) last pargs in
-  Error (Cmdliner_msg.err_pos_excess excess, cl)
+  Error (Cmdliner_msg.err_pos_excess (consume_excess ()), cl)
 
 let create ?(peek_opts = false) al args =
   let optidx, posidx, cl = arg_info_indexes al in
+  try
   match parse_opt_args ~peek_opts optidx cl args with
-  | Ok (cl, _) when peek_opts -> Ok cl
-  | Ok (cl, pargs) -> process_pos_args posidx cl pargs
-  | Error (errs, cl, _) -> Error (errs, cl)
+  | Ok (cl, _) when peek_opts -> `Ok cl
+  | Ok (cl, pargs) -> 
+    (match process_pos_args posidx cl pargs with 
+    | Ok v -> `Ok v 
+    | Error v -> `Error v)
+  | Error (errs, cl, pargs) ->
+    let _ : _ result = process_pos_args posidx cl pargs in
+    `Error (errs, cl)
+  with Completion_requested (prefix, kind) -> `Completion (prefix, kind)
 
 let deprecated_msgs cl =
   let add i arg acc = match Cmdliner_info.Arg.deprecated i with

src/cmdliner_cline.mli

@@ -9,7 +9,10 @@ type t
 
 val create :
   ?peek_opts:bool -> Cmdliner_info.Arg.Set.t -> string list ->
-  (t, string * t) result
+  [ `Ok of t
+  | `Completion of 
+    string * [ `Opt of Cmdliner_info.Arg.t | `Arg of Cmdliner_info.Arg.t | `Any ]
+  | `Error of string * t ]
 
 val opt_arg : t -> Cmdliner_info.Arg.t -> (int * string * (string option)) list
 val pos_arg : t -> Cmdliner_info.Arg.t -> string list

src/cmdliner_completion.ml

@@ -0,0 +1,76 @@
+let zsh_completion name = Printf.sprintf {|# This is a template zsh script which defines a completion function for a
+# cmdliner based program.
+#
+# The %s is the program name, should be replaced when eval'ing this script,
+# for example:
+#
+#   eval "$(cat set-zsh-completion.sh | sed 's/%s/myprog/g')"
+# 
+# The script:
+#
+# 1. Invokes the program with no arguments but COMP_CWORD, COMP_NWORD and
+# COMP_WORD# envrironment variables set, where # is the number from 1 to
+# COMP_NWORD, the COMP_CWORD designates the position where completion is
+# requested.
+# 
+# 2. It expects the output on stdout from the program where each three lines
+# are:
+#
+#   item
+#   COMPLETION
+#   DESCRIPTION
+#
+# or a single line (to activate filename completion):
+#
+#   file
+#
+# or a single line (to activate directory completion):
+#
+#   dir
+
+function _%s {
+  words[CURRENT]="+cmdliner_complete:${words[CURRENT]}"
+  local line="env COMP_RUN=1 ${(@)words}"
+  local -a completions
+  response=("${(@f)$(eval $line)}")
+  for t key desc in ${response}; do
+    if [[ "$t" == "item" ]]; then
+      completions+=("$key":"$desc")
+    elif [[ "$t" == "dir" ]]; then
+      _path_files -/
+    elif [[ "$t" == "file" ]]; then
+      _path_files -f
+    fi
+  done
+  if [ -n "$completions" ]; then
+    _describe -V unsorted completions -U
+  fi
+}
+
+compdef _%s %s
+|} name name name name name;;let bash_completion name = Printf.sprintf {|_%s() {
+  local prefix="${COMP_WORDS[COMP_CWORD]}"
+  COMP_WORDS[COMP_CWORD]="+cmdliner_complete:${COMP_WORDS[COMP_CWORD]}"
+  local line="env COMP_RUN=1 ${COMP_WORDS[@]}"
+  while read type; do
+    if [[ $type == 'dir' ]] && (type compopt &> /dev/null); then
+      if [[ $prefix != -* ]]; then
+        COMPREPLY+=( $(compgen -d "$prefix") )
+      fi
+    elif [[ $type == 'file' ]] && (type compopt &> /dev/null); then
+      if [[ $prefix != -* ]]; then
+        COMPREPLY+=( $(compgen -f "$prefix") )
+      fi
+    elif [[ $type == 'item' ]]; then
+      read value;
+      read _doc;
+      COMPREPLY+=($value)
+    fi
+  done < <(eval $line)
+  return 0
+}
+_%s_setup() {
+  complete -F _%s %s
+}
+_%s_setup;
+|} name name name name name;;