Add syntax help menu and cli option
This commit is contained in:
350
web.lisp
350
web.lisp
@ -38,6 +38,94 @@
|
||||
(defparameter *default-address* "127.0.0.1")
|
||||
(defparameter *default-prefix* "/")
|
||||
|
||||
(defwidget help-overlay ()
|
||||
()
|
||||
(:documentation "Simple class to handle holding the help overlay."))
|
||||
|
||||
(defmethod render ((overlay help-overlay))
|
||||
(with-html
|
||||
(:div :id "help-table-wrapper"
|
||||
(:div :id "help-header-wrapper"
|
||||
(:span :id "help-header" "Help")
|
||||
(:span :id "help-close-button"
|
||||
:onclick "document.querySelector(\".help-overlay\").style.display = \"none\""
|
||||
"Close"))
|
||||
(:table
|
||||
(:tr (:th "Operator") (:th "Syntax"))
|
||||
(loop for ((sym (name . nics) desc (examples)) . rest-desc)
|
||||
= *operator-descriptions* then rest-desc
|
||||
for ((_sym . syntax) . rest-st)
|
||||
= *operator-symbol-table* then rest-st
|
||||
while sym
|
||||
do
|
||||
(:tr
|
||||
(:td name)
|
||||
(:td (format nil "~{~a~^, ~}" (sort (copy-list syntax)
|
||||
'string<))))))
|
||||
(:p "You can input multiple propositions by separating them with"
|
||||
"commas (,):"
|
||||
(:br)
|
||||
(:code "ab,cd"))
|
||||
(:p "Two operands next to each other is treated as an 'implicit and'"
|
||||
"(unless this feature is disabled):"
|
||||
(:br)
|
||||
(:code (:raw "abc|d = a ∧ b ∧ c ∨ d"))))))
|
||||
|
||||
(defmethod get-dependencies ((overlay help-overlay))
|
||||
(append
|
||||
(list
|
||||
(reblocks-lass:make-dependency
|
||||
'(.help-overlay
|
||||
:display "none"
|
||||
:position "fixed"
|
||||
:top "0px"
|
||||
:left "0px"
|
||||
:width "100%"
|
||||
:height "100%"
|
||||
:z-index "100" ;; be above EVERYTHING
|
||||
(|#help-table-wrapper|
|
||||
:background "#ffffff"
|
||||
:border-width "2px"
|
||||
:border-style "solid"
|
||||
:border-color "black"
|
||||
:padding "10px"
|
||||
:width "fit-content"
|
||||
:height "fit-content"
|
||||
:position "fixed"
|
||||
:top "40%"
|
||||
:left "50%"
|
||||
:transform translate "-50%" "-50%"
|
||||
(|#help-header-wrapper|
|
||||
:margin-bottom "3px"
|
||||
:position "relative"
|
||||
(|#help-header|
|
||||
:font-size "x-large"
|
||||
:font-weight "bold"
|
||||
:display "block"
|
||||
:text-align "center")
|
||||
(|#help-close-button|
|
||||
:user-select "none"
|
||||
:text-decoration-line "underline"
|
||||
:cursor "pointer"
|
||||
:position "absolute"
|
||||
:top "0"
|
||||
:right "0"))
|
||||
(table
|
||||
:border-collapse "collapse"
|
||||
:border-spacing "0px"
|
||||
:margin "auto"
|
||||
((:or th td)
|
||||
:padding "3px"
|
||||
:padding-left "10px"
|
||||
:padding-right "10px"
|
||||
:text-align "left"
|
||||
:border-style "solid"
|
||||
:border-width "1px"
|
||||
:border-color "black"))
|
||||
(code
|
||||
:padding-left "1em")))))
|
||||
(call-next-method)))
|
||||
|
||||
(defwidget truth-table ()
|
||||
((data :initform nil
|
||||
:accessor truth-table-data)
|
||||
@ -77,24 +165,24 @@ reblocks bug.")
|
||||
(with-html
|
||||
(:div :class "label" "Output:")
|
||||
(:span :id "output-span"
|
||||
;; there seems to be a bug in reblocks that means you have to pass
|
||||
;; the second argument to `make-js-action'
|
||||
(:button :onclick (make-js-action
|
||||
(lambda (&key &allow-other-keys)
|
||||
(truth-table-toggle-output table)
|
||||
(update table))
|
||||
:args *blank-hash-table*)
|
||||
:id "output-expander-button"
|
||||
(if output-visible
|
||||
"⏷"
|
||||
"⏵"))
|
||||
(if (or pretty-print
|
||||
(equal format "ascii")
|
||||
(equal format "unicode"))
|
||||
(:pre :id "output-area" :hidden (not output-visible)
|
||||
other-text)
|
||||
(:code :id "output-area" :hidden (not output-visible)
|
||||
other-text)))
|
||||
;; there seems to be a bug in reblocks that means you have to pass
|
||||
;; the second argument to `make-js-action'
|
||||
(:button :onclick (make-js-action
|
||||
(lambda (&key &allow-other-keys)
|
||||
(truth-table-toggle-output table)
|
||||
(update table))
|
||||
:args *blank-hash-table*)
|
||||
:id "output-expander-button"
|
||||
(if output-visible
|
||||
"⏷"
|
||||
"⏵"))
|
||||
(if (or pretty-print
|
||||
(equal format "ascii")
|
||||
(equal format "unicode"))
|
||||
(:pre :id "output-area" :hidden (not output-visible)
|
||||
other-text)
|
||||
(:code :id "output-area" :hidden (not output-visible)
|
||||
other-text)))
|
||||
(:div :class "label" "HTML Preview:"))
|
||||
(princ html-text reblocks/html:*stream*))))
|
||||
nil)
|
||||
@ -175,9 +263,53 @@ reblocks bug.")
|
||||
((table :initform (make-instance 'truth-table)
|
||||
:accessor page-table)
|
||||
(error-box :initform (make-instance 'error-box)
|
||||
:accessor page-error-box))
|
||||
:accessor page-error-box)
|
||||
(help-overlay :initform (make-instance 'help-overlay)
|
||||
:accessor page-help-overlay))
|
||||
(:documentation "The root of the whole page"))
|
||||
|
||||
(defun parse-and-eval-propositions (input-str &key implicit-and
|
||||
multi-char-names
|
||||
include-vars
|
||||
include-intermediate)
|
||||
"Parse and then eval all of comma separated props in INPUT-STR."
|
||||
(let ((prop-start 0))
|
||||
(handler-case
|
||||
(loop
|
||||
for prop-str in (uiop:split-string input-str :separator '(#\,))
|
||||
for (parsed-exp vars) = (multiple-value-list
|
||||
(parse-proposition-string
|
||||
prop-str
|
||||
:implicit-and implicit-and
|
||||
:multi-char-names multi-char-names))
|
||||
when parsed-exp
|
||||
append vars into all-vars
|
||||
and
|
||||
collect parsed-exp into parsed-exps
|
||||
and
|
||||
do (incf prop-start (1+ (length prop-str)))
|
||||
finally
|
||||
(return (create-combined-truth-table
|
||||
parsed-exps
|
||||
(remove-duplicates all-vars :test 'equal
|
||||
:from-end t)
|
||||
:include-intermediate include-intermediate
|
||||
:include-vars include-vars)))
|
||||
(proposition-parse-error (e)
|
||||
;; adjust the position and proposition string
|
||||
(error 'proposition-parse-error
|
||||
:message (parse-error-message e)
|
||||
:proposition input-str
|
||||
:position (+ (parse-error-position e)
|
||||
prop-start))))))
|
||||
|
||||
(defun blank-prop-string-p (str)
|
||||
"Return t if STR would produce a blank proposition table."
|
||||
(not (find-if-not (lambda (c)
|
||||
(or (eq c #\,)
|
||||
(whitespace-p c)))
|
||||
str)))
|
||||
|
||||
(defmethod handle-generate-request ((page page)
|
||||
&key prop-str implicit-and multi-char-names
|
||||
format include-vars subexps latin pretty)
|
||||
@ -185,19 +317,17 @@ reblocks bug.")
|
||||
(with-slots (table error-box) page
|
||||
(setf (truth-table-format table) format
|
||||
(error-box-message error-box) nil)
|
||||
(if (not (zerop (length prop-str)))
|
||||
(if (not (blank-prop-string-p prop-str))
|
||||
(handler-case
|
||||
(multiple-value-bind (parsed-exp vars)
|
||||
(parse-proposition-string
|
||||
prop-str
|
||||
:implicit-and implicit-and
|
||||
:multi-char-names multi-char-names)
|
||||
(setf (truth-table-data table) (create-truth-table parsed-exp
|
||||
:vars vars
|
||||
:include-vars include-vars
|
||||
:include-intermediate subexps)
|
||||
(truth-table-latin-truths table) latin
|
||||
(truth-table-pretty-print table) pretty))
|
||||
(setf (truth-table-data table)
|
||||
(parse-and-eval-propositions
|
||||
prop-str
|
||||
:implicit-and implicit-and
|
||||
:multi-char-names multi-char-names
|
||||
:include-vars include-vars
|
||||
:include-intermediate subexps)
|
||||
(truth-table-latin-truths table) latin
|
||||
(truth-table-pretty-print table) pretty)
|
||||
((or proposition-parse-error proposition-eval-error) (e)
|
||||
(setf (error-box-message error-box) (princ-to-string e))))
|
||||
(setf (truth-table-data table) nil))
|
||||
@ -207,76 +337,86 @@ reblocks bug.")
|
||||
(defmethod render ((page page))
|
||||
"Render PAGE."
|
||||
(with-html
|
||||
(with-slots (table error-box) page
|
||||
(:h1 "Truth Table Generator")
|
||||
(with-html-form (:POST (lambda (&key prop-str implicit-and
|
||||
multi-char-names format
|
||||
include-vars subexps latin
|
||||
pretty
|
||||
&allow-other-keys)
|
||||
(handle-generate-request
|
||||
page :prop-str prop-str
|
||||
:implicit-and implicit-and
|
||||
:multi-char-names multi-char-names
|
||||
:format format
|
||||
:include-vars include-vars
|
||||
:subexps subexps
|
||||
:pretty pretty
|
||||
:latin latin)))
|
||||
(:div :id "main-controls-wrapper"
|
||||
(:input :id "prop-input-field"
|
||||
:type "text"
|
||||
:name "prop-str"
|
||||
:placeholder "Proposition string...")
|
||||
(:input :id "submit-button"
|
||||
:type "submit"
|
||||
:value "Generate"))
|
||||
(:div :id "extra-controls-wrapper"
|
||||
(:input :type "checkbox"
|
||||
:name "implicit-and"
|
||||
:checked t)
|
||||
(:label :for "implicit-and" "Implicit And")
|
||||
(:input :type "checkbox"
|
||||
:name "multi-char-names"
|
||||
:style "margin-left: 10px;")
|
||||
(:label :for "multi-char-names" "Multi-character Variables")
|
||||
(:input :type "checkbox"
|
||||
:name "include-vars"
|
||||
:checked t
|
||||
:style "margin-left: 10px;")
|
||||
(:label :for "include-vars" "Include Variables")
|
||||
(:input :type "checkbox"
|
||||
:name "subexps"
|
||||
:checked t
|
||||
:style "margin-left: 10px;")
|
||||
(:label :for "subexps" "Include Sub-expressions")
|
||||
(:input :type "checkbox"
|
||||
:name "pretty"
|
||||
:checked t
|
||||
:style "margin-left: 10px;")
|
||||
(:label :for "pretty" "Pretty Print")
|
||||
(:input :type "checkbox"
|
||||
:name "latin"
|
||||
:checked nil
|
||||
:style "margin-left: 10px;")
|
||||
(:label :for "latin" "Latin Truth Values")
|
||||
(:select :name "format" :style "margin-left: 10px;"
|
||||
(:option :value "html" "HTML")
|
||||
(:option :value "latex" "LaTeX")
|
||||
(:option :value "ascii" "ASCII")
|
||||
(:option :value "unicode" "Unicode"))))
|
||||
(render error-box)
|
||||
(render table)
|
||||
(:div :id "info-text"
|
||||
(:span
|
||||
"This website is free software under the terms of the AGPL"
|
||||
"license version 3. You can find a copy of the license ")
|
||||
(:a :href "https://www.gnu.org/licenses/agpl-3.0.html"
|
||||
"here")
|
||||
(:span ". You can find the source of this website ")
|
||||
(:a :href "https://git.zander.im/Zander671/truth-table"
|
||||
"here")
|
||||
(:span ".")))))
|
||||
(:doctype)
|
||||
(:html
|
||||
(:head
|
||||
(:title "Truth Table Generator"))
|
||||
(:body
|
||||
(with-slots (table error-box help-overlay) page
|
||||
(render help-overlay)
|
||||
(:h1 "Truth Table Generator")
|
||||
(with-html-form (:POST (lambda (&key prop-str implicit-and
|
||||
multi-char-names format
|
||||
include-vars subexps latin
|
||||
pretty
|
||||
&allow-other-keys)
|
||||
(handle-generate-request
|
||||
page :prop-str prop-str
|
||||
:implicit-and implicit-and
|
||||
:multi-char-names multi-char-names
|
||||
:format format
|
||||
:include-vars include-vars
|
||||
:subexps subexps
|
||||
:pretty pretty
|
||||
:latin latin)))
|
||||
(:div :id "main-controls-wrapper"
|
||||
(:input :id "prop-input-field"
|
||||
:type "text"
|
||||
:name "prop-str"
|
||||
:placeholder "Proposition string...")
|
||||
(:input :id "submit-button"
|
||||
:type "submit"
|
||||
:value "Generate")
|
||||
(:button :id "help-button"
|
||||
:onclick
|
||||
"document.querySelector(\".help-overlay\").style.display = \"initial\""
|
||||
"Help"))
|
||||
(:div :id "extra-controls-wrapper"
|
||||
(:input :type "checkbox"
|
||||
:name "implicit-and"
|
||||
:checked t)
|
||||
(:label :for "implicit-and" "Implicit And")
|
||||
(:input :type "checkbox"
|
||||
:name "multi-char-names"
|
||||
:style "margin-left: 10px;")
|
||||
(:label :for "multi-char-names" "Multi-character Variables")
|
||||
(:input :type "checkbox"
|
||||
:name "include-vars"
|
||||
:checked t
|
||||
:style "margin-left: 10px;")
|
||||
(:label :for "include-vars" "Include Variables")
|
||||
(:input :type "checkbox"
|
||||
:name "subexps"
|
||||
:checked t
|
||||
:style "margin-left: 10px;")
|
||||
(:label :for "subexps" "Include Sub-expressions")
|
||||
(:input :type "checkbox"
|
||||
:name "pretty"
|
||||
:checked t
|
||||
:style "margin-left: 10px;")
|
||||
(:label :for "pretty" "Pretty Print")
|
||||
(:input :type "checkbox"
|
||||
:name "latin"
|
||||
:checked nil
|
||||
:style "margin-left: 10px;")
|
||||
(:label :for "latin" "Latin Truth Values")
|
||||
(:select :name "format" :style "margin-left: 10px;"
|
||||
(:option :value "html" "HTML")
|
||||
(:option :value "latex" "LaTeX")
|
||||
(:option :value "ascii" "ASCII")
|
||||
(:option :value "unicode" "Unicode"))))
|
||||
(render error-box)
|
||||
(render table)
|
||||
(:div :id "info-text"
|
||||
(:span
|
||||
"This website is free software under the terms of the AGPL"
|
||||
"license version 3. You can find a copy of the license ")
|
||||
(:a :href "https://www.gnu.org/licenses/agpl-3.0.html"
|
||||
"here")
|
||||
(:span ". You can find the source of this website ")
|
||||
(:a :href "https://git.zander.im/Zander671/truth-table"
|
||||
"here")
|
||||
(:span ".")))))))
|
||||
|
||||
(defmethod get-dependencies ((page page))
|
||||
(append
|
||||
@ -290,13 +430,15 @@ reblocks bug.")
|
||||
:margin-bottom "5px"
|
||||
(|#main-controls-wrapper|
|
||||
:display flex
|
||||
:margin-bottom "5px"
|
||||
:margin-bottom "5px"
|
||||
(|#prop-input-field|
|
||||
:flex-grow "1"
|
||||
:margin-right "5px"
|
||||
:font-size "large")
|
||||
(|#submit-button|
|
||||
:font-size "large"))
|
||||
((:or |#submit-button| |#help-button|)
|
||||
:font-size "large")
|
||||
(|#help-button|
|
||||
:margin-left "5px"))
|
||||
(|#extra-controls-wrapper|
|
||||
:display "flex"
|
||||
:justify-content "center"
|
||||
|
||||
Reference in New Issue
Block a user