From 44f96ffca7ea5cd20148d05138a196cd03c451f2 Mon Sep 17 00:00:00 2001
From: David Botton <david@botton.com>
Date: Sun, 13 Feb 2022 19:06:48 -0500
Subject: [PATCH] clog-presentations

---
 clog.asd                       |  1 +
 source/clog-presentations.lisp | 56 ++++++++++++++++++++++++++++++++++
 source/clog.lisp               | 16 +++++++---
 tutorial/29-tutorial.lisp      | 32 +++++++++++++++++++
 4 files changed, 101 insertions(+), 4 deletions(-)
 create mode 100644 source/clog-presentations.lisp
 create mode 100644 tutorial/29-tutorial.lisp

diff --git a/clog.asd b/clog.asd
index 28ff9a0..eecc18c 100644
--- a/clog.asd
+++ b/clog.asd
@@ -30,6 +30,7 @@
 	       (:file "clog-body")
 	       (:file "clog-system")
 	       (:file "clog-panel")
+	       (:file "clog-presentations")
 	       (:file "clog-gui")
 	       (:file "clog-web")
 	       (:file "clog-helpers")))
diff --git a/source/clog-presentations.lisp b/source/clog-presentations.lisp
new file mode 100644
index 0000000..d56854e
--- /dev/null
+++ b/source/clog-presentations.lisp
@@ -0,0 +1,56 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; CLOG - The Common Lisp Omnificent GUI                                 ;;;;
+;;;; (c) 2020-2022 David Botton                                            ;;;;
+;;;; License BSD 3 Clause                                                  ;;;;
+;;;;                                                                       ;;;;
+;;;; clog-presentations.lisp                                               ;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(cl:in-package :clog)
+
+;;; clog-presentations - link Lisp classes to CLOG objects
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Implementation - clog-presentations
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; link-form-element-to-slot ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defmacro link-form-element-to-slot (clog-obj object accessor)
+  "Link changes to (value CLOG-OBJ) to (ACESSOR OBJECT)"
+  `(set-on-change ,clog-obj
+		  (lambda (obj)
+		    (declare (ignore obj))
+		    (setf (,slot-name ,object) (value ,clog-obj)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; link-element-to-slot ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defmacro link-element-to-slot (clog-obj object slot-name)
+  "Link changes to (text CLOG-OBJ) to (ACESSOR OBJECT)"
+  `(set-on-change ,clog-obj
+		  (lambda (obj)
+		    (declare (ignore obj))
+		    (setf (,slot-name ,object) (text ,clog-obj)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; link-slot-to-form-element ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defmacro link-slot-to-form-element (object accessor clog-obj)
+  "Link changes to lisp (ACCESSOR OBJECT) to (value CLOG-OBJ)"
+  `(defmethod (setf ,accessor) :after (new-value (obj (eql ,object)))
+     (setf (value ,clog-obj) new-value)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; link-slot-to-element ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defmacro link-slot-to-element (object accessor clog-obj)
+  "Link changes to lisp (ACCESSOR OBJECT) to (text CLOG-OBJ)"
+  `(defmethod (setf ,accessor) :after (new-value (obj (eql ,object)))
+     (setf (text ,clog-obj) new-value)))
+
diff --git a/source/clog.lisp b/source/clog.lisp
index 20fe359..3790ccb 100644
--- a/source/clog.lisp
+++ b/source/clog.lisp
@@ -37,7 +37,8 @@ embedded in a native template application.)"
   (@clog-obj             section)
   (@clog-element         section)
   (@clog-element-common  section)
-  (@clog-panel           section)
+  (@clog-presentations   section)
+  (@clog-panels          section)
   (@clog-style-block     section)
   (@clog-form            section)
   (@clog-canvas          section)
@@ -492,13 +493,20 @@ embedded in a native template application.)"
   (clog-table-column-group-item   class)
   (create-table-column-group-item generic-function))
 
-(defsection @clog-panel (:title "CLOG Panels")
+(defsection @clog-presentations (:title "CLOG Presentations")
+  "CLOG-Presentations - CLOG Presentations"
+  (link-form-element-to-slot macro)
+  (link-element-to-slot      macro)
+  (link-slot-to-form-element macro)
+  (link-slot-to-element      macro))
+
+(defsection @clog-panels (:title "CLOG Panels")
   "CLOG-Panel - CLOG Panels"
-  (clog-panel class)
+  (clog-panel   class)
   (create-panel generic-function)
 
   "CLOG-Panel-Box - CLOG Panel Box"
-  (clog-panel-box class)
+  (clog-panel-box   class)
   (create-panel-box generic-function)
   (panel-box        generic-function)
 
diff --git a/tutorial/29-tutorial.lisp b/tutorial/29-tutorial.lisp
new file mode 100644
index 0000000..01ffe1a
--- /dev/null
+++ b/tutorial/29-tutorial.lisp
@@ -0,0 +1,32 @@
+;; Demonstrate CLOG presentations
+;;   links established between CLOG objects and Lisp objects
+
+(defpackage #:clog-tut-29
+  (:use #:cl #:clog)
+  (:export start-tutorial))
+
+(in-package :clog-tut-29)
+
+(defclass my-class ()
+  ((my-slot :accessor my-slot :initform "")))
+
+(defun on-new-window (body)
+  (let* ((lisp-obj (make-instance 'my-class))
+	 (l1 (create-label body :content "Form value:"))
+	 (i1 (create-form-element body :text))
+	 (l2 (create-label body :content "(my-slot lisp-obj) value:"))
+	 (i2 (create-form-element body :text))
+	 (b1 (create-button body :content "Set (my-slot lisp-obj) Value"))
+	 (b2 (create-button body :content "Get (my-slot lisp-obj) Value")))
+    (link-form-element-to-slot i1 lisp-obj my-slot)
+    (link-slot-to-form-element lisp-obj my-slot i1)
+    (set-on-click b1
+		  (lambda (obj)
+		    (setf (my-slot lisp-obj) (value i2))))
+    (set-on-click b2
+		  (lambda (obj)
+		    (setf (value i2) (my-slot lisp-obj))))))
+
+(defun start-tutorial ()
+  (initialize 'on-new-window)
+  (open-browser))