mirror of
https://github.com/rabbibotton/clog.git
synced 2025-12-06 02:30:42 -08:00
allowing adding pages, table of contents for multiple contents on a page
This commit is contained in:
David Botton
parent
013f474652
commit
cee70f1c41
2 changed files with 83 additions and 21 deletions
|
|
@ -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
|
||||
(let ((pages (load-content sql-connection table page)))
|
||||
;; page content display
|
||||
(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=?")
|
||||
(list page)))))
|
||||
"key=? and createdate=?")
|
||||
(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)
|
||||
(list page)))))
|
||||
(format nil "delete from ~A where key=? and createdate=?" table)
|
||||
(list page (getf content :|createdate|))))))
|
||||
:new-comment (when (clog-auth:is-authorized-p
|
||||
roles can-comment)
|
||||
(lambda (content)
|
||||
(push `("unixepoch()") content)
|
||||
(push :createdate content)
|
||||
(push `("unixepoch()") content)
|
||||
(push :key content)
|
||||
(push '("unixepoch()") content)
|
||||
(push :|createdate| content)
|
||||
(push '("unixepoch()") 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)
|
||||
(list (getf comment :|key|)))
|
||||
(format nil "delete from ~A where key=? and parent=?"
|
||||
comment-table)
|
||||
(list (getf comment :|key|) page))
|
||||
(dbi:do-sql
|
||||
sql-connection
|
||||
(format nil "delete from ~A where key=? and username=?" comment-table)
|
||||
(list (getf comment :|key|) (getf prof :|username|)))))))
|
||||
(format nil "delete from ~A where key=? and username=? and parent=?"
|
||||
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|)
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue