mirrors/clog
1
Fork 0
mirror of https://github.com/rabbibotton/clog.git synced 2025-12-06 02:30:42 -08:00
Code Issues Projects Releases Wiki Activity

Theme helpers and better theming

Browse source
This commit is contained in:
David Botton 2022-04-26 22:43:59 -04:00
parent 99f7d663cb
commit 222b2c9d54
3 changed files with 132 additions and 93 deletions
Download patch file Download diff file Expand all files Collapse all files

214
source/clog-web-themes.lisp
View file

@ -11,106 +11,140 @@
(cl:in-package :clog-web) (cl:in-package :clog-web)
(defsection @clog-web-themes (:title "CLOG Web Site Themes") (defsection @clog-web-themes (:title "CLOG Web Site Themes")
"Theme helpers"
(get-setting function)
(get-property function)
"Built in themes" "Built in themes"
(default-theme function)) (default-theme function))
;;;;;;;;;;;;;;;;;
;; get-setting ;;
;;;;;;;;;;;;;;;;;
(defun get-setting (website key default)
"Return the setting for KEY or DEFAULT from website settings"
(get-property (settings website) key default))
;;;;;;;;;;;;;;;;;;
;; get-property ;;
;;;;;;;;;;;;;;;;;;
(defun get-property (properties key default)
"Return the property for KEY from the p-list PROPERTIES or DEFAULT"
(if (getf properties key)
(getf properties key)
default))
;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;
;; default-theme ;; ;; default-theme ;;
;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;
(defun default-theme (body website page properties) (defun default-theme (body page properties)
"The default theme for clog-web-site. "The default theme for clog-web-site.
Settings available: Settings available:
:color-class - w3 color class for menu bars and buttons :color-class - w3 color class for menu bars and buttons (def: w3-black)
:border-class - w3 border :border-class - w3 border (def: \"\")
:text-class - w3 text color class :text-class - w3 text color class (def: \"\")
:username-link - link when clicking on username (default /logout) :signup-link - link to signup (def: /signup)
:login-link - link to login (def: /login)
:username-link - link when clicking on username (def: /logout)
Page properties: Page properties:
:menu - ((\"Menu Name\" ((\"Menu Item\" \"link\")))) :menu - ((\"Menu Name\" ((\"Menu Item\" \"link\")))) (def: nil)
:content" :content - (def: \"\")"
(let ((sb (create-style-block body))) ;; Settings and Properties with default values
(add-style sb :element "a" '(("text-decoration" :none)))) (let* ((website (get-web-site body))
(let* ((row (create-web-auto-row body)) (color-class (get-setting website :color-class "w3-black"))
(left (create-web-auto-column row)) (border-class (get-setting website :border-class ""))
(right (create-web-auto-column row :vertical-align :middle))) (text-class (get-setting website :text-class ""))
(when (logo website) (login-link (get-setting website :login-link "/login"))
(set-geometry (create-img (create-a left (signup-link (get-setting website :signup-link "/signup"))
:link (url website)) (username-link (get-setting website :username-link "/logout"))
:url-src (logo website)) (menu-property (get-property properties :menu "w3-black"))
:height 75)) (content (get-property properties :content "")))
(create-span (create-a right ;; Setup CSS style changes
:link (url website)) (let ((sb (create-style-block body)))
:content (title website) (add-style sb :element "a" '(("text-decoration" :none))))
:class "w3-xlarge w3-sans-serif")) ;;
(let ((menu (create-web-menu-bar body :class "w3-card-4"))) ;; Page layout
(when (getf (settings website) :color-class) ;;
(add-class menu (getf (settings website) :color-class))) ;; SECTION: Above of menu bar
(dolist (drop-down (getf properties :menu)) (let* ((row (create-web-auto-row body))
(let ((drop (create-web-menu-drop-down menu (left (create-web-auto-column row))
:content (first drop-down) (right (create-web-auto-column row :vertical-align :middle)))
:class "w3-border")) (when (logo website)
(count 0)) (set-geometry (create-img (create-a left
(dolist (item (second drop-down)) :link (url website))
(when (or (and (fourth item) :url-src (logo website))
(clog-auth:is-authorized-p (roles website) :height 75))
(fourth item))) (create-span (create-a right
(eq (fourth item) nil)) :link (url website))
(incf count) :content (title website)
(create-web-menu-item drop :class "w3-xlarge w3-sans-serif"))
:content (first item) ;; SECTION: Menu bar
:link (second item)))) (let ((menu (create-web-menu-bar body :class "w3-card-4")))
(when (eql count 0) (add-class menu color-class)
(destroy (parent-element drop))))) (dolist (drop-down menu-property)
(when (getf (profile website) :|username|) (let ((drop (create-web-menu-drop-down menu
(create-web-menu-item menu :class "w3-right" :content (first drop-down)
:content (getf (profile website) :|username|) :class "w3-border"))
:link (if (getf (settings website) :username-link) (count 0))
(getf (settings website) :username-link) (dolist (item (second drop-down))
"/logout")))) (when (or (and (fourth item)
(create-br body) (clog-auth:is-authorized-p (roles website)
(let ((c (getf properties :content))) (fourth item)))
(when c (eq (fourth item) nil))
(typecase c (incf count)
(create-web-menu-item drop
:content (first item)
:link (second item))))
(when (eql count 0)
(destroy (parent-element drop)))))
(if (getf (profile website) :|username|)
(create-web-menu-item menu :class "w3-right"
:content (getf (profile website) :|username|)
:link username-link)
(when login-link
(create-web-menu-item menu :class "w3-right"
:content "login"
:link login-link))))
;; SECTION: Content area
(create-br body)
(when content
(typecase content
(string (string
(create-div body :content c)) (create-div body :content content))
(function (function
(funcall c body)) (funcall content body))
(t (t
(create-div body :content (format nil "~A" c)))))) (create-div body :content (format nil "~A" content)))))
(when (eq page :login) ;; SECTION: Special pages - Login
(let* ((outter (create-web-container body)) (when (eq page :login)
(form (create-form outter)) (let* ((outter (create-web-container body))
(t-class (if (getf (settings website) :text-class) (form (create-form outter))
(getf (settings website) :text-class) (p1 (create-p form))
"")) (l1 (create-label p1 :content "User Name"
(b-class (if (getf (settings website) :border-class) :class text-class))
(getf (settings website) :border-class) (user (create-form-element p1 :text
"")) :name "username"
(p1 (create-p form)) :class (format nil "w3-input ~A" border-class)))
(l1 (create-label p1 :content "User Name" (p2 (create-p form))
:class t-class)) (l2 (create-label p2 :content "Password"
(user (create-form-element p1 :text :class text-class))
:name "username" (pass (create-form-element p2 :password
:class (format nil "w3-input ~A" b-class))) :name "password"
(p2 (create-p form)) :class (format nil "w3-input ~A" border-class)))
(l2 (create-label p2 :content "Password" (p3 (create-p form)))
:class t-class)) (declare (ignore l1 l2 p3))
(pass (create-form-element p2 :password (setf (maximum-width outter) (unit :px 500))
:name "password" (setf (requiredp user) t)
:class (format nil "w3-input ~A" b-class))) (setf (requiredp pass) t)
(p3 (create-p form))) (create-form-element form :submit :value "Submit"
:class (format nil "~A ~A" "w3-button" color-class))
(declare (ignore l1 l2 p3)) (set-on-submit form (getf properties :on-submit))
(setf (maximum-width outter) (unit :px 500)) (when signup-link
(setf (requiredp user) t) (create-a form :class "w3-right" :content "sign up" :link signup-link))))
(setf (requiredp pass) t) ;; SECTION: Footer
(create-form-element form :submit :value "Submit" (create-br body)
:class (format nil "~A ~A" "w3-button" (create-br body)
(getf (settings website) (create-div body :content (format nil "~A" (footer website)))))
:color-class)))
(set-on-submit form (getf properties :on-submit))
(when (getf properties :sign-up)
(create-a form :class "w3-right" :content "sign up" :link (getf properties :sign-up)))))
(create-br body)
(create-br body)
(create-div body :content (format nil "~A" (footer website))))

6
source/clog-web.lisp
View file

@ -1097,6 +1097,10 @@ clog-body."))
(setf (web-site app) website) (setf (web-site app) website)
website)) website))
;;;;;;;;;;;;;;;;;;
;; get-web-site ;;
;;;;;;;;;;;;;;;;;;
(defgeneric get-web-site (clog-obj) (defgeneric get-web-site (clog-obj)
(:documentation "Retrieve the clog-web-site object created on CLOG-OBJ's (:documentation "Retrieve the clog-web-site object created on CLOG-OBJ's
connection")) connection"))
@ -1123,7 +1127,7 @@ permission to PAGE"))
(clog-auth:is-authorized-p (roles (get-web-site obj)) page)) (clog-auth:is-authorized-p (roles (get-web-site obj)) page))
(not authorize)) (not authorize))
(funcall (theme (get-web-site obj)) (funcall (theme (get-web-site obj))
obj (get-web-site obj) page properties) obj page properties)
(create-div obj :content "Authorization failure"))) (create-div obj :content "Authorization failure")))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

5
tutorial/31-tutorial.lisp
View file

@ -71,7 +71,9 @@
(let ((profile (get-profile body *sql-connection*))) (let ((profile (get-profile body *sql-connection*)))
(create-web-site body (create-web-site body
:settings '(:color-class "w3-blue-gray" :settings '(:color-class "w3-blue-gray"
:border-class "") :border-class ""
:signup-link "/signup"
:login-link "/login")
:profile profile :profile profile
:roles (if profile :roles (if profile
(if (equalp "admin" (if (equalp "admin"
@ -93,7 +95,6 @@
(create-web-page (create-web-page
body body
:login `(:menu ,*menu* :login `(:menu ,*menu*
:sign-up "/signup"
:on-submit ,(lambda (obj) :on-submit ,(lambda (obj)
(if (login body *sql-connection* (if (login body *sql-connection*
(name-value obj "username") (name-value obj "username")