From 94f1046fc1eb7f8e46cd3ccc201f79196f1d739a Mon Sep 17 00:00:00 2001 From: David Botton Date: Tue, 16 Nov 2021 23:30:28 -0500 Subject: [PATCH] Demo 4 - CMS Website --- README.md | 1 + demos/04-demo.lisp | 197 +++++++++++++++++++++++++++++++++++++++++++ demos/README.md | 1 + source/clog-web.lisp | 6 +- 4 files changed, 202 insertions(+), 3 deletions(-) create mode 100644 demos/04-demo.lisp diff --git a/README.md b/README.md index caa4369..500a902 100644 --- a/README.md +++ b/README.md @@ -220,6 +220,7 @@ Demo Summary - [02-demo.lisp](demos/02-demo.lisp) - Chat - Private instant messenger - [03-demo.lisp](demos/03-demo.lisp) - IDE - A very simple common lisp IDE (see source if editor dosen't load) +- [04-demo.lisp](demos/04-demo.lisp) - CMS Website - A very simple database driver website Tool Summary diff --git a/demos/04-demo.lisp b/demos/04-demo.lisp new file mode 100644 index 0000000..f10baf5 --- /dev/null +++ b/demos/04-demo.lisp @@ -0,0 +1,197 @@ +;;;; Demo 4 - CMS Website + +(defpackage #:clog-user + (:use #:cl #:clog #:clog-web) + (:export start-demo)) + +(in-package :clog-user) + +;; Site Configuration +(defconstant side-panel-size 200 "Size of menu") +(defconstant sysop-password "admin") + +(defvar *sql-connection*) +(defvar *site-config*) + +(defclass app-data () + ((head + :accessor head) + (side + :accessor side) + (main + :accessor main) + (sysop + :initform nil + :accessor sysop))) + +(defun create-web-frame (body app) + (setf (title (html-document body)) "Demo 4") + ;; +----------------------------------------------+ + ;; | header area (head) | + ;; +----------------------------------------------+ + ;; | | | + ;; | menu | content area | + ;; | (side) | (main) | + ;; | | | + ;; +----------+-----------------------------------+ + ;; create 3 pain site + ;; + ;; Header + (setf (head app) (create-web-panel body :content "

Demo 4:

A simple Lisp CMS

" + :class "w3-yellow")) + ;; Sidebar + (setf (side app) (create-web-sidebar body)) + (setf (box-width (side app)) (unit :px side-panel-size)) + (add-card-look (side app)) + ;; Main + (setf (main app) (create-web-content body)) + (set-margin-side (main app) :left (unit :px (+ side-panel-size 10))) + (create-web-container (main app))) + +(defun insert-content (app new-page text-area) + (sqlite:execute-non-query + *sql-connection* + (format nil "insert into config (menu, main) values ('~A', '~A')" + (escape-string (value new-page)) + (escape-string (value text-area)))) + (reset-menu app) + (route-content app (escape-string (value new-page)))) + +(defun new-content (app) + (setf (inner-html (main app)) "") + (let ((new-page (create-form-element (main app) :text)) + (tmp (create-br (main app))) + (text-area (create-text-area (main app) :rows 10 :columns 40))) + (declare (ignore tmp)) + (create-br (main app)) + (set-on-click (create-button (main app) :content "Insert") + (lambda (obj) + (declare (ignore obj)) + (insert-content app new-page text-area))))) + +(defun update-content (app page text-area) + (sqlite:execute-non-query + *sql-connection* + (format nil "update config set main='~A' where menu='~A'" + (escape-string (value text-area)) + page)) + (route-content app page)) + +(defun delete-content (app page) + (sqlite:execute-non-query + *sql-connection* + (format nil "delete from config where menu='~A'" page)) + (reset-menu app) + (route-content app "Home")) + +(defun edit-content (app page) + (setf (inner-html (main app)) "") + (let ((contents (sqlite:execute-to-list + *sql-connection* + (format nil "select main from config where menu='~A'" page)))) + (dolist (content contents) + (let ((text-area (create-text-area (main app) :rows 10 :columns 40 + :value (car content)))) + (create-br (main app)) + (set-on-click (create-button (main app) :content "Update") + (lambda (obj) + (declare (ignore obj)) + (update-content app page text-area))) + (unless (equal page "Home") + (set-on-click (create-button (main app) :content "Delete") + (lambda (obj) + (declare (ignore obj)) + (delete-content app page)))))))) + +(defun route-content (app page) + (setf (inner-html (main app)) "") + (let ((contents (sqlite:execute-to-list + *sql-connection* + (format nil "select main from config where menu='~A'" page)))) + (dolist (content contents) + (setf (inner-html (main app)) (car content)) + (create-br (main app)) + (create-br (main app)) + (when (sysop app) + (set-on-click (create-a (main app) :content "edit") + (lambda (obj) + (declare (ignore obj)) + (edit-content app page))))))) +(defun id-me (app) + (setf (inner-html (main app)) "") + (clog-web-form (main app) "Validate:" + '(("Password" "pass" :password)) + (lambda (res) + (if (equal (second (first res)) sysop-password) + (progn + (setf (sysop app) t) + (reset-menu app) + (setf (inner-html (main app)) "You are logged in.")) + (setf (inner-html (main app)) "Invalid password."))))) + +(defun reset-menu (app) + (setf (inner-html (side app)) "") + (let ((menu-items (sqlite:execute-to-list *sql-connection* + "select menu from config"))) + (dolist (menu-item menu-items) + (set-on-click + (create-web-sidebar-item (side app) :content (car menu-item)) + (lambda (obj) + (declare (ignore obj)) + (route-content app (car menu-item)))))) + (create-br (side app)) + (if (sysop app) + (progn + (set-on-click (create-a (side app) :content "new") + (lambda (obj) + (declare (ignore obj)) + (new-content app))) + (create-br (side app)) + (set-on-click (create-a (side app) :content "logout") + (lambda (obj) + (declare (ignore obj)) + (setf (sysop app) nil) + (reset-menu app) + (route-content app "Home")))) + (set-on-click (create-a (side app) :content "login") + (lambda (obj) + (declare (ignore obj)) + (id-me app))))) + +(defun on-new-window (body) + ;; Create an app-data object for every connection + (let ((app (make-instance 'app-data))) + (setf (connection-data-item body "app-data") app) + (clog-web-initialize body) + (create-web-frame body app) + (reset-menu app) + (route-content app "Home") + (run body))) + +(defun start-demo () + "Start dynamic website demo." + ;; The demo database is created in the clog dir + (let ((db-dir (merge-pathnames "demo4.db" (clog:clog-install-dir)))) + (setf *sql-connection* (sqlite:connect db-dir)) + (format t "Database location: ~A~%" db-dir)) + (handler-case + (setf *site-config* + (sqlite:execute-to-list *sql-connection* "select * from config")) + (error () + (print "First run creating config.") + (sqlite:execute-non-query + *sql-connection* + "create table config (menu varchar, main varchar)") + (sqlite:execute-non-query + *sql-connection* + "insert into config (menu, main) values ('Home', 'Hello welcome.')") + (sqlite:execute-non-query + *sql-connection* + "insert into config (menu, main) values ('Page2', 'Customize Me.')"))) + (initialize 'on-new-window) + (open-browser)) + +(defun stop-demo () + "Shutdown demo and close databases." + (sqlite:disconnect *sql-connection*) + (shutdown)) diff --git a/demos/README.md b/demos/README.md index 54932b6..0047ff1 100644 --- a/demos/README.md +++ b/demos/README.md @@ -38,3 +38,4 @@ Demo Summary - 02-demo.lisp - Chat - Private instant messenger - 03-demo.lisp - IDE - A very simple common lisp IDE (see source if editor dosen't load) +- 04-demo.lisp - CMS Website \ No newline at end of file diff --git a/source/clog-web.lisp b/source/clog-web.lisp index 36ede63..a45574e 100644 --- a/source/clog-web.lisp +++ b/source/clog-web.lisp @@ -858,8 +858,8 @@ is placed in DOM at top of OBJ instead of bottom of OBJ." "Create a form with CONTENT followed by FIELDS. FIELDS is a list of lists each list has: - (1) Field name - Used for (name attribute) - (2) Field description - Used for label + (1) Field description - Used for label + (2) Field name - Used for (name attribute) (3) Field type - Optional (defaults to :text) (4) Field type options - Optional @@ -960,7 +960,7 @@ if confirmed or nil if canceled. CANCEL-TEXT is only displayed if modal is t" fls html-id ok-text ; ok (if modal - (format nil "" + (format nil " " html-id cancel-text) "")) :hidden t