Add operands to syntax help message

base-packages.lisp

@@ -11,6 +11,7 @@
    #:parse-error-proposition
    #:parse-error-message
    #:*operator-symbol-table*
+   #:*operand-symbol-table*
    #:*operator-descriptions*
    #:operator-symbol
    #:operator-precedence

cli.lisp

@@ -84,36 +84,63 @@ functions involved in evaluating and typesetting."
           do (return-from ascii-string-p))
   t)
 
+(defun format-syntax-string (syntax-list &key ascii-only)
+  "Format SYNTAX-LIST into a string suitable for printing in a table in
+`print-syntax-help'."
+  (format nil "~{~a~^, ~}"
+          (sort (copy-list
+                 (if ascii-only
+                     (remove-if-not 'ascii-string-p
+                                    syntax-list)
+                     syntax-list))
+                'string<)))
+
 (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~^, ~}"
+    for syntax-str = (format-syntax-string syntax :ascii-only ascii-only)
-                             (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))
+       (setq name-col-len (max name-col-len (length "Operator"))
-             (box-lookup-table (if ascii-only
+             syntax-col-len (max syntax-col-len (length "Syntax")))
-                                   *table-border-ascii-alist*
+       (with-draw-table (t (list name-col-len syntax-col-len)
-                                   *table-border-unicode-alist*)))
+                         (if ascii-only
-         (with-draw-table (t col-widths box-lookup-table
+                             *table-border-ascii-alist*
-                           :padding 1 :align :left)
+                             *table-border-unicode-alist*)
-           (:row (list "Operator" "Syntax"))
+                         :padding 1 :align :left)
-           (:seperator)
+         (:row '("Operator" "Syntax"))
-           (loop for (sym (name . nicks) desct) in *operator-descriptions*
+         (:seperator)
-                 for syntax-str in syntax-entries do
+         (loop for (sym (name . nicks) desct) in *operator-descriptions*
-                   (:row (list name syntax-str))))))
+               for syntax-str in syntax-entries do
-  (format t "~%~%~a~%Example:~%  abc|d = ~a~%"
+                 (:row (list name syntax-str)))))
+  (terpri)
+  (loop for (sym . syntax) in *operand-symbol-table*
+        for name = (symbol-name sym)
+        for syntax-str = (format-syntax-string syntax :ascii-only ascii-only)
+        collect (string-downcase name) into names
+        maximize (length name) into name-col-len
+        collect syntax-str into syntax-strs
+        maximize (length syntax-str) into syntax-col-len
+        finally
+           (setq name-col-len (max name-col-len (length "Operand"))
+                 syntax-col-len (max syntax-col-len (length "Syntax")))
+           (with-draw-table (t (list name-col-len syntax-col-len)
+                             (if ascii-only
+                                 *table-border-ascii-alist*
+                                 *table-border-unicode-alist*)
+                             :padding 1 :align :left)
+             (:row '("Operand" "Syntax"))
+             (:seperator)
+             (loop for name in names
+                   for syntax-str in syntax-strs
+                   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")

parse.lisp

@@ -197,19 +197,23 @@ are useful for use in things like syntax explanation messages.")
   "Return whether OPER is a unary operator or not."
   (eq oper 'not))
 
+(defparameter *operand-symbol-table*
+  '((true "t" "true" "⊤" "1")
+    (false "f" "false" "⊥" "0"))
+  "Alist mapping operand symbols (true and false) to their textual
+representations.")
+
 (defun interpret-operand (oper-str)
   "Return a symbol representing OPER-STR, or the string itself if it represents
 a variable."
-  (cond
+  (dolist (entry *operand-symbol-table*)
-    ((member oper-str '("t" "true" "⊤" "1") :test 'equalp)
+    (when (member oper-str (cdr entry) :test 'equalp)
-     'true)
+      (return-from interpret-operand (car entry))))
-    ((member oper-str '("f" "false" "⊥" "0") :test 'equalp)
+  ;; check if OPER-STR is a valid variable name
-     'false)
+  (if (or (zerop (length oper-str))
-    (t
+          (find-if-not 'symbol-char-p oper-str))
-     (loop for char across oper-str
+      nil
-           unless (symbol-char-p char)
+      oper-str))
-             do (return nil)
-           finally (return oper-str)))))
 
 (defun string-first-char-safe (str)
   "Return the first character of STR, or nil if it is empty."

web.lisp

@@ -50,7 +50,7 @@
       (:span :id "help-close-button"
        :onclick "document.querySelector(\".help-overlay\").style.display = \"none\""
        "Close"))
-     (:table
+     (:table ;:style "margin-bottom: 10px;"
       (:tr (:th "Operator") (:th "Syntax"))
       (loop for ((sym (name . nics) desc (examples)) . rest-desc)
               = *operator-descriptions* then rest-desc
@@ -61,7 +61,13 @@
                (:tr
                 (:td name)
                 (:td (format nil "~{~a~^, ~}" (sort (copy-list syntax)
-                                                    'string<))))))
+                                                    'string<)))))
+      (:tr (:th "Operand") (:th "Syntax"))
+      (loop for (sym . syntax) in *operand-symbol-table* do
+        (:tr
+         (:td (string-downcase (symbol-name sym)))
+         (:td (format nil "~{~a~^, ~}" (sort (copy-list syntax)
+                                             'string<))))))
      (:p "You can input multiple propositions by separating them with"
       "commas (,):"
       (:br)