mirror of
https://github.com/rabbibotton/clog.git
synced 2025-12-06 02:30:42 -08:00
Updates to tuts and new with-sync-event
This commit is contained in:
parent
ec81e5fb2b
commit
18a5f8d78e
33 changed files with 157 additions and 104 deletions
|
|
@ -8,8 +8,6 @@ When to use page vs panel
|
||||||
Running JavaScript
|
Running JavaScript
|
||||||
Plug-in panels for use on other sites
|
Plug-in panels for use on other sites
|
||||||
|
|
||||||
- CLOG tools for concurrency - clog-mutex
|
|
||||||
|
|
||||||
- Multi control select and alignments in Builder
|
- Multi control select and alignments in Builder
|
||||||
|
|
||||||
- Right click menus CLOG-GUI
|
- Right click menus CLOG-GUI
|
||||||
|
|
|
||||||
|
|
@ -407,6 +407,16 @@ for openning windows on remote machines.</p></li>
|
||||||
|
|
||||||
<h2><a href="#x-28CLOG-3A-40CLOG-UTILITIES-20MGL-PAX-3ASECTION-29">5 CLOG Utilities</a></h2>
|
<h2><a href="#x-28CLOG-3A-40CLOG-UTILITIES-20MGL-PAX-3ASECTION-29">5 CLOG Utilities</a></h2>
|
||||||
|
|
||||||
|
<p>Concurrent Hash Tables</p>
|
||||||
|
|
||||||
|
<p><a id='x-28CLOG-3AMAKE-HASH-TABLE-2A-20FUNCTION-29'></a></p>
|
||||||
|
|
||||||
|
<ul>
|
||||||
|
<li><p><span class=reference-bullet><span class=reference><span class="locative-type">[function]</span> <span class="reference-object"><a href="#x-28CLOG-3AMAKE-HASH-TABLE-2A-20FUNCTION-29" >MAKE-HASH-TABLE*</a></span></span> <span class="locative-args">&REST ARGS</span></span></p>
|
||||||
|
|
||||||
|
<p>Use native concurrent hash tables</p></li>
|
||||||
|
</ul>
|
||||||
|
|
||||||
<p>CLOG-Group - Utility Class for CLOG-Obj storage</p>
|
<p>CLOG-Group - Utility Class for CLOG-Obj storage</p>
|
||||||
|
|
||||||
<p><a id='x-28CLOG-3ACLOG-GROUP-20CLASS-29'></a></p>
|
<p><a id='x-28CLOG-3ACLOG-GROUP-20CLASS-29'></a></p>
|
||||||
|
|
@ -629,6 +639,23 @@ clog-body of this connection and accessible with <a href="#x-28CLOG-3ACONNECTION
|
||||||
<p>Get connection's clog-body.</p></li>
|
<p>Get connection's clog-body.</p></li>
|
||||||
</ul>
|
</ul>
|
||||||
|
|
||||||
|
<p><a id='x-28CLOG-3ACONNECTION-SYNC-20GENERIC-FUNCTION-29'></a></p>
|
||||||
|
|
||||||
|
<ul>
|
||||||
|
<li><p><span class=reference-bullet><span class=reference><span class="locative-type">[generic-function]</span> <span class="reference-object"><a href="#x-28CLOG-3ACONNECTION-SYNC-20GENERIC-FUNCTION-29" >CONNECTION-SYNC</a></span></span> <span class="locative-args">CLOG-OBJ</span></span></p>
|
||||||
|
|
||||||
|
<p>Get connection's clog-sync for optional syncing events.</p></li>
|
||||||
|
</ul>
|
||||||
|
|
||||||
|
<p><a id='x-28CLOG-3AWITH-SYNC-EVENT-20MGL-PAX-3AMACRO-29'></a></p>
|
||||||
|
|
||||||
|
<ul>
|
||||||
|
<li><p><span class=reference-bullet><span class=reference><span class="locative-type">[macro]</span> <span class="reference-object"><a href="#x-28CLOG-3AWITH-SYNC-EVENT-20MGL-PAX-3AMACRO-29" >WITH-SYNC-EVENT</a></span></span> <span class="locative-args">(CLOG-OBJ) &BODY BODY</span></span></p>
|
||||||
|
|
||||||
|
<p>Place at start of event to serialize access to the event. All events in
|
||||||
|
an application share per connection the same queue of serialized events.</p></li>
|
||||||
|
</ul>
|
||||||
|
|
||||||
<p><a id='x-28CLOG-3AREMOVE-CONNECTION-DATA-ITEM-20GENERIC-FUNCTION-29'></a></p>
|
<p><a id='x-28CLOG-3AREMOVE-CONNECTION-DATA-ITEM-20GENERIC-FUNCTION-29'></a></p>
|
||||||
|
|
||||||
<ul>
|
<ul>
|
||||||
|
|
|
||||||
|
|
@ -474,6 +474,26 @@ clog-body of this connection and accessible with CONNECTION-BODY."))
|
||||||
(defmethod connection-body (clog-obj)
|
(defmethod connection-body (clog-obj)
|
||||||
(connection-data-item clog-obj "clog-body"))
|
(connection-data-item clog-obj "clog-body"))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; connection-sync ;;
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(defgeneric connection-sync (clog-obj)
|
||||||
|
(:documentation "Get connection's clog-sync for optional syncing events."))
|
||||||
|
|
||||||
|
(defmethod connection-sync (clog-obj)
|
||||||
|
(connection-data-item clog-obj "clog-sync"))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; with-sync-event ;;
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(defmacro with-sync-event ((clog-obj) &body body)
|
||||||
|
"Place at start of event to serialize access to the event. All events in
|
||||||
|
an application share per connection the same queue of serialized events."
|
||||||
|
`(bordeaux-threads:with-lock-held (,`(connection-sync ,clog-obj))
|
||||||
|
,@body))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; connection-data-item ;;
|
;; connection-data-item ;;
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
|
||||||
|
|
@ -41,6 +41,7 @@ the same as the clog directy this overides the relative paths used in them.")
|
||||||
(if on-new-window
|
(if on-new-window
|
||||||
(progn
|
(progn
|
||||||
(setf (connection-data-item body "clog-body") body)
|
(setf (connection-data-item body "clog-body") body)
|
||||||
|
(setf (connection-data-item body "clog-sync") (bordeaux-threads:make-lock))
|
||||||
(funcall on-new-window body))
|
(funcall on-new-window body))
|
||||||
(put-br (html-document body) "No route to on-new-window")))))
|
(put-br (html-document body) "No route to on-new-window")))))
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -105,6 +105,8 @@ embedded in a native template application.)"
|
||||||
(connection-data generic-function)
|
(connection-data generic-function)
|
||||||
(connection-data-item generic-function)
|
(connection-data-item generic-function)
|
||||||
(connection-body generic-function)
|
(connection-body generic-function)
|
||||||
|
(connection-sync generic-function)
|
||||||
|
(with-sync-event macro)
|
||||||
(remove-connection-data-item generic-function)
|
(remove-connection-data-item generic-function)
|
||||||
(validp generic-function)
|
(validp generic-function)
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -37,11 +37,11 @@
|
||||||
(clog-gui-initialize body)
|
(clog-gui-initialize body)
|
||||||
(add-class body "w3-teal")
|
(add-class body "w3-teal")
|
||||||
(let* ((menu-bar (create-gui-menu-bar body))
|
(let* ((menu-bar (create-gui-menu-bar body))
|
||||||
(icon-item (create-gui-menu-icon menu-bar :on-click #'on-help-about))
|
(icon-item (create-gui-menu-icon menu-bar :on-click 'on-help-about))
|
||||||
(file-item (create-gui-menu-drop-down menu-bar :content "File"))
|
(file-item (create-gui-menu-drop-down menu-bar :content "File"))
|
||||||
(file-new (create-gui-menu-item file-item :content "New Window" :on-click #'on-file-new))
|
(file-new (create-gui-menu-item file-item :content "New Window" :on-click 'on-file-new))
|
||||||
(help-item (create-gui-menu-drop-down menu-bar :content "Help"))
|
(help-item (create-gui-menu-drop-down menu-bar :content "Help"))
|
||||||
(help-about (create-gui-menu-item help-item :content "About" :on-click #'on-help-about))
|
(help-about (create-gui-menu-item help-item :content "About" :on-click 'on-help-about))
|
||||||
(full-screen (create-gui-menu-full-screen menu-bar)))
|
(full-screen (create-gui-menu-full-screen menu-bar)))
|
||||||
(declare (ignore icon-item file-new help-about full-screen))
|
(declare (ignore icon-item file-new help-about full-screen))
|
||||||
(run body))))
|
(run body))))
|
||||||
|
|
|
||||||
|
|
@ -40,8 +40,13 @@
|
||||||
(initialize #'on-new-window)
|
(initialize #'on-new-window)
|
||||||
;; Set the function on-new-window to execute
|
;; Set the function on-new-window to execute
|
||||||
;; everytime a browser connection to our app.
|
;; everytime a browser connection to our app.
|
||||||
;; #' tells common lisp to pass the function
|
;; #' tells common lisp to pass the function.
|
||||||
;; to intialize and not to execute it.
|
;; If we pass the symbol 'on-new-window it
|
||||||
|
;; it will look each time for the function
|
||||||
|
;; represented by our symbol. This is generally
|
||||||
|
;; prefered in development as then we can
|
||||||
|
;; recompile our events while running ie. M-C-x
|
||||||
|
;; in emacs.
|
||||||
|
|
||||||
;; Open a browser to http://127.0.0.1:8080 - the default for CLOG apps
|
;; Open a browser to http://127.0.0.1:8080 - the default for CLOG apps
|
||||||
(open-browser))
|
(open-browser))
|
||||||
|
|
|
||||||
|
|
@ -38,5 +38,5 @@
|
||||||
|
|
||||||
(defun start-tutorial ()
|
(defun start-tutorial ()
|
||||||
"Start turtorial."
|
"Start turtorial."
|
||||||
(initialize #'on-new-window)
|
(initialize 'on-new-window)
|
||||||
(open-browser))
|
(open-browser))
|
||||||
|
|
|
||||||
|
|
@ -12,22 +12,26 @@
|
||||||
(let ((x 0))
|
(let ((x 0))
|
||||||
(set-on-click hello-element
|
(set-on-click hello-element
|
||||||
(lambda (obj)
|
(lambda (obj)
|
||||||
(declare (ignore obj))
|
(declare (ignorable obj))
|
||||||
(incf x)
|
;; Add to try non-parallel events:
|
||||||
(dotimes (n x)
|
;; (with-sync-event (obj)
|
||||||
(create-p body
|
(let ((y (incf x)))
|
||||||
:content (format nil "Clicked ~A times." x))
|
(dotimes (n y)
|
||||||
(sleep x)))))
|
(create-p body
|
||||||
|
:content (format nil "Clicked ~A times." y))
|
||||||
|
(sleep y)))))) ;)
|
||||||
(run body)))
|
(run body)))
|
||||||
|
|
||||||
;;; Running this version of the last tutorial and clicking quickly on the (click me!)
|
;;; Running this version of the last tutorial and clicking quickly on the (click me!)
|
||||||
;;; will demonstrate an important aspect of CLOG, events can happen in _parallel_.
|
;;; will demonstrate an important aspect of CLOG, events can happen in _parallel_.
|
||||||
;;; This means that appropriate precautions to thread protect data should be taken
|
;;; This means that appropriate precautions to thread protect data should be taken
|
||||||
;;; and that events do not wait for previous event handlers to complete. One simple
|
;;; and that events do not wait for previous event handlers to complete. To change
|
||||||
;;; way to avoid issues is to use the key :one-time t on the set-on-click or other
|
;;; this behavior just add at start of event WITH-SYNC-EVENT and then all events
|
||||||
;;; event, this will turn off the event immediately when the user clicks and can then
|
;;; will be serialized like in "traditional" GUIs to that event, events using
|
||||||
;;; set the event again when done handling the event if want to again accept the event.
|
;;; WITH-SYNC-EVENT will be on same queue of incoming events and syncronized.
|
||||||
|
;;; But... notice what happens once syncing is on the next event doesn't hit until
|
||||||
|
;;; SLEEP returns.
|
||||||
(defun start-tutorial ()
|
(defun start-tutorial ()
|
||||||
"Start turtorial."
|
"Start turtorial."
|
||||||
(initialize #'on-new-window)
|
(initialize 'on-new-window)
|
||||||
(open-browser))
|
(open-browser))
|
||||||
|
|
|
||||||
|
|
@ -12,12 +12,12 @@
|
||||||
(setf (title (html-document body)) "Tutorial 4")
|
(setf (title (html-document body)) "Tutorial 4")
|
||||||
;; The same handler #'my-on-click is set on both targets
|
;; The same handler #'my-on-click is set on both targets
|
||||||
(set-on-click (create-section body :h1 :content "Hello World! (click me!)")
|
(set-on-click (create-section body :h1 :content "Hello World! (click me!)")
|
||||||
#'my-on-click)
|
'my-on-click)
|
||||||
(set-on-click (create-section body :h3 :content "Click me too!")
|
(set-on-click (create-section body :h3 :content "Click me too!")
|
||||||
#'my-on-click)
|
'my-on-click)
|
||||||
(run body))
|
(run body))
|
||||||
|
|
||||||
(defun start-tutorial ()
|
(defun start-tutorial ()
|
||||||
"Start turtorial."
|
"Start turtorial."
|
||||||
(initialize #'on-new-window)
|
(initialize 'on-new-window)
|
||||||
(open-browser))
|
(open-browser))
|
||||||
|
|
|
||||||
|
|
@ -15,12 +15,12 @@
|
||||||
"On-new-window handler."
|
"On-new-window handler."
|
||||||
(setf (title (html-document body)) "Tutorial 5")
|
(setf (title (html-document body)) "Tutorial 5")
|
||||||
(set-on-click (create-section body :h1 :content "Hello World! (click me!)")
|
(set-on-click (create-section body :h1 :content "Hello World! (click me!)")
|
||||||
#'my-on-click)
|
'my-on-click)
|
||||||
(setf (connection-data-item body "changer")
|
(setf (connection-data-item body "changer")
|
||||||
(create-section body :h1 :content "I change"))
|
(create-section body :h1 :content "I change"))
|
||||||
(run body))
|
(run body))
|
||||||
|
|
||||||
(defun start-tutorial ()
|
(defun start-tutorial ()
|
||||||
"Start turtorial."
|
"Start turtorial."
|
||||||
(initialize #'on-new-window)
|
(initialize 'on-new-window)
|
||||||
(open-browser))
|
(open-browser))
|
||||||
|
|
|
||||||
|
|
@ -28,10 +28,10 @@
|
||||||
"On-new-window handler."
|
"On-new-window handler."
|
||||||
(setf (title (html-document body)) "Tutorial 6")
|
(setf (title (html-document body)) "Tutorial 6")
|
||||||
(set-on-click (create-section body :h1 :content "(click me to start!)")
|
(set-on-click (create-section body :h1 :content "(click me to start!)")
|
||||||
#'my-on-click)
|
'my-on-click)
|
||||||
(run body))
|
(run body))
|
||||||
|
|
||||||
(defun start-tutorial ()
|
(defun start-tutorial ()
|
||||||
"Start turtorial."
|
"Start turtorial."
|
||||||
(initialize #'on-new-window)
|
(initialize 'on-new-window)
|
||||||
(open-browser))
|
(open-browser))
|
||||||
|
|
|
||||||
|
|
@ -34,7 +34,7 @@
|
||||||
(set-bounds))))
|
(set-bounds))))
|
||||||
;; Setup our "mover". Darth
|
;; Setup our "mover". Darth
|
||||||
(setf (positioning mover) :fixed)
|
(setf (positioning mover) :fixed)
|
||||||
(set-on-click mover #'on-click)
|
(set-on-click mover 'on-click)
|
||||||
;; Get Darth moving!
|
;; Get Darth moving!
|
||||||
(bordeaux-threads:make-thread ; In addtion to the main task (the on-new-window)
|
(bordeaux-threads:make-thread ; In addtion to the main task (the on-new-window)
|
||||||
(lambda () ; and the task created for each event like clicks
|
(lambda () ; and the task created for each event like clicks
|
||||||
|
|
@ -80,5 +80,5 @@
|
||||||
|
|
||||||
(defun start-tutorial ()
|
(defun start-tutorial ()
|
||||||
"Start turtorial."
|
"Start turtorial."
|
||||||
(initialize #'on-new-window)
|
(initialize 'on-new-window)
|
||||||
(open-browser))
|
(open-browser))
|
||||||
|
|
|
||||||
|
|
@ -5,11 +5,7 @@
|
||||||
(in-package :clog-tut-8)
|
(in-package :clog-tut-8)
|
||||||
|
|
||||||
(defclass app-data ()
|
(defclass app-data ()
|
||||||
((drag-mutex
|
((in-drag
|
||||||
:reader drag-mutex
|
|
||||||
:initform (bordeaux-threads:make-lock)
|
|
||||||
:documentation "Serialize access to the on-mouse-down event.")
|
|
||||||
(in-drag
|
|
||||||
:accessor in-drag-p
|
:accessor in-drag-p
|
||||||
:initform nil
|
:initform nil
|
||||||
:documentation "Ensure only one box is dragged at a time.")
|
:documentation "Ensure only one box is dragged at a time.")
|
||||||
|
|
@ -22,25 +18,25 @@
|
||||||
(:documentation "App data specific to each instance of our tutorial 8 app"))
|
(:documentation "App data specific to each instance of our tutorial 8 app"))
|
||||||
|
|
||||||
(defun on-mouse-down (obj data)
|
(defun on-mouse-down (obj data)
|
||||||
(let ((app (connection-data-item obj "app-data"))) ; Access our instance of App-Data
|
(with-sync-event (obj) ; Serialize events to on-mouse-down.
|
||||||
(bordeaux-threads:with-lock-held ((drag-mutex app)) ; Ensure the first event received
|
(let ((app (connection-data-item obj "app-data"))) ; Ensure the first event received
|
||||||
(unless (in-drag-p app) ; to drag is the only one, ie only
|
(unless (in-drag-p app) ; to drag is the only one, ie only
|
||||||
(setf (in-drag-p app) t) ; the innermost box is dragged.
|
(setf (in-drag-p app) t) ; the innermost box is dragged.
|
||||||
(let* ((mouse-x (getf data :screen-x)) ; Use the screen coordinates not
|
(let* ((mouse-x (getf data :screen-x)) ; Use the screen coordinates not
|
||||||
(mouse-y (getf data :screen-y)) ; the coordinates relative to the obj
|
(mouse-y (getf data :screen-y)) ; the coordinates relative to the obj
|
||||||
(obj-top (parse-integer (top obj) :junk-allowed t))
|
(obj-top (parse-integer (top obj) :junk-allowed t))
|
||||||
(obj-left (parse-integer (left obj) :junk-allowed t)))
|
(obj-left (parse-integer (left obj) :junk-allowed t)))
|
||||||
(setf (drag-x app) (- mouse-x obj-left))
|
(setf (drag-x app) (- mouse-x obj-left))
|
||||||
(setf (drag-y app) (- mouse-y obj-top))
|
(setf (drag-y app) (- mouse-y obj-top))
|
||||||
(if (eq (getf data :event-type) :touch)
|
(if (eq (getf data :event-type) :touch)
|
||||||
(progn
|
(progn
|
||||||
(set-on-touch-move obj 'on-mouse-move)
|
(set-on-touch-move obj 'on-mouse-move)
|
||||||
(set-on-touch-end obj 'stop-obj-grab)
|
(set-on-touch-end obj 'stop-obj-grab)
|
||||||
(set-on-touch-cancel obj 'on-mouse-leave))
|
(set-on-touch-cancel obj 'on-mouse-leave))
|
||||||
(progn
|
(progn
|
||||||
(set-on-mouse-move obj 'on-mouse-move)
|
(set-on-mouse-move obj 'on-mouse-move)
|
||||||
(set-on-mouse-up obj 'stop-obj-grab)
|
(set-on-mouse-up obj 'stop-obj-grab)
|
||||||
(set-on-mouse-leave obj 'on-mouse-leave))))))))
|
(set-on-mouse-leave obj 'on-mouse-leave))))))))
|
||||||
|
|
||||||
(defun on-mouse-move (obj data)
|
(defun on-mouse-move (obj data)
|
||||||
(let* ((app (connection-data-item obj "app-data"))
|
(let* ((app (connection-data-item obj "app-data"))
|
||||||
|
|
@ -102,5 +98,5 @@
|
||||||
|
|
||||||
(defun start-tutorial ()
|
(defun start-tutorial ()
|
||||||
"Start turtorial."
|
"Start turtorial."
|
||||||
(initialize #'on-new-window)
|
(initialize 'on-new-window)
|
||||||
(open-browser))
|
(open-browser))
|
||||||
|
|
|
||||||
|
|
@ -158,5 +158,5 @@
|
||||||
|
|
||||||
(defun start-tutorial ()
|
(defun start-tutorial ()
|
||||||
"Start turtorial."
|
"Start turtorial."
|
||||||
(initialize #'on-new-window)
|
(initialize 'on-new-window)
|
||||||
(open-browser))
|
(open-browser))
|
||||||
|
|
|
||||||
|
|
@ -24,5 +24,5 @@
|
||||||
|
|
||||||
(defun start-tutorial ()
|
(defun start-tutorial ()
|
||||||
"Start turtorial."
|
"Start turtorial."
|
||||||
(initialize #'on-new-window)
|
(initialize 'on-new-window)
|
||||||
(open-browser))
|
(open-browser))
|
||||||
|
|
|
||||||
|
|
@ -66,11 +66,11 @@
|
||||||
(reset form)))
|
(reset form)))
|
||||||
;; We need to override the boostrap default to submit the form html style
|
;; We need to override the boostrap default to submit the form html style
|
||||||
(set-on-submit form (lambda (obj)(declare (ignore obj))()))
|
(set-on-submit form (lambda (obj)(declare (ignore obj))()))
|
||||||
(set-on-click good-button #'on-click-good)
|
(set-on-click good-button 'on-click-good)
|
||||||
(set-on-click scary-button #'on-click-scary))
|
(set-on-click scary-button 'on-click-scary))
|
||||||
(run body)))
|
(run body)))
|
||||||
|
|
||||||
(defun start-tutorial ()
|
(defun start-tutorial ()
|
||||||
"Start tutorial."
|
"Start tutorial."
|
||||||
(initialize #'on-new-window)
|
(initialize 'on-new-window)
|
||||||
(open-browser :url "http://127.0.0.1:8080/tutorial/tut-11.html"))
|
(open-browser :url "http://127.0.0.1:8080/tutorial/tut-11.html"))
|
||||||
|
|
|
||||||
|
|
@ -81,35 +81,35 @@
|
||||||
(reset form)))
|
(reset form)))
|
||||||
;; We need to override the boostrap default to submit the form html style
|
;; We need to override the boostrap default to submit the form html style
|
||||||
(set-on-submit form (lambda (obj)(declare (ignore obj))()))
|
(set-on-submit form (lambda (obj)(declare (ignore obj))()))
|
||||||
(set-on-click good-button #'on-click-good)
|
(set-on-click good-button 'on-click-good)
|
||||||
(set-on-click scary-button #'on-click-scary))
|
(set-on-click scary-button 'on-click-scary))
|
||||||
(run body)))
|
(run body)))
|
||||||
|
|
||||||
(defun start-tutorial ()
|
(defun start-tutorial ()
|
||||||
"Start turtorial."
|
"Start turtorial."
|
||||||
(initialize #'on-main)
|
(initialize 'on-main)
|
||||||
;; Navigating to http://127.0.0.1:8080/page1 executes on-page1
|
;; Navigating to http://127.0.0.1:8080/page1 executes on-page1
|
||||||
(set-on-new-window #'on-page1 :path "/page1")
|
(set-on-new-window 'on-page1 :path "/page1")
|
||||||
;; Navigating to http://127.0.0.1:8080/page1.html executes on-page1
|
;; Navigating to http://127.0.0.1:8080/page1.html executes on-page1
|
||||||
;; There is no .html file - it is just a route to CLOG handler
|
;; There is no .html file - it is just a route to CLOG handler
|
||||||
;; but the user thinks it is like any other html file.
|
;; but the user thinks it is like any other html file.
|
||||||
(set-on-new-window #'on-page1 :path "/page1.html")
|
(set-on-new-window 'on-page1 :path "/page1.html")
|
||||||
;; Navigating to http://127.0.0.1:8080/somepath/page1/ executes on-page1
|
;; Navigating to http://127.0.0.1:8080/somepath/page1/ executes on-page1
|
||||||
;; the path set can be any valid html path and has no meaning.
|
;; the path set can be any valid html path and has no meaning.
|
||||||
(set-on-new-window #'on-page1 :path "/somepath/hi/")
|
(set-on-new-window 'on-page1 :path "/somepath/hi/")
|
||||||
;; Here we add another page, page2. It uses a boot file that turns
|
;; Here we add another page, page2. It uses a boot file that turns
|
||||||
;; on debugging to the browser console of communications with the
|
;; on debugging to the browser console of communications with the
|
||||||
;; server.
|
;; server.
|
||||||
(set-on-new-window #'on-page2 :path "/page2" :boot-file "/debug.html")
|
(set-on-new-window 'on-page2 :path "/page2" :boot-file "/debug.html")
|
||||||
;; Here we add another page, page3. But this time we use the html file
|
;; Here we add another page, page3. But this time we use the html file
|
||||||
;; from tutorial 11 and make it the boot-file and execute the same code
|
;; from tutorial 11 and make it the boot-file and execute the same code
|
||||||
;; in (on-tutorial11) as in tutorial 11.
|
;; in (on-tutorial11) as in tutorial 11.
|
||||||
(set-on-new-window #'on-tutorial11 :path "/page3"
|
(set-on-new-window 'on-tutorial11 :path "/page3"
|
||||||
:boot-file "/tutorial/tut-11.html")
|
:boot-file "/tutorial/tut-11.html")
|
||||||
;; Setting a "default" path says that any use of an included boot.js
|
;; Setting a "default" path says that any use of an included boot.js
|
||||||
;; file will route to this function, in this case #'on-default
|
;; file will route to this function, in this case #'on-default
|
||||||
;; which will determine if this is coming from the path used in tutorial
|
;; which will determine if this is coming from the path used in tutorial
|
||||||
;; 11 - "http://127.0.0.1:8080/tutorial/tut-11.html" and if it does
|
;; 11 - "http://127.0.0.1:8080/tutorial/tut-11.html" and if it does
|
||||||
;; use on-tutorial11, and if not say "No Dice!"
|
;; use on-tutorial11, and if not say "No Dice!"
|
||||||
(set-on-new-window #'on-default :path "default")
|
(set-on-new-window 'on-default :path "default")
|
||||||
(open-browser))
|
(open-browser))
|
||||||
|
|
|
||||||
|
|
@ -9,7 +9,7 @@
|
||||||
(run body))
|
(run body))
|
||||||
|
|
||||||
(defun start-app ()
|
(defun start-app ()
|
||||||
(initialize #'on-new-window
|
(initialize 'on-new-window
|
||||||
:static-root (merge-pathnames "./www/"
|
:static-root (merge-pathnames "./www/"
|
||||||
(asdf:system-source-directory :hello-clog)))
|
(asdf:system-source-directory :hello-clog)))
|
||||||
(open-browser))
|
(open-browser))
|
||||||
|
|
|
||||||
|
|
@ -54,5 +54,5 @@ Changes made to a local key will fire an event and print below:<br>"
|
||||||
|
|
||||||
(defun start-tutorial ()
|
(defun start-tutorial ()
|
||||||
"Start turtorial."
|
"Start turtorial."
|
||||||
(initialize #'on-new-window)
|
(initialize 'on-new-window)
|
||||||
(open-browser))
|
(open-browser))
|
||||||
|
|
|
||||||
|
|
@ -29,5 +29,5 @@
|
||||||
|
|
||||||
(defun start-tutorial ()
|
(defun start-tutorial ()
|
||||||
"Start turtorial."
|
"Start turtorial."
|
||||||
(initialize #'on-new-window)
|
(initialize 'on-new-window)
|
||||||
(open-browser))
|
(open-browser))
|
||||||
|
|
|
||||||
|
|
@ -75,6 +75,6 @@
|
||||||
|
|
||||||
(defun start-tutorial ()
|
(defun start-tutorial ()
|
||||||
"Start turtorial."
|
"Start turtorial."
|
||||||
(initialize #'on-index)
|
(initialize 'on-index)
|
||||||
(set-on-new-window #'on-page2 :path "/page2")
|
(set-on-new-window 'on-page2 :path "/page2")
|
||||||
(open-browser))
|
(open-browser))
|
||||||
|
|
|
||||||
|
|
@ -110,8 +110,8 @@
|
||||||
|
|
||||||
(defun start-tutorial ()
|
(defun start-tutorial ()
|
||||||
"Start tutorial."
|
"Start tutorial."
|
||||||
(initialize #'on-index)
|
(initialize 'on-index)
|
||||||
(set-on-new-window #'on-page2 :path "/page2")
|
(set-on-new-window 'on-page2 :path "/page2")
|
||||||
(set-on-new-window #'on-page3 :path "/page3")
|
(set-on-new-window 'on-page3 :path "/page3")
|
||||||
(set-on-new-window #'on-page4 :path "/page4")
|
(set-on-new-window 'on-page4 :path "/page4")
|
||||||
(open-browser))
|
(open-browser))
|
||||||
|
|
|
||||||
|
|
@ -57,5 +57,5 @@
|
||||||
|
|
||||||
(defun start-tutorial ()
|
(defun start-tutorial ()
|
||||||
"Start tutorial."
|
"Start tutorial."
|
||||||
(initialize #'on-new-window)
|
(initialize 'on-new-window)
|
||||||
(open-browser))
|
(open-browser))
|
||||||
|
|
|
||||||
|
|
@ -29,5 +29,5 @@
|
||||||
|
|
||||||
(defun start-tutorial ()
|
(defun start-tutorial ()
|
||||||
"Start tutorial."
|
"Start tutorial."
|
||||||
(initialize #'on-new-window)
|
(initialize 'on-new-window)
|
||||||
(open-browser))
|
(open-browser))
|
||||||
|
|
|
||||||
|
|
@ -71,5 +71,5 @@
|
||||||
|
|
||||||
(defun start-tutorial ()
|
(defun start-tutorial ()
|
||||||
"Start tutorial."
|
"Start tutorial."
|
||||||
(initialize #'on-new-window)
|
(initialize 'on-new-window)
|
||||||
(open-browser))
|
(open-browser))
|
||||||
|
|
|
||||||
|
|
@ -59,5 +59,5 @@ on the drop-root."))
|
||||||
|
|
||||||
(defun start-tutorial ()
|
(defun start-tutorial ()
|
||||||
"Start tutorial."
|
"Start tutorial."
|
||||||
(initialize #'on-new-window)
|
(initialize 'on-new-window)
|
||||||
(open-browser))
|
(open-browser))
|
||||||
|
|
|
||||||
|
|
@ -125,29 +125,29 @@
|
||||||
(clog-gui-initialize body)
|
(clog-gui-initialize body)
|
||||||
(add-class body "w3-cyan")
|
(add-class body "w3-cyan")
|
||||||
(let* ((menu (create-gui-menu-bar body))
|
(let* ((menu (create-gui-menu-bar body))
|
||||||
(tmp (create-gui-menu-icon menu :on-click #'on-help-about))
|
(tmp (create-gui-menu-icon menu :on-click 'on-help-about))
|
||||||
(file (create-gui-menu-drop-down menu :content "File"))
|
(file (create-gui-menu-drop-down menu :content "File"))
|
||||||
(tmp (create-gui-menu-item file :content "Count" :on-click #'on-file-count))
|
(tmp (create-gui-menu-item file :content "Count" :on-click 'on-file-count))
|
||||||
(tmp (create-gui-menu-item file :content "Browse" :on-click #'on-file-browse))
|
(tmp (create-gui-menu-item file :content "Browse" :on-click 'on-file-browse))
|
||||||
(tmp (create-gui-menu-item file :content "Drawing" :on-click #'on-file-drawing))
|
(tmp (create-gui-menu-item file :content "Drawing" :on-click 'on-file-drawing))
|
||||||
(tmp (create-gui-menu-item file :content "Movie" :on-click #'on-file-movies))
|
(tmp (create-gui-menu-item file :content "Movie" :on-click 'on-file-movies))
|
||||||
(tmp (create-gui-menu-item file :content "Pinned" :on-click #'on-file-pinned))
|
(tmp (create-gui-menu-item file :content "Pinned" :on-click 'on-file-pinned))
|
||||||
(win (create-gui-menu-drop-down menu :content "Window"))
|
(win (create-gui-menu-drop-down menu :content "Window"))
|
||||||
(tmp (create-gui-menu-item win :content "Maximize All" :on-click #'maximize-all-windows))
|
(tmp (create-gui-menu-item win :content "Maximize All" :on-click 'maximize-all-windows))
|
||||||
(tmp (create-gui-menu-item win :content "Normalize All" :on-click #'normalize-all-windows))
|
(tmp (create-gui-menu-item win :content "Normalize All" :on-click 'normalize-all-windows))
|
||||||
(tmp (create-gui-menu-window-select win))
|
(tmp (create-gui-menu-window-select win))
|
||||||
(dlg (create-gui-menu-drop-down menu :content "Dialogs"))
|
(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 "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 "Confirm Dialog Box" :on-click 'on-dlg-confirm))
|
||||||
(tmp (create-gui-menu-item dlg :content "Form Dialog Box" :on-click #'on-dlg-form))
|
(tmp (create-gui-menu-item dlg :content "Form Dialog Box" :on-click 'on-dlg-form))
|
||||||
(tmp (create-gui-menu-item dlg :content "Server File Dialog Box" :on-click #'on-dlg-file))
|
(tmp (create-gui-menu-item dlg :content "Server File Dialog Box" :on-click 'on-dlg-file))
|
||||||
(tst (create-gui-menu-drop-down menu :content "Toasts"))
|
(tst (create-gui-menu-drop-down menu :content "Toasts"))
|
||||||
(tmp (create-gui-menu-item tst :content "Alert Toast" :on-click #'on-toast-alert))
|
(tmp (create-gui-menu-item tst :content "Alert Toast" :on-click 'on-toast-alert))
|
||||||
(tmp (create-gui-menu-item tst :content "Warning Toast" :on-click #'on-toast-warn))
|
(tmp (create-gui-menu-item tst :content "Warning Toast" :on-click 'on-toast-warn))
|
||||||
(tmp (create-gui-menu-item tst :content "Success Toast" :on-click #'on-toast-success))
|
(tmp (create-gui-menu-item tst :content "Success Toast" :on-click 'on-toast-success))
|
||||||
(help (create-gui-menu-drop-down menu :content "Help"))
|
(help (create-gui-menu-drop-down menu :content "Help"))
|
||||||
(tmp (create-gui-menu-item help :content "About" :on-click #'on-help-about))
|
(tmp (create-gui-menu-item help :content "About" :on-click 'on-help-about))
|
||||||
(tmp (create-gui-menu-full-screen menu)))
|
(tmp (create-gui-menu-full-screen menu)))
|
||||||
(declare (ignore tmp)))
|
(declare (ignore tmp)))
|
||||||
(set-on-before-unload (window body) (lambda(obj)
|
(set-on-before-unload (window body) (lambda(obj)
|
||||||
|
|
@ -158,5 +158,5 @@
|
||||||
|
|
||||||
(defun start-tutorial ()
|
(defun start-tutorial ()
|
||||||
"Start turtorial."
|
"Start turtorial."
|
||||||
(initialize #'on-new-window)
|
(initialize 'on-new-window)
|
||||||
(open-browser))
|
(open-browser))
|
||||||
|
|
|
||||||
|
|
@ -52,5 +52,5 @@
|
||||||
|
|
||||||
(defun start-tutorial ()
|
(defun start-tutorial ()
|
||||||
"Start turtorial."
|
"Start turtorial."
|
||||||
(initialize #'on-new-window)
|
(initialize 'on-new-window)
|
||||||
(open-browser))
|
(open-browser))
|
||||||
|
|
|
||||||
|
|
@ -98,11 +98,11 @@
|
||||||
";; This is a code block<br>
|
";; This is a code block<br>
|
||||||
(defun start-tutorial ()<br>
|
(defun start-tutorial ()<br>
|
||||||
\"Start turtorial.\"<br>
|
\"Start turtorial.\"<br>
|
||||||
(initialize #'on-new-window)<br>
|
(initialize 'on-new-window)<br>
|
||||||
(open-browser))")
|
(open-browser))")
|
||||||
(run body)))
|
(run body)))
|
||||||
|
|
||||||
(defun start-tutorial ()
|
(defun start-tutorial ()
|
||||||
"Start turtorial."
|
"Start turtorial."
|
||||||
(initialize #'on-new-window)
|
(initialize 'on-new-window)
|
||||||
(open-browser))
|
(open-browser))
|
||||||
|
|
|
||||||
|
|
@ -66,5 +66,5 @@
|
||||||
|
|
||||||
(defun start-tutorial ()
|
(defun start-tutorial ()
|
||||||
"Start turtorial."
|
"Start turtorial."
|
||||||
(initialize #'on-new-window)
|
(initialize 'on-new-window)
|
||||||
(open-browser))
|
(open-browser))
|
||||||
|
|
|
||||||
|
|
@ -99,7 +99,7 @@
|
||||||
(defun start-tutorial ()
|
(defun start-tutorial ()
|
||||||
"Start turtorial."
|
"Start turtorial."
|
||||||
;; We would probably set :host to my IP and :port 80 here if running a live site
|
;; We would probably set :host to my IP and :port 80 here if running a live site
|
||||||
(initialize #'on-new-window)
|
(initialize 'on-new-window)
|
||||||
;; In real life, if we openning a browser here it would likely be
|
;; In real life, if we openning a browser here it would likely be
|
||||||
;; to a page with a monitor of system etc. since it is local.
|
;; to a page with a monitor of system etc. since it is local.
|
||||||
(open-browser))
|
(open-browser))
|
||||||
|
|
|
||||||
|
|
@ -9,7 +9,7 @@
|
||||||
(setf (color (hello-span panel)) (rgb (random 255) (random 255) (random 255))))
|
(setf (color (hello-span panel)) (rgb (random 255) (random 255) (random 255))))
|
||||||
|
|
||||||
(defun start-app ()
|
(defun start-app ()
|
||||||
(initialize #'create-hello-page
|
(initialize 'create-hello-page
|
||||||
:static-root (merge-pathnames "./www/"
|
:static-root (merge-pathnames "./www/"
|
||||||
(asdf:system-source-directory :hello-builder)))
|
(asdf:system-source-directory :hello-builder)))
|
||||||
(open-browser))
|
(open-browser))
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue