Add operands to syntax help message
This commit is contained in:
		@ -11,6 +11,7 @@
 | 
				
			|||||||
   #:parse-error-proposition
 | 
					   #:parse-error-proposition
 | 
				
			||||||
   #:parse-error-message
 | 
					   #:parse-error-message
 | 
				
			||||||
   #:*operator-symbol-table*
 | 
					   #:*operator-symbol-table*
 | 
				
			||||||
 | 
					   #:*operand-symbol-table*
 | 
				
			||||||
   #:*operator-descriptions*
 | 
					   #:*operator-descriptions*
 | 
				
			||||||
   #:operator-symbol
 | 
					   #:operator-symbol
 | 
				
			||||||
   #:operator-precedence
 | 
					   #:operator-precedence
 | 
				
			||||||
 | 
				
			|||||||
							
								
								
									
										55
									
								
								cli.lisp
									
									
									
									
									
								
							
							
						
						
									
										55
									
								
								cli.lisp
									
									
									
									
									
								
							@ -84,36 +84,63 @@ functions involved in evaluating and typesetting."
 | 
				
			|||||||
          do (return-from ascii-string-p))
 | 
					          do (return-from ascii-string-p))
 | 
				
			||||||
  t)
 | 
					  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)
 | 
					(defun print-syntax-help (ascii-only)
 | 
				
			||||||
  "Print the syntax help message."
 | 
					  "Print the syntax help message."
 | 
				
			||||||
  (loop
 | 
					  (loop
 | 
				
			||||||
    for ((sym (name . nicks) desc examples) . rest-desc)
 | 
					    for ((sym (name . nicks) desc examples) . rest-desc)
 | 
				
			||||||
      = *operator-descriptions* then rest-desc
 | 
					      = *operator-descriptions* then rest-desc
 | 
				
			||||||
    for ((_sym . syntax) . rest-st) = *operator-symbol-table* then rest-st
 | 
					    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
 | 
					    while sym
 | 
				
			||||||
    maximize (length name) into name-col-len
 | 
					    maximize (length name) into name-col-len
 | 
				
			||||||
    maximize (length syntax-str) into syntax-col-len
 | 
					    maximize (length syntax-str) into syntax-col-len
 | 
				
			||||||
    collect syntax-str into syntax-entries
 | 
					    collect syntax-str into syntax-entries
 | 
				
			||||||
    finally
 | 
					    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")))
 | 
				
			||||||
 | 
					       (with-draw-table (t (list name-col-len syntax-col-len)
 | 
				
			||||||
 | 
					                         (if ascii-only
 | 
				
			||||||
                             *table-border-ascii-alist*
 | 
					                             *table-border-ascii-alist*
 | 
				
			||||||
                                   *table-border-unicode-alist*)))
 | 
					                             *table-border-unicode-alist*)
 | 
				
			||||||
         (with-draw-table (t col-widths box-lookup-table
 | 
					 | 
				
			||||||
                         :padding 1 :align :left)
 | 
					                         :padding 1 :align :left)
 | 
				
			||||||
           (:row (list "Operator" "Syntax"))
 | 
					         (:row '("Operator" "Syntax"))
 | 
				
			||||||
         (:seperator)
 | 
					         (:seperator)
 | 
				
			||||||
         (loop for (sym (name . nicks) desct) in *operator-descriptions*
 | 
					         (loop for (sym (name . nicks) desct) in *operator-descriptions*
 | 
				
			||||||
               for syntax-str in syntax-entries do
 | 
					               for syntax-str in syntax-entries do
 | 
				
			||||||
                   (:row (list name syntax-str))))))
 | 
					                 (:row (list name syntax-str)))))
 | 
				
			||||||
  (format t "~%~%~a~%Example:~%  abc|d = ~a~%"
 | 
					  (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
 | 
					          (word-wrap-string "Two operands next to each other is treated as an
 | 
				
			||||||
'implicit and' (unless this feature is disabled).")
 | 
					'implicit and' (unless this feature is disabled).")
 | 
				
			||||||
          (typeset-proposition '(or (and "a" "b" "c") "d")
 | 
					          (typeset-proposition '(or (and "a" "b" "c") "d")
 | 
				
			||||||
 | 
				
			|||||||
							
								
								
									
										24
									
								
								parse.lisp
									
									
									
									
									
								
							
							
						
						
									
										24
									
								
								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."
 | 
					  "Return whether OPER is a unary operator or not."
 | 
				
			||||||
  (eq oper '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)
 | 
					(defun interpret-operand (oper-str)
 | 
				
			||||||
  "Return a symbol representing OPER-STR, or the string itself if it represents
 | 
					  "Return a symbol representing OPER-STR, or the string itself if it represents
 | 
				
			||||||
a variable."
 | 
					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)
 | 
					(defun string-first-char-safe (str)
 | 
				
			||||||
  "Return the first character of STR, or nil if it is empty."
 | 
					  "Return the first character of STR, or nil if it is empty."
 | 
				
			||||||
 | 
				
			|||||||
							
								
								
									
										8
									
								
								web.lisp
									
									
									
									
									
								
							
							
						
						
									
										8
									
								
								web.lisp
									
									
									
									
									
								
							@ -50,7 +50,7 @@
 | 
				
			|||||||
      (:span :id "help-close-button"
 | 
					      (:span :id "help-close-button"
 | 
				
			||||||
       :onclick "document.querySelector(\".help-overlay\").style.display = \"none\""
 | 
					       :onclick "document.querySelector(\".help-overlay\").style.display = \"none\""
 | 
				
			||||||
       "Close"))
 | 
					       "Close"))
 | 
				
			||||||
     (:table
 | 
					     (:table ;:style "margin-bottom: 10px;"
 | 
				
			||||||
      (:tr (:th "Operator") (:th "Syntax"))
 | 
					      (:tr (:th "Operator") (:th "Syntax"))
 | 
				
			||||||
      (loop for ((sym (name . nics) desc (examples)) . rest-desc)
 | 
					      (loop for ((sym (name . nics) desc (examples)) . rest-desc)
 | 
				
			||||||
              = *operator-descriptions* then rest-desc
 | 
					              = *operator-descriptions* then rest-desc
 | 
				
			||||||
@ -60,6 +60,12 @@
 | 
				
			|||||||
            do
 | 
					            do
 | 
				
			||||||
               (:tr
 | 
					               (:tr
 | 
				
			||||||
                (:td name)
 | 
					                (:td name)
 | 
				
			||||||
 | 
					                (:td (format nil "~{~a~^, ~}" (sort (copy-list syntax)
 | 
				
			||||||
 | 
					                                                    '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)
 | 
					         (:td (format nil "~{~a~^, ~}" (sort (copy-list syntax)
 | 
				
			||||||
                                             'string<))))))
 | 
					                                             'string<))))))
 | 
				
			||||||
     (:p "You can input multiple propositions by separating them with"
 | 
					     (:p "You can input multiple propositions by separating them with"
 | 
				
			||||||
 | 
				
			|||||||
		Reference in New Issue
	
	Block a user