Add std/cli, move std/getopt there

Import a bunch of CLI utilities from gerbil-utils into std/cli;
tweak them, document them, test them:
  - multicall to support multiple subcommands in a more modular way
  - getopt translation to Scheme calling convention
  - print-exit to print results of Scheme computation at the CLI
  - shell to support escaping strings for the shell

Add a few corresponding utilities to std/error

Move std/getopt to std/cli/getopt with its brothers;
leave a compatibility shim at std/getopt.

doc/.vuepress/config.js

@@ -121,6 +121,17 @@ module.exports = {
                         ]
                       },
 
+                      { title: "Unix Command Line Interface",
+                        path: "/reference/std/cli/",
+                        children: [
+                            "cli/",
+                            "cli/getopt",
+                            "cli/shell",
+                            "cli/print-exit",
+                            "cli/multicall",
+                        ]
+                      },
+
                       { title: "Databases and Key-Value Stores",
                         path: "/reference/std/db/",
                         children: [

doc/reference/std/cli/README.md

@@ -0,0 +1,7 @@
+# Unix Command Line Interface
+
+The following libraries are provided to support the Unix Command Line Interface (CLI):
+- [:std/cli/getopt](getopt.md)
+- [:std/cli/shell](shell.md)
+- [:std/cli/print-exit](print-exit.md)
+- [:std/cli/multicall](multicall.md)

doc/reference/std/cli/getopt.md

@@ -0,0 +1,269 @@
+# Command Line Argument Parsing
+
+The `:std/cli/getopt` library provides facilities for command line argument parsing.
+
+::: tip usage
+```scheme
+(import :std/cli/getopt)
+```
+:::
+
+This library used to be available as `:std/getopt` up to Gerbil v0.18,
+and is still available under that name for now, but its use is deprecated.
+
+## Interface
+
+### getopt
+```scheme
+(getopt <specifier> ...)
+=> <parser>
+
+specifier:
+ (command id [help: text] <cmd-specifier>)
+ <cmd-specifier> ...
+
+cmd-specifier:
+ (flag id short [long])
+ (option id short [long] [help: text] [value: proc] [default: value])
+ (argument id [help: text] [value: proc])
+ (optional-argument id [help: text] [value: proc] [default: value])
+ (rest-arguments id [help: text] [value: proc])
+```
+
+`getopt` creates a command line parser, which can be used to parse arguments
+with `getopt-parse`.
+
+### getopt-parse
+```scheme
+(getopt-parse <parser> args)
+=> (values cmd-id options)
+   options
+```
+
+`getopt-parse` accepts a parser and a list of string arguments and parses
+according to the parser specification. If it is parsing a specification with
+subcommands, it returns two values, the command id and a hash table with the
+parsed options. Otherwise it just returns the hash table with the parsed options.
+An exception is raised if parsing the arguments fails.
+
+### getopt-error?
+```scheme
+(getopt-error? obj)
+=> boolean
+```
+
+If parsing fails, then a `getopt-error` is raised, which can be guarded with
+`getopt-error?`.
+
+### getopt-display-help
+```scheme
+(getopt-display-help <tip> program-name [port = (current-output-port)])
+
+tip:
+ <getopt-error>
+ <parser>
+ <command>
+```
+
+The procedure `getopt-display-help` can be used to display
+a help message for a getopt error according to the argument specification.
+
+### getopt-display-help-topic
+```scheme
+(getopt-display-help-topic <parser> topic program-name [port = (current-output-port)])
+```
+
+The procedure `getopt-display-help-topic` can be used to display a help page
+for a subcommand.
+
+### getopt?
+```scheme
+(getopt? obj)
+=> boolean
+```
+
+Returns true if the object is a getopt parser
+
+### getopt-object?
+```scheme
+(getopt-object? obj)
+=> boolean
+```
+
+Returns true if the object is a getopt command or command specifier.
+
+### call-with-getopt
+```scheme
+(call-with-getopt proc args
+                  program: program
+                  help: (help #f)
+                  exit-on-error: (exit-on-error? #t)
+                  . gopts)
+```
+
+This shim around getopt parsing eliminates all the repetitive
+boilerplate around argument parsing with getopt.
+
+It creates a getopt parser that parses with options `gopts`, automatically
+including a help option or command accordingly.
+
+It then uses the parser to pare `args`, handling the exceptions and
+displayin help accordingly; if `exit-on-error` is true (the default),
+then parsing errors will exit the program.
+
+If the parse succeeds it invokes `proc` with the output of the parse.
+
+## Example
+
+For an example, here the a command line parser for the `gxpkg` program:
+```scheme
+(def (main . args)
+  (def install-cmd
+    (command 'install help: "install one or more packages"
+             (rest-arguments 'pkg help: "package to install")))
+  (def uninstall-cmd
+    (command 'uninstall help: "uninstall one or more packages"
+             (flag 'force "-f" help: "force uninstall even if there are orphaned dependencies")
+             (rest-arguments 'pkg help: "package to uninstall")))
+  (def update-cmd
+    (command 'update help: "update one or more packages"
+             (rest-arguments 'pkg help: "package to update; all for all packages")))
+  (def link-cmd
+    (command 'link help: "link a local development package"
+             (argument 'pkg help: "package to link")
+             (argument 'src help: "path to package source directory")))
+  (def unlink-cmd
+    (command 'unlink help: "unlink one or more local development packages"
+             (flag 'force "-f" help: "force unlink even if there are orphaned dependencies")
+             (rest-arguments 'pkg help: "package to unlink")))
+  (def build-cmd
+    (command 'build help: "rebuild one or more packages and their dependents"
+             (rest-arguments 'pkg help: "package to build; all for all packages")))
+  (def clean-cmd
+    (command 'clean help: "clean compilation artefacts from one or more packages"
+             (rest-arguments 'pkg help: "package to clean")))
+  (def list-cmd
+    (command 'list help: "list installed packages"))
+  (def retag-cmd
+    (command 'retag help: "retag installed packages"))
+  (def search-cmd
+    (command 'search help: "search the package directory"
+             (rest-arguments 'keywords help: "keywords to search for")))
+
+  (call-with-getopt gxpkg-main args
+    program: "gxpkg"
+    help: "The Gerbil Package Manager"
+    install-cmd
+    uninstall-cmd
+    update-cmd
+    link-cmd
+    unlink-cmd
+    build-cmd
+    clean-cmd
+    list-cmd
+    retag-cmd
+    search-cmd))
+
+(def (gxpkg-main cmd opt)
+  (let-hash opt
+    (case cmd
+      ((install)
+       (install-pkgs .pkg))
+      ((uninstall)
+       (uninstall-pkgs .pkg .?force))
+      ((update)
+       (update-pkgs .pkg))
+      ((link)
+       (link-pkg .pkg .src))
+      ((unlink)
+       (unlink-pkgs .pkg .?force))
+      ((build)
+       (build-pkgs .pkg))
+      ((clean)
+       (clean-pkgs .pkg))
+      ((list)
+       (list-pkgs))
+      ((retag)
+       (retag-pkgs))
+      ((search)
+       (search-pkgs .keywords)))))
+```
+
+### getopt-parse-&gt;function-arguments
+```scheme
+(getopt-parse->function-arguments getopt h) => list-of-arguments
+```
+
+This function takes a `getopt` specification and table `h` of arguments
+resulting from calling `getopt-parse`, and returns a list of argument
+with which to call a Scheme function that has an analogous call convention:
+  - supplied positional arguments are passed in order
+  - they are followed by all the rest arguments
+  - they are followed by the remaining specified keyword arguments.
+
+Omitted option arguments without default will be omitted.
+Omitted option arguments with a default will be included with the default value;
+the programmer must ensure that this default value is the same as
+the default value from the Scheme function being called, or there will be
+a semantic discrepancy between the CLI interface and the underlying Scheme function.
+
+NB: `h` will be modified in place, removing positional and rest arguments.
+Make sure to use `hash-copy` if you want to preserve the original data.
+
+TODO: add examples
+
+### call-with-getopt-parse
+```scheme
+(call-with-getopt-parse gopt hash fun) => results-of-fun
+```
+
+Given a getopt specification `gopt`, the `hash` resulting from calling
+`getopt-parse` on some provided command-line arguments, and a function `fun`
+that has a calling convention analogous to that specified by `gopt`,
+call the function with arguments that correspond to those provided by `hash`,
+as per `getopt-parse->function-arguments`.
+
+TODO: add examples, discuss abort-on-error behavior,
+lack of automatic help, etc.
+
+### call-with-processed-command-line
+```scheme
+(call-with-processed-command-line processor command-line function) => results-of-function
+```
+
+Generic function of three arguments:
+  - a `processor` that describes a `getopt` specification,
+  - a `command-line`, list of strings as provided by the invoking process, and
+  - a `function` to be called with the results of processing the command-line.
+
+The function is generic in the first argument.
+The default method recognizes a `getopt` specification as first argument,
+and appropriately calls `getopt-parse` and `call-with-getopt-parse`
+to process the command-line. It also recognizes a list as being arguments
+to which to apply `getopt` to obtain a specification,
+with which to proceed as above.
+
+You may define more methods, to work with your own variant of `getopt`,
+or with innovative ways to incrementally compose `getopt` specifications
+e.g. with prototype objects like `gerbil-poo`.
+
+TODO: add examples, discuss abort-on-error behavior,
+lack of automatic help, etc.
+
+### -&gt;getopt-spec
+```scheme
+(->getopt-spec arg) => list-of-getopt-arguments
+```
+Given an argument `arg`, return a list *lst* of getopt arguments
+to which one can `(apply getopt lst)` to specify a getopt object to parse with.
+
+Default behavior:
+  - If `arg` is a list, `flatten` it.
+  - If `arg` is a natural integer *n*,
+    specify a list of *n* positional `argument`s.
+  - If `arg` is `#f`, specify a single `rest-argument` named `rest`,
+    i.e. let it be a passthrough to be processed by the function being called.
+  - Otherwise, raise an error.
+
+This function is useful for calls not just to `getopt` directly,
+but also to `command` that itself calls `getopt`, etc.

doc/reference/std/cli/multicall.md

@@ -0,0 +1,129 @@
+# Multicall Binaries
+
+The `:std/cli/multicall` module provides facilities to define multicall binaries
+the behavior of which differs depending on the name of the binary,
+just like the gerbil binary itself, or famously like `busybox`.
+
+::: tip usage
+```scheme
+(import :std/cli/multicall)
+```
+:::
+
+An earlier version of this library used to be available as `:clan/multicall`
+in gerbil-utils.
+
+## Interface
+
+### current-program
+```scheme
+(def current-program (make-parameter []))
+```
+A parameter that contains the name of the current program or subprogram,
+as a list in reverse of the successive subcommands used to invoke it.
+
+### current-program-string
+```scheme
+(def current-program (make-parameter []))
+```
+Return as a string of space-separated commands and subcommands in order
+the name of the current program or subprogram.
+
+### entry-points
+```scheme
+entry-points => table
+```
+A table, indexed by symbols, of `entry-point` structs,
+describing the available shell entry points.
+
+### entry-point
+```scheme
+(defstruct entry-point (name function help getopt) transparent: #t)
+```
+A struct type describing an available entry-point:
+  - `name` is a symbol, whose `symbol->string` is used as command or subcommand
+     to select the entry-point from the CLI.
+  - `function` is the Scheme function to call if the entry-point is selected.
+  - `help` is a short help string describing the purpose of the entry-point,
+     to be displayed to the user when help is requested.
+  - `getopt` is a `getopt-spec`
+    based on which the rest of the command-line will be parsed, and
+    based on which help about the available options is displayed.
+
+### entry-points-getopt-spec
+```scheme
+(entry-points-getopt-spec [table])
+```
+Given a `table` of entry-points which default to the variable `entry-points`,
+return a getopt-spec (suitable to be passed to `(apply getopt ...)`) of
+`command` specifiers, one for each registered entry-point, in asciibetical order.
+
+### register-entry-point
+```scheme
+(register-entry-point function
+  [id: #f] [name: #f] [help: #f] [getopt: #f])
+```
+Register the function as entry-point,
+with given `name` (argument passed to `make-symbol`),
+or if not specified, a symbol made of only the
+[`easy-shell-characters?`](shell.md#easy-shell-characters) of `id`.
+The entry-point will have the given `help` and `getopt` fields.
+
+### define-entry-point
+```scheme
+(define-entry-point (id . formals) (options ...) body ...)
+```
+Syntax that expands to both
+  1. defining in the current scope function with the given name `id`
+     and specified Scheme function formals, and the given `body`.
+  2. register an entry-point for that function,
+     with given `id` and `options`.
+
+### multicall-default
+```scheme
+multicall-default
+```
+A mutable variable that contains the default function to call
+if the command doesn’t match any of the specified commands.
+
+### set-default-entry-point!
+```scheme
+(set-default-entry-point! symbol)
+```
+Set the default entry-point in `multicall-default` as given `symbol`.
+
+### help
+```scheme
+(help [command])
+```
+Global entry-point to print a help message (about the command, if specified)
+about the current overall command and subcommands.
+
+### meta
+```scheme
+(meta)
+```
+Global entry-point to print the available completions for the command,
+for use with CLI syntax autodetection.
+
+### version
+```scheme
+(version [all?: #f] [layer])
+```
+Global entry-point to print the current version.
+If `all?` (flag `-a`) is passed, print all components from build manifest.
+If `layer` (flag `-l`) is passed, print the thus-named component.
+
+### call-entry-point
+```scheme
+(call-entry-point . args)
+```
+Call an entry point as specified by `args`,
+or else the `multicall-default` entry point.
+
+### define-multicall-main
+```scheme
+define-multicall-main
+```
+Define `call-entry-point` as a suitable `main` function
+in the current scope.

doc/reference/std/cli/print-exit.md

@@ -0,0 +1,101 @@
+# Print results and Exit
+
+The `:std/cli/print-exit` module helps you write functions that can be
+invoked either from the Scheme REPL or the Unix CLI, and in either case
+will print their computation results after their invocation.
+
+::: tip usage
+```scheme
+(import :std/cli/print-exit)
+```
+:::
+
+The facilities are named in a way reminiscent of REPL (Read-Eval-Print-Loop),
+except that instead of a form being Read and Eval'ed,
+a function is called or a body is evaluated as in `begin`,
+and after the Print part we Exit rather than Loop.
+
+## Interface
+
+### value-printer
+```scheme
+(define value-printer (make-parameter prn))
+```
+This parameter will return a function called on each value received
+by `print-exit` or `print-values`
+(unless there is a single value `(void)` that isn't printed).
+
+Defaults to `prn`. You could instead use `writeln` or `displayln`.
+
+### print-values
+```scheme
+(print-values . vs) => (void)
+```
+Process a list of values `vs` from a previous computation
+(as per `(call-with-values thunk print-values)`), and
+print each of those values (as applicable) using `(value-printer)`,
+unless there is a single value that is `(void)`
+in which case don't print anything
+(also don't print anything if provided no values as per `(values)`).
+
+Any values but `(void)` and `(values)` will thus cause the values to be printed,
+one by one, using `(value-printer)`, similar to how the Scheme REPL works.
+However, the Scheme REPL would use [`writeln`](../misc/ports.md#writeln) as its
+value printer, but the default `(value-printer)` above is
+[`prn`](../misc/repr.md#prn) which we found to be more useful in this situation.
+
+### print-exit
+```scheme
+(print-exit . vs) => [exit]
+```
+
+Process a list of values `vs` from a previous computation
+(as per `(call-with-values thunk print-exit)`), and
+(1) print those values using `print-values`, then
+(2) exit with an according exit code.
+
+Any values but `#f` and `(values)` will cause the exit code 0 to be returned,
+which the Unix shell will interpret as success or true.
+The values `#f` and `(values)` will cause the exit code 1 to be returned,
+which the Unix shell will interpret as failure or false.
+
+The value `(void)` will thus indicate a silent success,
+wherein nothing is printed and success is assumed, as is customary in Scheme.
+The value `(values)` meanwhile will thus indicate a silent failure,
+wherein nothing is printed and failure is assumed, of which however
+only the first part (nothing printed) is customary in Scheme, whereas the
+failure assumed is not customary in Scheme (but a false value would be assumed in e.g. CL).
+
+### silent-exit
+```scheme
+(silent-exit success?) => void-or-values
+```
+
+Takes a boolean `success?` and returns a multiple values
+that when passed to `print-exit` will not be printed, yet
+will cause return an error code that the Unix shell will interpret
+as success or true if the boolean is true, and
+failure or false if the boolean is false.
+
+`(void)` is the silent true exit returned if `success?` is true,
+and `(values)` is the silent false exit returned if it is false.
+
+### call-print-exit
+```scheme
+(call-print-exit fun) => [exit]
+```
+Call a function, print the resulting values (if applicable),
+and exit with an according exit code, as per `print-exit`.
+If an error occurs during execution,
+exit with an error code as per
+[`with-exit-on-error`](../error.md#with-exit-on-error).
+
+### begin-print-exit
+```scheme
+(begin-print-exit body ...) => [exit]
+```
+Evaluates the `body` as in an anonymous function called by `call-print-exit`.
+
+This macro is named in a way reminiscent of REPL (Read-Eval-Print-Loop),
+except instead of a form being Read and Eval'ed, the body is evaluated
+like `begin`, and after the Print part it Exits rather than Loops.

doc/reference/std/cli/shell.md

@@ -0,0 +1,94 @@
+# Shell Command Support
+
+The `:std/cli/shell` library provides facilities for working with Unix shell code
+
+::: tip usage
+```scheme
+(import :std/cli/shell)
+```
+:::
+
+An earlier version of this library used to be available as `:clan/shell`
+in gerbil-utils.
+
+## Interface
+
+### easy-shell-character?
+```scheme
+(easy-shell-character? character) => bool
+```
+
+Returns true if the `character` if a string may contain the character in any position
+without that this fact requiring the string to be quoted in any shell.
+This include alphanumeric characters and those in `"@%-_=+:,./"`
+(not including the double quotes).
+
+All other ASCII characters may require the string to be quoted.
+For good measure we also quote strings containing non-ASCII characters.
+
+::: tip Examples:
+```scheme
+> (string-for-each (lambda (c) (or (easy-shell-character? c) (error "foo")))
+    "abcdefghijklmnopqrstuvwxzABCDEFGHIJKLMNOPQRSTUVWXZ012345678@%-_=+:,./") ;; no error
+> (string-for-each (lambda (c) (or (not (easy-shell-character? c)) (error "foo")))
+    "!`~#$^&*()[{]}\\|;'\"<>? \r\n\t\v") ;; no error either
+```
+:::
+
+### needs-shell-escape?
+```scheme
+(needs-shell-escape? string) => bool
+```
+Returns true if the `string` is known not to require quoting in a Unix shell.
+
+The current implementation only trusts strings where every character
+satisfies `easy-shell-character?` to not require quoting.
+
+::: tip Examples:
+```scheme
+> (map needs-shell-escape ["foo?" "~user" "$1" "*.*" "!1" "ab\\cd" "{}" "a;b" "&amp;" "|" "a b  c"])
+(#t #t #t #t #t #t #t #t #t #t #t)
+> (map needs-shell-escape ["foo" "%-_=+:,./" "1" "..." "abcd" "x=y:z,t.z/u+v_w"])
+(#f #f #f #f #f #f)
+```
+:::
+
+### escape-shell-token
+```scheme
+(escape-shell-token string) => shell-escaped-string
+```
+Given a `string`, returns a shell-escaped-string that,
+when included in a Unix shell command, will expand into the input `string`.
+
+::: tip Examples:
+```scheme
+> (map escape-shell-token ["foo?" "~user" "$1" "*.*" "!1" "ab\\cd" "{}" "a;b" "&amp;" "|" "a b  c"])
+("\"foo?\"" "\"~user\"" "\"\\$1\"" "\"*.*\"" "\"!1\"" "\"ab\\\\cd\"" "\"{}\"" "\"a;b\"" "\"&amp;\"" "\"|\"" "\"a b  c\"")
+> (let (l ["foo" "%-_=+:,./" "1" "..." "abcd" "x=y:z,t.z/u+v_w"])
+    (equal? l (map escape-shell-token l)))
+#t
+```
+:::
+
+### -&gt;envvar
+```scheme
+(->envvar . str) => environment-variable-name
+```
+Given a list of arguments `str`, return a string to be used as
+a shell environment variable name following the convention of having
+only upper-case ASCII letters and digits and underscores.
+
+The arguments are passed to `as-string` then uppercased, and
+any non-empty sequence of characters other than letters and digits
+are replaced by a single underscore.
+
+::: tip Examples:
+``` scheme
+> (->envvar "foo")
+"FOO"
+> (->envvar "bar baz")
+"BAR_BAZ"
+> (->envvar '("bar " "+!@#$") #(#\@ #\! "#") "baz")
+"BAR_BAZ"
+```
+:::

doc/reference/std/errors.md

@@ -426,7 +426,23 @@ displaying the exception with `display-exception`).
 ```
 
 Invokes `thunk` with an exception handler that dumps the exception
-stack trace with `dump-stack-trace!`.
+stack trace with `dump-stack-trace!`
+if `(dump-stack-trace?)` is true (the default).
+
+### dump-stack-trace?
+```scheme
+(define dump-stack-trace? (make-parameter #t))
+```
+A parameter that controls whether `with-exception-stack-trace`
+will actually dump a stack trace to standard error.
+
+You can `(dump-stack-trace? #f)`
+or locally `(parameterize ((dump-stack-trace? #f)) ...)`
+to disable this stack trace dump,
+in case you are building a program for end-users rather than for developers,
+and want to control what limited error output they see.
+Or you can re-enable them based on a debug flag at the CLI
+in cases you want them to provide you with extra debugging information.
 
 ### dump-stack-trace!
 ```scheme
@@ -435,3 +451,38 @@ stack trace with `dump-stack-trace!`.
 
 Displays the exception `exn`, dumping the stack trace of continuation
 `cont` if there is no stack trace information in the exception itself.
+
+### exit-with-error
+```scheme
+(exit-with-error exception) => [exit]
+```
+Display the `exception` to current error port and exit with error code 2.
+
+### exit-on-error?
+```scheme
+(def exit-on-error? (make-parameter #t))
+```
+This parameter controls whether `call-with-exit-on-error`, `with-exit-on-error`,
+`call-with-getopt`, and any function that indirectly uses them,
+will exit if an error is caught, rather than pass on the error
+and return to the REPL (or let a more fundamental function exit).
+
+### call-with-exit-on-error
+```scheme
+(call-with-exit-on-error thunk)
+```
+Calls the `thunk` in an environment wherein if an error is caught and
+`(exit-on-error)` is true, `exit-with-error` will be called,
+causing an error message to be printed and the process to exit with exit code 2.
+If `(exit-on-error)` is false, the error will simply be raised again.
+
+This mechanism enables users to modify the parameter
+(e.g. via a flag passed at the Unix CLI or a change made at the Scheme REPL)
+and control whether to exit with an error (e.g. for end-users)
+or enter a debugger REPL (e.g. for developers).
+
+### with-exit-on-error
+```scheme
+(with-exit-on-error body ...)
+```
+Evaluates the `body` as in a `thunk` passed to `call-with-exit-on-error`.

doc/reference/std/getopt.md

@@ -1,188 +1,17 @@
 # Command Line Argument Parsing
 
-The `:std/getopt` library provides facilities for command line argument parsing.
+This is the old name of the `:std/cli/getopt` module,
+that provides facilities for command line argument parsing.
 
-::: tip usage
-(import :std/getopt)
-:::
-
-## Interface
-
-### getopt
-```scheme
-(getopt <specifier> ...)
-=> <parser>
-
-specifier:
- (command id [help: text] <cmd-specifier>)
- <cmd-specifier> ...
-
-cmd-specifier:
- (flag id short [long])
- (option id short [long] [help: text] [value: proc] [default: value])
- (argument id [help: text] [value: proc])
- (optional-argument id [help: text] [value: proc] [default: value])
- (rest-arguments id [help: text] [value: proc])
-
-```
-
-`getopt` creates a command line parser, which can be used to parse arguments
-with `getopt-parse`.
-
-### getopt-parse
-```scheme
-(getopt-parse <parser> args)
-=> (values cmd-id options)
-   options
-```
-
-`getopt-parse` accepts a parser and a list of string arguments and parses
-according to the parser specification. If it is parsing a specification with
-subcommands, it returns two values, the command id and a hash table with the
-parsed options. Otherwise it just returns the hash table with the parsed options.
-An exception is raised if parsing the arguments fails.
-
-### getopt-error?
-```scheme
-(getopt-error? obj)
-=> boolean
-```
-
-If parsing fails, then a `getopt-error` is raised, which can be guarded with
-`getopt-error?`.
-
-### getopt-display-help
-```scheme
-(getopt-display-help <tip> program-name [port = (current-output-port)])
-
-
-tip:
- <getopt-error>
- <parser>
- <command>
-```
-
-The procedure `getopt-display-help` can be used to display
-a help message for a getopt error according to the argument specification.
+As of Gerbil v0.19 this name is deprecated and
+you should be using the new library instead,
+but the old name remains available for now
+for the sake of backward compatibility.
 
-### getopt-display-help-topic
-```scheme
-(getopt-display-help-topic <parser> topic program-name [port = (current-output-port)])
-```
-
-The procedure `getopt-display-help-topic` can be used to display a help page
-for a subcommand.
-
-### getopt?
-```scheme
-(getopt? obj)
-=> boolean
-```
-
-Returns true if the object is a getopt parser
-
-### getopt-object?
-```scheme
-(getopt-object? obj)
-=> boolean
-```
-
-Returns true if the object is a getopt command or command specifier.
-
-### call-with-getopt
+::: tip usage
 ```scheme
-(call-with-getopt proc args
-                  program: program
-                  help: (help #f)
-                  exit-on-error: (exit-on-error? #t)
-                  . gopts)
+(import :std/cli/getopt)
 ```
+:::
 
-This shim around getopt parsing eliminates all the repetitive
-boilerplate around argument parsing with getopt.
-
-It creates a getopt parser that parses with options `gopts`, automatically
-including a help option or command accordingly.
-
-It then uses the parser to pare `args`, handling the exceptions and
-displayin help accordingly; if `exit-on-error` is true (the default),
-then parsing errors will exit the program.
-
-If the parse succeeds it invokes `proc` with the output of the parse.
-
-## Example
-
-For an example, here the a command line parser for the `gxpkg` program:
-```scheme
-(def (main . args)
-  (def install-cmd
-    (command 'install help: "install one or more packages"
-             (rest-arguments 'pkg help: "package to install")))
-  (def uninstall-cmd
-    (command 'uninstall help: "uninstall one or more packages"
-             (flag 'force "-f" help: "force uninstall even if there are orphaned dependencies")
-             (rest-arguments 'pkg help: "package to uninstall")))
-  (def update-cmd
-    (command 'update help: "update one or more packages"
-             (rest-arguments 'pkg help: "package to update; all for all packages")))
-  (def link-cmd
-    (command 'link help: "link a local development package"
-             (argument 'pkg help: "package to link")
-             (argument 'src help: "path to package source directory")))
-  (def unlink-cmd
-    (command 'unlink help: "unlink one or more local development packages"
-             (flag 'force "-f" help: "force unlink even if there are orphaned dependencies")
-             (rest-arguments 'pkg help: "package to unlink")))
-  (def build-cmd
-    (command 'build help: "rebuild one or more packages and their dependents"
-             (rest-arguments 'pkg help: "package to build; all for all packages")))
-  (def clean-cmd
-    (command 'clean help: "clean compilation artefacts from one or more packages"
-             (rest-arguments 'pkg help: "package to clean")))
-  (def list-cmd
-    (command 'list help: "list installed packages"))
-  (def retag-cmd
-    (command 'retag help: "retag installed packages"))
-  (def search-cmd
-    (command 'search help: "search the package directory"
-             (rest-arguments 'keywords help: "keywords to search for")))
-
-  (call-with-getopt gxpkg-main args
-    program: "gxpkg"
-    help: "The Gerbil Package Manager"
-    install-cmd
-    uninstall-cmd
-    update-cmd
-    link-cmd
-    unlink-cmd
-    build-cmd
-    clean-cmd
-    list-cmd
-    retag-cmd
-    search-cmd))
-
-(def (gxpkg-main cmd opt)
-  (let-hash opt
-    (case cmd
-      ((install)
-       (install-pkgs .pkg))
-      ((uninstall)
-       (uninstall-pkgs .pkg .?force))
-      ((update)
-       (update-pkgs .pkg))
-      ((link)
-       (link-pkg .pkg .src))
-      ((unlink)
-       (unlink-pkgs .pkg .?force))
-      ((build)
-       (build-pkgs .pkg))
-      ((clean)
-       (clean-pkgs .pkg))
-      ((list)
-       (list-pkgs))
-      ((retag)
-       (retag-pkgs))
-      ((search)
-       (search-pkgs .keywords)))))
-
-```
+<!-- See [:std/cli/getopt](cli/getopt.md) for the module documentation. -->

src/std/build-spec.ss

@@ -37,6 +37,11 @@
     "amb"
     "contract"
     (gxc: "interface" ,@(include-gambit-sharp))
+    ;; cli
+    "cli/getopt"
+    "cli/shell"
+    "cli/print-exit"
+    "cli/multicall"
     ;; stdio
     "io"
     "io/interface"

src/std/cli/multicall.ss

@@ -0,0 +1,97 @@
+;; -*- Gerbil -*-
+;;;; Support for building a single multicall binary that has all the fricfrac functionality.
+
+(export #t)
+
+(import
+  (only-in :std/cli/print-exit begin-print-exit)
+  (only-in :std/cli/shell easy-shell-character?)
+  (only-in :std/format format)
+  (only-in :std/generic defgeneric)
+  (only-in :std/getopt getopt getopt-display-help-topic getopt-display-help
+           call-with-processed-command-line ->getopt-spec
+           command flag option argument optional-argument rest-arguments)
+  (only-in :std/iter for/collect)
+  (only-in :std/misc/hash hash->list/sort)
+  (only-in :std/misc/list flatten)
+  (only-in :std/misc/number nat?)
+  (only-in :std/misc/string as-string<?)
+  (only-in :std/sort sort)
+  (only-in :std/srfi/13 string-filter)
+  (only-in :std/sugar defrule with-id))
+
+(def current-program (make-parameter []))
+(def entry-points (make-hash-table))
+
+(def (current-program-string (program (current-program)))
+  (string-join (reverse (flatten program)) " "))
+
+(defstruct entry-point (name function help getopt) transparent: #t)
+
+(def (entry-points-getopt-spec (h entry-points))
+  (for/collect (([name . e] (hash->list/sort h as-string<?)))
+    (apply command name help: (entry-point-help e)
+           (->getopt-spec (entry-point-getopt e)))))
+
+;; TODO: allow registering a getopt: structure and/or other command information,
+;; so we can show detailed help and automatically parse arguments?
+;; TODO: also allow a preprocess: function to further process the result of getopt (if specified)
+;; or the raw arguments (if no getopt specified).
+(def (register-entry-point function
+                           id: (id #f) name: (name #f) help: (help #f)
+                           getopt: (getopt #f))
+  (let (name (make-symbol (or name (string-filter easy-shell-character? (as-string id)))))
+    (hash-put! entry-points name (make-entry-point name function help getopt))))
+
+;; TODO: syntax to specify not just help, but getopt, etc.
+(defrule (define-entry-point (id . formals) (options ...) body ...)
+  (begin (def (id . formals) body ...)
+         (register-entry-point id id: 'id options ...)))
+
+(defmutable multicall-default 'help)
+
+(def (set-default-entry-point! x)
+  (set! multicall-default x))
+
+(define-entry-point (help (command #f))
+  (help: "Print help about available commands"
+   getopt: [(optional-argument 'command help: "subcommand for which to display help")])
+  (displayln (display-build-manifest (build-manifest/head)))
+  (def gopt (getopt (entry-points-getopt-spec)))
+  (def program (current-program-string (cdr (current-program))))
+  (if command
+    (getopt-display-help-topic gopt (make-symbol command) program)
+    (getopt-display-help gopt program)))
+
+;; TODO: also handle getopt specifications?
+(define-entry-point (meta)
+  (help: "Print meta-information for completion purposes"
+   getopt: [])
+  (displayln (string-join (sort (map as-string (hash-keys entry-points)) string<?) " ")))
+
+;; TODO: add a flag for short?
+(define-entry-point (version all?: (all? #f) layer: (layer #f))
+  (help: "Print software version"
+   getopt: [(flag 'all? "-a" "--all" help: "also show versions of previous layers")
+            (option 'layer "-l" "--layer" help: "show versions for specified layer")])
+  (display-build-manifest (cond (all? build-manifest)
+                                (layer (build-manifest/layer layer))
+                                (else (build-manifest/head))))
+  (newline))
+
+(def (call-entry-point/internal command args)
+  (match (hash-get entry-points (make-symbol command))
+    (#f (raise (format "Unknown command ~s. Try command help.\n" command)))
+    ((entry-point _name fun _help getopt)
+     (parameterize ((current-program (cons command (current-program))))
+       (call-with-processed-command-line getopt args fun)))))
+
+(def (call-entry-point . args)
+  (begin-print-exit
+   (match args
+     ([] (call-entry-point/internal multicall-default []))
+     ([command . args] (call-entry-point/internal command args)))))
+
+(defrules define-multicall-main ()
+  ((_ ctx) (with-id ctx (main) (define main call-entry-point)))
+  ((d) (d d)))

src/std/cli/print-exit.ss

@@ -0,0 +1,48 @@
+;; -*- Gerbil -*-
+;;;; Support for building main functions that handle exiting nicely
+
+(export #t)
+
+(import
+  :gerbil/gambit
+  :std/error
+  :std/misc/list
+  :std/misc/ports
+  :std/misc/repr
+  :std/sugar)
+
+(def value-printer (make-parameter prn))
+
+(def (print-values . vs)
+  (unless (equal? vs [(void)])
+    (for-each (value-printer) vs))
+  (ignore-errors (force-current-outputs))
+  (void))
+
+;; Print resulting values, and exit with an according value.
+(def (print-exit . vs)
+  (apply print-values vs)
+  (exit (if (or (null? vs) (and (length=n? vs 1) (not (car vs)))) 1 0)))
+
+;; Return a magic value that will be not be printed but will return an error code.
+;; (void) is silent success, because it's what successful side-effecting functions return.
+;; (values) is failure, because it's the other naturally silent return thing, and it's abnormal enough.
+(def (silent-exit (bool #t))
+  (if bool (void) (values)))
+
+;; Execute a function, print the result (if applicable), and exit with an according value.
+;;
+;; (void) prints nothing and counts as false. #f is printed and counts as false.
+;; (values) prints nothing and counts as true. All other values are printed and count as true.
+;; If you want to print #f and return true, then print it then return (values).
+;;
+;; True is returned as exit code 0, false as exit code 1.
+;; Any uncaught exception will be printed then trigger an exit with code 2.
+(def (call-print-exit fun)
+  (with-exit-on-error (call/values fun print-exit)))
+
+;; Evaluate the body ... as in an anonymous function called by `call-print-exit`
+;; This macro is named in a way reminiscent of REPL (Read-Eval-Print-Loop),
+;; except instead of Read-Eval it evaluates forms like `begin`, and
+;; after the Print part it Exits rather than Loops.
+(defrule (begin-print-exit body ...) (call-print-exit (lambda () body ...)))

src/std/cli/shell-test.ss

@@ -0,0 +1,36 @@
+(export shell-test)
+
+(import
+  :std/error
+  :std/misc/string :std/srfi/13
+  :std/test
+  :std/pregexp :std/misc/repr :std/sugar :std/format
+  :std/cli/shell)
+
+(def shell-test
+  (test-suite "test :std/misc/shell"
+    (test-case "easy-shell-character?"
+      (string-for-each (lambda (c) (check (easy-shell-character? c) => #t))
+                       "abcdefghijklmnopqrstuvwxzABCDEFGHIJKLMNOPQRSTUVWXZ012345678@%-_=+:,./")
+      (string-for-each (lambda (c) (check (easy-shell-character? c) => #f))
+                       "!`~#$^&*()[{]}\\|;'\"<>? \r\n\t\v"))
+    (test-case "needs-shell-escape?, escape-shell-token"
+      (defrules checks+1 ()
+        ((_ (s e)) (begin
+                     (check (needs-shell-escape? s) => #t)
+                     (check (escape-shell-token s) => (string-append "\"" e "\""))))
+        ((_ s) (begin
+                 (check (needs-shell-escape? s) => #t)
+                 (check (escape-shell-token s) => (string-append "\"" s "\"")))))
+      (defrule (checks+ x ...)
+        (begin (checks+1 x) ...))
+      (checks+ "foo?" "~user" ("$1" "\\$1") "*.*" "!1" ("ab\\cd" "ab\\\\cd")
+               "{}" "a;b" "&amp;" "|" "a b  c")
+      (defrule (checks- s ...) (begin (check (needs-shell-escape? s) => #f) ...))
+      (checks- "foo" "%-_=+:,./" "1" "..." "abcd" "x=y:z,t.z/u+v_w"))
+    (test-case "->envvar"
+      (defrule (checks (s e) ...)
+        (begin (check (->envvar s) => e) ...))
+      (checks ("foo" "FOO")
+              ("bar baz" "BAR_BAZ"))
+      (check (->envvar '("bar " "+!@#$") #(#\@ #\! "#") "baz") => "BAR_BAZ"))))

src/std/cli/shell.ss

@@ -0,0 +1,42 @@
+;; Support for Unix shells
+;; TODO: If Windows shell support is needed, add it here, too.
+
+(export #t)
+
+(import
+  :std/srfi/13 :std/stxutil :std/text/char-set)
+
+(def (easy-shell-character? x)
+  (or (char-ascii-alphanumeric? x) (and (string-index "%+,-./:=@_" x) #t)))
+
+(def (needs-shell-escape? token)
+  ;; maybe also accept ^ and ~ in non-start position?
+  (not (string-every easy-shell-character? token)))
+
+(def (escape-shell-token token)
+  (if (needs-shell-escape? token)
+    (call-with-output-string []
+     (lambda (port)
+       (def (p x) (display x port))
+       (p #\")
+       (string-for-each
+        (lambda (c) (when (string-index "$`\\\"" c) (p #\\)) (p c))
+        token)
+       (p #\")))
+    token))
+
+(def (escape-shell-tokens tokens)
+  (string-join (map escape-shell-token tokens) " "))
+
+(def (->envvar . args)
+  (call-with-output-string
+   (lambda (p)
+     (def alpha? #t)
+     (string-for-each
+      (lambda (c)
+        (def caa? (char-ascii-alphanumeric? c))
+        (when caa?
+          (unless alpha? (write-char #\_ p))
+          (write-char c p))
+        (set! alpha? caa?))
+      (string-upcase (as-string args))))))

src/std/error.ss

@@ -29,7 +29,12 @@
         (rename: raise-bug BUG)
         is-it-bug?
         with-exception-stack-trace
-        dump-stack-trace!)
+        dump-stack-trace?
+        dump-stack-trace!
+        exit-with-error
+        exit-on-error?
+        call-with-exit-on-error
+        with-exit-on-error)
 
 ;; utility macro for definint error classes
 (defsyntax (deferror-class stx)
@@ -126,7 +131,7 @@
   (IOError message irritants: [irritants ...]))
 
 (defraise/context (raise-premature-end-of-input where irritants ...)
-  (PrematureEndOfInput "premature end of input"  irritants: [irritants ...]))
+  (PrematureEndOfInput "premature end of input" irritants: [irritants ...]))
 
 (defraise/context (raise-io-closed where message irritants ...)
   (Closed message irritants: [irritants ...]))
@@ -352,3 +357,32 @@
    wrong-number-of-values-exception-vals)
 
   (wrong-processor-c-return-exception?))
+
+(def exit-on-error? (make-parameter #t))
+
+(def (exit-with-error e)
+  (def port (current-error-port))
+  (defrules ignore-errors () ((_ body ...) (with-catch void (lambda () body ...))))
+  (ignore-errors (force-output port))
+  (ignore-errors (display-build-manifest build-manifest port))
+  (ignore-errors (newline port))
+  (ignore-errors (display-exception e port))
+  ;; If the stack trace was printed, making the message out of reach of the user,
+  ;; then redundantly print the error message at the bottom without the stack trace.
+  (ignore-errors
+   (when (and (dump-stack-trace?) (StackTrace? e))
+     (parameterize ((dump-stack-trace? #f))
+       (display-exception e port))))
+  (ignore-errors (force-output port))
+  (exit 2))
+
+(def (call-with-exit-on-error thunk)
+  (with-catch
+    (lambda (e)
+      (if (exit-on-error?)
+        (exit-with-error e)
+        (raise e)))
+    thunk))
+
+(defrules with-exit-on-error ()
+  ((_ body ...) (call-with-exit-on-error (lambda () body ...))))