diff options
-rw-r--r-- | web/panettone/src/css.lisp | 20 | ||||
-rw-r--r-- | web/panettone/src/panettone.lisp | 51 |
2 files changed, 53 insertions, 18 deletions
diff --git a/web/panettone/src/css.lisp b/web/panettone/src/css.lisp index f256e8e8f6ce..2357e0ccef8c 100644 --- a/web/panettone/src/css.lisp +++ b/web/panettone/src/css.lisp @@ -103,7 +103,18 @@ :border "none" :cursor "pointer") - ,@(button '(:and input (:= type "submit"))))) + ,@(button '(:and input (:= type "submit"))) + + (.form-link + ((:and input (:= type "submit")) + :background-color "initial" + :color "inherit" + :padding 0 + :text-decoration "underline") + + ((:and input (:= type "submit") + (:or :hover :active :focus)) + :box-shadow 0 0 0 0)))) (defparameter issue-styles `((.issue-info @@ -145,13 +156,14 @@ :font-size "1.5rem")) (nav - :display :flex - :color ,color/gray) + :display "flex" + :color ,color/gray + :justify-content "space-between") (footer :border-top "1px" "solid" ,color/gray :padding-top "1rem" - :margin-top "2rem" + :margin-top "1rem" :color ,color/gray) ,@(button '.new-issue) diff --git a/web/panettone/src/panettone.lisp b/web/panettone/src/panettone.lisp index 9cb0a8ef56d2..14010b8aa8d0 100644 --- a/web/panettone/src/panettone.lisp +++ b/web/panettone/src/panettone.lisp @@ -174,16 +174,39 @@ updated issue" (defvar *title* "Panettone") +(defvar *user* nil) + (setf (who:html-mode) :HTML5) -(defmacro render (&body body) +(defun render/footer-nav (&rest extra) + (who:with-html-output (*standard-output*) + (:footer + (:nav + (if (find (hunchentoot:request-uri*) + (list "/" "/issues/closed") + :test #'string=) + (who:htm (:span :class "placeholder")) + (who:htm (:a :href "/" "All Issues"))) + (if *user* + (who:htm + (:form :class "form-link log-out" + :method "post" + :action "/logout" + (:input :type "submit" :value "Log Out"))) + (who:htm + (:a :href "/login" "Log In"))))))) + +(defmacro render ((&key (footer t)) &body body) `(who:with-html-output-to-string (*standard-output* nil :prologue t) (:head (:title (who:esc *title*)) (:link :rel "stylesheet" :type "text/css" :href "/main.css")) (:body - (:div :class "content" - ,@body)))) + (:div + :class "content" + ,@body + (when ,footer + (render/footer-nav)))))) (defun render/alert (message) "Render an alert box for MESSAGE, if non-null" @@ -193,7 +216,7 @@ updated issue" (who:htm (:div :class "alert" (who:esc message)))))) (defun render/login (&key message (original-uri "/")) - (render + (render (:footer nil) (:div :class "login-form" (:header @@ -262,7 +285,7 @@ updated issue" (format nil "~A comment~:p" num-comments)))))))))))))) (defun render/index (&key issues) - (render + (render () (:header (:h1 "Issues") (:a @@ -275,7 +298,7 @@ updated issue" (render/issue-list :issues issues)))) (defun render/closed-issues (&key issues) - (render + (render () (:header (:h1 "Closed issues")) (:main @@ -285,7 +308,7 @@ updated issue" (render/issue-list :issues issues)))) (defun render/new-issue (&optional message) - (render + (render () (:header (:h1 "New Issue")) (:main @@ -324,7 +347,7 @@ updated issue" (check-type issue issue) (let ((issue-id (get-id issue)) (issue-status (status issue))) - (render + (render () (:header (:h1 (who:esc (subject issue))) (:div :class "issue-number" @@ -365,20 +388,16 @@ updated issue" (who:esc (displayname author)) " at " (who:esc (format-dottime (created-at comment))))))))) - (render/new-comment (get-id issue)))))) - (:footer - (:nav (:a :href "/" "All Issues")))))) + (render/new-comment (get-id issue))))))))) (defun render/not-found (entity-type) - (render + (render () (:h1 (who:esc entity-type) "Not Found"))) ;;; ;;; HTTP handlers ;;; -(defvar *user* nil) - (defun @auth (next) (if-let ((*user* (hunchentoot:session-value 'user))) (funcall next) @@ -402,6 +421,10 @@ updated issue" (hunchentoot:redirect (or original-uri "/"))) (render/login :message "Invalid credentials"))) +(defroute logout ("/logout" :method :post) () + (hunchentoot:delete-session-value 'user) + (hunchentoot:redirect "/")) + (defroute index ("/" :decorators (@auth)) () (let ((issues (open-issues *p-system*))) (render/index :issues issues))) |