diff options
Diffstat (limited to 'fussy.lisp')
| -rw-r--r-- | fussy.lisp | 104 |
1 files changed, 68 insertions, 36 deletions
@@ -200,7 +200,7 @@ returns a list of those names." (defgeneric url-path (theme)) (defmethod url-path ((theme theme-pkg)) - (format nil "/theme/~a" (string-downcase (theme-pkg-name theme)))) + (format nil "/package/~a" (string-downcase (theme-pkg-name theme)))) (defmethod url-path ((theme string)) (assert (theme-p theme)) (format nil "/theme/~a/~a" @@ -303,6 +303,7 @@ that they are not loaded during image gen.") theme (or variant (pathname-name (first (image-files-for-theme theme)))))) + (defun start (&key config-file) (unless config-file (setf config-file @@ -334,9 +335,6 @@ that they are not loaded during image gen.") (parse-integer string)) - - - (defparameter +themes-per-page+ 21) (defun page-nav (page page-count) @@ -350,13 +348,17 @@ that they are not loaded during image gen.") (format nil "~a" (1+ pg))) " ")))))) +(defun theme-preview-image (theme &optional variant) + (html:with-html + (:img + :class "preview" + :src (theme-preview-image-path theme variant)))) + (defun theme-preview-card (theme) (html:with-html (:div :class "card" (:a :href (url-path theme) (:h4 theme)) - (:img - :class "preview" - :src (theme-preview-image-path theme))))) + (theme-preview-image theme)))) (defun style () (html:with-html @@ -432,7 +434,6 @@ nav { h1 { text-align: center; } - ") (lzb:defendpoint* :get "/css/style.css" () () @@ -482,34 +483,65 @@ h1 { (dolist (theme themes) (theme-preview-card theme))))))))) +(defun a-package (string) + (a:if-let (pkg + (theme-pkg-with-name + (intern (string-upcase string) :fussy))) + pkg + (lzb:http-err 404 (format nil "No such theme package: ~a" string)))) + +(defun a-theme (string) + (if (theme-p string) string + (lzb:http-err 404 (format nil "No such theme: ~a" string)))) +(defun package-namestring (pkg) + (hq:>> () pkg theme-pkg-name symbol-name string-downcase)) -(lzb:defendpoint* :get "/package/:package:" () () +(lzb:defendpoint* :get "/package/:pkg a-package:" () () "The page endpoint for a theme package" - (a:if-let (pkg - (theme-pkg-with-name - (intern (string-upcase package) :fussy))) - (let ((themes - (themes-in-package pkg))) - (html:with-html-string - (:doctype) - (:html - (:head - (:title package) - (style)) - (:body - (:div :class "main" - (:h1 package) - (:div :class "info" - (:dl - (:dt "Description") - (:dd (theme-pkg-description pkg)) - (:dt "URL") - (:dd (:a :href (theme-pkg-url pkg) - (theme-pkg-url pkg))) - (:dt "Number of Themes") - (:dd (length themes)))) - (:div :class "container" - (dolist (theme themes) - (theme-preview-card theme)))))))) - (lzb:http-err 404 "No such theme"))) + (let ((themes + (themes-in-package pkg))) + (html:with-html-string + (:doctype) + (:html + (:head + (:title ) + (style)) + (:body + (:div :class "main" + (:h1 (package-namestring pkg) ) + (:div :class "info" + (:dl + (:dt "Description") + (:dd (theme-pkg-description pkg)) + (:dt "URL") + (:dd (:a :href (theme-pkg-url pkg) + (theme-pkg-url pkg))) + (:dt "Number of Themes") + (:dd (length themes)))) + (:div :class "container" + (dolist (theme themes) + (theme-preview-card theme))))))))) + + + +(lzb:defendpoint* :get "/theme/:pkg a-package:/:theme a-theme:" () () + "The page for a particular theme showing its previews for different prog langs" + (unless (member theme (themes-in-package pkg) :test #'string-equal) + (lzb:http-err 403 (format nil "The theme ~a is not in the package ~a" + theme (package-namestring pkg)))) + (html:with-html-string + (:doctype) + (:html + (:head + (:title theme) + (style)) + (:body + (:div :class "main" + (:h1 theme) + (:div + (:p "A theme in the package " + (:a :href (url-path pkg) (package-namestring pkg)))) + (:div :class "container" + (dolist (variant (mapcar #'pathname-name (image-files-for-theme theme))) + (theme-preview-image theme variant)))))))) |