allowing adding pages, table of contents for multiple contents on a page

source/clog-web-dbi.lisp

@@ -212,7 +212,7 @@ before display of value the return value is used. ON-NEW, ON-EDIT are
 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,
+shown. User must authorize on action set by CAN-COMMENT, CAN-ADMIN,
 CAN-SHOW-COMMENTS and if CAN-EDIT unless they are set to nil."
   (lambda (obj)
     (let* ((body    (connection-body obj))
@@ -220,12 +220,31 @@ CAN-SHOW-COMMENTS and if CAN-EDIT unless they are set to nil."
 	   (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
+      ;; set page to show content
       (when follow-url-page
 	(when (second url)
 	  (setf page (second url))))
-      ;; Page Content Display
+      ;; page content display
-      (let ((pages (load-content sql-connection table page)))
+      (let ((pages (load-content sql-connection table page
+				 :order-by "createdate desc")))
+	;; ask theme for table of contents or to allow add
+	(funcall theme obj :content-contents
+		 (list :content pages
+		       :do-add (when (clog-auth:is-authorized-p roles can-edit)
+				 (lambda (content)
+				     (push '("unixepoch()") content)
+				     (push :createdate content)
+				     (push page content)
+				     (push :key content)
+				     (push page content)
+				     (push :username content)
+				     (when on-new
+				       (setf content (funcall on-new content)))
+				     (print content)
+				     (when content
+				       (dbi:do-sql
+					 sql-connection
+					 (sql-insert* table content)))))))
 	(dolist (content pages)
 	  (when content
 	    (when on-content
@@ -241,8 +260,8 @@ CAN-SHOW-COMMENTS and if CAN-EDIT unless they are set to nil."
 					      sql-connection
 					      (sql-update table
 							  content
-							  "key=?")
+							  "key=? and createdate=?")
-					      (list page)))))
+					      (list page (getf content :|createdate|))))))
 			   :do-delete (when (clog-auth:is-authorized-p roles can-edit)
 					(lambda ()
 					  (if on-delete
@@ -251,26 +270,26 @@ CAN-SHOW-COMMENTS and if CAN-EDIT unless they are set to nil."
 					  (when on-delete
 					    (dbi:do-sql
 					      sql-connection
-					      (format nil "delete from ~A where key=?" table)
+					      (format nil "delete from ~A where key=? and createdate=?" table)
-					      (list page)))))
+					      (list page (getf content :|createdate|))))))
 			   :new-comment (when (clog-auth:is-authorized-p
 					       roles can-comment)
 					  (lambda (content)
-					    (push `("unixepoch()") content)
+					    (push '("unixepoch()") content)
-					    (push :createdate content)
+					    (push :|createdate| content)
-					    (push `("unixepoch()") content)
+					    (push '("unixepoch()") content)
-					    (push :key content)
+					    (push :|key| content)
 					    (push page content)
-					    (push :parent content)
+					    (push :|parent| content)
 					    (push (getf prof :|username|) content)
-					    (push :username content)
+					    (push :|username| content)
 					    (when on-new
 					      (setf content (funcall on-new content)))
 					    (when content
 					      (dbi:do-sql
 						sql-connection
 						(sql-insert* comment-table content))))))))))
-      ;; Comments Display
+      ;; comments display
       (when (and (clog-auth:is-authorized-p roles can-show-comments)
 		 comment-table)
 	(let ((comments (load-content sql-connection comment-table page
@@ -293,12 +312,14 @@ CAN-SHOW-COMMENTS and if CAN-EDIT unless they are set to nil."
 					    (if (clog-auth:is-authorized-p roles can-admin)
 						(dbi:do-sql
 						  sql-connection
-						  (format nil "delete from ~A where key=?" comment-table)
+						  (format nil "delete from ~A where key=? and parent=?"
-						  (list (getf comment :|key|)))
+							  comment-table)
+						  (list (getf comment :|key|) page))
 						(dbi:do-sql
 						  sql-connection
-						  (format nil "delete from ~A where key=? and username=?" comment-table)
+						  (format nil "delete from ~A where key=? and username=? and parent=?"
-						  (list (getf comment :|key|) (getf prof :|username|)))))))
+							  comment-table)
+						  (list (getf comment :|key|) (getf prof :|username|) page))))))
 			   :save-edit (when (or (clog-auth:is-authorized-p roles can-admin)
 						(and (getf prof :|username|)
 						     (equalp (getf comment :|username|)

source/clog-web-themes.lisp

@@ -65,9 +65,49 @@ Page properties:
 	 (username-link  (get-setting website :username-link "/logout"))
 	 (menu-property  (get-property properties :menu "w3-black"))
 	 (content        (get-property properties :content "")))
-    (cond ((or (eq page :content-body) ; data based content layout
+
+    (cond ;; Sub-section: Table of Contents
+          ((or (eq page :content-contents) ; data based contents layout
+	       (eq page :blog-contents))   ; blog based contents layout
+	   (let ((contents (get-property properties :content nil))
+		 (do-add   (get-property properties :do-add nil)))
+	     (when do-add
+	       (set-on-click (create-a body :class button-class
+					    :content "add contents")
+			     (lambda (obj)
+			       (set-on-click obj nil)
+			       (let* ((opanel (create-div obj :auto-place nil))
+				      (etitle (create-section opanel :h3 :content "New Title"))
+				      (ebody  (create-div opanel :content "New Body")))
+				 (place-after obj opanel)
+				 (setf (editablep etitle) t)
+				 (setf (editablep ebody) t)
+				 (set-border opanel :medium :dotted :red)
+				 (setf (text obj) "Save")
+				 (set-on-click obj
+					       (lambda (obj)
+						 (funcall do-add (list
+								  :|title| (text etitle)
+								  :|value| (text ebody)))
+						 (reload (location (connection-body obj))))))))
+	       (create-br body))
+	     (when contents
+	       (let ((ul (create-ordered-list body :auto-place nil))
+		     (count 0))
+		 (dolist (content contents)
+		   (incf count)
+		   (create-list-item (create-a ul :link (format nil "#~A" (getf content :|createdate|)))
+				     :content (getf content :|title|)))
+		 (when (> count 1)
+		   (place-inside-bottom-of body ul))))))
+	  ;; Sub-Section: Content
+	  ((or (eq page :content-body) ; data based content layout
 	       (eq page :blog-body))   ; blog based content layout
-	   (let ((etitle      (create-section body :h3 :content (getf content :|title|)))
+	   (let ((anchor      (create-child body
+					    (format nil "<a id=~A></a>"
+						    (getf content :|createdate|))))
+		 (etitle      (create-section body :h3
+					      :content	(getf content :|title|)))
 		 (ebody       (create-div body :content (getf content :|value|)))
 		 (panel       (create-div body))
 		 (new-comment (get-property properties :new-comment nil))
@@ -138,6 +178,7 @@ Page properties:
 			       (funcall do-delete)
 			       (reload (location (connection-body obj)))))))
 	   (create-br body))
+	  ;; Sub-Section: Comments
 	  ((or (eq page :content-comment) ; data comment layout
 	       (eq page :blog-comment))   ; blog comment layout
 	   (let* ((opanel (create-div body))