Zander671/truth-table
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Add a prefix option to web app

Browse Source
This commit is contained in:
Alexander Rosenberg 2024-09-05 18:10:14 -07:00
parent 85fbd9e5cd
commit 76ae43160a
Signed by: Zander671
GPG Key ID: 5FD0394ADBD72730
1 changed files with 11 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
web.lisp
View File

@ -36,6 +36,7 @@
(defparameter *default-port* 8000) (defparameter *default-port* 8000)
(defparameter *default-address* "127.0.0.1") (defparameter *default-address* "127.0.0.1")
(defparameter *default-prefix* "/")
(defwidget truth-table () (defwidget truth-table ()
((data :initform nil ((data :initform nil
@ -297,7 +298,11 @@ reblocks bug.")
(#\p "port" port t (#\p "port" port t
,(format nil "specify port to use (default: ~d)" *default-port*)) ,(format nil "specify port to use (default: ~d)" *default-port*))
(#\a "address" address t (#\a "address" address t
,(format nil "specify address to bind to (default: ~a)" *default-address*))) ,(format nil "specify address to bind to (default: ~a)"
*default-address*))
(#\x "prefix" prefix t
,(format nil "specify the URL prefix (default: ~a)"
*default-prefix*)))
"Spec for use in `parse-command-line.") "Spec for use in `parse-command-line.")
(defun determine-port (opts) (defun determine-port (opts)
@ -342,10 +347,14 @@ arguments."
(uiop:quit 0))) (uiop:quit 0)))
(when cmdline-error (when cmdline-error
(uiop:quit 1)) (uiop:quit 1))
(defapp truth-table-app
:prefix (or (option-value 'prefix opts)
*default-prefix*))
(reblocks/server:start :apps '(truth-table-app) (reblocks/server:start :apps '(truth-table-app)
:port port :port port
:interface address :interface address
:debug (option-value 'debug opts))))))) :debug (option-value 'debug opts)
:disable-welcome-app t))))))
(defun toplevel () (defun toplevel ()
"Top-level function to be passed to `save-lisp-and-die'." "Top-level function to be passed to `save-lisp-and-die'."