Make web server

typeset.lisp

@@ -71,6 +71,22 @@
     (false . "\\bot"))
   "Lookup table mapping operators to their LaTeX representation.")
 
+(defparameter *operator-html-lookup-alist*
+  '((and . "∧")
+    (nand . "↑")
+    (or . "∨")
+    (nor . "↓")
+    (xor . "⊕")
+    (not . "¬")
+    (implies . "→")
+    (converse . "←")
+    (iff . "↔")
+    (open-paren . "(")
+    (close-paren . ")")
+    (true . "⊤")
+    (false . "⊥"))
+  "Lookup table mapping operators to their HTML representation.")
+
 (defun latex-var-name-transform (name)
   "Transform NAME so that it is escaped for use in LaTeX."
   (format nil "{~{~A~}}" (loop for char across name
@@ -83,6 +99,16 @@
                                else
                                  collect char)))
 
+(defun html-var-name-transform (name)
+  "Transform NAME so that it is escaped for use in HTML."
+  (format nil "~{~A~}" (loop for char across name
+                             if (eq char #\<)
+                               collect "&lt;"
+                             else if (eq char #\>)
+                                    collect "&gt;"
+                             else
+                               collect char)))
+
 (defun typeset-proposition (expr &optional
                                    (lookup-table *operator-ascii-lookup-alist*)
                                    var-name-transform
@@ -93,6 +119,9 @@ be a table mapping operators to their textual representation. VAR-NAME-TRANSFORM
 escape it for use in the target typesetting system. PARENT-PERC is for internal
 use (it controls when parentheses are applied.)"
   (cond
+    ;; expr is empty
+    ((null expr)
+     "")
     ;; expr is a variable name
     ((stringp expr)
      (if var-name-transform 
@@ -154,6 +183,35 @@ between each row."
             typeset-exprs
             (extract-truth-table-values table))))
 
+(defun format-html-properties-alist (props)
+  "Format PROPS, a list of conses, as a list of HTML properties."
+  (loop for (name . value) in props
+        when (eq value t)
+          collect (format nil "~A=\"\"" name)
+        else when value
+               collect (format nil "~A=~S" name (princ-to-string value))))
+
+
+(defun convert-truth-table-to-html (table &key class id more-props)
+  "Convert TABLE, which should be a truth table as returned by
+`create-truth-table' to HTML. CLASS and ID are their respective HTML
+properties. MORE-PROPS is an alist mapping properties to values.
+NOTE: though the overall order does not matter, the order must be the same
+between each row."
+  (let ((typeset-exprs (mapcar (lambda (expr)
+                                 (typeset-proposition
+                                  expr *operator-html-lookup-alist*
+                                  'html-var-name-transform))
+                               (extract-truth-table-expressions table))))
+    (format nil "~
+<table~@[ class=~s~]~@[ id=~s~]~{ ~A~}>~
+  <tr>~{<th>~A</th>~}</tr>~
+  ~{<tr>~{<td>~:[&perp;~;&top;~]</td>~}</tr>~}~
+</table>"
+            class id (format-html-properties-alist more-props)
+            typeset-exprs
+            (extract-truth-table-values table))))
+
 (defparameter *table-border-ascii-alist*
   '((vertical . #\|)
     (horizontal . #\-)
@@ -255,7 +313,7 @@ between each row."
                            (cdr (assoc 'bottom-right box-lookup-table))))))
 
 (defparameter *known-formats*
-  '("unicode" "ascii" "latex")
+  '("unicode" "ascii" "latex" "html")
   "The known formats that `typeset-table-to-format' can take.")
 
 (defun typeset-table-to-format (table format)
@@ -269,4 +327,6 @@ between each row."
                           *table-border-ascii-alist*))
     ((equal format "latex")
      (convert-truth-table-to-latex table))
+    ((equal format "html")
+     (convert-truth-table-to-html table))
     (t (error 'table-format-error :format format))))