diff --git a/source/clog-web-themes.lisp b/source/clog-web-themes.lisp index 31c1755..dc376a8 100644 --- a/source/clog-web-themes.lisp +++ b/source/clog-web-themes.lisp @@ -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))))) diff --git a/source/clog-web.lisp b/source/clog-web.lisp index 4629b68..5aa280a 100644 --- a/source/clog-web.lisp +++ b/source/clog-web.lisp @@ -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"))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/tutorial/31-tutorial.lisp b/tutorial/31-tutorial.lisp index 534277d..be38cd9 100644 --- a/tutorial/31-tutorial.lisp +++ b/tutorial/31-tutorial.lisp @@ -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")