diff --git a/tools/clog-builder-control-list.lisp b/tools/clog-builder-control-list.lisp
index b655da1..91b81aa 100644
--- a/tools/clog-builder-control-list.lisp
+++ b/tools/clog-builder-control-list.lisp
@@ -132,92 +132,93 @@
(defun on-populate-control-list-win (content &key win)
"Populate the control-list-window to allow drag and drop adjust of order
of controls and double click to select control."
- (with-sync-event (content)
- (let ((app (connection-data-item content "builder-app-data")))
- (let ((panel-id (html-id content))
- (last-ctl nil))
- (when (control-list-win app)
- (let ((lwin (control-list-win app)))
- (setf (inner-html lwin) "")
- (set-on-mouse-click (create-div lwin :content (attribute content "data-clog-name"))
- (lambda (obj data)
- (declare (ignore obj data))
- (deselect-current-control app)
- (on-populate-control-properties-win content :win win)
- (on-populate-control-list-win content :win win)))
- (labels ((add-siblings (control sim)
- (let (dln dcc)
- (loop
- (when (equal (html-id control) "undefined") (return))
- (setf dcc (attribute control "data-clog-composite-control"))
- (setf dln (attribute control "data-clog-name"))
- (unless (equal dln "undefined")
- (let ((list-item (create-div lwin :content (format nil "↕ ~A~A" sim dln)))
- (status (hiddenp (get-placer control))))
- (if status
- (setf (color list-item) :darkred)
- (setf (background-color list-item) :grey))
- (setf (draggablep list-item) t)
- (setf (attribute list-item "data-clog-control") (html-id control))
- ;; click to select item
- (set-on-mouse-down list-item
- (lambda (obj data)
- (let* ((html-id (attribute obj "data-clog-control"))
- (control (get-from-control-list app
- panel-id
- html-id)))
- (cond ((or (getf data :shift-key)
- (getf data :ctrl-key)
- (getf data :meta-key))
- (when (drop-new-control app content data)
- (incf-next-id content)))
- (t
- (when last-ctl
- (set-border last-ctl "0px" :dotted :blue))
- (set-border list-item "2px" :dotted :blue)
- (setf last-ctl list-item)
- (select-control control))))))
- (set-on-double-click list-item
- (lambda (obj)
+ (when content
+ (with-sync-event (content)
+ (let ((app (connection-data-item content "builder-app-data")))
+ (let ((panel-id (html-id content))
+ (last-ctl nil))
+ (when (control-list-win app)
+ (let ((lwin (control-list-win app)))
+ (setf (inner-html lwin) "")
+ (set-on-mouse-click (create-div lwin :content (attribute content "data-clog-name"))
+ (lambda (obj data)
+ (declare (ignore obj data))
+ (deselect-current-control app)
+ (on-populate-control-properties-win content :win win)
+ (on-populate-control-list-win content :win win)))
+ (labels ((add-siblings (control sim)
+ (let (dln dcc)
+ (loop
+ (when (equal (html-id control) "undefined") (return))
+ (setf dcc (attribute control "data-clog-composite-control"))
+ (setf dln (attribute control "data-clog-name"))
+ (unless (equal dln "undefined")
+ (let ((list-item (create-div lwin :content (format nil "↕ ~A~A" sim dln)))
+ (status (hiddenp (get-placer control))))
+ (if status
+ (setf (color list-item) :darkred)
+ (setf (background-color list-item) :grey))
+ (setf (draggablep list-item) t)
+ (setf (attribute list-item "data-clog-control") (html-id control))
+ ;; click to select item
+ (set-on-mouse-down list-item
+ (lambda (obj data)
(let* ((html-id (attribute obj "data-clog-control"))
(control (get-from-control-list app
panel-id
- html-id))
- (placer (get-placer control))
- (state (hiddenp placer)))
- (setf (hiddenp placer) (not state))
- (select-control control)
- (on-populate-control-list-win content :win win))))
- ;; drag and drop to change
- (set-on-drag-over list-item (lambda (obj)(declare (ignore obj))()))
- (set-on-drop list-item
- (lambda (obj data)
- (let* ((id (attribute obj "data-clog-control"))
- (control1 (get-from-control-list app
- panel-id
- id))
- (control2 (get-from-control-list app
- panel-id
- (getf data :drag-data)))
- (placer1 (get-placer control1))
- (placer2 (get-placer control2)))
- (if (getf data :shift-key)
- (place-inside-bottom-of control1 control2)
- (place-before control1 control2))
- (place-after control2 placer2)
- (set-geometry placer1 :top (position-top control1)
- :left (position-left control1)
- :width (client-width control1)
- :height (client-height control1))
- (set-geometry placer2 :top (position-top control2)
- :left (position-left control2)
- :width (client-width control2)
- :height (client-height control2))
- (on-populate-control-properties-win content :win win)
- (on-populate-control-list-win content :win win))))
- (set-on-drag-start list-item (lambda (obj)(declare (ignore obj))())
- :drag-data (html-id control))
- (when (equal dcc "undefined") ; when t is not a composite control
- (add-siblings (first-child control) (format nil "~A→" sim)))))
- (setf control (next-sibling control))))))
- (add-siblings (first-child content) ""))))))))
+ html-id)))
+ (cond ((or (getf data :shift-key)
+ (getf data :ctrl-key)
+ (getf data :meta-key))
+ (when (drop-new-control app content data)
+ (incf-next-id content)))
+ (t
+ (when last-ctl
+ (set-border last-ctl "0px" :dotted :blue))
+ (set-border list-item "2px" :dotted :blue)
+ (setf last-ctl list-item)
+ (select-control control))))))
+ (set-on-double-click list-item
+ (lambda (obj)
+ (let* ((html-id (attribute obj "data-clog-control"))
+ (control (get-from-control-list app
+ panel-id
+ html-id))
+ (placer (get-placer control))
+ (state (hiddenp placer)))
+ (setf (hiddenp placer) (not state))
+ (select-control control)
+ (on-populate-control-list-win content :win win))))
+ ;; drag and drop to change
+ (set-on-drag-over list-item (lambda (obj)(declare (ignore obj))()))
+ (set-on-drop list-item
+ (lambda (obj data)
+ (let* ((id (attribute obj "data-clog-control"))
+ (control1 (get-from-control-list app
+ panel-id
+ id))
+ (control2 (get-from-control-list app
+ panel-id
+ (getf data :drag-data)))
+ (placer1 (get-placer control1))
+ (placer2 (get-placer control2)))
+ (if (getf data :shift-key)
+ (place-inside-bottom-of control1 control2)
+ (place-before control1 control2))
+ (place-after control2 placer2)
+ (set-geometry placer1 :top (position-top control1)
+ :left (position-left control1)
+ :width (client-width control1)
+ :height (client-height control1))
+ (set-geometry placer2 :top (position-top control2)
+ :left (position-left control2)
+ :width (client-width control2)
+ :height (client-height control2))
+ (on-populate-control-properties-win content :win win)
+ (on-populate-control-list-win content :win win))))
+ (set-on-drag-start list-item (lambda (obj)(declare (ignore obj))())
+ :drag-data (html-id control))
+ (when (equal dcc "undefined") ; when t is not a composite control
+ (add-siblings (first-child control) (format nil "~A→" sim)))))
+ (setf control (next-sibling control))))))
+ (add-siblings (first-child content) "")))))))))
diff --git a/tools/clog-builder-panels.lisp b/tools/clog-builder-panels.lisp
index e0d0b24..189bce1 100644
--- a/tools/clog-builder-panels.lisp
+++ b/tools/clog-builder-panels.lisp
@@ -490,11 +490,12 @@ not a temporarily attached one when using select-control."
"")
:name "_blank"))
-(defun on-new-builder-panel (obj &key (open-file nil))
+(defun on-new-builder-panel (obj &key (open-file nil) open-ext)
"Open new panel"
(unless (and open-file
(window-to-top-by-param obj open-file))
(let* ((app (connection-data-item obj "builder-app-data"))
+ ext-panel
(win (create-gui-window obj :top 40 :left 225
:width 645 :height 430
:client-movement *client-side-movement*))
@@ -506,6 +507,9 @@ not a temporarily attached one when using select-control."
(m-load (create-gui-menu-item m-file :content "load"))
(m-save (create-gui-menu-item m-file :content "save (cmd/ctrl-s)"))
(m-saveas (create-gui-menu-item m-file :content "save as.."))
+ (m-reopnp (create-gui-menu-item m-file :content "save, close and reopen as panel"))
+ (m-reopn (create-gui-menu-item m-file :content "save, close and popup this panel"))
+ (m-reopnh (create-gui-menu-item m-file :content "save, close and popup this panel no w3css"))
(m-edit (create-gui-menu-drop-down menu :content "Edit"))
(m-undo (create-gui-menu-item m-edit :content "undo"))
(m-redo (create-gui-menu-item m-edit :content "redo"))
@@ -518,9 +522,9 @@ not a temporarily attached one when using select-control."
(m-rndras (create-gui-menu-item m-lisp :content "render form to lisp as..."))
(m-test (create-gui-menu-item m-lisp :content "evaluate and test"))
(m-events (create-gui-menu-drop-down menu :content "Events"))
- (tmp (create-gui-menu-item m-events :content "Control CLOG Events" :on-click 'on-show-control-events-win))
- (tmp (create-gui-menu-item m-events :content "Control JavaScript Events" :on-click 'on-show-control-js-events-win))
- (tmp (create-gui-menu-item m-events :content "Control ParenScript Events" :on-click 'on-show-control-ps-events-win))
+ (tmp (create-gui-menu-item m-events :content "show CLOG events" :on-click 'on-show-control-events-win))
+ (tmp (create-gui-menu-item m-events :content "show JavaScript events" :on-click 'on-show-control-js-events-win))
+ (tmp (create-gui-menu-item m-events :content "show ParenScript events" :on-click 'on-show-control-ps-events-win))
(m-help (create-gui-menu-drop-down menu :content "Help"))
(m-helpk (create-gui-menu-item m-help :content "quick start"))
(tool-bar (create-div (top-panel box)))
@@ -576,6 +580,57 @@ not a temporarily attached one when using select-control."
(setf (height btn-save) "12px")
(setf (height btn-load) "12px")
(setf (height btn-help) "12px")
+ (when (or open-ext
+ *open-panels-as-popups*)
+ (multiple-value-bind (pop pop-win)
+ (open-clog-popup obj :specs "width=640,height=480")
+ (when pop
+ (create-div content :content "Panel is external. Click to bring to front.")
+ (set-on-click content
+ (lambda (obj) (focus pop-win)))
+ (setf ext-panel pop)
+ (cond ((eq open-ext :custom)
+ (load-css (html-document pop) "/css/jquery-ui.css")
+ (load-script (html-document pop) "/js/jquery-ui.js"))
+ (t
+ (clog-gui-initialize pop)
+ (clog-web-initialize pop :w3-css-url nil)))
+ (setf (connection-data-item pop "builder-app-data") app)
+ (let ((nbox (create-panel-box-layout pop
+ :left-width 0 :right-width 0
+ :top-height 0 :bottom-height 0)))
+ (setf box nbox)
+ (setf content (center-panel nbox))
+ (setf panel-id (html-id content))
+ (set-on-focus (window pop)
+ (lambda (obj)
+ (declare (ignore obj))
+ (setf (title (html-document pop)) (attribute content "data-clog-name"))))
+ (set-on-before-unload (window pop)
+ (lambda (obj)
+ (declare (ignore obj))
+ (setf content nil)
+ (setf ext-panel nil)
+ (window-close win)))
+ (set-on-click (create-gui-menu-item m-file :content "export as a boot html")
+ (lambda (obj)
+ (server-file-dialog obj "Export as a Boot HTML" "./"
+ (lambda (filename)
+ (when filename
+ (maphash
+ (lambda (html-id control)
+ (declare (ignore html-id))
+ (place-inside-bottom-of (bottom-panel box)
+ (get-placer control)))
+ (get-control-list app panel-id))
+ ;; needs to clear data attrs
+ (save-body-to-file filename :body pop :if-exists :rename)
+ (maphash
+ (lambda (html-id control)
+ (declare (ignore html-id))
+ (place-after control (get-placer control)))
+ (get-control-list app panel-id)))))))
+ (focus pop-win)))))
(setf-next-id content 1)
(setf (overflow content) :auto)
(init-control-list app panel-id)
@@ -605,11 +660,10 @@ not a temporarily attached one when using select-control."
(set-on-window-close win
(lambda (obj)
(declare (ignore obj))
- ;; clear associated windows on close
(setf (current-control app) nil)
(destroy-control-list app panel-id)
- (on-populate-control-properties-win content :win win)
- (on-populate-control-list-win content :win win)))
+ (when ext-panel
+ (close-window (window ext-panel)))))
(set-on-window-size-done win
(lambda (obj)
(declare (ignore obj))
@@ -742,6 +796,8 @@ not a temporarily attached one when using select-control."
(clrhash (get-control-list app panel-id))
(on-populate-loaded-window content :win win)
(setf (window-title win) (attribute content "data-clog-name"))
+ (when ext-panel
+ (setf (title (html-document ext-panel)) (attribute content "data-clog-name")))
(setf (window-param win) fname)
(on-populate-control-list-win content :win win))
(load-file (obj)
@@ -852,6 +908,21 @@ not a temporarily attached one when using select-control."
(save obj nil)))
(set-on-click m-saveas (lambda (obj)
(save obj nil :save-as t)))
+ (set-on-click m-reopn (lambda (obj)
+ (when is-dirty
+ (save obj nil))
+ (window-close win)
+ (on-new-builder-panel obj :open-file file-name :open-ext t)))
+ (set-on-click m-reopnh (lambda (obj)
+ (when is-dirty
+ (save obj nil))
+ (window-close win)
+ (on-new-builder-panel obj :open-file file-name :open-ext :custom)))
+ (set-on-click m-reopnp (lambda (obj)
+ (when is-dirty
+ (save obj nil))
+ (window-close win)
+ (on-new-builder-panel obj :open-file file-name)))
(set-on-click btn-test #'eval-test)
(set-on-click m-test #'eval-test)
(set-on-mouse-click btn-rndr (lambda (obj data) (render obj data)))
@@ -864,413 +935,10 @@ not a temporarily attached one when using select-control."
(when (drop-new-control app content data :win win)
(incf-next-id content))))))))
-(defun on-attach-builder-custom (body)
- "New custom builder page has attached"
- (let* ((params (form-get-data body))
- (curl (form-data-item params "curl")))
- (on-attach-builder-page body :custom-boot curl)))
-
-(defun on-attach-builder-page (body &key custom-boot)
- "New builder page has attached"
- (let* ((params (form-get-data body))
- (panel-uid (form-data-item params "bid"))
- (app (gethash panel-uid *app-sync-hash*))
- win
- (box (create-panel-box-layout body
- :left-width 0 :right-width 0
- :top-height 0 :bottom-height 0))
- (content (center-panel box))
- (in-simulation nil)
- (undo-chain nil)
- (redo-chain nil)
- (file-name "")
- (render-file-name "")
- (panel-id (html-id content)))
- ;; sync new window with app
- (setf (connection-data-item body "builder-app-data") app)
- (remhash panel-uid *app-sync-hash*)
- (funcall (gethash (format nil "~A-link" panel-uid) *app-sync-hash*) content)
- (setf win (gethash (format nil "~A-win" panel-uid) *app-sync-hash*))
- (remhash (format nil "~A-win" panel-uid) *app-sync-hash*)
- ;; setup window and page
- (setf-next-id content 1)
- (let ((panel-name (format nil "page-~A" (incf (next-panel-id app)))))
- (setf (title (html-document body)) panel-name)
- (setf (window-title win) panel-name)
- (setf (attribute content "data-clog-name") panel-name))
- (setf (attribute content "data-clog-type") "clog-data")
- (setf (attribute content "data-in-package") "clog-user")
- (setf (attribute content "data-custom-slots") "")
- (setf (overflow content) :auto)
- (set-on-focus (window body)
- (lambda (obj)
- (declare (ignore obj))
- (setf (title (html-document body)) (attribute content "data-clog-name"))))
- ;; setup close of page
- (set-on-before-unload (window body)
- (lambda (obj)
- (declare (ignore obj))
- (window-close win)))
- ;; activate associated windows on open
- (deselect-current-control app)
- (panel-mode win t)
- (on-populate-control-properties-win content :win win)
- (on-populate-control-list-win content :win win)
- ;; setup window events
- (set-on-window-focus win
- (lambda (obj)
- (declare (ignore obj))
- (panel-mode win t)
- (on-populate-control-properties-win content :win win)
- (on-populate-control-list-win content :win win)))
- (set-on-window-blur win
- (lambda (obj)
- (declare (ignore obj))
- (panel-mode win nil)))
- (set-on-window-close win
- (lambda (obj)
- (declare (ignore obj))
- ;; clear associated windows on close
- (setf (current-control app) nil)
- (destroy-control-list app panel-id)
- (close-window (window body))))
- ;; setup jquery and jquery-ui
- (cond (custom-boot
- (load-css (html-document body) "/css/jquery-ui.css")
- (load-script (html-document body) "/js/jquery-ui.js"))
- (t
- (clog-gui-initialize body)
- (clog-web-initialize body :w3-css-url nil)))
- ;; init builder
- (init-control-list app panel-id)
- (let* ((pbox (create-panel-box-layout (window-content win)
- :left-width 0 :right-width 0
- :top-height 33 :bottom-height 0))
- (tool-bar (create-div (top-panel pbox) :class "w3-center"))
- (btn-class "w3-button w3-white w3-border w3-border-black w3-ripple")
- (btn-copy (create-img tool-bar :alt-text "copy" :url-src img-btn-copy :class btn-class))
- (btn-paste (create-img tool-bar :alt-text "paste" :url-src img-btn-paste :class btn-class))
- (btn-cut (create-img tool-bar :alt-text "cut" :url-src img-btn-cut :class btn-class))
- (btn-del (create-img tool-bar :alt-text "delete" :url-src img-btn-del :class btn-class))
- (btn-undo (create-img tool-bar :alt-text "undo" :url-src img-btn-undo :class btn-class))
- (btn-redo (create-img tool-bar :alt-text "redo" :url-src img-btn-redo :class btn-class))
- (btn-sim (create-img tool-bar :alt-text "simulate" :url-src img-btn-sim :class btn-class))
- (btn-test (create-img tool-bar :alt-text "test" :url-src img-btn-test :class btn-class))
- (btn-rndr (create-img tool-bar :alt-text "render" :url-src img-btn-rndr :class btn-class))
- (btn-save (create-img tool-bar :alt-text "save" :url-src img-btn-save :class btn-class))
- (btn-load (create-img tool-bar :alt-text "load" :url-src img-btn-load :class btn-class))
- (btn-exp (create-img tool-bar :alt-text "export" :url-src img-btn-exp :class btn-class))
- (wcontent (center-panel pbox)))
- (setf (background-color (top-panel pbox)) :black)
- (setf (advisory-title btn-copy) "copy")
- (setf (advisory-title btn-paste) "paste")
- (setf (advisory-title btn-cut) "cut")
- (setf (advisory-title btn-del) "delete")
- (setf (advisory-title btn-undo) "undo")
- (setf (advisory-title btn-redo) "redo")
- (setf (advisory-title btn-test) "test")
- (setf (advisory-title btn-rndr) "render to lisp - shift-click render as...")
- (setf (advisory-title btn-save) "save - shift-click save as...")
- (setf (advisory-title btn-load) "load")
- (setf (advisory-title btn-sim) "start simulation")
- (setf (advisory-title btn-exp) "export as boot page")
- (setf (height btn-copy) "12px")
- (setf (height btn-paste) "12px")
- (setf (height btn-cut) "12px")
- (setf (height btn-del) "12px")
- (setf (height btn-undo) "12px")
- (setf (height btn-redo) "12px")
- (setf (height btn-sim) "12px")
- (setf (height btn-test) "12px")
- (setf (height btn-rndr) "12px")
- (setf (height btn-save) "12px")
- (setf (height btn-load) "12px")
- (setf (height btn-exp) "12px")
- (create-div wcontent :content
- "
Drop and work with controls on it's window.")
- ;; setup tool bar events
- (set-on-click btn-exp (lambda (obj)
- (server-file-dialog obj "Export as Boot HTML" "./"
- (lambda (filename)
- (when filename
- (maphash
- (lambda (html-id control)
- (declare (ignore html-id))
- (place-inside-bottom-of (bottom-panel box)
- (get-placer control)))
- (get-control-list app panel-id))
- (save-body-to-file filename :body body :if-exists :rename)
- (maphash
- (lambda (html-id control)
- (declare (ignore html-id))
- (place-after control (get-placer control)))
- (get-control-list app panel-id)))))))
- (flet (;; copy
- (copy (obj)
- (when (current-control app)
- (maphash
- (lambda (html-id control)
- (declare (ignore html-id))
- (place-inside-bottom-of (bottom-panel box)
- (get-placer control)))
- (get-control-list app panel-id))
- (setf (copy-buf app)
- (js-query content
- (format nil
- "var z=~a.clone(); z=$('').append(z);~
- z.find('*').each(function(){~
- if($(this).attr('data-clog-composite-control') == 't'){$(this).text('')}~
- if($(this).attr('id') !== undefined && ~
- $(this).attr('id').substring(0,5)=='CLOGB'){$(this).removeAttr('id')}});~
- z.html()"
- (jquery (current-control app)))))
- (system-clipboard-write obj (copy-buf app))
- (let ((c (create-text-area (window-content (copy-history-win app))
- :value (copy-buf app)
- :auto-place nil)))
- (place-inside-top-of (window-content (copy-history-win app)) c)
- (setf (width c) "100%"))
- (maphash
- (lambda (html-id control)
- (declare (ignore html-id))
- (place-after control (get-placer control)))
- (get-control-list app panel-id))))
- ;; paste
- (paste (obj)
- (let ((buf (or (system-clipboard-read obj)
- (copy-buf app))))
- (when buf
- (let ((control (create-control content content
- `(:name "custom"
- :create-type :paste)
- (format nil "CLOGB~A~A"
- (get-universal-time)
- (next-id content))
- :custom-query buf)))
- (setf (attribute control "data-clog-name")
- (format nil "~A-~A" "copy" (next-id content)))
- (incf-next-id content)
- (add-sub-controls control content :win win :paste t)
- (let ((cr (control-info (attribute control "data-clog-type"))))
- (when (getf cr :on-load)
- (funcall (getf cr :on-load) control cr)))
- (setup-control content control :win win)
- (select-control control)
- (on-populate-control-list-win content :win win)
- (jquery-execute (get-placer content) "trigger('clog-builder-snap-shot')")))))
- ;; delete
- (del (obj)
- (declare (ignore obj))
- (when (current-control app)
- (delete-current-control app panel-id (html-id (current-control app)))
- (on-populate-control-properties-win content :win win)
- (on-populate-control-list-win content :win win)
- (jquery-execute (get-placer content) "trigger('clog-builder-snap-shot')"))))
- ;; set up del/cut/copy/paste handlers
- (set-on-copy content #'copy)
- (set-on-click btn-copy #'copy)
- (set-on-paste content #'paste)
- (set-on-click btn-paste #'paste)
- (set-on-click btn-del #'del)
- (set-on-cut content (lambda (obj)
- (copy obj)
- (del obj)))
- (set-on-click btn-cut (lambda (obj)
- (copy obj)
- (del obj))))
- (set-on-click btn-sim (lambda (obj)
- (declare (ignore obj))
- (cond (in-simulation
- (setf (url-src btn-sim) img-btn-sim)
- (setf (advisory-title btn-sim) "start simulation")
- (setf in-simulation nil)
- (maphash (lambda (html-id control)
- (declare (ignore html-id))
- (setf (hiddenp (get-placer control)) nil))
- (get-control-list app panel-id)))
- (t
- (setf (url-src btn-sim) img-btn-cons)
- (setf (advisory-title btn-sim) "construction mode")
- (deselect-current-control app)
- (on-populate-control-properties-win content :win win)
- (setf in-simulation t)
- (maphash (lambda (html-id control)
- (declare (ignore html-id))
- (setf (hiddenp (get-placer control)) t))
- (get-control-list app panel-id))
- (focus (first-child content))))))
- (set-on-click btn-undo (lambda (obj)
- (declare (ignore obj))
- (when undo-chain
- (setf (inner-html content)
- (let ((val (pop undo-chain)))
- (push val redo-chain)
- val))
- (clrhash (get-control-list app panel-id))
- (on-populate-loaded-window content :win win)
- (setf (window-title win) (attribute content "data-clog-name"))
- (on-populate-control-properties-win content :win win)
- (on-populate-control-list-win content :win win))))
- (set-on-event content "clog-builder-snap-shot"
- (lambda (obj)
- (declare (ignore obj))
- (setf redo-chain nil)
- (push (panel-snap-shot content panel-id (bottom-panel box)) undo-chain)
- (when (current-control app)
- (focus (get-placer (current-control app))))))
- (set-on-click btn-redo (lambda (obj)
- (declare (ignore obj))
- (when redo-chain
- (setf (inner-html content)
- (let ((val (pop redo-chain)))
- (push val undo-chain)
- val))
- (clrhash (get-control-list app panel-id))
- (on-populate-loaded-window content :win win)
- (setf (window-title win) (attribute content "data-clog-name"))
- (on-populate-control-properties-win content :win win)
- (on-populate-control-list-win content :win win))))
- (set-on-click btn-load (lambda (obj)
- (server-file-dialog win "Load Panel" (directory-namestring (if (equal file-name "")
- (current-project-dir app)
- file-name))
- (lambda (fname)
- (window-focus win)
- (when fname
- (setf file-name fname)
- (setf render-file-name (format nil "~A~A.lisp"
- (directory-namestring file-name)
- (pathname-name file-name)))
- (setf (inner-html content)
- (read-file fname :clog-obj obj))
- (clrhash (get-control-list app panel-id))
- (on-populate-loaded-window content :win win)
- (setf (title (html-document body)) (attribute content "data-clog-name"))
- (setf (window-title win) (attribute content "data-clog-name"))
- (on-populate-control-list-win content :win win))))))
- (set-on-mouse-click btn-save
- (lambda (obj data)
- (cond ((or (equal file-name "")
- (getf data :shift-key))
- (when (equal file-name "")
- (setf file-name (format nil "~A~A.clog"
- (current-project-dir app)
- (attribute content "data-clog-name"))))
- (server-file-dialog obj "Save Panel As.." file-name
- (lambda (fname)
- (window-focus win)
- (when fname
- (setf file-name fname)
- (setf render-file-name (format nil "~A~A.lisp"
- (directory-namestring file-name)
- (pathname-name file-name)))
- (add-class btn-save "w3-animate-top")
- (save-panel fname content panel-id (bottom-panel box))
- (sleep .5)
- (remove-class btn-save "w3-animate-top"))
- :initial-filename file-name)))
- (t
- (add-class btn-save "w3-animate-top")
- (save-panel file-name content panel-id (bottom-panel box))
- (sleep .5)
- (remove-class btn-save "w3-animate-top")))))
- (set-on-click btn-test
- (lambda (obj)
- (do-eval obj (render-clog-code content (bottom-panel box))
- (attribute content "data-clog-name")
- :package (attribute content "data-in-package")
- :custom-boot custom-boot)))
- (set-on-mouse-click btn-rndr
- (lambda (obj data)
- (cond ((or (equal render-file-name "")
- (getf data :shift-key))
- (when (equal render-file-name "")
- (if (equal file-name "")
- (setf render-file-name (format nil "~A.lisp" (attribute content "data-clog-name")))
- (setf render-file-name (format nil "~A~A.lisp"
- (directory-namestring file-name)
- (pathname-name file-name)))))
- (server-file-dialog obj "Render As.." render-file-name
- (lambda (fname)
- (window-focus win)
- (when fname
- (setf render-file-name fname)
- (add-class btn-rndr "w3-animate-top")
- (write-file (render-clog-code content (bottom-panel box))
- fname :clog-obj obj)
- (sleep .5)
- (remove-class btn-rndr "w3-animate-top")))
- :initial-filename render-file-name))
- (t
- (add-class btn-rndr "w3-animate-top")
- (write-file (render-clog-code content (bottom-panel box))
- render-file-name :clog-obj obj)))
- (sleep .5)
- (remove-class btn-rndr "w3-animate-top"))))
- (set-on-mouse-down content
- (lambda (obj data)
- (declare (ignore obj))
- (unless in-simulation
- (when (drop-new-control app content data :win win)
- (incf-next-id content)))))))
+(defun on-new-builder-page (obj &key custom-boot url-launch)
+ "Open new page"
+ (on-new-builder-panel obj :open-ext t))
(defun on-new-builder-basic-page (obj)
"Menu item to open new basic HTML page"
- (set-on-new-window 'on-attach-builder-custom :boot-file "/boot.html" :path "/builder-custom")
- (on-new-builder-page obj :custom-boot "/boot.html" :url-launch nil))
-
-(defun on-new-builder-launch-page (obj)
- "Menu item to open new page"
- (on-new-builder-page obj :url-launch t))
-
-(defun on-new-builder-custom (obj)
- "Open custom boot page"
- (let ((custom-boot "/boot.html"))
- (input-dialog obj "Boot File Name:"
- (lambda (answer)
- (when answer
- (setf custom-boot answer)
- (set-on-new-window 'on-attach-builder-custom
- :boot-file custom-boot :path "/builder-custom")
- (on-new-builder-page obj :custom-boot custom-boot :url-launch t)))
- :default-value custom-boot :modal t)))
-
-(defun on-new-builder-page (obj &key custom-boot url-launch)
- "Open new page"
- (let* ((app (connection-data-item obj "builder-app-data"))
- (win (create-gui-window obj :top 40 :left 225 :width 600 :client-movement *client-side-movement*))
- (panel-uid (format nil "~A" (get-universal-time))) ;; unique id for panel
- (boot-loc (if custom-boot
- "builder-custom"
- "builder-page"))
- (curl (if custom-boot
- (format nil "&curl=~A" (quri:url-encode custom-boot))
- ""))
- (link (format nil "http://127.0.0.1:~A/~A?bid=~A~A" clog:*clog-port* boot-loc panel-uid curl))
- (link-rel (format nil "/~A?bid=~A~A" boot-loc panel-uid curl))
- (btn-txt (if url-launch
- "Click to launch default browser or copy URL."
- "Click if browser does not open new page shortly."))
- (txt-area (create-div (window-content win)))
- (page-link (create-a txt-area
- :target "_blank"
- :content (format nil "
" btn-txt)
- :link link))
- (txt-link (create-div txt-area
- :content (format nil "
~A" link)))
- content)
- (declare (ignore page-link txt-link))
- (on-show-control-events-win win)
- (setf (gethash panel-uid *app-sync-hash*) app)
- (setf (gethash (format nil "~A-win" panel-uid) *app-sync-hash*) win)
- (setf (gethash (format nil "~A-link" panel-uid) *app-sync-hash*)
- (lambda (obj)
- (setf content obj)
- (setf panel-uid (html-id content))
- (destroy txt-area)
- (remhash (format nil "~A-link" panel-uid) *app-sync-hash*)))
- (unless url-launch
- (open-window (window (connection-body obj)) link-rel))))
-
+ (on-new-builder-panel obj :open-ext :custom))
diff --git a/tools/clog-builder-settings.lisp b/tools/clog-builder-settings.lisp
index d05be76..8b1ce74 100644
--- a/tools/clog-builder-settings.lisp
+++ b/tools/clog-builder-settings.lisp
@@ -12,10 +12,12 @@
;; Open panels and files in new browser tabs by default
(defparameter *open-external* nil)
-;; Open files in browser popus instead of tabs if browser allows
+;; Open files in browser popups instead of tabs if browser allows
(defparameter *open-external-in-popup* nil)
-;; Open panels in browser popus instead of tabs if browser allows
+;; Open panel editors in browser popus instead of tabs if browser allows
(defparameter *open-external-panels-in-popup* nil)
+;; Open panels as popups by default
+(defparameter *open-panels-as-popups* nil)
;; Use emacs instead of the source-editor when openning external
(defparameter *open-external-with-emacs* nil)
;; Best Light Theme for Lisp
diff --git a/tools/clog-builder.lisp b/tools/clog-builder.lisp
index 1d0ff16..48c26af 100644
--- a/tools/clog-builder.lisp
+++ b/tools/clog-builder.lisp
@@ -352,11 +352,10 @@ clog-builder window.")
(win (create-gui-menu-drop-down menu :content "Window"))
(help (create-gui-menu-drop-down menu :content "Help")))
(declare (ignore icon))
- (create-gui-menu-item file :content "New CLOG-GUI Panel" :on-click 'on-new-builder-panel)
- (create-gui-menu-item file :content "New CLOG-WEB Page in New Tab" :on-click 'on-new-builder-page)
- (create-gui-menu-item file :content "New Basic HTML Page in New Tab" :on-click 'on-new-builder-basic-page)
- (create-gui-menu-item file :content "New CLOG-WEB Page Delayed in New Tab" :on-click 'on-new-builder-launch-page)
- (create-gui-menu-item file :content "New Custom Boot Page in New Tab" :on-click 'on-new-builder-custom)
+ (add-class menu "w3-small")
+ (create-gui-menu-item file :content "New CLOG Panel" :on-click 'on-new-builder-panel)
+ (create-gui-menu-item file :content "New CLOG Panel External Edit" :on-click 'on-new-builder-page)
+ (create-gui-menu-item file :content "New HTML Panel External Edit" :on-click 'on-new-builder-basic-page)
(create-gui-menu-item file :content "New Application Template" :on-click 'on-new-app-template)
(create-gui-menu-item src :content "Project Window" :on-click 'on-show-project)
(create-gui-menu-item src :content "Directory Window" :on-click 'on-dir-win)
@@ -367,10 +366,6 @@ clog-builder window.")
(open-window (window body) "/source-editor?open-file=%20")))
(create-gui-menu-item src :content "New System Browser" :on-click 'on-new-sys-browser)
(create-gui-menu-item src :content "New ASDF System Browser" :on-click 'on-new-asdf-browser)
- (create-gui-menu-item tools :content "Control CLOG Events" :on-click 'on-show-control-events-win)
- (create-gui-menu-item tools :content "Control JavaScript Events" :on-click 'on-show-control-js-events-win)
- (create-gui-menu-item tools :content "Control ParenScript Events" :on-click 'on-show-control-ps-events-win)
- (create-gui-menu-item tools :content "Directory Window" :on-click 'on-dir-win)
(create-gui-menu-item tools :content "List Callers" :on-click 'on-show-callers)
(create-gui-menu-item tools :content "List Callees" :on-click 'on-show-callees)
(create-gui-menu-item tools :content "Thread Viewer" :on-click 'on-show-thread-viewer)
@@ -484,10 +479,10 @@ instead of the project window will be displayed."
(setf port clog:*clog-port*)
(set-on-new-window 'on-new-builder :path "/builder")
(set-on-new-window 'on-new-db-admin :path "/dbadmin")
- (set-on-new-window 'on-attach-builder-page :path "/builder-page")
(set-on-new-window 'on-convert-image :path "/image-to-data")
(set-on-new-window 'on-open-panel-window :path "/panel-editor")
(set-on-new-window 'on-open-file-window :path "/source-editor")
+ (enable-clog-popup)
(when clogframe
(uiop:run-program (list "./clogframe"
"CLOG Builder"