clog popups

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

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 "")
+                                                (specs ""))
-                                                (replace "false"))
   (let ((new-id (format nil "CLOG~A" (clog-connection:generate-id))))
-    (execute obj (format nil "clog['~A']=open('~A','~A','~A',~A)"
+    (execute obj (format nil "clog['~A']=open('~A','~A','~A')"
-                         new-id url name specs replace))
+                         new-id url name specs))
     (make-clog-window (connection-id obj) :html-id new-id)))
 
 ;;;;;;;;;;;;;;;;;;

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)
 

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."
 <tr><td>cmd/ctl-s</td><td> Save</td></tr>
 <tr><td>ctl-=</td><td>Expand region</td></tr>
 <tr><td>opt/alt-m</td><td>Macroexpand</td></tr>
-</table>"
+</table><p><a target='_blank' href='https://github.com/ajaxorg/ace/wiki/Default-Keyboard-Shortcuts'>Default Keybindings</a>"
                                     :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)