More docs

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

@@ -4,15 +4,15 @@ 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
+(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.
 
-::: tip usage
-(import :std/cli/print-exit)
-:::
-
 ## Interface
 
 ### value-printer
@@ -86,7 +86,8 @@ and `(values)` is the silent false exit returned if it is false.
 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,
-abort with an error code as per `with-abort-on-error`.
+exit with an error code as per
+[`with-exit-on-error`](../misc/error.md#with-exit-on-error).
 
 ### begin-print-exit
 ```scheme

doc/reference/std/cli/shell.md

@@ -24,4 +24,69 @@ This include alphanumeric characters and those in `"@%-_=+:,./"`
 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
+```
+:::
+
+### ->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`.

src/std/cli/getopt.ss

@@ -378,49 +378,46 @@
 (def (call-with-getopt proc args
                        program: program
                        help: (help #f)
-                       exit-on-error: (exit-on-error? #t)
+                       exit-on-error: (exit? (exit-on-error?))
                        . gopts)
   (def (parse! gopt return)
     (try
      (getopt-parse gopt args)
-     (catch (getopt-error? exn)
-       (getopt-display-help exn program (current-error-port))
-       (if exit-on-error?
-         (exit 1)
-         (return 'error)))
      (catch (e)
-       (display-exception e (current-error-port))
-       (if exit-on-error?
-         (exit 2)
-         (return 'error)))))
-
-  (let/cc return
-    (let* ((gopt (apply getopt help: help gopts))
-           (cmds (!getopt-cmds gopt)))
-      (if (null? cmds)
-        ;; it only has options; add -h/--help
-        (let ((help-flag
-               (flag 'help "-h" "--help"
-                 help: "display help"))
-              (opts (!getopt-opts gopt)))
-          (if (null? opts)
-            (set! (!getopt-opts gopt)
-              [help-flag])
-            (set-cdr! (last-pair opts)
-                      [help-flag]))
-          (let (opt (parse! gopt return))
-            (if (hash-get opt 'help)
-              (getopt-display-help gopt program)
-              (proc opt))))
-        ;; it has commands; add help <command>
-        (let (help-cmd
-              (command 'help  help: "display help; help <command> for command help"
-                (optional-argument 'command value: string->symbol)))
-          (set-cdr! (last-pair cmds) [help-cmd])
-          (let ((values cmd opt) (parse! gopt return))
-            (if (eq? cmd 'help)
-              (getopt-display-help-topic gopt (hash-get opt 'command) program)
-              (proc cmd opt))))))))
+       (cond
+        ((not exit?) (raise e))
+        ((getopt-error? exn)
+         (getopt-display-help exn program (current-error-port))
+         (exit 1))
+        (else
+         (exit-with-error e))))))
+
+  (let* ((gopt (apply getopt help: help gopts))
+         (cmds (!getopt-cmds gopt)))
+    (if (null? cmds)
+      ;; it only has options; add -h/--help
+      (let ((help-flag
+             (flag 'help "-h" "--help"
+               help: "display help"))
+            (opts (!getopt-opts gopt)))
+        (if (null? opts)
+          (set! (!getopt-opts gopt)
+            [help-flag])
+          (set-cdr! (last-pair opts)
+                    [help-flag]))
+        (let (opt (parse! gopt))
+          (if (hash-get opt 'help)
+            (getopt-display-help gopt program)
+            (proc opt))))
+      ;; it has commands; add help <command>
+      (let (help-cmd
+            (command 'help  help: "display help; help <command> for command help"
+              (optional-argument 'command value: string->symbol)))
+        (set-cdr! (last-pair cmds) [help-cmd])
+        (let ((values cmd opt) (parse! gopt))
+          (if (eq? cmd 'help)
+            (getopt-display-help-topic gopt (hash-get opt 'command) program)
+            (proc cmd opt)))))))
 
 (def (getopt-parse->positional-arguments! gopt h)
   (defvalues (names rest-name) (getopt->positional-names gopt))

src/std/cli/shell-test.ss

@@ -32,4 +32,5 @@
       (defrule (checks (s e) ...)
         (begin (check (->envvar s) => e) ...))
       (checks ("foo" "FOO")
-              ("bar baz" "BAR_BAZ")))))
+              ("bar baz" "BAR_BAZ"))
+      (check (->envvar '("bar " "+!@#$") #(#\@ #\! "#") "baz") => "BAR_BAZ"))))

src/std/error.ss

@@ -31,9 +31,10 @@
         with-exception-stack-trace
         dump-stack-trace?
         dump-stack-trace!
-        abort-on-error?
-        call-with-abort-on-error
-        with-abort-on-error)
+        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)
@@ -357,21 +358,30 @@
 
   (wrong-processor-c-return-exception?))
 
-(def abort-on-error? (make-parameter #t))
-
-(def (call-with-abort-on-error thunk)
+(def exit-on-error? (make-parameter #t))
+
+(def (exit-with-error e)
+  (def port (current-error-port))
+  (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 (abort-on-error?)
-        (let (port (current-error-port))
-          (with-catch void (cut force-output port))
-          ;;(show-build-manifest all?: #t port: port)
-          (parameterize ((dump-stack-trace? #f))
-            (display-exception e port))
-          (force-output port)
-          (exit 2))
+      (if (exit-on-error?)
+        (exit-with-error e)
         (raise e)))
     thunk))
 
-(defrules with-abort-on-error ()
-  ((_ body ...) (call-with-abort-on-error (lambda () body ...))))
+(defrules with-exit-on-error ()
+  ((_ body ...) (call-with-exit-on-error (lambda () body ...))))