Created
June 22, 2022 13:45
-
-
Save rongarret/13e521f696a7a45b0e60c8ebecbdabeb to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(require :webutils) | |
(ensure-http-server 1234) | |
(defv ti1 (textinput :ti1)) | |
(defv ti2 (textarea :ti2 40 5)) | |
(defv pwi (pwinput :pwi)) | |
(defv ta (textarea :ta1 80 5)) | |
(defv cb1 (make-instance 'checkbox :id :cb1 :default t)) | |
(defv cb2 (make-instance 'checkbox :id :cb2 :override :off)) | |
(defv m (menu :m1 '(foo baz bar) :default 'bar)) | |
(defun multimenu (id items &rest attrs) | |
(make-multi-menu :id id :items items :attrs (apply '-> attrs))) | |
(defv mm (multimenu :mm1 (list 'foo :baz "bar" "<b>bold</b>"))) | |
(defv rb1 (radio-buttons :rb1 '(foo baz bar))) | |
(defv d1 (make-instance 'date-input :id 'd1)) | |
(defv fi (fileinput "file1")) | |
(defv stylesheet | |
(css-render | |
'(body (font-family sans-serif) | |
div (margin auto width 800px border "1px solid black" padding 10px) | |
table (border-collapse collapse) | |
td (border "1px solid black" padding 3px)))) | |
(defpage "/test" | |
(:head (:title "Test") (:style :type "text/css" (str stylesheet))) | |
(:div | |
(:form :method :post :action (script-name*) | |
(hro (make-table `(("Field 1" ,ti1) | |
("Field 2" ,ti2) | |
("Password" ,pwi) | |
("Will you?" ,cb1) | |
("Won't you?" ,cb2) | |
("Pick one" ,m) | |
("Pick several" ,mm) | |
("Date" ,d1) | |
("One more:" ,rb1)))) | |
(:input :type :submit)) | |
(:form :method :post :action (script-name*) :enctype "multipart/form-data" | |
(:hr "File: " (hro fi) (:input :type :submit) :hr)) | |
(generate-info-table | |
(post-parameters*) (value m) (value mm) (value d1) (format-date (value d1)) | |
(filename fi) (contents fi)) | |
)) | |
(defun link1 (addr text) (princ (html (:a :href (str addr) (str text))))) | |
(defun link2 (addr text) (format t "<a href='~A'>~A</a>" addr text)) | |
; Requires patch to cl-who: | |
(defun link3 (addr text) (princ (html (:a :href addr text)))) | |
(let ((cnt 0)) | |
(defpage "/home" | |
(:head (:title "Welcome") (:style :type "text/css" (str stylesheet))) | |
(:body | |
(:div | |
(:h2 "Welcome! λ«»“”") | |
(:form :method :post :action "/" | |
"X: " (:input :type :text :name :x) | |
"Y: " (:input :type :text :name :y) | |
(:input :type :submit)) | |
:br | |
(:a :href "/hunchentoot/test" "Demos") :br | |
(link1 "/test" "Form test") :br | |
(link2 "/crash" "Error test") :br | |
(link3 "/production-crash" "Production error test") :br | |
:hr | |
(generate-info-table | |
(incf cnt) | |
*request* | |
(script-name*) | |
(get-parameters*) | |
(post-parameters*)) | |
:hr "Table test" :br | |
(hro (make-table `((1 2 3) (4 "foo bar" ,(make-table '((nested table))))))) | |
:hr | |
(str (list 1 2 3)) :br | |
(str "<b>Bold</b>") :br (esc "<b>Bold</b>") :br (print "<b>Bold</b>") | |
:hr | |
(hro *request*) | |
:hr | |
(wco (describe *request*)))))) | |
(defun crash () (error "Intentional error for testing")) | |
(defpage "/crash" (crash)) | |
(defpage "/production-crash" (let ((*devel-mode* nil)) (crash))) | |
(defpage "/" (forward "/home")) | |
(setf ht:*LOG-LISP-BACKTRACES-P* nil) | |
(setf ht:*LOG-LISP-ERRORS-P* nil) | |
(setf ht:*SHOW-LISP-ERRORS-P* nil) | |
(setf *devel-mode* t) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment