demo waiting for response

README.md

@@ -63,7 +63,7 @@ To load this package and work through tutorials (assuming you
 have Quicklisp configured):
 
 1. Start emacs then M-x slime
-2. In the REPL, run (tutorials currently 1 - 22):
+2. In the REPL, run (tutorials currently 1 - 23):
 
 ```
 CL-USER> (ql:quickload :clog)
@@ -188,6 +188,7 @@ Tutorial Summary
 - 20-tutorial.lisp - New CLOG plugin from JavaScript component
 - 21-tutorial.lisp - New CLOG plugin in Common-Lisp
 - 22-tutorial.lisp - CLOG GUI Menus and Desktop Look and Feel
+- 23-tutorial.lisp - Using semaphores to wait for input
 
 Demo Summary
 

clog.asd

@@ -10,7 +10,7 @@
   :pathname "source/"
   :depends-on (#:clack #:websocket-driver #:alexandria #:hunchentoot #:cl-ppcre
 	       #:bordeaux-threads #:trivial-open-browser #:cl-dbi #:parse-float
-		       #:lack-middleware-static #:mgl-pax #:quri)
+	       #:sqlite #:lack-middleware-static #:mgl-pax #:quri)
   :components ((:file "clog-connection")
 	       (:file "clog")
 	       (:file "clog-docs")

source/clog-connection.lisp

@@ -270,12 +270,15 @@ path by querying the browser. See PATH-NAME (CLOG-LOCATION)."
 				        (format nil "<script>clog['post-data']='~A'</script>"
 						post-data))
 				      page-data)))))))
-		     ;; Pass the handling on next rule
+		     ;; Pass the handling on to next rule
 		     (t (funcall app env))))))
 	 (:static :path (lambda (path)
+			  ;; Request is static path if not the websocket connection.
+			  ;; Websocket url is /clog
 			  (cond ((ppcre:scan "^(?:/clog$)" path) nil)
 				(t path)))
 		  :root static-root)
+	 ;; Handle Websocket connection
 	 (lambda (env)
 	   (clog-server env))))
   (setf *client-handler* (clack:clackup *app* :address host :port port))

source/clog-element.lisp

@@ -2105,6 +2105,18 @@ A list of standard cursor types can be found at:
 (defmethod remove-from-clog ((obj clog-element))
   (js-execute obj (format nil "~A=null;" (script-id obj))))
 
+;;;;;;;;;;;;;
+;; destroy ;;
+;;;;;;;;;;;;;
+
+(defgeneric destroy (clog-element)
+  (:documentation "Remove CLOG-Element from the DOM on browser and clog cache
+on browser."))
+
+(defmethod destroy ((obj clog-element))
+  (remove-from-dom obj)
+  (remove-from-clog obj))
+
 ;;;;;;;;;;;
 ;; click ;;
 ;;;;;;;;;;;

source/clog-gui.lisp

@@ -828,12 +828,14 @@ on-window-resize-done at end of resize."))
 ;;;;;;;;;;;;;;;;;;
 
 (defgeneric window-close (clog-gui-window)
-  (:documentation "Close CLOG-GUI-WINDOW. on-window-can-close is not called."))
+  (:documentation "Close CLOG-GUI-WINDOW. on-window-can-close is not called.
+CLOG-GUI-WINDOW is removed from DOM but still present in the CLOG cache on
+the browser."))
 
 (defmethod window-close ((obj clog-gui-window))
   (let ((app (connection-data-item obj "clog-gui")))
     (remhash (format nil "~A" (html-id obj)) (windows app))
-    (remove-from-dom (window-select-item obj))
+    (destroy (window-select-item obj))
     (remove-from-dom obj)
     (fire-on-window-change nil app)
     (fire-on-window-close obj)))
@@ -970,7 +972,7 @@ interactions. Use window-end-modal to undo."))
 
 (defmethod window-end-modal ((obj clog-gui-window))
   (let ((app (connection-data-item obj "clog-gui")))
-    (remove-from-dom (modal-background app))
+    (destroy (modal-background app))
     (window-focus obj)))
 
 ;;;;;;;;;;;;;;;;;;;

source/clog.lisp

@@ -315,6 +315,7 @@ embedded in a native template application.)"
   (toggle-class     generic-function)
   (remove-from-dom  generic-function)
   (remove-from-clog generic-function)
+  (destroy          generic-function)
   (click            generic-function)
 
   "CLOG-Element - DOM Traversal Methods"

tools/clog-db-admin.lisp

@@ -46,14 +46,15 @@
  
 </form>"
 				 :width  400
-				 :height 450)))
+				 :height 450
+				 :hidden t)))
     (window-center win)
+    (setf (visiblep win) t)
     (set-on-click (attach-as-child obj "odb-open")
 		  (lambda (obj)
 		    (format t "open db : ~A" (name-value obj "db-name"))
 		    (setf (db-connection app)
-			  (dbi:connect :sqlite3
-				       :database-name (name-value obj "db-name")))
+			  (sqlite:connect (name-value obj "db-name")))
 		    (setf (title (html-document (body app)))
 			  (format nil "CLOG DB Admin - ~A" (name-value obj "db-name")))
 		    (window-close win))
@@ -64,7 +65,7 @@
 (defun on-db-close (obj)
   (let ((app (connection-data-item obj "app-data")))
     (when (db-connection app)
-      (dbi:disconnect (db-connection app)))
+      (sqlite:disconnect (db-connection app)))
     (print "db disconnected")
     (setf (title (html-document (body app))) "CLOG DB Admin")))
 
@@ -82,21 +83,16 @@
  
 </form>"
 				:width  400
-				 :height 200)))
+				:height 200
+				:hidden t)))
     (window-center win)
+    (setf (visiblep win) t)
     (set-on-click (attach-as-child obj "odb-open")
 		  (lambda (obj)
 		    (format t "open query : ~A~%~%" (name-value obj "db-query"))
-		    (print (dbi:fetch-all
-		     (dbi:execute
-		      (dbi:prepare (db-connection app)
-				   (name-value obj "db-query"))
-                      ())))
-		    ;; (let* ((query (dbi:prepare (db-connection app) (name-value obj "db-query")))
-		    ;; 	   (query (dbi:execute query)))
-		    ;;   (loop for row = (dbi:fetch query)
-		    ;; 	    while row
-		    ;; 	    do (format t "~A~%" row)))
+		    (print (sqlite:execute-to-list
+			    (db-connection app)
+			    (name-value obj "db-query")))
 		    (window-close win)))
 
     (set-on-click (attach-as-child obj "odb-cancel") (lambda (obj)
@@ -112,8 +108,10 @@
 			                 <div><p><center>CLOG DB Admin</center>
                                          <center>(c) 2021 - David Botton</center></p></div>"
 				  :width   200
-				  :height  200)))
+				  :height  200
+				  :hidden  t)))
     (window-center about)
+    (setf (visiblep about) t)    
     (set-on-window-can-size about (lambda (obj)
 				    (declare (ignore obj))()))))
 
@@ -140,7 +138,7 @@
 	   (tmp   (create-gui-menu-full-screen menu))))
     (run body)
     (when (db-connection app)
-      (dbi:disconnect (db-connection app))
+      (sqlite:disconnect (db-connection app))
       (print "db disconnected"))))
 
 (defun clog-db-admin ()

tutorial/23-tutorial.lisp

@@ -0,0 +1,34 @@
+(defpackage #:clog-user
+  (:use #:cl #:clog #:clog-gui)
+  (:export start-tutorial))
+
+(in-package :clog-user)
+
+;; This is a simple demo using semaphores to wait for user input
+(defun ask (obj)
+  (let ((result nil)
+	(hold (bordeaux-threads:make-semaphore))
+	(q-box (create-div obj)))
+    (set-on-click (create-button q-box :content "Yes")
+		  (lambda (obj)
+		    (setf result :yes)
+		    (bordeaux-threads:signal-semaphore hold)))
+    (set-on-click (create-button q-box :content "No")
+		  (lambda (obj)
+		    (setf result :no)
+		    (bordeaux-threads:signal-semaphore hold)))
+    (bordeaux-threads:wait-on-semaphore hold :timeout 10)
+    (destroy q-box)
+    result))
+
+(defun on-new-window (body)
+  (set-on-click (create-button body :content
+			       "Click for my question. You have 10 seconds to answer.")
+		(lambda (obj)
+		  (create-div body :content (ask body))))
+  (run body))
+
+(defun start-tutorial ()
+  "Start turtorial."
+  (initialize #'on-new-window)
+  (open-browser))

tutorial/README.md

@@ -55,3 +55,4 @@ Tutorial Summary
 - 20-tutorial.lisp - New CLOG plugin from JavaScript component
 - 21-tutorial.lisp - New CLOG plugin in Common-Lisp
 - 22-tutorial.lisp - CLOG GUI Menus and Desktop Look and Feel
+- 23-tutorial.lisp - Using semaphores to wait for input