Docs and clean up.

README.md

@@ -1,5 +1,4 @@
 
-
 # CLOG - The Common Lisp Omnificent GUI
 
 ## David Botton <david@botton.com>
@@ -9,5 +8,40 @@
 ####
 The Common Lisp Omnificient GUI, CLOG for short, uses web technology
 to produce graphical user interfaces for applications locally or
-remotely.
+remotely, ie as web applications.
 
+Status:
+
+- Connection methods
+  - Websockets - Done
+  - AJAX/HTML - to do (In 2021 are there browsers supporting Websockets?)
+  - Long Poll - to do (Needed for websites for webcrawlers and firewalls) 
+  - Direct API access to native browser components - to do
+
+- HTML bindings and Browser - to do
+  - Base (Not per se a binding of Node in DOM but takes its place)
+  - Base Elements (HTML Elements)
+  - Canvas - HTML 5 Canvas bindings
+  - SVG - HTML SVG vector graphics
+  - Multimedia - HTML 5 Audio and Video
+  - Styles - CSS Style blocks
+  - Window, Navigator, Screen, Location, Document
+
+- CLOG higher level containers and GUI widgets - to do
+
+- Database bindings and server side APIs - to do
+  - Current CL packages
+  - Direct bidings to widgets ete.
+
+- CLOG Devtools - to do
+  - Generate application scaffolding
+  - GUI Builder
+	- Grid style
+	- Page style
+  - Electron for native GUIs
+  
+- Plugins - to do
+  - General CL systems
+  - Widgets
+  
+- Documentation

clog-connection.lisp

@@ -54,7 +54,7 @@
 (defun query (connection-id script)
   "Execute SCRIPT on CONNECTION-ID, return value."
   (let ((uid (clog::generate-connection-id)))
-    (clog::store-query uid nil)
+    (clog::prep-query uid nil)
     (execute connection-id
 	     (format nil "ws.send (\"~A:\"+eval(\"~A\"));" uid script))
     (clog::wait-for-answer uid)))

clog.lisp

@@ -58,8 +58,12 @@ application."
 
 (defvar *connection-lock* (bordeaux-threads:make-lock)
   "Protect the connection hash tables")
+(defvar *queries-lock*    (bordeaux-threads:make-lock)
+  "Protect query hash tables")
 
-(defvar *queries* (make-hash-table) "Waiting queries")
+(defvar *queries*        (make-hash-table) "Query ID to Answers")
+(defvar *queries-sems*   (make-hash-table) "Query ID to semiphores")
+(defvar *query-time-out* 3 "Number of seconds to timeout waiting for a query")
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; generate-connection-id ;;
@@ -77,6 +81,31 @@ application."
   "Return the connection associated with CONNECITION-ID. (Private)"
   (gethash connection-id *connection-ids*))
 
+;;;;;;;;;;;;;;;;
+;; prep-query ;;
+;;;;;;;;;;;;;;;;
+
+(defun prep-query (id default-answer)
+  "Setup up a query to be received from a script identified by ID an returning
+with DEFAULT-ANSWER in case of a time out. (Private)"
+  (bordeaux-threads:with-lock-held (*queries-lock*)
+    (setf (gethash id *queries-sems*) (bordeaux-threads:make-semaphore))
+    (setf (gethash id *queries*) default-answer)))
+
+;;;;;;;;;;;;;;;;;;;;;
+;; wait-for-answer ;;
+;;;;;;;;;;;;;;;;;;;;;
+
+(defun wait-for-answer (id &key (timeout *query-time-out*))
+  "Block after prep-query and sending the query script with ID and TIMEOUT with
+the default answer. (Private)"
+  (bordeaux-threads:wait-on-semaphore (gethash id *queries-sems*) :timeout timeout)
+  (let ((answer (gethash id *queries*)))
+    (bordeaux-threads:with-lock-held (*queries-lock*)
+      (remhash id *queries*)
+      (remhash id *queries-sems*))
+    answer))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; handle-new-connection ;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -105,22 +134,6 @@ application."
 ;; handle-message ;;
 ;;;;;;;;;;;;;;;;;;;;
 
-(defvar *queries-lock* (bordeaux-threads:make-lock))
-(defvar *queries-sems* (make-hash-table))
-
-(defun store-query (id answer)
-  (bordeaux-threads:with-lock-held (*queries-lock*)
-    (setf (gethash id *queries-sems*) (bordeaux-threads:make-semaphore))
-    (setf (gethash id *queries*) answer)))
-
-(defun wait-for-answer (id)
-  (bordeaux-threads:wait-on-semaphore (gethash id *queries-sems*) :timeout 3)
-  (let ((answer (gethash id *queries*)))
-    (bordeaux-threads:with-lock-held (*queries-lock*)
-      (remhash id *queries*)
-      (remhash id *queries-sems*))
-    answer))
-
 (defun handle-message (connection message)
   (let ((id (gethash connection *connections*))
 	(ml (ppcre:split ":" message :limit 2)))

test/test-clog.lisp

@@ -1,31 +1,30 @@
 (defpackage #:test-clog
   (:use #:cl)
-  (:export test-connect on-connect1 on-connect2))
+  (:export test-connect on-connect))
 
 (in-package :test-clog)
 
-(defun on-connect1 (id)
+(defun on-connect (id)
   (format t "Connection ~A is valid? ~A~%" id (clog-connection:validp id))
-  ;; (clog:execute-script id "alert('test1');")
   (dotimes (n 10)
     (clog-connection:cwrite id "<b>connection-write</b>")
     (clog-connection:cwriteln id "<i>connection-writeln</i>")
     (sleep .2))
+  (clog-connection:cwrite id "<br><b>Query Result : </b>")
+  (clog-connection:cwrite id (clog-connection:query id "navigator.appVersion"))
   (clog-connection:cwrite id "<hr>simulate network interupt")
   (clog-connection:cclose id)
   (sleep .2)
   (clog-connection:cwrite id "<br><b>reconnected</b>")
   (sleep .2)
   (clog-connection:cwrite id "<br><b>shutting down connection</b>")
+  (sleep .2)
+  ;; It is generally uneccessary to shutdown the connection
   (clog-connection:shutdown id))
 
-(defun on-connect2 (id)
-  (clog-connection:cwrite id "<b>Query Result : </b>")
-  (clog-connection:cwrite id (clog-connection:query id "navigator.appVersion")))
-
 (defun test-connect ()
   (print "Init connection")
-  (clog:initialize #'on-connect2 :boot-file "/debug.html")
+  (clog:initialize #'on-connect :boot-file "/debug.html")
   (print "Open browser")
   (clog:open-browser)
 )