Added with-connection-cache for minimizing wire traffic on large setups of pages.

doc/clog-manual.html

@@ -717,6 +717,25 @@ an application share per connection the same queue of serialized events.</p></li
 <p>Returns true if connection is valid on this <code>CLOG-OBJ</code>.</p></li>
 </ul>
 
+<p><a id="x-28CLOG-3AWITH-CONNECTION-CACHE-20MGL-PAX-3AMACRO-29"></a>
+<a id="CLOG:WITH-CONNECTION-CACHE%20MGL-PAX:MACRO"></a></p>
+
+<ul>
+<li><p><span class=reference-bullet><span class=reference><span class="locative-type">[macro]</span> <span class="reference-object"><a href="#CLOG:WITH-CONNECTION-CACHE%20MGL-PAX:MACRO" >WITH-CONNECTION-CACHE</a></span></span> <span class="locative-args">(CLOG-OBJ) &amp;BODY BODY</span></span></p>
+
+<p>Caches writes to the connection-id of <code>CLOG-OBJ</code> until
+flushed with <a href="#CLOG:FLUSH-CONNECTION-CACHE%20FUNCTION" title="CLOG:FLUSH-CONNECTION-CACHE FUNCTION"><code>FLUSH-CONNECTION-CACHE</code></a> or a query is made.</p></li>
+</ul>
+
+<p><a id="x-28CLOG-3AFLUSH-CONNECTION-CACHE-20FUNCTION-29"></a>
+<a id="CLOG:FLUSH-CONNECTION-CACHE%20FUNCTION"></a></p>
+
+<ul>
+<li><p><span class=reference-bullet><span class=reference><span class="locative-type">[function]</span> <span class="reference-object"><a href="#CLOG:FLUSH-CONNECTION-CACHE%20FUNCTION" >FLUSH-CONNECTION-CACHE</a></span></span> <span class="locative-args">CLOG-OBJ</span></span></p>
+
+<p>Flush connection cache if on.</p></li>
+</ul>
+
 <p>CLOG-Obj - Internals for Extensions and Plugins</p>
 
 <p><a id="x-28CLOG-3AHTML-ID-20GENERIC-FUNCTION-29"></a>
@@ -8151,10 +8170,11 @@ result or <code>DEFAULT-ANSWER</code> on time out.</p></li>
 <a id="CLOG:CLOG-REPL%20FUNCTION"></a></p>
 
 <ul>
-<li><p><span class=reference-bullet><span class=reference><span class="locative-type">[function]</span> <span class="reference-object"><a href="#CLOG:CLOG-REPL%20FUNCTION" >CLOG-REPL</a></span></span></span></p>
+<li><p><span class=reference-bullet><span class=reference><span class="locative-type">[function]</span> <span class="reference-object"><a href="#CLOG:CLOG-REPL%20FUNCTION" >CLOG-REPL</a></span></span> <span class="locative-args">&amp;KEY (CLOG-GUI-INITIALIZE <code>T</code>) (CLOG-WEB-INITIALIZE <code>T</code>)</span></span></p>
 
 <p>Set a path /repl that opens a blank page and sets the global
-clog-user:<em>body</em> to last window openned to /repl.</p></li>
+clog-user:<em>body</em> to last window openned to /repl. Debug mode is
+set (logging to browser console), </p></li>
 </ul>
 
 <p><a id="x-28CLOG-3ASAVE-BODY-TO-FILE-20FUNCTION-29"></a>

source/clog-base.lisp

@@ -14,7 +14,16 @@
 ;;; methods to retrieve connection-data (data that is associated with the
 ;;; current page regardless of object or thread of execution is lisp).
 
-(push :clog *features*)
+(pushnew :clog *features*)
+
+(defvar *connection-cache* nil
+  "Dynamic variable containing optional cache. Every thread has its
+own context and therefore its own copy of this variable when
+dynamically bound. As a result no thread protection is needed to
+access. To use dynamically bind the *connection-cache* and set it
+to (list :cache) turn on caching. By default this is off its main use
+is in initial setup complex pages. (private)
+See macro with-connection-cache.")
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Implementation - clog-obj
@@ -84,9 +93,34 @@ during attachment. (Private)"))
 dicarded, return CLOG-OBJ. (Internal)"))
 
 (defmethod js-execute ((obj clog-obj) script)
-  (clog-connection:execute (connection-id obj) script)
+  (if *connection-cache*
+      (push script *connection-cache*)
+      (clog-connection:execute (connection-id obj) script))
   obj)
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; with-connection-cache ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defmacro with-connection-cache ((clog-obj) &body body)
+  "Caches writes to the connection-id of CLOG-OBJ until
+flushed with FLUSH-CONNECTION-CACHE or a query is made."
+  `(let ((*connection-cache* (list :cache)))
+     ,@body
+     (clog:flush-connection-cache ,clog-obj)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; flush-connection-cache ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun flush-connection-cache (clog-obj)
+  "Flush connection cache if on."
+  (when *connection-cache*
+    (dolist (script (reverse *connection-cache*))
+      (unless (eq script :cache)
+	(clog-connection:execute (connection-id clog-obj) script)))
+    (setf *connection-cache* (list :cache))))
+
 ;;;;;;;;;;;;;;
 ;; js-query ;;
 ;;;;;;;;;;;;;;
@@ -95,6 +129,7 @@ dicarded, return CLOG-OBJ. (Internal)"))
   (:documentation "Execure SCRIPT on browser and return result. (Internal)"))
 
 (defmethod js-query ((obj clog-obj) script &key (default-answer nil))
+  (flush-connection-cache obj)
   (clog-connection:query (connection-id obj) script :default-answer default-answer))
 
 ;;;;;;;;;;;;;

source/clog.lisp

@@ -113,6 +113,8 @@ embedded in a native template application.)"
   (with-sync-event             macro)
   (remove-connection-data-item generic-function)
   (validp                      generic-function)
+  (with-connection-cache       macro)
+  (flush-connection-cache      function)
 
   "CLOG-Obj - Internals for Extensions and Plugins"
   (html-id      generic-function)

tutorial/09-tutorial.lisp

@@ -6,154 +6,157 @@
 
 (defun on-new-window (body)
   (setf (title (html-document body)) "Tutorial 9")
-  (let* (last-tab
+  ;; When doing extensive setup of a page using connection cache
-	 ;; Note: Since the there is no need to use the tmp objects
+  ;; reduces rountrip traffic and speeds setup considerably.
-	 ;;       we reuse the same symbol name (tmp) even though the
+  (with-connection-cache (body)
-	 ;;       compiler can mark those for garbage collection early
+    (let* (last-tab
-	 ;;       this not an issue as the element is created already
+	   ;; Note: Since the there is no need to use the tmp objects
-	 ;;       in the browser window. This is probably not the best
+	   ;;       we reuse the same symbol name (tmp) even though the
-	 ;;       option for a production app though regardless.
+	   ;;       compiler can mark those for garbage collection early
-	 ;;
+	   ;;       this not an issue as the element is created already
-	 ;; Create tabs and panels
+	   ;;       in the browser window. This is probably not the best
-	 (t1  (create-button body :content "Tab1"))
+	   ;;       option for a production app though regardless.
-	 (t2  (create-button body :content "Tab2"))
+	   ;;
-	 (t3  (create-button body :content "Tab3"))
+	   ;; Create tabs and panels
-	 (tmp (create-br body))
+	   (t1  (create-button body :content "Tab1"))
-	 (p1  (create-div body))
+	   (t2  (create-button body :content "Tab2"))
-	 (p2  (create-div body))
+	   (t3  (create-button body :content "Tab3"))
-	 (p3  (create-div body :content "Panel3 - Type here"))
+	   (tmp (create-br body))
-	 ;; Create form for panel 1
+	   (p1  (create-div body))
-	 (f1  (create-form p1))
+	   (p2  (create-div body))
-	 (fe1 (create-form-element f1 :text
+	   (p3  (create-div body :content "Panel3 - Type here"))
-				   :label (create-label f1 :content "Fill in blank:")))
+	   ;; Create form for panel 1
-	 (tmp (create-br f1))
+	   (f1  (create-form p1))
-	 (fe2 (create-form-element f1 :color :value "#ffffff"
+	   (fe1 (create-form-element f1 :text
-					     :label (create-label f1 :content "Pick a color:")))
+				     :label (create-label f1 :content "Fill in blank:")))
-	 (tmp (create-br f1))
+	   (tmp (create-br f1))
-	 (tmp (create-form-element f1 :submit :value "OK"))
+	   (fe2 (create-form-element f1 :color :value "#ffffff"
-	 (tmp (create-form-element f1 :reset :value "Start Again"))
+					       :label (create-label f1 :content "Pick a color:")))
-	 ;; Create for for panel 2
+	   (tmp (create-br f1))
-	 (f2  (create-form p2))
+	   (tmp (create-form-element f1 :submit :value "OK"))
-	 (fs2 (create-fieldset f2 :legend "Stuff"))
+	   (tmp (create-form-element f1 :reset :value "Start Again"))
-	 (tmp (create-label fs2 :content "Please type here:"))
+	   ;; Create for for panel 2
-	 (ta1 (create-text-area fs2 :columns 60 :rows 8 :label tmp))
+	   (f2  (create-form p2))
-	 (tmp (create-br fs2))
+	   (fs2 (create-fieldset f2 :legend "Stuff"))
-	 (rd1 (create-form-element fs2 :radio :name "rd"))
+	   (tmp (create-label fs2 :content "Please type here:"))
-	 (tmp (create-label fs2 :content "To Be" :label-for rd1))
+	   (ta1 (create-text-area fs2 :columns 60 :rows 8 :label tmp))
-	 (rd2 (create-form-element fs2 :radio :name "rd"))
+	   (tmp (create-br fs2))
-	 (tmp (create-label fs2 :content "No to Be" :label-for rd2))
+	   (rd1 (create-form-element fs2 :radio :name "rd"))
-	 (tmp (create-br fs2))
+	   (tmp (create-label fs2 :content "To Be" :label-for rd1))
-	 (ck1 (create-form-element fs2 :checkbox :name "ck"))
+	   (rd2 (create-form-element fs2 :radio :name "rd"))
-	 (tmp (create-label fs2 :content "Here" :label-for ck1))
+	   (tmp (create-label fs2 :content "No to Be" :label-for rd2))
-	 (ck2 (create-form-element fs2 :checkbox :name "ck"))
+	   (tmp (create-br fs2))
-	 (tmp (create-label fs2 :content "There" :label-for ck2))
+	   (ck1 (create-form-element fs2 :checkbox :name "ck"))
-	 (tmp (create-br fs2))	 
+	   (tmp (create-label fs2 :content "Here" :label-for ck1))
-	 (sl1 (create-select fs2 :label (create-label fs2 :content "Pick one:")))
+	   (ck2 (create-form-element fs2 :checkbox :name "ck"))
-	 (sl2 (create-select fs2 :label (create-label fs2 :content "Pick one:")))	 
+	   (tmp (create-label fs2 :content "There" :label-for ck2))
-	 (sl3 (create-select fs2 :multiple t
+	   (tmp (create-br fs2))
-			     :label (create-label fs2 :content "Pick some:")))
+	   (sl1 (create-select fs2 :label (create-label fs2 :content "Pick one:")))
-	 (o1  (create-option sl3 :content "one"))
+	   (sl2 (create-select fs2 :label (create-label fs2 :content "Pick one:")))
-	 (o2  (create-option sl3 :content "two"))
+	   (sl3 (create-select fs2 :multiple t
-	 (o3  (create-option sl3 :content "three"))
+				   :label (create-label fs2 :content "Pick some:")))
-	 (og1 (create-optgroup sl3 :content "These are a group"))
+	   (o1  (create-option sl3 :content "one"))
-	 (o4  (create-option og1 :content "four"))
+	   (o2  (create-option sl3 :content "two"))
-	 (o5  (create-option og1 :content "five"))
+	   (o3  (create-option sl3 :content "three"))
-	 (tmp (create-form-element f2 :submit :value "OK"))
+	   (og1 (create-optgroup sl3 :content "These are a group"))
-	 (tmp (create-form-element f2 :reset :value "Start Again")))
+	   (o4  (create-option og1 :content "four"))
-    (declare (ignore tmp))
+	   (o5  (create-option og1 :content "five"))
+	   (tmp (create-form-element f2 :submit :value "OK"))
+	   (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)
-    (setf (size fe1) 60)    
-    (make-data-list fe1 '("Cool Title"
-			  "Not So Cool Title"
-			  "Why Not, Another Title"))    
-    (make-data-list fe2 '("#ffffff"
-			  "#ff0000"
-			  "#00ff00"
-			  "#0000ff"
-			  "#ff00ff"))    
-    (set-on-submit f1
-		   (lambda (obj)
-		     (declare (ignore obj))
-		     (setf (title (html-document body)) (value fe1))
-		     (setf (background-color p1) (value fe2))
-		     (setf (hiddenp f1) t)
-		     (create-span p1 :content
-				  "<br><b>Your form has been submitted</b>")))    
-    (setf (width p1) "100%")
-    (setf (width p2) "100%")
-    (setf (width p3) "100%")    
-    (setf (height p1) 400)
-    (setf (height p2) 400)
-    (setf (height p3) 400)
-    (set-border p1 :thin :solid :black)
-    (set-border p2 :thin :solid :black)
-    (set-border p3 :thin :solid :black)
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-    ;; Panel 2 contents
+      (setf (place-holder fe1) "type here..")
+      (setf (requiredp fe1) t)
+      (setf (size fe1) 60)
+      (make-data-list fe1 '("Cool Title"
+			    "Not So Cool Title"
+			    "Why Not, Another Title"))
+      (make-data-list fe2 '("#ffffff"
+			    "#ff0000"
+			    "#00ff00"
+			    "#0000ff"
+			    "#ff00ff"))
+      (set-on-submit f1
+		     (lambda (obj)
+		       (declare (ignore obj))
+		       (setf (title (html-document body)) (value fe1))
+		       (setf (background-color p1) (value fe2))
+		       (setf (hiddenp f1) t)
+		       (create-span p1 :content
+				    "<br><b>Your form has been submitted</b>")))
+      (setf (width p1) "100%")
+      (setf (width p2) "100%")
+      (setf (width p3) "100%")
+      (setf (height p1) 400)
+      (setf (height p2) 400)
+      (setf (height p3) 400)
+      (set-border p1 :thin :solid :black)
+      (set-border p2 :thin :solid :black)
+      (set-border p3 :thin :solid :black)
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-    (setf (vertical-align ta1) :top)
+      ;; Panel 2 contents
-    (disable-resize ta1)
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-    (setf (vertical-align sl1) :top)
+      (setf (vertical-align ta1) :top)
-    (setf (vertical-align sl2) :top)
+      (disable-resize ta1)
-    (setf (vertical-align sl3) :top)
+      (setf (vertical-align sl1) :top)
-    (setf (size sl1) 3)
+      (setf (vertical-align sl2) :top)
-    (add-select-options sl1 '("one"
+      (setf (vertical-align sl3) :top)
-			      "two"
+      (setf (size sl1) 3)
-			      "three"
+      (add-select-options sl1 '("one"
-			      "four"
+				"two"
-			      "five"))
+				"three"
-    (add-select-options sl2 '("one"
+				"four"
-			      "two"
+				"five"))
-			      "three"
+      (add-select-options sl2 '("one"
-			      "four"
+				"two"
-			      "five"))
+				"three"
-    (set-on-change sl3 (lambda (obj)
+				"four"
-			 (declare (ignore obj))
+				"five"))
-			 (when (selectedp o5)
+      (set-on-change sl3 (lambda (obj)
-			   (alert (window body) "Selected 5"))))
+			   (declare (ignore obj))
-    (set-on-submit f2
+			   (when (selectedp o5)
-		   (lambda (obj)
+			     (alert (window body) "Selected 5"))))
-		     (declare (ignore obj))
+      (set-on-submit f2
-		     (setf (hiddenp f2) t)
+		     (lambda (obj)
-		     (create-span p2 :content
+		       (declare (ignore obj))
-		       (format nil "<br><b>Your form has been submitted:</b>
+		       (setf (hiddenp f2) t)
+		       (create-span p2 :content
+				    (format nil "<br><b>Your form has been submitted:</b>
                                        <br>~A<hr>1 - ~A<br>2 - ~A<br>3 - ~A"
-			       (value ta1)
+					    (value ta1)
-			       (value sl1)
+					    (value sl1)
-			       (value sl2)
+					    (value sl2)
-			       (selectedp o2)))))
+					    (selectedp o2)))))
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-    ;; Panel 3 contents
+      ;; Panel 3 contents
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-    (setf (editablep p3) t)
+      (setf (editablep p3) t)
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-    ;; Tab functionality
+      ;; Tab functionality
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-    (flet ((select-tab (obj)
+      (flet ((select-tab (obj)
-	     (setf (hiddenp p1) t)
+	       (setf (hiddenp p1) t)
-	     (setf (hiddenp p2) t)
+	       (setf (hiddenp p2) t)
-	     (setf (hiddenp p3) t)
+	       (setf (hiddenp p3) t)
-	     (setf (background-color t1) :lightgrey)
+	       (setf (background-color t1) :lightgrey)
-	     (setf (background-color t2) :lightgrey)
+	       (setf (background-color t2) :lightgrey)
-	     (setf (background-color t3) :lightgrey)	     
+	       (setf (background-color t3) :lightgrey)
-	     (setf (background-color last-tab) :lightblue)
+	       (setf (background-color last-tab) :lightblue)
-	     (setf (hiddenp obj) nil)
+	       (setf (hiddenp obj) nil)
-	     (focus obj)))
+	       (focus obj)))
-      (setf last-tab t1)
+	(setf last-tab t1)
-      (select-tab p1)      
+	(select-tab p1)
-      (set-on-click t1 (lambda (obj)
+	(set-on-click t1 (lambda (obj)
-			 (setf last-tab obj)
+			   (setf last-tab obj)
-			 (select-tab p1)))
+			   (select-tab p1)))
-      (set-on-click t2 (lambda (obj)
+	(set-on-click t2 (lambda (obj)
-			 (setf last-tab obj)
+			   (setf last-tab obj)
-			 (select-tab p2)))
+			   (select-tab p2)))
-      (set-on-click t3 (lambda (obj)
+	(set-on-click t3 (lambda (obj)
-			 (setf last-tab obj)
+			   (setf last-tab obj)
-			 (select-tab p3))))))
+			   (select-tab p3)))))))
 
 (defun start-tutorial ()
   "Start turtorial."