From 0001feccc6a3319fc37287ceb7a740a99a9e5d2a Mon Sep 17 00:00:00 2001 From: David Botton Date: Fri, 8 Mar 2024 16:28:49 -0500 Subject: [PATCH] clog popups --- source/clog-connection.lisp | 9 ++++-- source/clog-window.lisp | 60 +++++++++++++++++++++++++++++++++---- source/clog.lisp | 5 ++++ tools/clog-builder.lisp | 7 +++-- 4 files changed, 70 insertions(+), 11 deletions(-) diff --git a/source/clog-connection.lisp b/source/clog-connection.lisp index 3f30541..8d6acfb 100644 --- a/source/clog-connection.lisp +++ b/source/clog-connection.lisp @@ -1,6 +1,6 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; CLOG - The Common Lisp Omnificent GUI ;;;; -;;;; (c) 2020-2022 David Botton ;;;; +;;;; (c) 2020-2024 David Botton ;;;; ;;;; License BSD 3 Clause ;;;; ;;;; ;;;; ;;;; clog-connection.lisp ;;;; @@ -61,6 +61,7 @@ script." (new-line function) (alert-box function) (generate-id function) + (random-hex-string function) (debug-mode function) (set-html-on-close function)) @@ -94,7 +95,8 @@ script." (defparameter *isaac-ctx* (isaac:init-self-seed :count 5 :is64 #+:X86-64 t #-:X86-64 nil) - "A ISAAC::ISAAC-CTX. Or, a ISAAC::ISAAC64-CTX on X86-64. It will be used to generate random hex strings for connection IDs") + "A ISAAC::ISAAC-CTX. Or, a ISAAC::ISAAC64-CTX on X86-64. It will be used to +generate random hex strings for connection IDs") (defvar *queries* (make-hash-table*) "Query ID to Answers") (defvar *queries-sems* (make-hash-table*) "Query ID to semiphores") @@ -113,7 +115,8 @@ script." "Dynamic variable indicating the url path used.") (defparameter *compiled-boot-js* - (with-open-file (stream (merge-pathnames #P"static-files/js/boot.js" (asdf:system-source-directory :clog))) + (with-open-file (stream (merge-pathnames #P"static-files/js/boot.js" + (asdf:system-source-directory :clog))) (let ((content (make-string (file-length stream)))) (read-sequence content stream) content)) diff --git a/source/clog-window.lisp b/source/clog-window.lisp index 465f515..64998db 100644 --- a/source/clog-window.lisp +++ b/source/clog-window.lisp @@ -8,6 +8,57 @@ (cl:in-package :clog) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Implementation - clog popup windows +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defparameter *clog-popup-sync-hash* (make-hash-table :test 'equalp) + "Used for syncing clog popup window creation with the thread creating +them.") + +(defparameter *clog-popup-path* "/clogwin" + "Default URL for popup windows") + +(defun clog-popup-handler (body) + "Handle the connection of a new popup clog window (internal)" + (let ((sync (form-data-item (form-get-data body) "sync"))) + (cond (sync + (clog-popup-openned body sync)) + (t + (create-div body :content "Invalid Access"))))) + +(defun enable-clog-popup (&key (path *clog-popup-path*)) + "Enable handling of clog enabled popups" + (set-on-new-window 'clog-popup-handler :path path)) + +(defun open-clog-popup (obj &key (path *clog-popup-path*) + (add-sync-to-path t) + (sync-key (clog-connection:random-hex-string)) + specs name (wait-timeout 10)) + "Open a new browser window/popup in most cases a tab. Since they are controlled +by clog you have full control of the new popups and are more flexible than using +open-windo. Returns the clog-body of the new window on the new connection or nil +if failed within :WAIT-TIMEOUT" + (let* ((sem (bordeaux-threads:make-semaphore)) + (mpath (if add-sync-to-path + (format nil "~A?sync=~A" path sync-key) + path)) + (new-win (open-window (window (connection-body obj)) mpath :specs specs :name name))) + (setf (gethash sync-key *clog-popup-sync-hash*) sem) + (bordeaux-threads:wait-on-semaphore sem :timeout wait-timeout) + (setf sem (gethash sync-key *clog-popup-sync-hash*)) + (if (typep sem 'clog-obj) + sem + nil))) + +(defun clog-popup-openned (obj sync-key) + "Used to notify open-clog-popup the new popup window is ready for custom +clog-popup handlers." + (let ((sem (gethash sync-key *clog-popup-sync-hash*))) + (when sem + (setf (gethash sync-key *clog-popup-sync-hash*) (connection-body obj)) + (bordeaux-threads:signal-semaphore sem)))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Implementation - clog-window ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -385,7 +436,7 @@ events and messages may not be trasmitted on most browsers.")) ;; open-window ;; ;;;;;;;;;;;;;;;;; -(defgeneric open-window (clog-window url &key name specs replace) +(defgeneric open-window (clog-window url &key name specs) (:documentation "This will launch a new window of current browser where CLOG-WINDOW is displayed (remote or local) and returns a new clog-window. In modern browsers it is very limitted to just open a new tab with url @@ -393,11 +444,10 @@ unless is a localhost url.")) (defmethod open-window ((obj clog-window) url &key (name "_blank") - (specs "") - (replace "false")) + (specs "")) (let ((new-id (format nil "CLOG~A" (clog-connection:generate-id)))) - (execute obj (format nil "clog['~A']=open('~A','~A','~A',~A)" - new-id url name specs replace)) + (execute obj (format nil "clog['~A']=open('~A','~A','~A')" + new-id url name specs)) (make-clog-window (connection-id obj) :html-id new-id))) ;;;;;;;;;;;;;;;;;; diff --git a/source/clog.lisp b/source/clog.lisp index 2361837..1fecb90 100644 --- a/source/clog.lisp +++ b/source/clog.lisp @@ -934,6 +934,11 @@ embedded in a native template application.)" (navigator generic-function)) (defsection @clog-window (:title "CLOG Window Objects") + "CLOG Popups" + (enable-clog-popup function) + (open-clog-popup function) + (clog-popup-openned function) + "CLOG-Window - CLOG Window Objects" (clog-window class) diff --git a/tools/clog-builder.lisp b/tools/clog-builder.lisp index 6e03413..6eb0142 100644 --- a/tools/clog-builder.lisp +++ b/tools/clog-builder.lisp @@ -2614,7 +2614,9 @@ It parse the string TEXT without using READ functions." (let ((app (make-instance 'builder-app-data)) (file (form-data-item (form-get-data body) "open-file"))) (setf (connection-data-item body "builder-app-data") app) - (setf (title (html-document body)) "CLOG Builder - Source Editor") + (if file + (setf (title (html-document body)) file) + (setf (title (html-document body)) (format nil "CLOG Builder - Source Editor"))) (clog-gui-initialize body) (add-class body "w3-blue-grey") (on-open-file body :open-file file :maximized t))) @@ -2730,7 +2732,7 @@ It parse the string TEXT without using READ functions." cmd/ctl-s Save ctl-=Expand region opt/alt-mMacroexpand -" +

Default Keybindings" :width 400 :height 300 :title "Help"))) (set-on-window-size-done win @@ -2773,7 +2775,6 @@ It parse the string TEXT without using READ functions." (setf is-dirty t))) (set-on-event ace "clog-save-ace" (lambda (obj) - (declare (ignore obj)) (unless (equal file-name "") (add-class btn-save "w3-animate-top") (write-file (text-value ace) file-name :clog-obj obj)