Add syntax help menu and cli option
This commit is contained in:
122
typeset.lisp
122
typeset.lisp
@ -318,7 +318,8 @@ between each row."
|
||||
(bottom-right . #\┘))
|
||||
"Characters used to draw Unicode table borders.")
|
||||
|
||||
(defun typeset-table-break (stream lengths horiz start column end)
|
||||
(defun typeset-table-break (stream lengths horiz start column end
|
||||
&key (left-pad-len 0) (right-pad-len 0))
|
||||
"Typeset the first row, the last row, or a break to STREAM. The proper box
|
||||
character will be placed at each intersection. LENGTHS is a list of column
|
||||
lengths. HORIZ, START, COLUMN, and END are the box characters to use when
|
||||
@ -328,20 +329,78 @@ drawing."
|
||||
while length
|
||||
do
|
||||
(format stream "~a"
|
||||
(make-string length :initial-element horiz))
|
||||
(make-string (+ left-pad-len length right-pad-len)
|
||||
:initial-element horiz))
|
||||
when rest do
|
||||
(format stream "~c" column))
|
||||
(format stream "~c" end))
|
||||
|
||||
(defun typeset-table-row (stream lengths row vert)
|
||||
(defun typeset-table-row (stream lengths row vert
|
||||
&key (align :center) (left-pad-str "")
|
||||
(right-pad-str ""))
|
||||
"Typeset ROW to STREAM. VERT is the vertical separator. LENGTHS should be the
|
||||
length of each column."
|
||||
(loop for col in row
|
||||
(loop with format = (case align
|
||||
(:right
|
||||
"~c~a~v:<~a~>~a")
|
||||
(:left
|
||||
"~c~a~v@<~a~>~a")
|
||||
(t ;; :center
|
||||
"~c~a~v:@<~a~>~a"))
|
||||
for col in row
|
||||
for length in lengths
|
||||
do
|
||||
(format stream "~c~v:@<~a~>" vert length col))
|
||||
(format stream format
|
||||
vert left-pad-str length col right-pad-str))
|
||||
(format stream "~c" vert))
|
||||
|
||||
(defmacro with-draw-table ((stream col-widths lookup-table
|
||||
&key (padding 0) (align :center))
|
||||
&body body)
|
||||
"Execute BODY with the function \=:seperator and \=:row bound. STREAM is the
|
||||
stream to write the table to. COL-WIDTHS is a list of column
|
||||
widths. LOOKUP-TABLE is the table to use to lookup characters for the table
|
||||
border. PADDING is the number to spaces to both append and prepend to each table
|
||||
cell. ALIGN is one of \=:right, \=:center, or \=:left."
|
||||
(let ((pad-str-var (gensym)))
|
||||
`(let ((,pad-str-var (make-string ,padding :initial-element #\space)))
|
||||
(truth-table/base::typeset-table-break
|
||||
,stream ,col-widths
|
||||
(cdr (assoc 'horizontal ,lookup-table))
|
||||
(cdr (assoc 'top-left ,lookup-table))
|
||||
(cdr (assoc 'down ,lookup-table))
|
||||
(cdr (assoc 'top-right ,lookup-table))
|
||||
:right-pad-len ,padding
|
||||
:left-pad-len ,padding)
|
||||
(format ,stream "~%")
|
||||
(flet ((:seperator ()
|
||||
(truth-table/base::typeset-table-break
|
||||
,stream ,col-widths
|
||||
(cdr (assoc 'horizontal ,lookup-table))
|
||||
(cdr (assoc 'right ,lookup-table))
|
||||
(cdr (assoc 'cross ,lookup-table))
|
||||
(cdr (assoc 'left ,lookup-table))
|
||||
:right-pad-len ,padding
|
||||
:left-pad-len ,padding)
|
||||
(format ,stream "~%"))
|
||||
(:row (row)
|
||||
(truth-table/base::typeset-table-row
|
||||
,stream ,col-widths row
|
||||
(cdr (assoc 'vertical ,lookup-table))
|
||||
:align ,align
|
||||
:left-pad-str ,pad-str-var
|
||||
:right-pad-str ,pad-str-var)
|
||||
(format ,stream "~%")))
|
||||
,@body)
|
||||
(truth-table/base::typeset-table-break
|
||||
,stream ,col-widths
|
||||
(cdr (assoc 'horizontal ,lookup-table))
|
||||
(cdr (assoc 'bottom-left ,lookup-table))
|
||||
(cdr (assoc 'up ,lookup-table))
|
||||
(cdr (assoc 'bottom-right ,lookup-table))
|
||||
:right-pad-len ,padding
|
||||
:left-pad-len ,padding))))
|
||||
|
||||
(defun typeset-truth-table (table &optional
|
||||
(expr-lookup-table
|
||||
*operator-ascii-lookup-alist*)
|
||||
@ -355,47 +414,28 @@ between each row."
|
||||
(let* ((typeset-exprs (mapcar (lambda (expr)
|
||||
(typeset-proposition
|
||||
expr :lookup-table expr-lookup-table
|
||||
:latin-truths latin-truths))
|
||||
:latin-truths latin-truths))
|
||||
(extract-truth-table-expressions table)))
|
||||
(col-widths (mapcar (lambda (expr)
|
||||
(+ (length expr) 2))
|
||||
typeset-exprs)))
|
||||
(with-output-to-string (str)
|
||||
(typeset-table-break str col-widths
|
||||
(cdr (assoc 'horizontal box-lookup-table))
|
||||
(cdr (assoc 'top-left box-lookup-table))
|
||||
(cdr (assoc 'down box-lookup-table))
|
||||
(cdr (assoc 'top-right box-lookup-table)))
|
||||
(terpri str)
|
||||
(typeset-table-row str col-widths typeset-exprs
|
||||
(cdr (assoc 'vertical box-lookup-table)))
|
||||
(terpri str)
|
||||
(typeset-table-break str col-widths
|
||||
(cdr (assoc 'horizontal box-lookup-table))
|
||||
(cdr (assoc 'right box-lookup-table))
|
||||
(cdr (assoc 'cross box-lookup-table))
|
||||
(cdr (assoc 'left box-lookup-table)))
|
||||
(terpri str)
|
||||
(dolist (row (extract-truth-table-values table))
|
||||
(typeset-table-row str col-widths
|
||||
;; convert t or nil to strings
|
||||
(mapcar (lambda (entry)
|
||||
(cdr (assoc (if entry
|
||||
(if latin-truths
|
||||
'latin-true
|
||||
'true)
|
||||
(if latin-truths
|
||||
'latin-false
|
||||
'false))
|
||||
expr-lookup-table)))
|
||||
row)
|
||||
(cdr (assoc 'vertical box-lookup-table)))
|
||||
(terpri str))
|
||||
(typeset-table-break str col-widths
|
||||
(cdr (assoc 'horizontal box-lookup-table))
|
||||
(cdr (assoc 'bottom-left box-lookup-table))
|
||||
(cdr (assoc 'up box-lookup-table))
|
||||
(cdr (assoc 'bottom-right box-lookup-table))))))
|
||||
(with-draw-table (str col-widths box-lookup-table)
|
||||
(:row typeset-exprs)
|
||||
(:seperator)
|
||||
(dolist (row (extract-truth-table-values table))
|
||||
(:row (mapcar
|
||||
(lambda (entry)
|
||||
(cdr (assoc
|
||||
(if entry
|
||||
(if latin-truths
|
||||
'latin-true
|
||||
'true)
|
||||
(if latin-truths
|
||||
'latin-false
|
||||
'false))
|
||||
expr-lookup-table)))
|
||||
row)))))))
|
||||
|
||||
(defparameter *known-formats*
|
||||
'("unicode" "ascii" "latex" "html")
|
||||
|
||||
Reference in New Issue
Block a user