diff --git a/source/clog-web-dbi.lisp b/source/clog-web-dbi.lisp index 0716bd4..aa45be2 100644 --- a/source/clog-web-dbi.lisp +++ b/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 "

Welcome to CLOG

" + :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 "
prof = ~A
url = '~A'
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))))))))) diff --git a/source/clog-web-themes.lisp b/source/clog-web-themes.lisp index dc376a8..a50ff2d 100644 --- a/source/clog-web-themes.lisp +++ b/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 - (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)))))))