mirror of
https://github.com/rabbibotton/clog.git
synced 2025-12-06 02:30:42 -08:00
Theme helpers and better theming
This commit is contained in:
David Botton
parent
99f7d663cb
commit
222b2c9d54
3 changed files with 132 additions and 93 deletions
|
|
@ -11,106 +11,140 @@
|
|||
(cl:in-package :clog-web)
|
||||
|
||||
(defsection @clog-web-themes (:title "CLOG Web Site Themes")
|
||||
"Theme helpers"
|
||||
(get-setting function)
|
||||
(get-property function)
|
||||
|
||||
"Built in themes"
|
||||
(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 ;;
|
||||
;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defun default-theme (body website page properties)
|
||||
(defun default-theme (body page properties)
|
||||
"The default theme for clog-web-site.
|
||||
Settings available:
|
||||
:color-class - w3 color class for menu bars and buttons
|
||||
:border-class - w3 border
|
||||
:text-class - w3 text color class
|
||||
:username-link - link when clicking on username (default /logout)
|
||||
:color-class - w3 color class for menu bars and buttons (def: w3-black)
|
||||
:border-class - w3 border (def: \"\")
|
||||
:text-class - w3 text color class (def: \"\")
|
||||
: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:
|
||||
:menu - ((\"Menu Name\" ((\"Menu Item\" \"link\"))))
|
||||
:content"
|
||||
(let ((sb (create-style-block body)))
|
||||
(add-style sb :element "a" '(("text-decoration" :none))))
|
||||
(let* ((row (create-web-auto-row body))
|
||||
(left (create-web-auto-column row))
|
||||
(right (create-web-auto-column row :vertical-align :middle)))
|
||||
(when (logo website)
|
||||
(set-geometry (create-img (create-a left
|
||||
:link (url website))
|
||||
:url-src (logo website))
|
||||
:height 75))
|
||||
(create-span (create-a right
|
||||
:link (url website))
|
||||
:content (title website)
|
||||
:class "w3-xlarge w3-sans-serif"))
|
||||
(let ((menu (create-web-menu-bar body :class "w3-card-4")))
|
||||
(when (getf (settings website) :color-class)
|
||||
(add-class menu (getf (settings website) :color-class)))
|
||||
(dolist (drop-down (getf properties :menu))
|
||||
(let ((drop (create-web-menu-drop-down menu
|
||||
:content (first drop-down)
|
||||
:class "w3-border"))
|
||||
(count 0))
|
||||
(dolist (item (second drop-down))
|
||||
(when (or (and (fourth item)
|
||||
(clog-auth:is-authorized-p (roles website)
|
||||
(fourth item)))
|
||||
(eq (fourth item) nil))
|
||||
(incf count)
|
||||
(create-web-menu-item drop
|
||||
:content (first item)
|
||||
:link (second item))))
|
||||
(when (eql count 0)
|
||||
(destroy (parent-element drop)))))
|
||||
(when (getf (profile website) :|username|)
|
||||
(create-web-menu-item menu :class "w3-right"
|
||||
:content (getf (profile website) :|username|)
|
||||
:link (if (getf (settings website) :username-link)
|
||||
(getf (settings website) :username-link)
|
||||
"/logout"))))
|
||||
(create-br body)
|
||||
(let ((c (getf properties :content)))
|
||||
(when c
|
||||
(typecase c
|
||||
:menu - ((\"Menu Name\" ((\"Menu Item\" \"link\")))) (def: nil)
|
||||
:content - (def: \"\")"
|
||||
;; Settings and Properties with default values
|
||||
(let* ((website (get-web-site body))
|
||||
(color-class (get-setting website :color-class "w3-black"))
|
||||
(border-class (get-setting website :border-class ""))
|
||||
(text-class (get-setting website :text-class ""))
|
||||
(login-link (get-setting website :login-link "/login"))
|
||||
(signup-link (get-setting website :signup-link "/signup"))
|
||||
(username-link (get-setting website :username-link "/logout"))
|
||||
(menu-property (get-property properties :menu "w3-black"))
|
||||
(content (get-property properties :content "")))
|
||||
;; Setup CSS style changes
|
||||
(let ((sb (create-style-block body)))
|
||||
(add-style sb :element "a" '(("text-decoration" :none))))
|
||||
;;
|
||||
;; Page layout
|
||||
;;
|
||||
;; SECTION: Above of menu bar
|
||||
(let* ((row (create-web-auto-row body))
|
||||
(left (create-web-auto-column row))
|
||||
(right (create-web-auto-column row :vertical-align :middle)))
|
||||
(when (logo website)
|
||||
(set-geometry (create-img (create-a left
|
||||
:link (url website))
|
||||
:url-src (logo website))
|
||||
:height 75))
|
||||
(create-span (create-a right
|
||||
:link (url website))
|
||||
:content (title website)
|
||||
:class "w3-xlarge w3-sans-serif"))
|
||||
;; SECTION: Menu bar
|
||||
(let ((menu (create-web-menu-bar body :class "w3-card-4")))
|
||||
(add-class menu color-class)
|
||||
(dolist (drop-down menu-property)
|
||||
(let ((drop (create-web-menu-drop-down menu
|
||||
:content (first drop-down)
|
||||
:class "w3-border"))
|
||||
(count 0))
|
||||
(dolist (item (second drop-down))
|
||||
(when (or (and (fourth item)
|
||||
(clog-auth:is-authorized-p (roles website)
|
||||
(fourth item)))
|
||||
(eq (fourth item) nil))
|
||||
(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
|
||||
(create-div body :content c))
|
||||
(create-div body :content content))
|
||||
(function
|
||||
(funcall c body))
|
||||
(funcall content body))
|
||||
(t
|
||||
(create-div body :content (format nil "~A" c))))))
|
||||
(when (eq page :login)
|
||||
(let* ((outter (create-web-container body))
|
||||
(form (create-form outter))
|
||||
(t-class (if (getf (settings website) :text-class)
|
||||
(getf (settings website) :text-class)
|
||||
""))
|
||||
(b-class (if (getf (settings website) :border-class)
|
||||
(getf (settings website) :border-class)
|
||||
""))
|
||||
(p1 (create-p form))
|
||||
(l1 (create-label p1 :content "User Name"
|
||||
:class t-class))
|
||||
(user (create-form-element p1 :text
|
||||
:name "username"
|
||||
:class (format nil "w3-input ~A" b-class)))
|
||||
(p2 (create-p form))
|
||||
(l2 (create-label p2 :content "Password"
|
||||
:class t-class))
|
||||
(pass (create-form-element p2 :password
|
||||
:name "password"
|
||||
:class (format nil "w3-input ~A" b-class)))
|
||||
(p3 (create-p form)))
|
||||
|
||||
(declare (ignore l1 l2 p3))
|
||||
(setf (maximum-width outter) (unit :px 500))
|
||||
(setf (requiredp user) t)
|
||||
(setf (requiredp pass) t)
|
||||
(create-form-element form :submit :value "Submit"
|
||||
:class (format nil "~A ~A" "w3-button"
|
||||
(getf (settings 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))))
|
||||
(create-div body :content (format nil "~A" content)))))
|
||||
;; SECTION: Special pages - Login
|
||||
(when (eq page :login)
|
||||
(let* ((outter (create-web-container body))
|
||||
(form (create-form outter))
|
||||
(p1 (create-p form))
|
||||
(l1 (create-label p1 :content "User Name"
|
||||
:class text-class))
|
||||
(user (create-form-element p1 :text
|
||||
:name "username"
|
||||
:class (format nil "w3-input ~A" border-class)))
|
||||
(p2 (create-p form))
|
||||
(l2 (create-label p2 :content "Password"
|
||||
:class text-class))
|
||||
(pass (create-form-element p2 :password
|
||||
:name "password"
|
||||
:class (format nil "w3-input ~A" border-class)))
|
||||
(p3 (create-p form)))
|
||||
(declare (ignore l1 l2 p3))
|
||||
(setf (maximum-width outter) (unit :px 500))
|
||||
(setf (requiredp user) t)
|
||||
(setf (requiredp pass) t)
|
||||
(create-form-element form :submit :value "Submit"
|
||||
:class (format nil "~A ~A" "w3-button" color-class))
|
||||
(set-on-submit form (getf properties :on-submit))
|
||||
(when signup-link
|
||||
(create-a form :class "w3-right" :content "sign up" :link signup-link))))
|
||||
;; SECTION: Footer
|
||||
(create-br body)
|
||||
(create-br body)
|
||||
(create-div body :content (format nil "~A" (footer website)))))
|
||||
|
|
|
|||
|
|
@ -1097,6 +1097,10 @@ clog-body."))
|
|||
(setf (web-site app) website)
|
||||
website))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;
|
||||
;; get-web-site ;;
|
||||
;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defgeneric get-web-site (clog-obj)
|
||||
(:documentation "Retrieve the clog-web-site object created on CLOG-OBJ's
|
||||
connection"))
|
||||
|
|
@ -1123,7 +1127,7 @@ permission to PAGE"))
|
|||
(clog-auth:is-authorized-p (roles (get-web-site obj)) page))
|
||||
(not authorize))
|
||||
(funcall (theme (get-web-site obj))
|
||||
obj (get-web-site obj) page properties)
|
||||
obj page properties)
|
||||
(create-div obj :content "Authorization failure")))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
|
|
|||
|
|
@ -71,7 +71,9 @@
|
|||
(let ((profile (get-profile body *sql-connection*)))
|
||||
(create-web-site body
|
||||
:settings '(:color-class "w3-blue-gray"
|
||||
:border-class "")
|
||||
:border-class ""
|
||||
:signup-link "/signup"
|
||||
:login-link "/login")
|
||||
:profile profile
|
||||
:roles (if profile
|
||||
(if (equalp "admin"
|
||||
|
|
@ -93,7 +95,6 @@
|
|||
(create-web-page
|
||||
body
|
||||
:login `(:menu ,*menu*
|
||||
:sign-up "/signup"
|
||||
:on-submit ,(lambda (obj)
|
||||
(if (login body *sql-connection*
|
||||
(name-value obj "username")
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue