Add syntax help menu and cli option

cli.lisp

@@ -50,8 +50,80 @@ functions involved in evaluating and typesetting."
                                               :pretty-print pretty-print
                                               :latin-truths latin-truths)))))
 
+(defun word-wrap-string (string &optional (cols 80))
+  (with-output-to-string (str)
+    (loop with word = ()
+          with word-len = 0
+          with cur-col = 0
+          for char across string
+          when (whitespace-p char) do
+            (if (>= (+ cur-col word-len 1) cols)
+                (progn
+                  (terpri str)
+                  (setq cur-col 0))
+                (unless (zerop cur-col)
+                  (format str " ")
+                  (incf cur-col)))
+            (format str "~{~c~}" (nreverse  word))
+            (setq word nil
+                  cur-col (+ cur-col word-len)
+                  word-len 0)
+          else do
+            (push char word)
+            (incf word-len)
+          finally
+             (if (>= (+ cur-col word-len 1) cols)
+                 (terpri str)
+                 (format str " "))
+             (format str "~{~c~}" (nreverse word)))))
+
+(defun ascii-string-p (str)
+  "Return true if STR is only ASCII characters."
+  (loop for char across str
+        unless (<= (char-code char) 127)
+          do (return-from ascii-string-p))
+  t)
+
+(defun print-syntax-help (ascii-only)
+  "Print the syntax help message."
+  (loop
+    for ((sym (name . nicks) desc examples) . rest-desc)
+      = *operator-descriptions* then rest-desc
+    for ((_sym . syntax) . rest-st) = *operator-symbol-table* then rest-st
+    for syntax-str = (format nil "~{~a~^, ~}"
+                             (sort (copy-list
+                                    (if ascii-only
+                                        (remove-if-not 'ascii-string-p
+                                                       syntax)
+                                        syntax))
+                                   'string<))
+    while sym
+    maximize (length name) into name-col-len
+    maximize (length syntax-str) into syntax-col-len
+    collect syntax-str into syntax-entries
+    finally
+       (let ((col-widths (list name-col-len syntax-col-len))
+             (box-lookup-table (if ascii-only
+                                   *table-border-ascii-alist*
+                                   *table-border-unicode-alist*)))
+         (with-draw-table (t col-widths box-lookup-table
+                           :padding 1 :align :left)
+           (:row (list "Operator" "Syntax"))
+           (:seperator)
+           (loop for (sym (name . nicks) desct) in *operator-descriptions*
+                 for syntax-str in syntax-entries do
+                   (:row (list name syntax-str))))))
+  (format t "~%~%~a~%Example:~%  abc|d = ~a~%"
+          (word-wrap-string "Two operands next to each other is treated as an
+'implicit and' (unless this feature is disabled).")
+          (typeset-proposition '(or (and "a" "b" "c") "d")
+                               :lookup-table (if ascii-only
+                                                 *operator-ascii-lookup-alist*
+                                                 *operator-unicode-lookup-alist*))))
+
 (defparameter *command-line-spec*
   '((#\h "help" help nil "print this message, then exit")
+    (nil "syntax-help" syntax-help nil "print a syntax help message, then exit")
     (#\f "format" format t
      "specify the output format (*unicode*, ascii, latex, or html)")
     (#\s "subexps" subexps nil "include sub-expressions in the output table")
@@ -85,6 +157,20 @@ arguments."
            (print-usage t *command-line-spec* "truth-table"
                         :general-args "<propositions...>")
            (uiop:quit (if cmdline-error 1 0)))
+          ((and (not cmdline-error) ;; if option parsing failed, error out
+                (option-value 'syntax-help opts))
+           (let ((format (option-value 'format opts)))
+             (cond
+               ((or (not format)
+                    (equal format "unicode"))
+                (print-syntax-help nil))
+               ((equal format "ascii")
+                (print-syntax-help t))
+               (t
+                (cerror "Exit without printing anything" 'command-line-error
+                        :message (format nil "The syntax help table is only ~
+                       available in ASCII or Unicode.")))))
+           (uiop:quit))
           ((null prop-strs)
            (cerror *cli-parse-continue-string* 'no-input-error))
           (cmdline-error
@@ -96,12 +182,12 @@ arguments."
                (setq format "unicode"))
              (princ (eval-and-typeset-propositions
                      prop-strs :format format
-                               :implicit-and (not (option-value 'no-implicit opts))
-                               :multi-char-names (option-value 'multi-char opts)
-                               :include-vars (not (option-value 'no-vars opts))
-                               :include-intermediate (option-value 'subexps opts)
-                               :pretty-print (option-value 'pretty opts)
-                               :latin-truths (option-value 'latin opts)))
+                     :implicit-and (not (option-value 'no-implicit opts))
+                     :multi-char-names (option-value 'multi-char opts)
+                     :include-vars (not (option-value 'no-vars opts))
+                     :include-intermediate (option-value 'subexps opts)
+                     :pretty-print (option-value 'pretty opts)
+                     :latin-truths (option-value 'latin opts)))
              (terpri))))))))
 
 (defun toplevel ()