diff --git a/README.md b/README.md index aa4bea6..ecc6aeb 100644 --- a/README.md +++ b/README.md @@ -1,5 +1,4 @@ - # CLOG - The Common Lisp Omnificent GUI ## David Botton @@ -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 diff --git a/clog-connection.lisp b/clog-connection.lisp index 2ea6d13..6befa41 100644 --- a/clog-connection.lisp +++ b/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))) diff --git a/clog.lisp b/clog.lisp index 58f2efe..080f324 100644 --- a/clog.lisp +++ b/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))) diff --git a/test/test-clog.lisp b/test/test-clog.lisp index f597717..b0ddb7f 100644 --- a/test/test-clog.lisp +++ b/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 "connection-write") (clog-connection:cwriteln id "connection-writeln") (sleep .2)) + (clog-connection:cwrite id "
Query Result : ") + (clog-connection:cwrite id (clog-connection:query id "navigator.appVersion")) (clog-connection:cwrite id "
simulate network interupt") (clog-connection:cclose id) (sleep .2) (clog-connection:cwrite id "
reconnected") (sleep .2) (clog-connection:cwrite id "
shutting down connection") + (sleep .2) + ;; It is generally uneccessary to shutdown the connection (clog-connection:shutdown id)) -(defun on-connect2 (id) - (clog-connection:cwrite id "Query Result : ") - (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) )