mirror of
https://github.com/rabbibotton/clog.git
synced 2025-12-06 02:30:42 -08:00
Added with-connection-cache for minimizing wire traffic on large setups of pages.
This commit is contained in:
David Botton
parent
ad6a4ad585
commit
28e9b45059
4 changed files with 204 additions and 144 deletions
|
|
@ -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) &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">&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>
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
||||
;;;;;;;;;;;;;
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -6,154 +6,157 @@
|
|||
|
||||
(defun on-new-window (body)
|
||||
(setf (title (html-document body)) "Tutorial 9")
|
||||
(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
|
||||
;; option for a production app though regardless.
|
||||
;;
|
||||
;; Create tabs and panels
|
||||
(t1 (create-button body :content "Tab1"))
|
||||
(t2 (create-button body :content "Tab2"))
|
||||
(t3 (create-button body :content "Tab3"))
|
||||
(tmp (create-br body))
|
||||
(p1 (create-div body))
|
||||
(p2 (create-div body))
|
||||
(p3 (create-div body :content "Panel3 - Type here"))
|
||||
;; Create form for panel 1
|
||||
(f1 (create-form p1))
|
||||
(fe1 (create-form-element f1 :text
|
||||
:label (create-label f1 :content "Fill in blank:")))
|
||||
(tmp (create-br f1))
|
||||
(fe2 (create-form-element f1 :color :value "#ffffff"
|
||||
:label (create-label f1 :content "Pick a color:")))
|
||||
(tmp (create-br f1))
|
||||
(tmp (create-form-element f1 :submit :value "OK"))
|
||||
(tmp (create-form-element f1 :reset :value "Start Again"))
|
||||
;; Create for for panel 2
|
||||
(f2 (create-form p2))
|
||||
(fs2 (create-fieldset f2 :legend "Stuff"))
|
||||
(tmp (create-label fs2 :content "Please type here:"))
|
||||
(ta1 (create-text-area fs2 :columns 60 :rows 8 :label tmp))
|
||||
(tmp (create-br fs2))
|
||||
(rd1 (create-form-element fs2 :radio :name "rd"))
|
||||
(tmp (create-label fs2 :content "To Be" :label-for rd1))
|
||||
(rd2 (create-form-element fs2 :radio :name "rd"))
|
||||
(tmp (create-label fs2 :content "No to Be" :label-for rd2))
|
||||
(tmp (create-br fs2))
|
||||
(ck1 (create-form-element fs2 :checkbox :name "ck"))
|
||||
(tmp (create-label fs2 :content "Here" :label-for ck1))
|
||||
(ck2 (create-form-element fs2 :checkbox :name "ck"))
|
||||
(tmp (create-label fs2 :content "There" :label-for ck2))
|
||||
(tmp (create-br fs2))
|
||||
(sl1 (create-select fs2 :label (create-label fs2 :content "Pick one:")))
|
||||
(sl2 (create-select fs2 :label (create-label fs2 :content "Pick one:")))
|
||||
(sl3 (create-select fs2 :multiple t
|
||||
:label (create-label fs2 :content "Pick some:")))
|
||||
(o1 (create-option sl3 :content "one"))
|
||||
(o2 (create-option sl3 :content "two"))
|
||||
(o3 (create-option sl3 :content "three"))
|
||||
(og1 (create-optgroup sl3 :content "These are a group"))
|
||||
(o4 (create-option og1 :content "four"))
|
||||
(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))
|
||||
;; When doing extensive setup of a page using connection cache
|
||||
;; reduces rountrip traffic and speeds setup considerably.
|
||||
(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
|
||||
;; option for a production app though regardless.
|
||||
;;
|
||||
;; Create tabs and panels
|
||||
(t1 (create-button body :content "Tab1"))
|
||||
(t2 (create-button body :content "Tab2"))
|
||||
(t3 (create-button body :content "Tab3"))
|
||||
(tmp (create-br body))
|
||||
(p1 (create-div body))
|
||||
(p2 (create-div body))
|
||||
(p3 (create-div body :content "Panel3 - Type here"))
|
||||
;; Create form for panel 1
|
||||
(f1 (create-form p1))
|
||||
(fe1 (create-form-element f1 :text
|
||||
:label (create-label f1 :content "Fill in blank:")))
|
||||
(tmp (create-br f1))
|
||||
(fe2 (create-form-element f1 :color :value "#ffffff"
|
||||
:label (create-label f1 :content "Pick a color:")))
|
||||
(tmp (create-br f1))
|
||||
(tmp (create-form-element f1 :submit :value "OK"))
|
||||
(tmp (create-form-element f1 :reset :value "Start Again"))
|
||||
;; Create for for panel 2
|
||||
(f2 (create-form p2))
|
||||
(fs2 (create-fieldset f2 :legend "Stuff"))
|
||||
(tmp (create-label fs2 :content "Please type here:"))
|
||||
(ta1 (create-text-area fs2 :columns 60 :rows 8 :label tmp))
|
||||
(tmp (create-br fs2))
|
||||
(rd1 (create-form-element fs2 :radio :name "rd"))
|
||||
(tmp (create-label fs2 :content "To Be" :label-for rd1))
|
||||
(rd2 (create-form-element fs2 :radio :name "rd"))
|
||||
(tmp (create-label fs2 :content "No to Be" :label-for rd2))
|
||||
(tmp (create-br fs2))
|
||||
(ck1 (create-form-element fs2 :checkbox :name "ck"))
|
||||
(tmp (create-label fs2 :content "Here" :label-for ck1))
|
||||
(ck2 (create-form-element fs2 :checkbox :name "ck"))
|
||||
(tmp (create-label fs2 :content "There" :label-for ck2))
|
||||
(tmp (create-br fs2))
|
||||
(sl1 (create-select fs2 :label (create-label fs2 :content "Pick one:")))
|
||||
(sl2 (create-select fs2 :label (create-label fs2 :content "Pick one:")))
|
||||
(sl3 (create-select fs2 :multiple t
|
||||
:label (create-label fs2 :content "Pick some:")))
|
||||
(o1 (create-option sl3 :content "one"))
|
||||
(o2 (create-option sl3 :content "two"))
|
||||
(o3 (create-option sl3 :content "three"))
|
||||
(og1 (create-optgroup sl3 :content "These are a group"))
|
||||
(o4 (create-option og1 :content "four"))
|
||||
(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
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(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 1 contents
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; 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)
|
||||
(disable-resize ta1)
|
||||
(setf (vertical-align sl1) :top)
|
||||
(setf (vertical-align sl2) :top)
|
||||
(setf (vertical-align sl3) :top)
|
||||
(setf (size sl1) 3)
|
||||
(add-select-options sl1 '("one"
|
||||
"two"
|
||||
"three"
|
||||
"four"
|
||||
"five"))
|
||||
(add-select-options sl2 '("one"
|
||||
"two"
|
||||
"three"
|
||||
"four"
|
||||
"five"))
|
||||
(set-on-change sl3 (lambda (obj)
|
||||
(declare (ignore obj))
|
||||
(when (selectedp o5)
|
||||
(alert (window body) "Selected 5"))))
|
||||
(set-on-submit f2
|
||||
(lambda (obj)
|
||||
(declare (ignore obj))
|
||||
(setf (hiddenp f2) t)
|
||||
(create-span p2 :content
|
||||
(format nil "<br><b>Your form has been submitted:</b>
|
||||
;; Panel 2 contents
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(setf (vertical-align ta1) :top)
|
||||
(disable-resize ta1)
|
||||
(setf (vertical-align sl1) :top)
|
||||
(setf (vertical-align sl2) :top)
|
||||
(setf (vertical-align sl3) :top)
|
||||
(setf (size sl1) 3)
|
||||
(add-select-options sl1 '("one"
|
||||
"two"
|
||||
"three"
|
||||
"four"
|
||||
"five"))
|
||||
(add-select-options sl2 '("one"
|
||||
"two"
|
||||
"three"
|
||||
"four"
|
||||
"five"))
|
||||
(set-on-change sl3 (lambda (obj)
|
||||
(declare (ignore obj))
|
||||
(when (selectedp o5)
|
||||
(alert (window body) "Selected 5"))))
|
||||
(set-on-submit f2
|
||||
(lambda (obj)
|
||||
(declare (ignore obj))
|
||||
(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 sl1)
|
||||
(value sl2)
|
||||
(selectedp o2)))))
|
||||
(value ta1)
|
||||
(value sl1)
|
||||
(value sl2)
|
||||
(selectedp o2)))))
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Panel 3 contents
|
||||
;; Panel 3 contents
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(setf (editablep p3) t)
|
||||
(setf (editablep p3) t)
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Tab functionality
|
||||
;; Tab functionality
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(flet ((select-tab (obj)
|
||||
(setf (hiddenp p1) t)
|
||||
(setf (hiddenp p2) t)
|
||||
(setf (hiddenp p3) t)
|
||||
(setf (background-color t1) :lightgrey)
|
||||
(setf (background-color t2) :lightgrey)
|
||||
(setf (background-color t3) :lightgrey)
|
||||
(setf (background-color last-tab) :lightblue)
|
||||
(setf (hiddenp obj) nil)
|
||||
(focus obj)))
|
||||
(setf last-tab t1)
|
||||
(select-tab p1)
|
||||
(set-on-click t1 (lambda (obj)
|
||||
(setf last-tab obj)
|
||||
(select-tab p1)))
|
||||
(set-on-click t2 (lambda (obj)
|
||||
(setf last-tab obj)
|
||||
(select-tab p2)))
|
||||
(set-on-click t3 (lambda (obj)
|
||||
(setf last-tab obj)
|
||||
(select-tab p3))))))
|
||||
(flet ((select-tab (obj)
|
||||
(setf (hiddenp p1) t)
|
||||
(setf (hiddenp p2) t)
|
||||
(setf (hiddenp p3) t)
|
||||
(setf (background-color t1) :lightgrey)
|
||||
(setf (background-color t2) :lightgrey)
|
||||
(setf (background-color t3) :lightgrey)
|
||||
(setf (background-color last-tab) :lightblue)
|
||||
(setf (hiddenp obj) nil)
|
||||
(focus obj)))
|
||||
(setf last-tab t1)
|
||||
(select-tab p1)
|
||||
(set-on-click t1 (lambda (obj)
|
||||
(setf last-tab obj)
|
||||
(select-tab p1)))
|
||||
(set-on-click t2 (lambda (obj)
|
||||
(setf last-tab obj)
|
||||
(select-tab p2)))
|
||||
(set-on-click t3 (lambda (obj)
|
||||
(setf last-tab obj)
|
||||
(select-tab p3)))))))
|
||||
|
||||
(defun start-tutorial ()
|
||||
"Start turtorial."
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue