mirror of
https://github.com/rabbibotton/clog.git
synced 2025-12-06 10:40:45 -08:00
remove use of URL schemes for editting in clog-web-content
This commit is contained in:
David Botton
parent
9ceb719618
commit
eb3f82579c
2 changed files with 103 additions and 110 deletions
|
|
@ -213,14 +213,7 @@ 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 delete content - baseurl/page/delete
|
||||
to delete comment - baseurl/page/comment/comment-id/delete
|
||||
"
|
||||
CAN-SHOW-COMMENTS and if CAN-EDIT unless they are set to nil."
|
||||
(lambda (obj)
|
||||
(let* ((body (connection-body obj))
|
||||
(theme (theme (get-web-site body)))
|
||||
|
|
@ -231,35 +224,6 @@ to delete comment - baseurl/page/comment/comment-id/delete
|
|||
(when follow-url-page
|
||||
(when (second url)
|
||||
(setf page (second url))))
|
||||
;; Perform commands on content and comments
|
||||
(cond ((equalp (third url) ;; delete content
|
||||
"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"))
|
||||
(if on-delete
|
||||
(setf on-delete (funcall on-delete obj page (fourth url)))
|
||||
(setf on-delete t))
|
||||
(when on-delete
|
||||
(if (clog-auth:is-authorized-p roles can-admin)
|
||||
(dbi:do-sql
|
||||
sql-connection
|
||||
(format nil "delete from ~A where key=?" comment-table)
|
||||
(list (fourth url)))
|
||||
(dbi:do-sql
|
||||
sql-connection
|
||||
(format nil "delete from ~A where key=? and username=?" comment-table)
|
||||
(list (fourth url) (getf prof :|username|)))))))
|
||||
(let ((content (car (load-content
|
||||
sql-connection table page))))
|
||||
(when content
|
||||
|
|
@ -268,17 +232,30 @@ to delete comment - baseurl/page/comment/comment-id/delete
|
|||
(funcall theme obj :content-body
|
||||
(list :content content
|
||||
:base-url (format nil "~A/~A" base-url page)
|
||||
:save-edit (lambda (content)
|
||||
:save-edit (when (clog-auth:is-authorized-p roles can-edit)
|
||||
(lambda (content)
|
||||
(when on-edit
|
||||
(setf content (funcall on-edit content)))
|
||||
(when content
|
||||
(dbi:do-sql
|
||||
sql-connection
|
||||
(sql-update table
|
||||
content
|
||||
"key=?")
|
||||
(list page)))
|
||||
:can-edit (clog-auth:is-authorized-p roles can-edit)
|
||||
:new-comment (lambda (content)
|
||||
(list page)))))
|
||||
:do-delete (when (clog-auth:is-authorized-p roles can-edit)
|
||||
(lambda ()
|
||||
(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)))))
|
||||
:new-comment (when (clog-auth:is-authorized-p
|
||||
roles can-comment)
|
||||
(lambda (content)
|
||||
(push `("unixepoch()") content)
|
||||
(push :createdate content)
|
||||
(push `("unixepoch()") content)
|
||||
|
|
@ -289,11 +266,10 @@ to delete comment - baseurl/page/comment/comment-id/delete
|
|||
(push :username content)
|
||||
(when on-new
|
||||
(setf content (funcall on-new content)))
|
||||
(when content
|
||||
(dbi:do-sql
|
||||
sql-connection
|
||||
(sql-insert* comment-table content)))
|
||||
:can-comment (clog-auth:is-authorized-p
|
||||
roles can-comment)))))
|
||||
(sql-insert* comment-table content)))))))))
|
||||
(when (and (clog-auth:is-authorized-p roles can-show-comments)
|
||||
comment-table)
|
||||
(let ((comments (load-content sql-connection comment-table page
|
||||
|
|
@ -308,19 +284,35 @@ to delete comment - baseurl/page/comment/comment-id/delete
|
|||
base-url
|
||||
page
|
||||
(getf comment :|key|))
|
||||
:save-edit (lambda (content)
|
||||
:do-delete (when (or (clog-auth:is-authorized-p roles can-admin)
|
||||
(and (getf prof :|username|)
|
||||
(equalp (getf comment :|username|)
|
||||
(getf prof :|username|))))
|
||||
(lambda ()
|
||||
(if on-delete
|
||||
(setf on-delete (funcall on-delete obj page (getf comment :|key|)))
|
||||
(setf on-delete t))
|
||||
(when on-delete
|
||||
(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|)))
|
||||
(dbi:do-sql
|
||||
sql-connection
|
||||
(format nil "delete from ~A where key=? and username=?" comment-table)
|
||||
(list (getf comment :|key|) (getf prof :|username|)))))))
|
||||
:save-edit (when (or (clog-auth:is-authorized-p roles can-admin)
|
||||
(and (getf prof :|username|)
|
||||
(equalp (getf comment :|username|)
|
||||
(getf prof :|username|))))
|
||||
(lambda (content)
|
||||
(when on-edit
|
||||
(setf content (funcall on-edit content)))
|
||||
(when content
|
||||
(dbi:do-sql
|
||||
sql-connection
|
||||
(sql-update comment-table
|
||||
content
|
||||
"key=?")
|
||||
(list (getf comment :|key|))))
|
||||
:can-edit (or (clog-auth:is-authorized-p
|
||||
roles can-admin)
|
||||
(and (getf prof :|username|)
|
||||
(equalp (getf comment :|username|)
|
||||
(getf prof :|username|))))
|
||||
:can-comment (clog-auth:is-authorized-p
|
||||
roles can-comment)))))))))
|
||||
(list (getf comment :|key|))))))))))))))
|
||||
|
|
|
|||
|
|
@ -70,8 +70,11 @@ Page properties:
|
|||
(eq page :blog-body)) ; blog based content layout
|
||||
(let ((etitle (create-section body :h3 :content (getf content :|title|)))
|
||||
(ebody (create-div body :content (getf content :|value|)))
|
||||
(panel (create-div body)))
|
||||
(when (get-property properties :can-comment nil)
|
||||
(panel (create-div body))
|
||||
(new-comment (get-property properties :new-comment nil))
|
||||
(save-edit (get-property properties :save-edit nil))
|
||||
(do-delete (get-property properties :do-delete nil)))
|
||||
(when new-comment
|
||||
(labels ((start-add (obj)
|
||||
(create-br obj)
|
||||
(let* ((opanel (create-div panel :auto-place nil))
|
||||
|
|
@ -87,15 +90,11 @@ Page properties:
|
|||
(setf (text obj) "save")
|
||||
(set-on-click obj
|
||||
(lambda (obj)
|
||||
(let ((tcomment (text npanel))
|
||||
(save (get-property
|
||||
properties
|
||||
:new-comment
|
||||
nil)))
|
||||
(let ((tcomment (text npanel)))
|
||||
(set-on-click obj nil)
|
||||
(setf (editablep npanel) nil)
|
||||
(setf (inner-html npanel) tcomment)
|
||||
(funcall save (list :|value| tcomment))
|
||||
(funcall new-comment (list :|value| tcomment))
|
||||
(set-border opanel :thin :dotted :black)
|
||||
(setf (text obj) "comment")
|
||||
(set-on-click obj #'start-add)
|
||||
|
|
@ -103,7 +102,7 @@ Page properties:
|
|||
(set-on-click (create-a panel :class button-class
|
||||
:content "comment")
|
||||
#'start-add)))
|
||||
(when (get-property properties :can-edit nil)
|
||||
(when save-edit
|
||||
(labels ((start-edit (obj)
|
||||
(setf (editablep etitle) t)
|
||||
(setf (text etitle) (inner-html etitle))
|
||||
|
|
@ -117,16 +116,13 @@ Page properties:
|
|||
(set-on-click obj
|
||||
(lambda (obj)
|
||||
(let ((ttitle (text etitle))
|
||||
(tbody (text ebody))
|
||||
(save (get-property
|
||||
properties
|
||||
:save-edit nil)))
|
||||
(tbody (text ebody)))
|
||||
(set-on-click obj nil)
|
||||
(setf (editablep etitle) nil)
|
||||
(setf (inner-html etitle) ttitle)
|
||||
(setf (editablep ebody) nil)
|
||||
(setf (inner-html ebody) tbody)
|
||||
(funcall save
|
||||
(funcall save-edit
|
||||
(list :|title| ttitle
|
||||
:|value| tbody))
|
||||
(set-border etitle :none "" "")
|
||||
|
|
@ -135,10 +131,13 @@ Page properties:
|
|||
(set-on-click obj #'start-edit))))))
|
||||
(set-on-click (create-a panel :class button-class
|
||||
:content "edit")
|
||||
#'start-edit))
|
||||
(create-a panel :class button-class
|
||||
:content "delete"
|
||||
:link (format nil "~A/delete" base-url))))
|
||||
#'start-edit)))
|
||||
(when do-delete
|
||||
(set-on-click (create-a panel :class button-class
|
||||
:content "delete")
|
||||
(lambda (obj)
|
||||
(funcall do-delete)
|
||||
(reload (location (connection-body obj)))))))
|
||||
(create-br body))
|
||||
((or (eq page :content-comment) ; data comment layout
|
||||
(eq page :blog-comment)) ; blog comment layout
|
||||
|
|
@ -147,8 +146,10 @@ Page properties:
|
|||
(comment (create-span opanel :content (getf content :|value|))))
|
||||
(declare (ignore ipanel))
|
||||
(set-border opanel :thin :dotted :black)
|
||||
(let ((panel (create-span opanel :content " ")))
|
||||
(when (get-property properties :can-edit nil)
|
||||
(let ((panel (create-span opanel :content " "))
|
||||
(save-edit (get-property properties :save-edit nil))
|
||||
(do-delete (get-property properties :do-delete nil)))
|
||||
(when save-edit
|
||||
(labels ((start-edit (obj)
|
||||
(setf (editablep comment) t)
|
||||
(setf (text comment) (inner-html comment))
|
||||
|
|
@ -158,23 +159,23 @@ Page properties:
|
|||
(set-on-click obj nil)
|
||||
(set-on-click obj
|
||||
(lambda (obj)
|
||||
(let ((tcomment (text comment))
|
||||
(save (get-property
|
||||
properties
|
||||
:save-edit nil)))
|
||||
(let ((tcomment (text comment)))
|
||||
(set-on-click obj nil)
|
||||
(setf (editablep comment) nil)
|
||||
(setf (inner-html comment) tcomment)
|
||||
(funcall save (list :|value| tcomment))
|
||||
(funcall save-edit (list :|value| tcomment))
|
||||
(set-border opanel :thin :dotted :black)
|
||||
(setf (text obj) "edit")
|
||||
(set-on-click obj #'start-edit))))))
|
||||
(set-on-click (create-a panel :class button-class
|
||||
:content "edit")
|
||||
#'start-edit))
|
||||
(create-a panel :class button-class
|
||||
:content "delete"
|
||||
:link (format nil "~A/delete" base-url))))))
|
||||
#'start-edit)))
|
||||
(when do-delete
|
||||
(set-on-click (create-a panel :class button-class
|
||||
:content "delete")
|
||||
(lambda (obj)
|
||||
(funcall do-delete)
|
||||
(reload (location (connection-body obj)))))))))
|
||||
;; Full page layout ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(t
|
||||
;; Setup CSS style changes
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue