demo waiting for response

This commit is contained in:
David Botton 2021-02-21 10:52:20 -05:00
parent 59698297c5
commit 9bf04093e1
9 changed files with 76 additions and 24 deletions

View file

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

View file

@ -10,7 +10,7 @@
:pathname "source/" :pathname "source/"
:depends-on (#:clack #:websocket-driver #:alexandria #:hunchentoot #:cl-ppcre :depends-on (#:clack #:websocket-driver #:alexandria #:hunchentoot #:cl-ppcre
#:bordeaux-threads #:trivial-open-browser #:cl-dbi #:parse-float #: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") :components ((:file "clog-connection")
(:file "clog") (:file "clog")
(:file "clog-docs") (:file "clog-docs")

View file

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

View file

@ -2105,6 +2105,18 @@ A list of standard cursor types can be found at:
(defmethod remove-from-clog ((obj clog-element)) (defmethod remove-from-clog ((obj clog-element))
(js-execute obj (format nil "~A=null;" (script-id obj)))) (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 ;; ;; click ;;
;;;;;;;;;;; ;;;;;;;;;;;

View file

@ -828,12 +828,14 @@ on-window-resize-done at end of resize."))
;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;
(defgeneric window-close (clog-gui-window) (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)) (defmethod window-close ((obj clog-gui-window))
(let ((app (connection-data-item obj "clog-gui"))) (let ((app (connection-data-item obj "clog-gui")))
(remhash (format nil "~A" (html-id obj)) (windows app)) (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) (remove-from-dom obj)
(fire-on-window-change nil app) (fire-on-window-change nil app)
(fire-on-window-close obj))) (fire-on-window-close obj)))
@ -970,7 +972,7 @@ interactions. Use window-end-modal to undo."))
(defmethod window-end-modal ((obj clog-gui-window)) (defmethod window-end-modal ((obj clog-gui-window))
(let ((app (connection-data-item obj "clog-gui"))) (let ((app (connection-data-item obj "clog-gui")))
(remove-from-dom (modal-background app)) (destroy (modal-background app))
(window-focus obj))) (window-focus obj)))
;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;

View file

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

View file

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

34
tutorial/23-tutorial.lisp Normal file
View file

@ -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))

View file

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