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)))))))