mirrors/clog
1
Fork 0
mirror of https://github.com/rabbibotton/clog.git synced 2025-12-06 02:30:42 -08:00
Code Issues Projects Releases Wiki Activity

added buttons to content and comments when authorized, added delete

Browse source
This commit is contained in:
David Botton 2022-05-06 18:12:32 -04:00
parent fae0485b5b
commit b23f5bb1fc
2 changed files with 197 additions and 97 deletions
Download patch file Download diff file Expand all files Collapse all files

83
source/clog-web-dbi.lisp
View file

@ -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 authorize on action set by CAN-COMMENT, CAN-SHOW-COMMENTS and if
CAN-EDIT unless they are set to nil."
must be base-url). ON-CONTENT, ON-COMMENT are called with (obj value)
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,
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
sql-connection table page))
:|value|)))
;; 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"))
(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|)))))
(create-div body :content (format nil "<br>prof = ~A<br>url = '~A'<br>roles = ~A"
prof (second url) roles)))))
(when on-comment
(setf comment (funcall on-comment obj comment)))
(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)))))))))

211
source/clog-web-themes.lisp
View file

@ -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
(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)))
(when (logo website)
(set-geometry (create-img (create-a left
:link (url website))
:url-src (logo website))
:height 75))
(create-span (create-a right
: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")))
(add-class menu color-class)
(dolist (drop-down menu-property)
(let ((drop (create-web-menu-drop-down menu
:content (first drop-down)
:class "w3-border"))
(count 0))
(dolist (item (second drop-down))
(when (or (and (fourth item)
(clog-auth:is-authorized-p (roles website)
(fourth item)))
(eq (fourth item) nil))
(incf count)
(create-web-menu-item drop
:content (first item)
:link (second item))))
(when (eql count 0)
(destroy (parent-element drop)))))
(if (getf (profile website) :|username|)
(create-web-menu-item menu :class "w3-right"
:content (getf (profile website) :|username|)
:link username-link)
(when login-link
(create-web-menu-item menu :class "w3-right"
:content "login"
:link login-link))))
;; SECTION: Content area
(create-br body)
(when content
(typecase content
(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)))))
(cond ((or (eq page :content-body) ; data based content layout
(eq page :blog-body)) ; blog based content layout
(create-section body :h3 :content (getf content :|title|))
(create-div body :content (getf content :|value|))
(let ((panel (create-div body)))
(when (get-property properties :can-comment nil)
(create-a panel :class button-class
:content "comment"
:link (format nil "~A/add" base-url)))
(when (get-property properties :can-edit nil)
(create-a panel :class button-class
:content "edit"
:link (format nil "~A/edit" base-url))
(create-a panel :class button-class
:content "delete"
:link (format nil "~A/delete" base-url))))
(create-br body))
((or (eq page :content-comment) ; data comment layout
(eq page :blog-comment)) ; blog comment layout
(let ((comment (create-div body :content (getf content :|value|))))
(set-border comment :thin :dotted :black)
(let ((panel (create-div body)))
(when (get-property properties :can-comment nil)
(create-a panel :class button-class
:content "comment"
:link (format nil "~A/add" base-url)))
(when (get-property properties :can-edit nil)
(create-a panel :class button-class
:content "edit"
:link (format nil "~A/edit" base-url))
(create-a panel :class button-class
:content "delete"
:link (format nil "~A/delete" base-url))))))
;; Full page layout ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(t
;; 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)))
(when (logo website)
(set-geometry (create-img (create-a left
:link (url website))
:url-src (logo website))
:height 75))
(create-span (create-a right
: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")))
(add-class menu color-class)
(dolist (drop-down menu-property)
(let ((drop (create-web-menu-drop-down menu
:content (first drop-down)
:class "w3-border"))
(count 0))
(dolist (item (second drop-down))
(when (or (and (fourth item)
(clog-auth:is-authorized-p (roles website)
(fourth item)))
(eq (fourth item) nil))
(incf count)
(create-web-menu-item drop
:content (first item)
:link (second item))))
(when (eql count 0)
(destroy (parent-element drop)))))
(if (getf (profile website) :|username|)
(create-web-menu-item menu :class "w3-right"
:content (getf (profile website) :|username|)
:link username-link)
(when login-link
(create-web-menu-item menu :class "w3-right"
:content "login"
:link login-link))))
;; SECTION: Content area
(create-br body)
(when content
(typecase content
(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)))))))