mirrors/clog
1
Fork 0
mirror of https://github.com/rabbibotton/clog.git synced 2025-12-06 02:30:42 -08:00
Code Issues Projects Releases Wiki Activity

ability to switch static routes at run-time

Browse source
This commit is contained in:
David Botton 2024-07-01 00:30:55 -04:00
parent 144a4e2133
commit eb63715883
9 changed files with 244 additions and 237 deletions
Download patch file Download diff file Expand all files Collapse all files

2
clog.asd vendored
View file

@ -10,7 +10,7 @@
:description "CLOG - The Common Lisp Omnificent GUI" :description "CLOG - The Common Lisp Omnificent GUI"
:author "David Botton <david@botton.com>" :author "David Botton <david@botton.com>"
:license "BSD" :license "BSD"
:version "1.9.0" :version "2.2"
:serial t :serial t
:depends-on (#:clack #:websocket-driver #:alexandria #:hunchentoot #:cl-ppcre :depends-on (#:clack #:websocket-driver #:alexandria #:hunchentoot #:cl-ppcre
#:bordeaux-threads #:trivial-open-browser #:parse-float #:quri #:bordeaux-threads #:trivial-open-browser #:parse-float #:quri

425
source/clog-connection-websockets.lisp
View file

@ -17,13 +17,13 @@
(defvar *client-handler* nil "Clack 'handler' for socket traffic") (defvar *client-handler* nil "Clack 'handler' for socket traffic")
(defvar *long-poll-first* nil (defvar *long-poll-first* nil
"Dynamic variable indicating to use html output instead of "Dynamic variable indicating to use html output instead of
websocket for output at start if connection.") websocket for output at start if connection.")
(defvar *extended-long-poll* nil (defvar *extended-long-poll* nil
"Dynamic variable indicating to extend long polling beyond "Dynamic variable indicating to extend long polling beyond
extablishing websocket for output.") extablishing websocket for output.")
(defvar *long-poll-url* nil (defvar *long-poll-url* nil
"Dynamic variable indicating the url path used.") "Dynamic variable indicating the url path used.")
(defparameter *compiled-boot-js* (defparameter *compiled-boot-js*
(with-open-file (stream (merge-pathnames #P"static-files/js/boot.js" (with-open-file (stream (merge-pathnames #P"static-files/js/boot.js"
@ -50,13 +50,13 @@
(setf (gethash id *connection-ids*) connection) (setf (gethash id *connection-ids*) connection)
(handler-case (handler-case
(websocket-driver:close-connection old (websocket-driver:close-connection old
"Aborting this old connection since receiving a reconnection request.") "Aborting this old connection since receiving a reconnection request.")
(t (c) (t (c)
(when *verbose-output* (when *verbose-output*
(format t "Failed to close the old connection when establishing reconnection. ~ (format t "Failed to close the old connection when establishing reconnection. ~
This can be normal: The old connection could not work for the client, ~ This can be normal: The old connection could not work for the client, ~
so the client is requesting to reconnect.~%Condition - ~A.~&" so the client is requesting to reconnect.~%Condition - ~A.~&"
c)))))) c))))))
(id (id
(format t "Reconnection id ~A not found. Closing the connection.~%" id) (format t "Reconnection id ~A not found. Closing the connection.~%" id)
(websocket-driver:close-connection connection)) ; Don't send the reason for better security. (websocket-driver:close-connection connection)) ; Don't send the reason for better security.
@ -95,67 +95,67 @@
(let ((connection-id (gethash connection *connections*)) (let ((connection-id (gethash connection *connections*))
(ml (ppcre:split ":" message :limit 2))) (ml (ppcre:split ":" message :limit 2)))
(cond ((null connection-id) (cond ((null connection-id)
;; a zombie connection ;; a zombie connection
(when *verbose-output* (when *verbose-output*
(format t "A zombie connection ~A. CLOG doesn't remember its connection-id. Closing it.~%" (format t "A zombie connection ~A. CLOG doesn't remember its connection-id. Closing it.~%"
connection)) connection))
(websocket-driver:close-connection connection)) ; don't send the reason for better security (websocket-driver:close-connection connection)) ; don't send the reason for better security
((equal (first ml) "0") ((equal (first ml) "0")
;; a ping ;; a ping
(when *browser-gc-on-ping* (when *browser-gc-on-ping*
;; run browser gc ;; run browser gc
(execute connection-id (execute connection-id
"Object.entries(clog).forEach(function(c,i,a) "Object.entries(clog).forEach(function(c,i,a)
{if ((c[1] !== null) && (typeof c[1] === 'object') && (c[1].nodeType===1)) {if ((c[1] !== null) && (typeof c[1] === 'object') && (c[1].nodeType===1))
{if (c[1].isConnected===false) {$(clog['body']).trigger('gc', c[0])}}})")) {if (c[1].isConnected===false) {$(clog['body']).trigger('gc', c[0])}}})"))
(when *verbose-output* (when *verbose-output*
(format t "Connection ~A Ping~%" connection-id) (format t "Connection ~A Ping~%" connection-id)
(execute connection-id "null"))) (execute connection-id "null")))
((equal (first ml) "E") ((equal (first ml) "E")
;; an event ;; an event
(let* ((em (ppcre:split " " (second ml) :limit 2)) (let* ((em (ppcre:split " " (second ml) :limit 2))
(event-id (first em)) (event-id (first em))
(data (second em))) (data (second em)))
(when *verbose-output* (when *verbose-output*
(format t "Connection ~A Hook = ~A Data = ~A~%" (format t "Connection ~A Hook = ~A Data = ~A~%"
connection-id event-id data)) connection-id event-id data))
(bordeaux-threads:make-thread (bordeaux-threads:make-thread
(lambda () (lambda ()
(if *break-on-error* (if *break-on-error*
(let* ((event-hash (get-connection-data connection-id)) (let* ((event-hash (get-connection-data connection-id))
(event (when event-hash (event (when event-hash
(gethash event-id event-hash)))) (gethash event-id event-hash))))
(when event (when event
(let* ((debug-hook (gethash "clog-debug" event-hash))) (let* ((debug-hook (gethash "clog-debug" event-hash)))
(if (and debug-hook (not *disable-clog-debugging*)) (if (and debug-hook (not *disable-clog-debugging*))
(funcall debug-hook event data) (funcall debug-hook event data)
(funcall event data))))) (funcall event data)))))
(handler-case (handler-case
(let* ((event-hash (get-connection-data connection-id)) (let* ((event-hash (get-connection-data connection-id))
(event (when event-hash (event (when event-hash
(gethash event-id (gethash event-id
event-hash)))) event-hash))))
(when event (when event
(funcall event data))) (funcall event data)))
(t (c) (t (c)
(format t "Condition caught in handle-message for event - ~A.~&" c) (format t "Condition caught in handle-message for event - ~A.~&" c)
(values 0 c))))) (values 0 c)))))
:name (format nil "CLOG event handler ~A" :name (format nil "CLOG event handler ~A"
event-id)))) event-id))))
(t (t
;; a JavaScript execution result ;; a JavaScript execution result
(let ((server-query-id (first ml)) (let ((server-query-id (first ml))
(browser-returned-answer (second ml))) (browser-returned-answer (second ml)))
(when *verbose-output* (when *verbose-output*
(format t "Connection ~A ~A = ~A ~A = ~A~%" (format t "Connection ~A ~A = ~A ~A = ~A~%"
connection-id connection-id
'server-query-id 'server-query-id
server-query-id server-query-id
'browser-returned-answer 'browser-returned-answer
browser-returned-answer)) browser-returned-answer))
(setf (gethash (parse-integer server-query-id) *queries*) browser-returned-answer) (setf (gethash (parse-integer server-query-id) *queries*) browser-returned-answer)
(bordeaux-threads:signal-semaphore (bordeaux-threads:signal-semaphore
(gethash (parse-integer server-query-id) *queries-sems*)))))) (gethash (parse-integer server-query-id) *queries-sems*))))))
(t (c) (t (c)
(format t "Condition caught in handle-message - ~A.~&" c) (format t "Condition caught in handle-message - ~A.~&" c)
(values 0 c)))) (values 0 c))))
@ -169,11 +169,11 @@
(when *verbose-output* (when *verbose-output*
(format t "Connection close request ~A.~%" (format t "Connection close request ~A.~%"
connection)) connection))
(when *reconnect-delay* (when *reconnect-delay*
(when *verbose-output* (when *verbose-output*
(format t "Connection close request ~A delayed ~A for reconnects.~%" (format t "Connection close request ~A delayed ~A for reconnects.~%"
connection *reconnect-delay*)) connection *reconnect-delay*))
(sleep *reconnect-delay*)) (sleep *reconnect-delay*))
(handler-case (handler-case
(let ((id (gethash connection *connections*))) (let ((id (gethash connection *connections*)))
(when id (when id
@ -231,7 +231,7 @@
(handler-case (handler-case
(websocket-driver:start-connection ws) (websocket-driver:start-connection ws)
(t (c) (t (c)
(format t "Condition caught in websocket-driver:start-connection - ~A.~&" c))))) (format t "Condition caught in websocket-driver:start-connection - ~A.~&" c)))))
(t (c) (t (c)
(format t "Condition caught in clog-server start-up - ~A.~&" c) (format t "Condition caught in clog-server start-up - ~A.~&" c)
(values '(400 nil) c)))) (values '(400 nil) c))))
@ -242,20 +242,20 @@
(defun initialize (on-connect-handler (defun initialize (on-connect-handler
&key &key
(host "0.0.0.0") (host "0.0.0.0")
(port 8080) (port 8080)
(server :hunchentoot) (server :hunchentoot)
(lack-middleware-list nil) (lack-middleware-list nil)
(extended-routing nil) (extended-routing nil)
(long-poll-first nil) (long-poll-first nil)
(boot-file "/boot.html") (boot-file "/boot.html")
(boot-function nil) (boot-function nil)
(static-boot-html nil) (static-boot-html nil)
(static-boot-js nil) (static-boot-js nil)
(static-root #P"./static-files/") (static-root #P"./static-files/")
(ssl nil) (ssl nil)
(ssl-key-file nil) (ssl-key-file nil)
(ssl-cert-file nil)) (ssl-cert-file nil))
"Initialize CLOG on a socket using HOST and PORT to serve BOOT-FILE as the "Initialize CLOG on a socket using HOST and PORT to serve BOOT-FILE as the
default route for '/' to establish web-socket connections and static files default route for '/' to establish web-socket connections and static files
located at STATIC-ROOT. The webserver used with CLACK can be chosen with located at STATIC-ROOT. The webserver used with CLACK can be chosen with
@ -279,130 +279,125 @@ the contents sent to the brower."
(set-on-connect on-connect-handler) (set-on-connect on-connect-handler)
(when boot-file (when boot-file
(set-clog-path "/" boot-file)) (set-clog-path "/" boot-file))
(setf *static-root* static-root)
(setf *clog-port* port)
(setf *app* (setf *app*
(lack:builder (lack:builder
(lambda (app) (lambda (app)
(lambda (env) (lambda (env)
;; if not static-boot-js use internal compiled boot.js ;; Special handling of "clog paths"
(if (and (eq static-boot-js nil) (let* ((url-path (getf env :path-info))
(equalp (getf env :path-info) "/js/boot.js")) (clog-path (gethash url-path *url-to-boot-file*)))
`(200 (:content-type "text/javascript") (unless clog-path
(,*compiled-boot-js*)) (when extended-routing
(funcall app env)))) (maphash (lambda (k v)
(lambda (app) (unless (equal k "/")
(lambda (env) (when (ppcre:scan (format nil "^~A/" k)
;; Special handling of "clog paths" url-path)
(let* ((url-path (getf env :path-info)) (setf clog-path v))))
(clog-path (gethash url-path *url-to-boot-file*))) *url-to-boot-file*)))
(unless clog-path (cond (clog-path
(when extended-routing (let ((file (uiop:subpathname static-root clog-path)))
(maphash (lambda (k v) (with-open-file (stream file :direction :input
(unless (equal k "/") :if-does-not-exist nil)
(when (ppcre:scan (format nil "^~A/" k) (let ((page-data (if stream
url-path) (make-string (file-length stream))
(setf clog-path v)))) (if static-boot-html
*url-to-boot-file*))) (cond ((eq static-boot-html t)
(cond (clog-path "")
(let ((file (uiop:subpathname static-root clog-path))) ((eq static-boot-html :error)
(with-open-file (stream file :direction :input (error (format nil "Can not open boot file - ~A"
:if-does-not-exist nil) file)))
(let ((page-data (if stream (t
(make-string (file-length stream)) static-boot-html))
(if static-boot-html (compiled-boot-html nil nil))))
(cond ((eq static-boot-html t) (post-data nil))
"") (when stream
((eq static-boot-html :error) (read-sequence page-data stream))
(error (format nil "Can not open boot file - ~A" (when boot-function
file))) (setf page-data (funcall boot-function
(t url-path
static-boot-html)) page-data)))
(compiled-boot-html nil nil)))) (when (search "multipart/form-data;"
(post-data nil)) (getf env :content-type))
(when stream (let ((id (random-hex-string))
(read-sequence page-data stream)) (req (lack.request:make-request env)))
(when boot-function (setf (gethash id *connection-data*)
(setf page-data (funcall boot-function (lack.request:request-body-parameters req))
url-path (setf post-data id)))
page-data))) (when (equal (getf env :content-type)
(when (search "multipart/form-data;" "application/x-www-form-urlencoded")
(getf env :content-type)) (setf post-data (cond ((eq (class-name (class-of (getf env :raw-body)))
(let ((id (random-hex-string)) 'circular-streams:circular-input-stream)
(req (lack.request:make-request env))) (let ((array-buffer (make-array (getf env :content-length)
(setf (gethash id *connection-data*) :adjustable t
(lack.request:request-body-parameters req)) :fill-pointer t)))
(setf post-data id))) (read-sequence array-buffer (getf env :raw-body))
(when (equal (getf env :content-type) (flex:octets-to-string array-buffer)))
"application/x-www-form-urlencoded") (t
(setf post-data (cond ((eq (class-name (class-of (getf env :raw-body))) (let ((string-buffer (make-string (getf env :content-length))))
'circular-streams:circular-input-stream) (read-sequence string-buffer (getf env :raw-body))
(let ((array-buffer (make-array (getf env :content-length) string-buffer)))))
:adjustable t (cond (long-poll-first
:fill-pointer t))) (let ((id (random-hex-string)))
(read-sequence array-buffer (getf env :raw-body)) (setf (gethash id *connection-data*) (make-hash-table* :test #'equal))
(flex:octets-to-string array-buffer))) (setf (gethash "connection-id" (get-connection-data id)) id)
(t (format t "New html connection id - ~A~%" id)
(let ((string-buffer (make-string (getf env :content-length)))) (lambda (responder)
(read-sequence string-buffer (getf env :raw-body)) (let* ((writer (funcall responder '(200 (:content-type "text/html"))))
string-buffer))))) (stream (lack.util.writer-stream:make-writer-stream writer))
(cond (long-poll-first (*long-poll-url* url-path)
(let ((id (random-hex-string))) (*long-poll-first* stream)
(setf (gethash id *connection-data*) (make-hash-table* :test #'equal)) (*extended-long-poll* (if (eq long-poll-first t)
(setf (gethash "connection-id" (get-connection-data id)) id) :extend
(format t "New html connection id - ~A~%" id) long-poll-first)))
(lambda (responder) (write-sequence page-data stream)
(let* ((writer (funcall responder '(200 (:content-type "text/html")))) (write-sequence
(stream (lack.util.writer-stream:make-writer-stream writer)) (format nil "<script>clog['connection_id']='~A';Open_ws();</script>" id)
(*long-poll-url* url-path) stream)
(*long-poll-first* stream) (when post-data
(*extended-long-poll* (if (eq long-poll-first t) (write-sequence
:extend (format nil "<script>clog['post-data']='~A'</script>"
long-poll-first))) post-data)
(write-sequence page-data stream) stream))
(write-sequence (if *break-on-error*
(format nil "<script>clog['connection_id']='~A';Open_ws();</script>" id) (funcall *on-connect-handler* id)
stream) (handler-case
(when post-data (funcall *on-connect-handler* id)
(write-sequence (t (c)
(format nil "<script>clog['post-data']='~A'</script>" (format t "Condition caught connection ~A - ~A.~&" id c)
post-data) (values 0 c))))
stream)) (when *long-poll-first*
(if *break-on-error* (setf *long-poll-first* nil)
(funcall *on-connect-handler* id) (handler-case
(handler-case (finish-output stream)
(funcall *on-connect-handler* id) (t (c)
(t (c) (format t "Condition caught finish-output ~A - ~A.~&" id c)
(format t "Condition caught connection ~A - ~A.~&" id c) (values 0 c))))
(values 0 c)))) (format t "HTML connection closed - ~A~%" id)))))
(when *long-poll-first* (t
(setf *long-poll-first* nil) (lambda (responder)
(handler-case (let* ((writer (funcall responder '(200 (:content-type "text/html"))))
(finish-output stream) (stream (lack.util.writer-stream:make-writer-stream writer)))
(t (c) (write-sequence page-data stream)
(format t "Condition caught finish-output ~A - ~A.~&" id c) (when post-data
(values 0 c)))) (write-sequence
(format t "HTML connection closed - ~A~%" id))))) (format nil "<script>clog['post-data']='~A'</script>"
(t post-data)
(lambda (responder) stream))
(let* ((writer (funcall responder '(200 (:content-type "text/html")))) (finish-output stream)))))))))
(stream (lack.util.writer-stream:make-writer-stream writer))) ;; Pass the handling on to next rule
(write-sequence page-data stream) (t (funcall app env))))))
(when post-data (lambda (env)
(write-sequence (let* ((path (getf env :path-info)))
(format nil "<script>clog['post-data']='~A'</script>" (cond ((and (eq static-boot-js nil)
post-data) (equalp path "/js/boot.js"))
stream)) `(200 (:content-type "text/javascript")
(finish-output stream))))))))) (,*compiled-boot-js*)))
;; Pass the handling on to next rule ((ppcre:scan "^(?:/clog$)" path)
(t (funcall app env)))))) (clog-server env))
(:static :path (lambda (path) (t
;; Request is static path if not the websocket connection. (lack/middleware/static::call-app-file *static-root* env)))))))
;; Websocket url is /clog
(cond ((ppcre:scan "^(?:/clog$)" path) nil)
(t path)))
:root static-root)
;; Handle Websocket connection
(lambda (env)
(clog-server env))))
;; Wrap lack middlewares ;; Wrap lack middlewares
(setf *app* (reduce #'funcall (setf *app* (reduce #'funcall
lack-middleware-list lack-middleware-list
@ -475,15 +470,15 @@ DEFAULT-ANSWER."
(finish-output *long-poll-first*) (finish-output *long-poll-first*)
(loop (loop
for n from 1 to 10 do for n from 1 to 10 do
(let ((con (get-connection connection-id))) (let ((con (get-connection connection-id)))
(when con (when con
(unless (or (eq *extended-long-poll* :extend) (unless (or (eq *extended-long-poll* :extend)
(> (decf *extended-long-poll*) 0)) (> (decf *extended-long-poll*) 0))
(format t "Closing long-poll for ~A~%" connection-id) (format t "Closing long-poll for ~A~%" connection-id)
(setf *long-poll-first* nil)) (setf *long-poll-first* nil))
(return)) (return))
(format t "Awaiting websocket connection for ~A~%" connection-id) (format t "Awaiting websocket connection for ~A~%" connection-id)
(sleep .1)))) (sleep .1))))
(let ((uid (generate-id))) (let ((uid (generate-id)))
(prep-query uid (when default-answer (format nil "~A" default-answer))) (prep-query uid (when default-answer (format nil "~A" default-answer)))
(execute connection-id (execute connection-id
@ -500,7 +495,7 @@ DEFAULT-ANSWER."
(declare (ignore path content)) (declare (ignore path content))
"Returns a compiled version version of boot.html. The compiled boot.html "Returns a compiled version version of boot.html. The compiled boot.html
uses the jQuery CDN instead of the static js files." uses the jQuery CDN instead of the static js files."
"<!doctype HTML> "<!doctype HTML>
<HTML> <HTML>
<HEAD> <HEAD>
<meta http-equiv='Cache-Control' content='no-cache, no-store, must-revalidate' /> <meta http-equiv='Cache-Control' content='no-cache, no-store, must-revalidate' />

12
source/clog-connection.lisp
View file

@ -34,11 +34,13 @@ script."
"CLOG system startup and shutdown" "CLOG system startup and shutdown"
(*verbose-output* variable) (*verbose-output* variable)
(*browser-gc-on-ping* variable) (*browser-gc-on-ping* variable)
(*break-on-error* variable) (*break-on-error* variable)
(*disable-clog-debugging* variable) (*disable-clog-debugging* variable)
(*reconnect-delay* variable) (*reconnect-delay* variable)
(*static-root* variable)
(*clog-port* variable)
(initialize function) (initialize function)
(random-port function) (random-port function)
@ -89,6 +91,8 @@ script."
(defvar *break-on-error* t "Allow invoking debugger (default t)") (defvar *break-on-error* t "Allow invoking debugger (default t)")
(defvar *disable-clog-debugging* nil "When true turns off debug hooks (default nil)") (defvar *disable-clog-debugging* nil "When true turns off debug hooks (default nil)")
(defvar *reconnect-delay* 7 "Time to delay in seconds for possible reconnect (default 7)") (defvar *reconnect-delay* 7 "Time to delay in seconds for possible reconnect (default 7)")
(defparameter *static-root* nil "Contains the static-root setting after initialization.")
(defparameter *clog-port* 8080 "Port this instance of clog was started on")
(defvar *on-connect-handler* nil "New connection event handler.") (defvar *on-connect-handler* nil "New connection event handler.")

16
source/clog-system.lisp
View file

@ -20,20 +20,9 @@
"Set a debug hook that is called for every event with (event data) "Set a debug hook that is called for every event with (event data)
that must be (funcall event data).") that must be (funcall event data).")
(defvar *overide-static-root* nil
"Override the static-root settings. This is not normally a good idea, but if
trying to run the tutorials or demos and unable to have your local directory
the same as the clog directy this overides the relative paths used in them.")
(defvar *static-root* nil
"Contains the static-root setting after initialization.")
(defvar *extended-routing* nil (defvar *extended-routing* nil
"If true extended routing is done.") "If true extended routing is done.")
(defparameter *clog-port* 8080
"Port this instance of clog was started on")
;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;
;; initialize ;; ;; initialize ;;
;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;
@ -134,11 +123,8 @@ number is chosen."
(setf *clog-running* t) (setf *clog-running* t)
(when (or (eql port 0) (eq port nil)) (when (or (eql port 0) (eq port nil))
(setf port (clog-connection:random-port))) (setf port (clog-connection:random-port)))
(setf *clog-port* port)
(setf *static-root* (truename (or *overide-static-root*
static-root)))
(apply #'clog-connection:initialize (apply #'clog-connection:initialize
(append (list #'on-connect :static-root *static-root* :port *clog-port*) (append (list #'on-connect :static-root static-root :port port)
rest)))) rest))))
;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;

2
source/clog.lisp
View file

@ -17,6 +17,8 @@
(mgl-pax:define-package :clog (mgl-pax:define-package :clog
(:documentation "CLOG - The Common List Omnificent GUI") (:documentation "CLOG - The Common List Omnificent GUI")
(:import-from :clog-connection (:import-from :clog-connection
:*clog-port*
:*static-root*
#:make-hash-table* #:make-hash-table*
#:escape-string #:escape-string
#:generate-id #:generate-id

4
tools/clog-builder-panels.lisp
View file

@ -509,7 +509,9 @@ not a temporarily attached one when using select-control."
(*default-title-class* *builder-title-class*) (*default-title-class* *builder-title-class*)
(*default-border-class* *builder-border-class*) (*default-border-class* *builder-border-class*)
ext-panel ext-panel
(win (create-gui-window obj :top 40 :left (+ *builder-left-panel-size* 5) (win (create-gui-window obj
:top (menu-bar-height obj)
:left (+ *builder-left-panel-size* 5)
:width 645 :height 430 :width 645 :height 430
:client-movement *client-side-movement*)) :client-movement *client-side-movement*))
(box (create-panel-box-layout (window-content win) (box (create-panel-box-layout (window-content win)

9
tools/clog-builder-project-tree.lisp
View file

@ -86,6 +86,11 @@
(lambda (obj) (lambda (obj)
(let* ((*default-title-class* *builder-title-class*) (let* ((*default-title-class* *builder-title-class*)
(*default-border-class* *builder-border-class*)) (*default-border-class* *builder-border-class*))
(setf *static-root*
(merge-pathnames (if (equal (current-project app) "clog")
"./static-root/"
"./www/")
(format nil "~A" (asdf:system-source-directory (current-project app)))))
(input-dialog obj "Run form:" (input-dialog obj "Run form:"
(lambda (result) (lambda (result)
(when result (when result
@ -100,7 +105,9 @@
:capture-console nil :capture-console nil
:capture-result nil :capture-result nil
:eval-in-package "clog-user"))) :eval-in-package "clog-user")))
:default-value entry-point)))) :default-value entry-point)
(alert-toast obj "Static Root Set"
*static-root* :color-class "w3-yellow" :time-out 3))))
(labels ((project-tree-dir-select (node dir) (labels ((project-tree-dir-select (node dir)
(let ((filter (equalp (text-value filter-btn) (let ((filter (equalp (text-value filter-btn)
"filter"))) "filter")))

7
tools/clog-builder-projects.lisp
View file

@ -81,6 +81,13 @@
(let ((app (connection-data-item panel "builder-app-data")) (let ((app (connection-data-item panel "builder-app-data"))
(val (text-value (entry-point panel)))) (val (text-value (entry-point panel))))
(unless (equal val "") (unless (equal val "")
(setf *static-root*
(merge-pathnames (if (equal (current-project app) "clog")
"./static-root/"
"./www/")
(format nil "~A" (asdf:system-source-directory (current-project app)))))
(alert-toast panel "Static Root Set"
*static-root* :color-class "w3-yellow")
(setf clog:*clog-debug* (setf clog:*clog-debug*
(lambda (event data) (lambda (event data)
(with-clog-debugger (panel (with-clog-debugger (panel

4
tools/clog-builder-repl.lisp
View file

@ -2,6 +2,8 @@
(defun on-open-repl-console (obj repl) (defun on-open-repl-console (obj repl)
(let* ((win (on-open-file obj :title "CLOG REPL Console" (let* ((win (on-open-file obj :title "CLOG REPL Console"
:top (+ (menu-bar-height obj) 485)
:left (+ *builder-left-panel-size* 5)
:is-console t :is-console t
:closer-html "&#10752;" :closer-html "&#10752;"
:editor-use-console-for-evals t))) :editor-use-console-for-evals t)))
@ -18,6 +20,8 @@
(*default-title-class* *builder-title-class*) (*default-title-class* *builder-title-class*)
(*default-border-class* *builder-border-class*) (*default-border-class* *builder-border-class*)
(win (create-gui-window obj :title "CLOG Builder REPL" (win (create-gui-window obj :title "CLOG Builder REPL"
:top (menu-bar-height obj)
:left (+ *builder-left-panel-size* 5)
:has-pinner t :has-pinner t
:keep-on-top t :keep-on-top t
:width 700 :height 480 :width 700 :height 480