mirror of
https://github.com/rabbibotton/clog.git
synced 2025-12-06 02:30:42 -08:00
clog popups
This commit is contained in:
David Botton
parent
4bb3dfbefa
commit
0001feccc6
4 changed files with 70 additions and 11 deletions
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue