Declerative syntax macro with-clog-create and tutorial 33

LEARN.md

@@ -93,6 +93,7 @@ CLOG "The Framework" (Code Tutorials)
 - [30-tutorial.lisp](tutorial/30-tutorial.lisp) - Instant websites - clog-web-site
 - [31-tutorial.lisp](tutorial/31-tutorial.lisp) - Database and Authority based websites - clog-web-dbi and clog-auth
 - [32-tutorial.lisp](tutorial/32-tutorial.lisp) - Database Managed Content websites - clog-web-content
+- [33-tutorial.lisp](tutorial/33-tutorial.lisp) - with-clog-create - Using a declartive syntax for GUIs
 
 CLOG Demos - Learn through Projects
 

README.md

@@ -249,6 +249,7 @@ CLOG Tutorials
 - [30-tutorial.lisp](tutorial/30-tutorial.lisp) - Instant websites - clog-web-site
 - [31-tutorial.lisp](tutorial/31-tutorial.lisp) - Database and Authority based websites - clog-web-dbi and clog-auth
 - [32-tutorial.lisp](tutorial/32-tutorial.lisp) - Database Managed Content websites - clog-web-content
+- [33-tutorial.lisp](tutorial/33-tutorial.lisp) - with-clog-create - Using a declartive syntax for GUIs
 
 CLOG Demos
 

source/clog-utilities.lisp

@@ -20,6 +20,50 @@
   (apply #'make-hash-table :synchronized t args)
   #-(or sbcl ecl mezzano) (apply #'make-hash-table args))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Implementation - with-clog-create ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defmacro with-clog-create (obj spec &body body)
+"To use the macro you remove the create- from the create
+functions. The clog-obj passed as the first parameter of the macro is
+passed as the parent obj to the declared object, after that nested
+levels of decleraton are used as the parent clog-obj. To bind a
+variable to any created clog object using :bind var. See tutorial 33
+and 22 for examples."
+  (flet ((extract-bind (args)
+	   (when args
+	     (let ((fargs ())
+		    bind)
+	       (do* ((i 0)
+		      (x (nth i args) (nth i args)))
+		 ((>= i (length args)))
+		 (if (eql x :bind)
+		   (progn
+		     (setf bind (nth (1+ i) args))
+		     (incf i 2))
+		   (progn
+		     (push x fargs)
+		     (incf i))))
+	       (values (reverse fargs) bind)))))
+    (let ((let-bindings ())
+	   (used-bindings ()))
+      (labels ((create-from-spec (spec parent-binding)
+		 (destructuring-bind (gui-func-name args &body children)
+		   spec
+		   (multiple-value-bind (gui-func-args bind) (extract-bind args)
+		     (let* ((binding (or bind (gensym)))
+			     (create-func-name (intern (concatenate 'string "CREATE-" (symbol-name gui-func-name)))))
+		       (push `(,binding (,create-func-name ,parent-binding ,@gui-func-args)) let-bindings)
+		       (when (or bind children)
+			 (push binding used-bindings))
+		       (dolist (child-spec children)
+			 (create-from-spec child-spec binding)))))))
+	(create-from-spec spec obj)
+	`(let* ,(reverse let-bindings)
+	   (declare (ignore ,@(set-difference (mapcar #'first let-bindings) used-bindings)))
+	   ,@body)))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Implementation - clog-group
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

source/clog.lisp

@@ -72,6 +72,9 @@ embedded in a native template application.)"
   "Concurrent Hash Tables"
   (make-hash-table* function)
 
+  "Declerative Syntax Support"
+  (with-clog-create macro)
+
   "CLOG-Group - Utility Class for CLOG-Obj storage"
   (clog-group    class)
   (create-group  function)

tutorial/09-tutorial.lisp

@@ -7,15 +7,18 @@
 (defun on-new-window (body)
   (setf (title (html-document body)) "Tutorial 9")
   ;; When doing extensive setup of a page using connection cache
-  ;; reduces rountrip traffic and speeds setup considerably.
+  ;; reduces rountrip traffic and speeds setup.
   (with-connection-cache (body)
     (let* (last-tab
 	   ;; Note: Since the there is no need to use the tmp objects
 	   ;;       we reuse the same symbol name (tmp) even though the
 	   ;;       compiler can mark those for garbage collection early
 	   ;;       this not an issue as the element is created already
-	   ;;       in the browser window. This is probably not the best
+	   ;;       in the browser window.
-	   ;;       option for a production app though regardless.
+	   ;;
+	   ;;       See tutorial 33 for a far more elegant approach
+	   ;;       that uses with-clog-create for this type of code
+	   ;;       based layout.
 	   ;;
 	   ;; Create tabs and panels
 	   (t1  (create-button body :content "Tab1"))
@@ -65,7 +68,7 @@
 	   (tmp (create-form-element f2 :reset :value "Start Again")))
       (declare (ignore tmp))
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-      ;; Panel 1 contents
+    ;; Panel 1 contents
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
       (setf (place-holder fe1) "type here..")
       (setf (requiredp fe1) t)
@@ -96,7 +99,7 @@
       (set-border p2 :thin :solid :black)
       (set-border p3 :thin :solid :black)
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-      ;; Panel 2 contents
+    ;; Panel 2 contents
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
       (setf (vertical-align ta1) :top)
       (disable-resize ta1)
@@ -130,11 +133,11 @@
 					    (value sl2)
 					    (selectedp o2)))))
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-      ;; Panel 3 contents
+    ;; Panel 3 contents
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
       (setf (editablep p3) t)
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-      ;; Tab functionality
+    ;; Tab functionality
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
       (flet ((select-tab (obj)
 	       (setf (hiddenp p1) t)

tutorial/22-tutorial.lisp

@@ -21,7 +21,7 @@
   (let* ((win (create-gui-window obj :title "Drawing"))
 	 (canvas (create-canvas (window-content win) :width 600 :height 400))
 	 (cx     (create-context2d canvas)))
-    (set-border canvas :thin :solid :black)    
+    (set-border canvas :thin :solid :black)
     (fill-style cx :green)
     (fill-rect cx 10 10 150 100)
     (fill-style cx :blue)
@@ -53,7 +53,7 @@
   (alert-dialog obj "This is a modal alert box"))
 
 (defun on-dlg-confirm (obj)
-  (confirm-dialog obj "Shall we play a game?"		  
+  (confirm-dialog obj "Shall we play a game?"
 		(lambda (input)
 		  (if input
 		      (alert-dialog obj "How about Global Thermonuclear War.")
@@ -119,11 +119,11 @@
 				    (declare (ignore obj))()))))
 
 (defun on-new-window (body)
-  (setf (title (html-document body)) "Tutorial 22")  
+  (setf (title (html-document body)) "Tutorial 22")
   ;; For web oriented apps consider using the :client-movement option.
   ;; See clog-gui-initialize documentation.
   (clog-gui-initialize body)
-  (add-class body "w3-cyan")  
+  (add-class body "w3-cyan")
   (let* ((menu  (create-gui-menu-bar body))
 	 (tmp   (create-gui-menu-icon menu :on-click 'on-help-about))
 	 (file  (create-gui-menu-drop-down menu :content "File"))
@@ -137,7 +137,7 @@
 	 (tmp   (create-gui-menu-item win :content "Normalize All" :on-click 'normalize-all-windows))
 	 (tmp   (create-gui-menu-window-select win))
 	 (dlg   (create-gui-menu-drop-down menu :content "Dialogs"))
-	 (tmp   (create-gui-menu-item dlg :content "Alert Dialog Box" :on-click 'on-dlg-alert))	 
+	 (tmp   (create-gui-menu-item dlg :content "Alert Dialog Box" :on-click 'on-dlg-alert))
 	 (tmp   (create-gui-menu-item dlg :content "Input Dialog Box" :on-click 'on-dlg-input))
 	 (tmp   (create-gui-menu-item dlg :content "Confirm Dialog Box" :on-click 'on-dlg-confirm))
 	 (tmp   (create-gui-menu-item dlg :content "Form Dialog Box" :on-click 'on-dlg-form))
@@ -150,6 +150,34 @@
 	 (tmp   (create-gui-menu-item help :content "About" :on-click 'on-help-about))
 	 (tmp   (create-gui-menu-full-screen menu)))
     (declare (ignore tmp)))
+  ;; Alternatively with-clog-create can be used to declartively create the menu
+  ;; see tutorial 33
+  ;; (with-clog-create body
+  ;;   (gui-menu-bar ()
+  ;; 		  (gui-menu-icon (:on-click 'on-help-about))
+  ;; 		  (gui-menu-drop-down (:content "File")
+  ;; 				      (gui-menu-item (:content "Count" :on-click 'on-file-count))
+  ;; 				      (gui-menu-item (:content "Browse" :on-click 'on-file-browse))
+  ;; 				      (gui-menu-item (:content "Drawing" :on-click 'on-file-drawing))
+  ;; 				      (gui-menu-item (:content "Movie" :on-click 'on-file-movies))
+  ;; 				      (gui-menu-item (:content "Pinned" :on-click 'on-file-pinned)))
+  ;; 		  (gui-menu-drop-down (:content "Window")
+  ;; 				      (gui-menu-item (:content "Maximize All" :on-click 'maximize-all-windows))
+  ;; 				      (gui-menu-item (:content "Normalize All" :on-click 'normalize-all-windows))
+  ;; 				      (gui-menu-window-select ()))
+  ;; 		  (gui-menu-drop-down (:content "Dialogs")
+  ;; 				      (gui-menu-item (:content "Alert Dialog Box" :on-click 'on-dlg-alert))
+  ;; 				      (gui-menu-item (:content "Input Dialog Box" :on-click 'on-dlg-input))
+  ;; 				      (gui-menu-item (:content "Confirm Dialog Box" :on-click 'on-dlg-confirm))
+  ;; 				      (gui-menu-item (:content "Form Dialog Box" :on-click 'on-dlg-form))
+  ;; 				      (gui-menu-item (:content "Server File Dialog Box" :on-click 'on-dlg-file)))
+  ;; 		  (gui-menu-drop-down (:content "Toasts")
+  ;; 				      (gui-menu-item (:content "Alert Toast" :on-click 'on-toast-alert))
+  ;; 				      (gui-menu-item (:content "Warning Toast" :on-click 'on-toast-warn))
+  ;; 				      (gui-menu-item (:content "Success Toast" :on-click 'on-toast-success)))
+  ;; 		  (gui-menu-drop-down (:content "Help")
+  ;; 				      (gui-menu-item (:content "About" :on-click 'on-help-about)))
+  ;; 		  (gui-menu-full-screen ())))
   (set-on-before-unload (window body) (lambda(obj)
 					(declare (ignore obj))
 					;; return empty string to prevent nav off page

tutorial/README.md

@@ -58,3 +58,4 @@ Tutorial Summary
 - 30-tutorial.lisp - Instant websites - clog-web-site
 - 31-tutorial.lisp - Database and Authority based websites - clog-web-dbi and clog-auth
 - 32-tutorial.lisp - Database Managed Content websites - clog-web-content
+- 33-tutorial.lisp - with-clog-create - Using a declartive syntax for GUIs