Even more completion and help work

command-interface/building.dylan

@@ -111,8 +111,9 @@ define method build-named-parameter (command :: <command-node>, names :: <sequen
                     keys);
   let syms = #();
   for (name in names)
-    let sym = make(<symbol-node>,
+    let sym = make(<parameter-symbol-node>,
                    symbol: as(<symbol>, name),
+                   parameter: param,
                    repeatable?: node-repeatable?(param),
                    repeat-marker: param,
                    successors: list(param));

command-interface/completion.dylan

@@ -11,6 +11,12 @@ define class <command-completion> (<object>)
   /* node the completion was performed for */
   constant slot completion-node :: <parse-node>,
     required-init-keyword: node:;
+  /* Value placeholder for help */
+  constant slot completion-help-symbol :: false-or(<string>) = #f,
+    init-keyword: help-symbol:;
+  /* Main help text */
+  constant slot completion-help-text :: false-or(<string>) = #f,
+    init-keyword: help-text:;
   /* token used to hint the completion, if provided */
   constant slot completion-token :: false-or(<command-token>) = #f,
     init-keyword: token:;
@@ -30,6 +36,7 @@ define method initialize (completion :: <command-completion>,
                           #rest args, #key, #all-keys)
  => ();
   next-method();
+  // initialize reverse links
   for (option in completion.completion-options)
     option-completion(option) := completion;
   end;
@@ -44,6 +51,7 @@ end method;
  * values.
  */
 define class <command-completion-option> (<object>)
+  /* normally initialized by make(<completion>) */
   slot option-completion :: false-or(<command-completion>) = #f;
   /* string for this option */
   constant slot option-string :: <string>,
@@ -61,7 +69,11 @@ define function make-completion (node :: <parse-node>,
                                  #key exhaustive? :: <boolean> = #f,
                                       complete-options :: <sequence> = #(),
                                       other-options :: <sequence> = #())
- => (completion :: <command-completion>);
+  => (completion :: <command-completion>);
+  // get node help strings
+  let help-symbol = node-help-symbol(node);
+  let help-text = node-help-text(node);
+  // apply token restrictions
   if (token)
     let tokstr = token-string(token);
     // filter options using token
@@ -75,11 +87,14 @@ define function make-completion (node :: <parse-node>,
       end;
     end;
   end;
-  // add longest common prefix as an incomplete option
+  // add longest common prefix as an incomplete option,
+  // but filter it against existing options and the token
   let all-options = concatenate(complete-options, other-options);
   let lcp = longest-common-prefix(all-options);
   unless (empty?(lcp) | member?(lcp, all-options, test: \=))
-    other-options := add!(other-options, lcp);
+    unless (token & lcp = token-string(token))
+      other-options := add!(other-options, lcp);
+    end;
   end;
   // construct the result
   local method as-complete-option(string :: <string>)
@@ -91,6 +106,8 @@ define function make-completion (node :: <parse-node>,
   make(<command-completion>,
        node: node, token: token,
        exhaustive?: exhaustive?,
+       help-symbol: help-symbol,
+       help-text: help-text,
        options: concatenate-as(<list>,
                                map(as-complete-option, complete-options),
                                map(as-other-option, other-options)));

command-interface/help.dylan

@@ -30,53 +30,58 @@ define method show-command-help (nodes :: <sequence>, tokens :: <sequence>)
   let cmd-title :: <list> = #();
   let cmd-help :: false-or(<string>) = #f;
 
+  // find the last command node
   for (token in tokens, node in nodes)
     if (instance?(node, <command-node>))
-      if (~cmd)
-        cmd := node;
-        cmd-title := add(cmd-title, as(<string>, node-symbol(node)));
-        if (command-help(node))
-          cmd-help := command-help(node);
-        end if;
+      cmd := node;
+      cmd-title := add(cmd-title, as(<string>, node-symbol(node)));
+      if (command-help(node))
+        cmd-help := command-help(node);
       end if;
     end if;
   end for;
 
+  // complain if no command found
   if (~cmd)
     error("Incomplete command.");
   end;
 
+  // fudge the title
   cmd-title := reverse(cmd-title);
   cmd-title := map(as-lowercase, cmd-title);
 
+  // default help
   if (~cmd-help)
     cmd-help := "No help.";
   end;
 
-  format-out("\n");
-  format-out("  %s\n    %s\n\n", join(cmd-title, " "), cmd-help);
+  // determine possible successor nodes
+  let successors = node-successors(cmd);
+  let commands = choose(rcurry(instance?, <command-node>), successors);
+  local method is-param?(node :: <parse-node>)
+          => (param? :: <boolean>);
+          instance?(node, <parameter-node>) | instance?(node, <parameter-symbol-node>)
+        end;
+  let params = choose(is-param?, successors);
 
-  for (parameter in command-parameters(cmd))
-    let param-help = parameter-help(parameter);
-    if (~param-help)
-      param-help := "No help.";
+  // print stuff
+  format-out("\n");
+  format-out("  %s\n    %s\n", join(cmd-title, " "), cmd-help);
+  format-out("\n");
+  unless (empty?(commands))
+    format-out("  Subcommands:\n");
+    for (command in commands)
+      format-out("    %s\n", node-help-symbol(command));
+      format-out("      %s\n", node-help-text(command));
     end;
-    select (parameter-kind(parameter))
-      #"flag" =>
-        begin
-          format-out("    %s\n", parameter-name(parameter));
-          format-out("     %s\n", param-help);
-        end;
-      #"simple" =>
-        begin
-          format-out("    <%s>\n", parameter-name(parameter));
-          format-out("      %s\n", param-help);
-        end;
-      #"named" =>
-        begin
-          format-out("    %s <value>\n", parameter-name(parameter));
-          format-out("      %s\n", param-help);
-        end;
+    format-out("\n");
+  end;
+  unless (empty?(params))
+    format-out("  Parameters:\n");
+    for (param in params)
+      format-out("    %s\n", node-help-symbol(param));
+      format-out("      %s\n", node-help-text(param));
     end;
+    format-out("\n");
   end;
 end method;

command-interface/macros.dylan

@@ -33,7 +33,7 @@ define macro command-aux-definer
                             ?bindings;
                             ?implementation;
                           end method;
-           let %command = build-command(%root, %symbols, handler: %handler, ?keywords);
+           let %command = build-command(%root, %symbols, ?keywords);
            ?parameters
          end }
 
@@ -71,6 +71,8 @@ define macro command-aux-definer
     { } => { }
     { help ?text:expression; ... }
       => { help: ?text, ... }
+    { implementation ?:expression; ... }
+      => { handler: %handler, ... }
     { ?other:*; ... } => { ... }
 
   // definitions that define parameters

command-interface/nodes.dylan

@@ -49,6 +49,12 @@ define abstract class <parse-node> (<object>)
     init-keyword: repeat-marker:;
 end class;
 
+define open generic node-help-symbol (node :: <parse-node>)
+ => (help-symbol :: <string>);
+
+define open generic node-help-text (node :: <parse-node>)
+ => (help-text :: <string>);
+
 /* Generate completions for the given node
  *
  * May or may not be provided a partial token.
@@ -69,6 +75,16 @@ define open generic node-accept ( node :: <parse-node>, parser :: <command-parse
  => ();
 
 
+define method node-help-symbol (node :: <parse-node>)
+ => (help-symbol :: <string>);
+  "<...>";
+end method;
+
+define method node-help-text (node :: <parse-node>)
+ => (help-symbol :: <string>);
+  "No help.";
+end method;
+
 /* Is the node acceptable as next node in given parser state?
  *
  * This prevents non-repeatable parameters from being added again.
@@ -148,6 +164,16 @@ define method print-object(object :: <symbol-node>, stream :: <stream>) => ();
   format(stream, "%s", node-symbol(object));
 end method;
 
+define method node-help-symbol (node :: <symbol-node>)
+ => (help-symbol :: <string>);
+  as(<string>, node-symbol(node));
+end method;
+
+define method node-help-text (node :: <symbol-node>)
+ => (help-symbol :: <string>);
+  "";
+end method;
+
 define method node-match (node :: <symbol-node>, parser :: <command-parser>, token :: <command-token>)
  => (matched? :: <boolean>);
   starts-with?(as(<string>, node-symbol(node)),
@@ -186,13 +212,25 @@ define method print-object(object :: <command-node>, stream :: <stream>) => ();
   format(stream, "%s - %s", node-symbol(object), command-help(object));
 end method;
 
+define method node-help-text (node :: <command-node>)
+ => (help-text :: <string>);
+  command-help(node) | "Command";
+end method;
+
 define method node-accept (node :: <command-node>, parser :: <command-parser>, token :: <command-token>)
  => ();
   if (command-handler(node))
     parser-push-command(parser, node);
   end
 end method;
 
+define method node-complete (node :: <command-node>, parser :: <command-parser>, token :: false-or(<command-token>))
+ => (completion :: <command-completion>);
+  make-completion(node, token,
+                  exhaustive?: #t,
+                  complete-options: list(as(<string>, node-symbol(node))));
+end method;
+
 define method command-add-parameter (node :: <command-node>, parameter :: <parameter-node>)
  => ();
   command-parameters(node) := add!(command-parameters(node), parameter);
@@ -224,6 +262,32 @@ define method node-successors (node :: <wrapper-node>)
   concatenate(node-successors(wrapper-root(node)), next-method());
 end method;
 
+
+/* A symbol that comes before a parameter
+ */
+define class <parameter-symbol-node> (<symbol-node>)
+  constant slot symbol-parameter :: <parameter-node>,
+    init-keyword: parameter:;
+end class;
+
+define method node-help-symbol (node :: <parameter-symbol-node>)
+ => (help-symbol :: <string>);
+  let parameter = symbol-parameter(node);
+  concatenate(as(<string>, node-symbol(node)),
+              " <", as(<string>, parameter-name(parameter)),
+              if (node-repeatable?(parameter))
+                ">..."
+              else
+                ">"
+              end);
+end method;
+
+define method node-help-text (node :: <parameter-symbol-node>)
+ => (help-text :: <string>);
+  node-help-text(symbol-parameter(node));
+end method;
+
+
 /* Syntactical kinds of parameters
  */
 define constant <parameter-kind> = one-of(#"simple", #"named", #"flag");
@@ -245,6 +309,21 @@ define open abstract class <parameter-node> (<parse-node>)
     init-keyword: value-type:;
 end class;
 
+define method node-help-symbol (node :: <parameter-node>)
+ => (help-symbol :: <string>);
+  concatenate("<", as(<string>, parameter-name(node)),
+              if (node-repeatable?(node))
+                ">..."
+              else
+                ">"
+              end)
+end method;
+
+define method node-help-text (node :: <parameter-node>)
+ => (help-symbol :: <string>);
+  parameter-help(node) | "Parameter";
+end method;
+
 /* Parameters can be converted to values
  *
  * By default they convert to simple strings.
@@ -299,9 +378,19 @@ end class;
 
 /* Flag parameters
  */
-define class <flag-node> (<parameter-node>, <symbol-node>)
+define class <flag-node> (<parameter-node>, <parameter-symbol-node>)
 end class;
 
+define method node-help-symbol (node :: <flag-node>)
+ => (help-symbol :: <string>);
+  as(<string>, parameter-name(node));
+end method;
+
+define method node-help-text (node :: <flag-node>)
+ => (help-symbol :: <string>);
+  parameter-help(node) | "Flag";
+end method;
+
 define method parameter-convert (parser :: <command-parser>, node :: <flag-node>, token :: <command-token>)
  => (value :: <boolean>);
   #t;
@@ -338,6 +427,15 @@ define class <oneof-node> (<parameter-node>)
     required-init-keyword: alternatives:;
 end class;
 
+define method node-help-text (node :: <oneof-node>)
+  => (help-symbol :: <string>);
+  let alternatives = oneof-alternatives(node);
+  unless (oneof-case-sensitive?(node))
+    alternatives := map(as-lowercase, alternatives);
+  end;
+  parameter-help(node) | concatenate("One of: ", join(alternatives, ", "));
+end method;
+
 define method node-match (node :: <oneof-node>, parser :: <command-parser>, token :: <command-token>)
  => (matched? :: <boolean>);
   let string = token-string(token);