added buttons to content and comments when authorized, added delete

source/clog-web-dbi.lisp

@@ -148,7 +148,8 @@ if one is present and login fails."
   (dbi:do-sql
     sql-connection
     (sql-insert* "content" '(:key        "main"
-			     :value      "<h3>Welcome to CLOG</h3>"
+			     :title      "Welcome to CLOG"
+			     :value      "Sample data"
 			     :createdate ("date()"))))
   (dbi:do-sql
     sql-connection
@@ -192,6 +193,8 @@ optional WHERE and ORDER-BY sql."
 			   (base-url          "/content")
 			   (follow-url-page   t)
 			   comment-table
+			   on-content
+			   on-comment
 			   on-new
 			   on-edit
 			   on-delete
@@ -201,28 +204,86 @@ optional WHERE and ORDER-BY sql."
   "Create content for CLOG-WEB:CREATE-WEB-PAGE based on dbi TABLE
 value where key=PAGE or if FOLLOW-URL-PAGE is true PAGE is default
 page if no second on path otherwise page is the second on path (first
-must be base-url). If comment-table is nil no comments are shown. User
+must be base-url). ON-CONTENT, ON-COMMENT are called with (obj value)
-must authorize on action set by CAN-COMMENT, CAN-SHOW-COMMENTS and if
+before display of value the return value is used. ON-NEW, ON-EDIT are
-CAN-EDIT unless they are set to nil."
+called with (obj value) to allow filter of value before storage, if
+nil is return aborted. ON-DELETE called with (obj page comment-id) if
+returns nil aborted. If comment-table is nil no comments are
+shown. User must authorize on action set by CAN-COMMENT,
+CAN-SHOW-COMMENTS and if CAN-EDIT unless they are set to nil. The URL
+scheme as as follows:
+
+to add content    - baseurl/add
+or add content    - baseurl/page/add
+to edit content   - baseurl/page/edit
+to delete content - baseurl/page/delete
+to add comment    - baseurl/page/comment/add
+or add comment    - baseurl/page/comment/comment-id/add
+to delete comment - baseurl/page/comment/comment-id/delete
+to edit comment   - baseurl/page/comment/comment-id/edit
+"
   (lambda (obj)
     (let* ((body    (connection-body obj))
+	   (theme   (theme (get-web-site body)))
 	   (prof    (profile (get-web-site body)))
 	   (roles   (roles (get-web-site body)))
 	   (url     (base-url-split base-url (path-name (location body)))))
+      ;; Set page to show content
       (when follow-url-page
 	(when (second url)
 	  (setf page (second url))))
-      (let ((content (getf (car (load-content
+      ;; Perform commands on content and comments
-				 sql-connection table page))
+      (cond ((equalp (third url) ;; delete content
-			   :|value|)))
+		     "delete")
+	     (when (clog-auth:is-authorized-p roles can-edit)
+	       (if on-delete
+		   (setf on-delete (setf on-delete (funcall on-delete obj page nil)))
+		   (setf on-delete t))
+	       (when on-delete
+		 (dbi:do-sql
+		   sql-connection
+		   (format nil "delete from ~A where key=?" table)
+		   (list page)))))
+	    ((and (and (third url) ;; delete comment
+		       "comment")
+		  (equalp (fifth url)
+			  "delete"))
+	     (when (clog-auth:is-authorized-p roles can-edit)
+	       (if on-delete
+		   (setf on-delete (funcall on-delete obj page (fourth url)))
+		   (setf on-delete t))
+	       (when on-delete
+		 (dbi:do-sql
+		   sql-connection
+		   (format nil "delete from ~A where key=?" comment-table)
+		   (list (fourth url)))))))
+      (let ((content (car (load-content
+			   sql-connection table page))))
 	(when content
-	  (create-div body :content content)))
+	  (when on-content
+	    (setf content (funcall on-content obj content)))
+	  (funcall theme obj :content-body
+		   (list :content content
+			 :base-url (format nil "~A/~A" base-url page)
+			 :can-edit (clog-auth:is-authorized-p roles can-edit)
+			 :can-comment (clog-auth:is-authorized-p
+				       roles can-comment)))))
       (when (and (clog-auth:is-authorized-p roles can-show-comments)
 		 comment-table)
 	(let ((comments (load-content sql-connection comment-table page
 				      :key-col  "parent"
 				      :order-by "createdate desc")))
 	  (dolist (comment comments)
-	    (create-div obj :content (getf comment :|value|)))))
+	    (when on-comment
-      (create-div body :content (format nil "<br>prof = ~A<br>url = '~A'<br>roles = ~A"
+	      (setf comment (funcall on-comment obj comment)))	    
-					prof (second url) roles)))))
+	    (funcall theme obj :content-comment
+		     (list :content comment
+			   :base-url (format nil "~A/~A/comment/~A"
+					     base-url
+					     page
+					     (getf comment :|key|))
+			   :can-edit (and (getf prof :|username|)
+					  (equalp (getf comment :|username|)
+						  (getf prof    :|username|)))
+			   :can-comment (clog-auth:is-authorized-p
+					 roles can-comment)))))))))

source/clog-web-themes.lisp

@@ -56,95 +56,134 @@ Page properties:
   (let* ((website        (get-web-site body))
 	 (color-class    (get-setting website :color-class "w3-black"))
 	 (border-class   (get-setting website :border-class ""))
+	 (button-class   (get-setting website :button-class
+				      "w3-button w3-round-xlarge
+                                       w3-tiny w3-border w3-padding-small"))
 	 (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"))
+	 (base-url       (get-property properties :base-url "/"))
 	 (content        (get-property properties :content "")))
-    ;; Setup CSS style changes
+    (cond ((or (eq page :content-body) ; data based content layout
-    (let ((sb (create-style-block body)))
+	       (eq page :blog-body))   ; blog based content layout
-      (add-style sb :element "a" '(("text-decoration" :none))))
+	   (create-section body :h3 :content (getf content :|title|))
-    ;;
+	   (create-div body :content (getf content :|value|))
-    ;; Page layout
+	   (let ((panel (create-div body)))
-    ;;
+	     (when (get-property properties :can-comment nil)
-    ;; SECTION: Above of menu bar
+	       (create-a panel :class button-class
-    (let* ((row   (create-web-auto-row body))
+			       :content "comment"
-	   (left  (create-web-auto-column row))
+			       :link (format nil "~A/add" base-url)))
-	   (right (create-web-auto-column row :vertical-align :middle)))
+	     (when (get-property properties :can-edit nil)
-      (when (logo website)
+	       (create-a panel :class button-class
-	(set-geometry (create-img (create-a left
+			       :content "edit"
-					    :link (url website))
+			       :link (format nil "~A/edit" base-url))
-				  :url-src (logo website))
+	       (create-a panel :class button-class
-		      :height 75))
+			       :content "delete"
-      (create-span (create-a right
+			       :link (format nil "~A/delete" base-url))))
-			     :link (url website))
+	   (create-br body))
-		   :content (title website)
+	  ((or (eq page :content-comment) ; data comment layout
-		   :class "w3-xlarge w3-sans-serif"))
+	       (eq page :blog-comment))   ; blog comment layout
-    ;; SECTION: Menu bar
+	   (let ((comment (create-div body :content (getf content :|value|))))
-    (let ((menu  (create-web-menu-bar body :class "w3-card-4")))
+	     (set-border comment :thin :dotted :black)
-      (add-class menu color-class)
+	     (let ((panel (create-div body)))
-      (dolist (drop-down menu-property)
+	       (when (get-property properties :can-comment nil)
-	(let ((drop  (create-web-menu-drop-down menu
+		 (create-a panel :class button-class
-						:content (first drop-down)
+				 :content "comment"
-						:class "w3-border"))
+				 :link (format nil "~A/add" base-url)))
-	      (count 0))
+	       (when (get-property properties :can-edit nil)
-	  (dolist (item (second drop-down))
+		 (create-a panel :class button-class
-	    (when (or (and (fourth item)
+				 :content "edit"
-			   (clog-auth:is-authorized-p (roles website)
+				 :link (format nil "~A/edit" base-url))
-						      (fourth item)))
+		 (create-a panel :class button-class
-		      (eq (fourth item) nil))
+				 :content "delete"
-	      (incf count)
+				 :link (format nil "~A/delete" base-url))))))
-	      (create-web-menu-item drop
+	  ;; Full page layout ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-				    :content (first item)
+	  (t
-				    :link (second item))))
+	   ;; Setup CSS style changes
-	  (when (eql count 0)
+	   (let ((sb (create-style-block body)))
-	    (destroy (parent-element drop)))))
+	     (add-style sb :element "a" '(("text-decoration" :none))))
-      (if (getf (profile website) :|username|)
+	   ;;
-	  (create-web-menu-item menu :class "w3-right"
+	   ;; Page layout
-				     :content (getf (profile website) :|username|)
+	   ;;
-				     :link username-link)
+	   ;; SECTION: Above of menu bar
-	  (when login-link
+	   (let* ((row   (create-web-auto-row body))
-	    (create-web-menu-item menu :class "w3-right"
+		  (left  (create-web-auto-column row))
-				       :content "login"
+		  (right (create-web-auto-column row :vertical-align :middle)))
-				       :link login-link))))
+	     (when (logo website)
-    ;; SECTION: Content area
+	       (set-geometry (create-img (create-a left
-    (create-br body)
+						   :link (url website))
-    (when content
+					 :url-src (logo website))
-      (typecase content
+			     :height 75))
-	(string
+	     (create-span (create-a right
-	 (create-div body :content content))
+				    :link (url website))
-	(function
+			  :content (title website)
-	 (funcall content body))
+			  :class "w3-xlarge w3-sans-serif"))
-	(t
+	   ;; SECTION: Menu bar
-	 (create-div body :content (format nil "~A" content)))))
+	   (let ((menu  (create-web-menu-bar body :class "w3-card-4")))
-    ;; SECTION: Special pages - Login
+	     (add-class menu color-class)
-    (when (eq page :login)
+	     (dolist (drop-down menu-property)
-      (let* ((outter    (create-web-container body))
+	       (let ((drop  (create-web-menu-drop-down menu
-	     (form      (create-form outter))
+						       :content (first drop-down)
-	     (p1        (create-p form))
+						       :class "w3-border"))
-	     (l1        (create-label p1 :content "User Name"
+		     (count 0))
-					 :class text-class))
+		 (dolist (item (second drop-down))
-	     (user      (create-form-element p1 :text
+		   (when (or (and (fourth item)
-					     :name "username"
+				  (clog-auth:is-authorized-p (roles website)
-					     :class (format nil "w3-input ~A" border-class)))
+							     (fourth item)))
-	     (p2        (create-p form))
+			     (eq (fourth item) nil))
-	     (l2        (create-label p2 :content "Password"
+		     (incf count)
-					 :class text-class))
+		     (create-web-menu-item drop
-	     (pass      (create-form-element p2 :password
+					   :content (first item)
-					     :name "password"
+					   :link (second item))))
-					     :class (format nil "w3-input ~A" border-class)))
+		 (when (eql count 0)
-	     (p3        (create-p form)))
+		   (destroy (parent-element drop)))))
-	(declare (ignore l1 l2 p3))
+	     (if (getf (profile website) :|username|)
-	(setf (maximum-width outter) (unit :px 500))
+		 (create-web-menu-item menu :class "w3-right"
-	(setf (requiredp user) t)
+					    :content (getf (profile website) :|username|)
-	(setf (requiredp pass) t)
+					    :link username-link)
-	(create-form-element form :submit :value "Submit"
+		 (when login-link
-					  :class (format nil "~A ~A" "w3-button" color-class))
+		   (create-web-menu-item menu :class "w3-right"
-	(set-on-submit form (getf properties :on-submit))
+					      :content "login"
-	(when signup-link
+					      :link login-link))))
-	  (create-a form :class "w3-right" :content "sign up" :link signup-link))))
+	   ;; SECTION: Content area
-    ;; SECTION: Footer
+	   (create-br body)
-    (create-br body)
+	   (when content
-    (create-br body)
+	     (typecase content
-    (create-div body :content (format nil "~A" (footer website)))))
+	       (string
+		(create-div body :content content))
+	       (function
+		(funcall content body))
+	       (t
+		(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)))))))