diff --git a/.gitignore b/.gitignore
index 2bf7a83..8ce2733 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1 +1,2 @@
-truth-table
\ No newline at end of file
+truth-table
+truth-table-webserver
\ No newline at end of file
diff --git a/Makefile b/Makefile
index 8c7bffa..b3730c2 100644
--- a/Makefile
+++ b/Makefile
@@ -2,14 +2,19 @@ LISP ?= sbcl
BASE_FILES=packages.lisp parse.lisp table.lisp typeset.lisp eval.lisp
CLI_FILES=cli.lisp
+WEB_FILES=web.lisp
-all: cli
+all: cli web
cli: truth-table
truth-table: build.lisp truth-table.asd $(BASE_FILES) $(CLI_FILES)
$(LISP) --load build.lisp --eval '(cli)'
+web: truth-table-webserver
+truth-table-webserver: build.lisp truth-table.asd $(BASE_FILES) $(WEB_FILES)
+ $(LISP) --load build.lisp --eval '(web)'
+
clean:
- rm -f truth-table
+ rm -f truth-table truth-table-webserver
.PHONY: all cli clean
diff --git a/arguments.lisp b/arguments.lisp
new file mode 100644
index 0000000..f83c838
--- /dev/null
+++ b/arguments.lisp
@@ -0,0 +1,158 @@
+;; arguments.lisp -- Command line option parsing
+;; Copyright (C) 2024 Alexander Rosenberg
+;;
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see .
+(in-package :truth-table/args)
+
+(define-condition command-line-error (error)
+ ((message :initarg :message
+ :accessor command-line-error-message))
+ (:report (lambda (con stream)
+ (format stream "~a"
+ (command-line-error-message con))))
+ (:documentation "The parent condition of all command line errors."))
+
+(define-condition cli-argument-error (command-line-error)
+ ((opt :initarg :opt
+ :accessor cli-argument-error-opt))
+ (:report (lambda (con stream)
+ (with-slots (opt message) con
+ (format stream
+ "~a: ~:[--~a~;-~c~]" message (characterp opt) opt))))
+ (:documentation "Condition representing an error that occurred during
+processing of command line arguments."))
+
+(define-condition unknown-option-error (cli-argument-error)
+ ((message :initform "unknown option"))
+ (:documentation "Condition representing an unknown command line option."))
+
+(define-condition option-no-arg-error (cli-argument-error)
+ ((message :initform "option requires an argument"))
+ (:documentation "Condition representing an error that occurred because a
+command line option did not have its required argument."))
+
+(define-condition no-input-error (command-line-error)
+ ((message :initform "no propositions given"))
+ (:documentation "Condition representing no propositions given on the command
+line."))
+
+(defparameter *cli-parse-continue-string*
+ "Continue paring arguments normally."
+ "String to use for `cerror' during argument parsing.")
+
+(defun parse-long-option (spec arg next-arg)
+ "Parse the long option ARG. Return a list of its symbol, its value (or t if
+it did not have one), and weather it consumed NEXT-ARG or not."
+ (destructuring-bind (name &optional value)
+ (uiop:split-string (subseq arg 2)
+ :max 2
+ :separator "=")
+ (loop for (short long symbol has-arg-p dest) in spec
+ when (equal name long) do
+ (if has-arg-p
+ (cond
+ (value
+ (return (list symbol value nil)))
+ (next-arg
+ (return (list symbol next-arg t)))
+ (t
+ (cerror *cli-parse-continue-string*
+ 'option-no-arg-error :opt name)
+ (return (list symbol nil nil))))
+ (return (list symbol t nil)))
+ finally
+ (cerror *cli-parse-continue-string*
+ 'unknown-option-error :opt name)
+ (return (list symbol nil nil)))))
+
+(defun parse-short-option (spec arg next-arg)
+ "Parse the short options in ARG according to SPEC. Return a list of options
+with each entry being similar to the return value of `parse-long-option'."
+ (loop with output = '()
+ for i from 1 to (1- (length arg))
+ for char = (elt arg i)
+ for (short long symbol has-arg-p desc) = (assoc char spec) do
+ (cond
+ (has-arg-p
+ (cond
+ ((< i (1- (length arg)))
+ (push (list symbol (subseq arg (1+ i)) nil) output)
+ (return output))
+ (next-arg
+ (push (list symbol next-arg t) output)
+ (return output))
+ (t
+ (cerror *cli-parse-continue-string*
+ 'option-no-arg-error :opt char))))
+ (short
+ (push (list symbol t nil) output))
+ (t
+ (cerror *cli-parse-continue-string*
+ 'unknown-option-error :opt char)))
+ finally (return output)))
+
+(defun parse-command-line (spec argv)
+ "Parse command line arguments in ARGV according to SPEC. Return an alist with
+the car being the option's symbol (as specified in SPEC), and the cdr being
+the argument it had on the command line, or t if it had none. The rest of the
+arguments will be placed in a list at the beginning of the alist."
+ (let ((output-opts '())
+ (output-other '()))
+ (loop for (arg . rest) = argv then rest
+ while (and arg (not (equal arg "--"))) do
+ (cond
+ ((uiop:string-prefix-p "--" arg)
+ (destructuring-bind (symbol value skip-next-p)
+ (parse-long-option spec arg (car rest))
+ (push (cons symbol value) output-opts)
+ (when skip-next-p
+ (setq rest (cdr rest)))))
+ ((uiop:string-prefix-p "-" arg)
+ (loop for (symbol value skip-next-p) in (parse-short-option
+ spec arg (car rest))
+ do
+ (push (cons symbol value) output-opts)
+ (when skip-next-p
+ (setq rest (cdr rest)))))
+ (t
+ (push arg output-other)))
+ finally (setf output-other (nconc (nreverse rest) output-other)))
+ (cons (nreverse output-other) output-opts)))
+
+(defun print-usage (stream spec exec-name &optional general-args)
+ "Print the command line usage corresponding to SPEC to STREAM."
+ (format stream "usage: ~a [options]~@[ ~a~]~%~%" exec-name general-args)
+ (loop with longest-option
+ = (apply 'max (mapcar
+ (lambda (entry)
+ (destructuring-bind (short long sym has-arg-p &rest other)
+ entry
+ (declare (ignorable other sym))
+ (+ (if short 2 0)
+ (if long (+ 2 (length long)) 0)
+ (if (and short long) 2 0)
+ (if has-arg-p 6 0))))
+ spec))
+ for (short long symbol has-arg-p desc) in spec
+ do
+ (format stream " ~v@<~@[-~c~]~@[, ~*~]~@[--~a~]~@[=~*~]~> ~a~%"
+ longest-option
+ short (or short long) long has-arg-p desc))
+ (format stream "~%The choice surrounded by '*' is the default. Arguments to long
+options are also required for their short variant.~%"))
+
+(defun option-value (opt opts)
+ "Get the value of command line option OPT from OTPS, which is an alist as
+returned as the second output of `parse-command-line'."
+ (cdr (assoc opt opts)))
diff --git a/build.lisp b/build.lisp
index 9ae821c..d3e8991 100644
--- a/build.lisp
+++ b/build.lisp
@@ -17,3 +17,13 @@
:executable t
:save-runtime-options t
:toplevel (intern "TOPLEVEL" :truth-table/cli)))
+
+(defun web ()
+ "Build the web server executable."
+ (asdf:load-system :truth-table/web)
+ (require :truth-table/web)
+ (sb-ext:save-lisp-and-die
+ "truth-table-webserver"
+ :executable t
+ :save-runtime-options t
+ :toplevel (intern "TOPLEVEL" :truth-table/web)))
diff --git a/cli.lisp b/cli.lisp
index 8bd58c5..40bea09 100644
--- a/cli.lisp
+++ b/cli.lisp
@@ -15,38 +15,6 @@
;; along with this program. If not, see .
(in-package :truth-table/cli)
-(define-condition command-line-error (error)
- ((message :initarg :message
- :accessor command-line-error-message))
- (:report (lambda (con stream)
- (format stream "~a"
- (command-line-error-message con))))
- (:documentation "The parent condition of all command line errors."))
-
-(define-condition cli-argument-error (command-line-error)
- ((opt :initarg :opt
- :accessor cli-argument-error-opt))
- (:report (lambda (con stream)
- (with-slots (opt message) con
- (format stream
- "~a: ~:[--~a~;-~c~]" message (characterp opt) opt))))
- (:documentation "Condition representing an error that occurred during
-processing of command line arguments."))
-
-(define-condition unknown-option-error (cli-argument-error)
- ((message :initform "unknown option"))
- (:documentation "Condition representing an unknown command line option."))
-
-(define-condition option-no-arg-error (cli-argument-error)
- ((message :initform "option requires an argument"))
- (:documentation "Condition representing an error that occurred because a
-command line option did not have its required argument."))
-
-(define-condition no-input-error (command-line-error)
- ((message :initform "no propositions given"))
- (:documentation "Condition representing no propositions given on the command
-line."))
-
(defun eval-and-typeset-propositions (prop-strs &key (format "unicode")
(implicit-and t)
multi-char-names
@@ -83,116 +51,6 @@ functions involved in evaluating and typesetting."
"Specification for `parse-command-line'. This is of the format:
(short long symbol has-arg-p desc).")
-(defparameter *cli-parse-continue-string*
- "Continue paring arguments normally."
- "String to use for `cerror' during argument parsing.")
-
-(defun parse-long-option (spec arg next-arg)
- "Parse the long option ARG. Return a list of its symbol, its value (or t if
-it did not have one), and weather it consumed NEXT-ARG or not."
- (destructuring-bind (name &optional value)
- (uiop:split-string (subseq arg 2)
- :max 2
- :separator "=")
- (loop for (short long symbol has-arg-p dest) in spec
- when (equal name long) do
- (if has-arg-p
- (cond
- (value
- (return (list symbol value nil)))
- (next-arg
- (return (list symbol next-arg t)))
- (t
- (cerror *cli-parse-continue-string*
- 'option-no-arg-error :opt name)
- (return (list symbol nil nil))))
- (return (list symbol t nil)))
- finally
- (cerror *cli-parse-continue-string*
- 'unknown-option-error :opt name)
- (return (list symbol nil nil)))))
-
-(defun parse-short-option (spec arg next-arg)
- "Parse the short options in ARG according to SPEC. Return a list of options
-with each entry being similar to the return value of `parse-long-option'."
- (loop with output = '()
- for i from 1 to (1- (length arg))
- for char = (elt arg i)
- for (short long symbol has-arg-p desc) = (assoc char spec) do
- (cond
- (has-arg-p
- (cond
- ((< i (1- (length arg)))
- (push (list symbol (subseq arg (1+ i)) nil) output)
- (return output))
- (next-arg
- (push (list symbol next-arg t) output)
- (return output))
- (t
- (cerror *cli-parse-continue-string*
- 'option-no-arg-error :opt char))))
- (short
- (push (list symbol t nil) output))
- (t
- (cerror *cli-parse-continue-string*
- 'unknown-option-error :opt char)))
- finally (return output)))
-
-(defun parse-command-line (spec argv)
- "Parse command line arguments in ARGV according to SPEC. Return an alist with
-the car being the option's symbol (as specified in SPEC), and the cdr being
-the argument it had on the command line, or t if it had none. The rest of the
-arguments will be placed in a list at the beginning of the alist."
- (let ((output-opts '())
- (output-other '()))
- (loop for (arg . rest) = argv then rest
- while (and arg (not (equal arg "--"))) do
- (cond
- ((uiop:string-prefix-p "--" arg)
- (destructuring-bind (symbol value skip-next-p)
- (parse-long-option spec arg (car rest))
- (push (cons symbol value) output-opts)
- (when skip-next-p
- (setq rest (cdr rest)))))
- ((uiop:string-prefix-p "-" arg)
- (loop for (symbol value skip-next-p) in (parse-short-option
- spec arg (car rest))
- do
- (push (cons symbol value) output-opts)
- (when skip-next-p
- (setq rest (cdr rest)))))
- (t
- (push arg output-other)))
- finally (setf output-other (nconc (nreverse rest) output-other)))
- (cons (nreverse output-other) output-opts)))
-
-(defun print-usage (stream spec)
- "Print the command line usage corresponding to SPEC to STREAM."
- (format stream "usage: truth-table [options] ~%~%")
- (loop with longest-option
- = (apply 'max (mapcar
- (lambda (entry)
- (destructuring-bind (short long sym has-arg-p &rest other)
- entry
- (declare (ignorable other sym))
- (+ (if short 2 0)
- (if long (+ 2 (length long)) 0)
- (if (and short long) 2 0)
- (if has-arg-p 6 0))))
- spec))
- for (short long symbol has-arg-p desc) in spec
- do
- (format stream " ~v@<~@[-~c~]~@[, ~*~]~@[--~a~]~@[=~*~]~> ~a~%"
- longest-option
- short (or short long) long has-arg-p desc))
- (format stream "~%The choice surrounded by '*' is the default. Arguments to long
-options are also required for their short variant.~%"))
-
-(defun option-value (opt opts)
- "Get the value of command line option OPT from OTPS, which is an alist as
-returned as the second output of `parse-command-line'."
- (cdr (assoc opt opts)))
-
(defun main (argv)
"The main entry point to the program. ARGV is the list of command line
arguments."
@@ -212,7 +70,8 @@ arguments."
(parse-command-line *command-line-spec* argv)
(cond
((option-value 'help opts)
- (print-usage t *command-line-spec*)
+ (print-usage t *command-line-spec*
+ "truth-table" "")
(uiop:quit (if cmdline-error 1 0)))
((null prop-strs)
(cerror *cli-parse-continue-string* 'no-input-error))
diff --git a/packages.lisp b/packages.lisp
index 1f65ce3..da8acbd 100644
--- a/packages.lisp
+++ b/packages.lisp
@@ -47,6 +47,25 @@
#:*known-formats*
#:typeset-table-to-format))
+(defpackage #:truth-table/args
+ (:use #:common-lisp)
+ (:export
+ #:*cli-parse-continue-string*
+ #:command-line-error
+ #:cli-argument-error
+ #:unknown-option-error
+ #:option-no-arg-error
+ #:no-input-error
+ #:parse-command-line
+ #:print-usage
+ #:option-value))
+
(defpackage #:truth-table/cli
- (:use #:common-lisp #:truth-table/base)
+ (:use #:common-lisp #:truth-table/base
+ #:truth-table/args)
+ (:export #:toplevel #:main))
+
+(defpackage #:truth-table/web
+ (:use #:common-lisp #:truth-table/base
+ #:truth-table/args)
(:export #:toplevel #:main))
diff --git a/truth-table.asd b/truth-table.asd
index 45901b3..3535f4d 100644
--- a/truth-table.asd
+++ b/truth-table.asd
@@ -1,11 +1,12 @@
(defsystem #:truth-table
+ :version "0.0.1"
:description "Tools for working with logical propositions and truth tables"
:author "Alexander Rosenberg "
:license "AGPL3"
:depends-on ())
(defsystem #:truth-table/base
- :version "0.0.1"
+ :depends-on ()
:serial t
:components
((:file "packages")
@@ -14,11 +15,31 @@
(:file "table")
(:file "typeset")))
+(defsystem #:truth-table/args
+ :depends-on (#:uiop)
+ :serial t
+ :components
+ ((:file "packages")
+ (:file "arguments")))
+
(defsystem #:truth-table/cli
:depends-on (#:uiop
#:with-user-abort
- #:truth-table/base)
+ #:truth-table/base
+ #:truth-table/args)
:serial t
:components
((:file "packages")
(:file "cli")))
+
+(defsystem #:truth-table/web
+ :depends-on (#:uiop
+ #:with-user-abort
+ #:reblocks
+ #:reblocks-ui
+ #:truth-table/base
+ #:truth-table/args)
+ :serial t
+ :components
+ ((:file "packages")
+ (:file "web")))
diff --git a/web.lisp b/web.lisp
new file mode 100644
index 0000000..46489f4
--- /dev/null
+++ b/web.lisp
@@ -0,0 +1,30 @@
+;; web.lisp -- Website to allow users to make truth tables
+;; Copyright (C) 2024 Alexander Rosenberg
+;;
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see .
+(in-package :truth-table/web)
+
+(defun main (argv)
+ "The main entry point to the program. ARGV is the list of command line
+arguments."
+ (format t "Hello World~%"))
+
+(defun toplevel ()
+ "Top-level function to be passed to `save-lisp-and-die'."
+ (handler-case
+ (with-user-abort:with-user-abort
+ (main (uiop:command-line-arguments)))
+ (with-user-abort:user-abort ()
+ (format *error-output* "Keyboard interrupt~%")
+ (uiop:quit 1))))