about summary refs log tree commit diff
path: root/web
diff options
context:
space:
mode:
authorGriffin Smith <grfn@gws.fyi>2020-08-28T22·10-0400
committerglittershark <grfn@gws.fyi>2020-08-29T16·43+0000
commitde851ec08b6a2796d0333a650d368de73fb8b923 (patch)
tree56ce32b5b178ea6404c471f6a80edd1420e0a5a9 /web
parent74a8c3d3591801eea4ad00c74b98f0043f20d4cc (diff)
feat(panettone): Add nav to the top of the page as well r/1737
The absence of the navbar containing the "all issues" and "log out"
links from the top of the page has been a common complaint - initially I
disagreed, but after some time thinking about it I've come around. This
adds the same nav - with the "All Issues" link and the "Log Out" link -
to the top of every page, and also fixes a bug where query params would
prevent the "All Issues" link from being hidden on the "All Issues"
page, which looked especially weird when they were right next to each other.

Change-Id: I1d07175fa07aee057ddd140a6864d01342fbb7ef
Reviewed-on: https://cl.tvl.fyi/c/depot/+/1868
Reviewed-by: kanepyork <rikingcoding@gmail.com>
Tested-by: BuildkiteCI
Diffstat (limited to 'web')
-rw-r--r--web/panettone/default.nix1
-rw-r--r--web/panettone/src/packages.lisp1
-rw-r--r--web/panettone/src/panettone.lisp55
3 files changed, 33 insertions, 24 deletions
diff --git a/web/panettone/default.nix b/web/panettone/default.nix
index 4f6faaea32..3ff8ca55ec 100644
--- a/web/panettone/default.nix
+++ b/web/panettone/default.nix
@@ -5,6 +5,7 @@ depot.nix.buildLisp.program {
 
   deps = with depot.third_party.lisp; [
     cl-json
+    cl-ppcre
     cl-who
     drakma
     defclass-std
diff --git a/web/panettone/src/packages.lisp b/web/panettone/src/packages.lisp
index 596589f790..1510df224b 100644
--- a/web/panettone/src/packages.lisp
+++ b/web/panettone/src/packages.lisp
@@ -41,6 +41,7 @@
         :panettone.authentication)
   (:import-from :defclass-std :defclass/std)
   (:import-from :alexandria :if-let :when-let :switch :alist-hash-table)
+  (:import-from :cl-ppcre :split)
   (:import-from
    :panettone.model
    :id :subject :body :author-dn :issue-id :status :created-at
diff --git a/web/panettone/src/panettone.lisp b/web/panettone/src/panettone.lisp
index 9ea82f2efb..d4746c7706 100644
--- a/web/panettone/src/panettone.lisp
+++ b/web/panettone/src/panettone.lisp
@@ -65,33 +65,35 @@
 
 (setf (who:html-mode) :html5)
 
-(defun render/footer-nav ()
+(defun render/nav ()
   (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
-               (format nil
-                       "/login?original-uri=~A"
-                       (drakma:url-encode (hunchentoot:request-uri*)
-                                          :utf-8))
-               "Log In")))))))
+    (:nav
+     (if (find (car (split "\\?" (hunchentoot:request-uri*) :limit 2))
+               (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
+              (format nil
+                      "/login?original-uri=~A"
+                      (drakma:url-encode (hunchentoot:request-uri*)
+                                         :utf-8))
+              "Log In"))))))
 
 (defun author (object)
   (find-user-by-dn (author-dn object)))
 
-(defmacro render ((&key (footer t)) &body body)
+(defmacro render ((&key
+                     (footer t)
+                     (header t))
+                  &body body)
   `(who:with-html-output-to-string (*standard-output* nil :prologue t)
      (:html
       :lang "en"
@@ -103,9 +105,14 @@
       (:body
        (:div
         :class "content"
+        (when ,header
+          (who:htm
+           (render/nav)))
         ,@body
         (when ,footer
-          (render/footer-nav)))))))
+          (who:htm
+           (:footer
+            (render/nav)))))))))
 
 (defun form-button (&key
                       class
@@ -129,7 +136,7 @@
       (who:htm (:div :class "alert" (who:esc message))))))
 
 (defun render/login (&key message (original-uri "/"))
-  (render (:footer nil)
+  (render (:footer nil :header nil)
     (:div
      :class "login-form"
      (:header