Theme helpers and better theming

source/clog-web-themes.lisp

@@ -11,25 +11,64 @@
 (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
+  :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:
-  :menu - ((\"Menu Name\" ((\"Menu Item\" \"link\"))))
+  :menu - ((\"Menu Name\" ((\"Menu Item\" \"link\")))) (def: nil)
-  :content"
+  :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)))
@@ -42,10 +81,10 @@ Page properties:
 			     :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")))
-    (when (getf (settings website) :color-class)
+      (add-class menu color-class)
-      (add-class menu (getf (settings website) :color-class)))
+      (dolist (drop-down menu-property)
-    (dolist (drop-down (getf properties :menu))
 	(let ((drop  (create-web-menu-drop-down menu
 						:content (first drop-down)
 						:class "w3-border"))
@@ -61,56 +100,51 @@ Page properties:
 				    :link (second item))))
 	  (when (eql count 0)
 	    (destroy (parent-element drop)))))
-    (when (getf (profile website) :|username|)
+      (if (getf (profile website) :|username|)
 	  (create-web-menu-item menu :class "w3-right"
 				     :content (getf (profile website) :|username|)
-				 :link (if (getf (settings website) :username-link)
+				     :link username-link)
-					   (getf (settings website) :username-link)
+	  (when login-link
-					   "/logout"))))
+	    (create-web-menu-item menu :class "w3-right"
+				       :content "login"
+				       :link login-link))))
+    ;; SECTION: Content area
     (create-br body)
-  (let ((c (getf properties :content)))
+    (when content
-    (when c
+      (typecase content
-      (typecase c
 	(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))))))
+	 (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))
-	   (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))
+					 :class text-class))
 	     (user      (create-form-element p1 :text
 					     :name "username"
-					   :class (format nil "w3-input ~A" b-class)))
+					     :class (format nil "w3-input ~A" border-class)))
 	     (p2        (create-p form))
 	     (l2        (create-label p2 :content "Password"
-				       :class t-class))
+					 :class text-class))
 	     (pass      (create-form-element p2 :password
 					     :name "password"
-					   :class (format nil "w3-input ~A" b-class)))
+					     :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"
+					  :class (format nil "~A ~A" "w3-button" color-class))
-						       (getf (settings website)
-							     :color-class)))
 	(set-on-submit form (getf properties :on-submit))
-      (when (getf properties :sign-up)
+	(when signup-link
-	(create-a form :class "w3-right" :content "sign up" :link (getf properties :sign-up)))))
+	  (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))))
+    (create-div body :content (format nil "~A" (footer website)))))

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")))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

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")