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

Simplication of externaly editting panels

Browse source
This commit is contained in:
David Botton 2024-03-21 16:58:30 -04:00
parent a57cdff3d6
commit 2fa7493a7a
4 changed files with 178 additions and 512 deletions
Download patch file Download diff file Expand all files Collapse all files

173
tools/clog-builder-control-list.lisp
View file

@ -132,92 +132,93 @@
(defun on-populate-control-list-win (content &key win) (defun on-populate-control-list-win (content &key win)
"Populate the control-list-window to allow drag and drop adjust of order "Populate the control-list-window to allow drag and drop adjust of order
of controls and double click to select control." of controls and double click to select control."
(with-sync-event (content) (when content
(let ((app (connection-data-item content "builder-app-data"))) (with-sync-event (content)
(let ((panel-id (html-id content)) (let ((app (connection-data-item content "builder-app-data")))
(last-ctl nil)) (let ((panel-id (html-id content))
(when (control-list-win app) (last-ctl nil))
(let ((lwin (control-list-win app))) (when (control-list-win app)
(setf (inner-html lwin) "") (let ((lwin (control-list-win app)))
(set-on-mouse-click (create-div lwin :content (attribute content "data-clog-name")) (setf (inner-html lwin) "")
(lambda (obj data) (set-on-mouse-click (create-div lwin :content (attribute content "data-clog-name"))
(declare (ignore obj data)) (lambda (obj data)
(deselect-current-control app) (declare (ignore obj data))
(on-populate-control-properties-win content :win win) (deselect-current-control app)
(on-populate-control-list-win content :win win))) (on-populate-control-properties-win content :win win)
(labels ((add-siblings (control sim) (on-populate-control-list-win content :win win)))
(let (dln dcc) (labels ((add-siblings (control sim)
(loop (let (dln dcc)
(when (equal (html-id control) "undefined") (return)) (loop
(setf dcc (attribute control "data-clog-composite-control")) (when (equal (html-id control) "undefined") (return))
(setf dln (attribute control "data-clog-name")) (setf dcc (attribute control "data-clog-composite-control"))
(unless (equal dln "undefined") (setf dln (attribute control "data-clog-name"))
(let ((list-item (create-div lwin :content (format nil "↕ ~A~A" sim dln))) (unless (equal dln "undefined")
(status (hiddenp (get-placer control)))) (let ((list-item (create-div lwin :content (format nil "↕ ~A~A" sim dln)))
(if status (status (hiddenp (get-placer control))))
(setf (color list-item) :darkred) (if status
(setf (background-color list-item) :grey)) (setf (color list-item) :darkred)
(setf (draggablep list-item) t) (setf (background-color list-item) :grey))
(setf (attribute list-item "data-clog-control") (html-id control)) (setf (draggablep list-item) t)
;; click to select item (setf (attribute list-item "data-clog-control") (html-id control))
(set-on-mouse-down list-item ;; click to select item
(lambda (obj data) (set-on-mouse-down list-item
(let* ((html-id (attribute obj "data-clog-control")) (lambda (obj data)
(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)
(let* ((html-id (attribute obj "data-clog-control")) (let* ((html-id (attribute obj "data-clog-control"))
(control (get-from-control-list app (control (get-from-control-list app
panel-id panel-id
html-id)) html-id)))
(placer (get-placer control)) (cond ((or (getf data :shift-key)
(state (hiddenp placer))) (getf data :ctrl-key)
(setf (hiddenp placer) (not state)) (getf data :meta-key))
(select-control control) (when (drop-new-control app content data)
(on-populate-control-list-win content :win win)))) (incf-next-id content)))
;; drag and drop to change (t
(set-on-drag-over list-item (lambda (obj)(declare (ignore obj))())) (when last-ctl
(set-on-drop list-item (set-border last-ctl "0px" :dotted :blue))
(lambda (obj data) (set-border list-item "2px" :dotted :blue)
(let* ((id (attribute obj "data-clog-control")) (setf last-ctl list-item)
(control1 (get-from-control-list app (select-control control))))))
panel-id (set-on-double-click list-item
id)) (lambda (obj)
(control2 (get-from-control-list app (let* ((html-id (attribute obj "data-clog-control"))
panel-id (control (get-from-control-list app
(getf data :drag-data))) panel-id
(placer1 (get-placer control1)) html-id))
(placer2 (get-placer control2))) (placer (get-placer control))
(if (getf data :shift-key) (state (hiddenp placer)))
(place-inside-bottom-of control1 control2) (setf (hiddenp placer) (not state))
(place-before control1 control2)) (select-control control)
(place-after control2 placer2) (on-populate-control-list-win content :win win))))
(set-geometry placer1 :top (position-top control1) ;; drag and drop to change
:left (position-left control1) (set-on-drag-over list-item (lambda (obj)(declare (ignore obj))()))
:width (client-width control1) (set-on-drop list-item
:height (client-height control1)) (lambda (obj data)
(set-geometry placer2 :top (position-top control2) (let* ((id (attribute obj "data-clog-control"))
:left (position-left control2) (control1 (get-from-control-list app
:width (client-width control2) panel-id
:height (client-height control2)) id))
(on-populate-control-properties-win content :win win) (control2 (get-from-control-list app
(on-populate-control-list-win content :win win)))) panel-id
(set-on-drag-start list-item (lambda (obj)(declare (ignore obj))()) (getf data :drag-data)))
:drag-data (html-id control)) (placer1 (get-placer control1))
(when (equal dcc "undefined") ; when t is not a composite control (placer2 (get-placer control2)))
(add-siblings (first-child control) (format nil "~A→" sim))))) (if (getf data :shift-key)
(setf control (next-sibling control)))))) (place-inside-bottom-of control1 control2)
(add-siblings (first-child content) "")))))))) (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) "")))))))))

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

@ -490,11 +490,12 @@ not a temporarily attached one when using select-control."
"") "")
:name "_blank")) :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" "Open new panel"
(unless (and open-file (unless (and open-file
(window-to-top-by-param obj open-file)) (window-to-top-by-param obj open-file))
(let* ((app (connection-data-item obj "builder-app-data")) (let* ((app (connection-data-item obj "builder-app-data"))
ext-panel
(win (create-gui-window obj :top 40 :left 225 (win (create-gui-window obj :top 40 :left 225
:width 645 :height 430 :width 645 :height 430
:client-movement *client-side-movement*)) :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-load (create-gui-menu-item m-file :content "load"))
(m-save (create-gui-menu-item m-file :content "save (cmd/ctrl-s)")) (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-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-edit (create-gui-menu-drop-down menu :content "Edit"))
(m-undo (create-gui-menu-item m-edit :content "undo")) (m-undo (create-gui-menu-item m-edit :content "undo"))
(m-redo (create-gui-menu-item m-edit :content "redo")) (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-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-test (create-gui-menu-item m-lisp :content "evaluate and test"))
(m-events (create-gui-menu-drop-down menu :content "Events")) (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 "show 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 "show 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 ParenScript events" :on-click 'on-show-control-ps-events-win))
(m-help (create-gui-menu-drop-down menu :content "Help")) (m-help (create-gui-menu-drop-down menu :content "Help"))
(m-helpk (create-gui-menu-item m-help :content "quick start")) (m-helpk (create-gui-menu-item m-help :content "quick start"))
(tool-bar (create-div (top-panel box))) (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-save) "12px")
(setf (height btn-load) "12px") (setf (height btn-load) "12px")
(setf (height btn-help) "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-next-id content 1)
(setf (overflow content) :auto) (setf (overflow content) :auto)
(init-control-list app panel-id) (init-control-list app panel-id)
@ -605,11 +660,10 @@ not a temporarily attached one when using select-control."
(set-on-window-close win (set-on-window-close win
(lambda (obj) (lambda (obj)
(declare (ignore obj)) (declare (ignore obj))
;; clear associated windows on close
(setf (current-control app) nil) (setf (current-control app) nil)
(destroy-control-list app panel-id) (destroy-control-list app panel-id)
(on-populate-control-properties-win content :win win) (when ext-panel
(on-populate-control-list-win content :win win))) (close-window (window ext-panel)))))
(set-on-window-size-done win (set-on-window-size-done win
(lambda (obj) (lambda (obj)
(declare (ignore obj)) (declare (ignore obj))
@ -742,6 +796,8 @@ not a temporarily attached one when using select-control."
(clrhash (get-control-list app panel-id)) (clrhash (get-control-list app panel-id))
(on-populate-loaded-window content :win win) (on-populate-loaded-window content :win win)
(setf (window-title win) (attribute content "data-clog-name")) (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) (setf (window-param win) fname)
(on-populate-control-list-win content :win win)) (on-populate-control-list-win content :win win))
(load-file (obj) (load-file (obj)
@ -852,6 +908,21 @@ not a temporarily attached one when using select-control."
(save obj nil))) (save obj nil)))
(set-on-click m-saveas (lambda (obj) (set-on-click m-saveas (lambda (obj)
(save obj nil :save-as t))) (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 btn-test #'eval-test)
(set-on-click m-test #'eval-test) (set-on-click m-test #'eval-test)
(set-on-mouse-click btn-rndr (lambda (obj data) (render obj data))) (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) (when (drop-new-control app content data :win win)
(incf-next-id content)))))))) (incf-next-id content))))))))
(defun on-attach-builder-custom (body) (defun on-new-builder-page (obj &key custom-boot url-launch)
"New custom builder page has attached" "Open new page"
(let* ((params (form-get-data body)) (on-new-builder-panel obj :open-ext t))
(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
"<br><center>Drop and work with controls on it's window.</center>")
;; 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=$('<div />').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-basic-page (obj) (defun on-new-builder-basic-page (obj)
"Menu item to open new basic HTML page" "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-panel obj :open-ext :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 "<br><center><button>
~A
</button></center>" btn-txt)
:link link))
(txt-link (create-div txt-area
:content (format nil "<br><center>~A</center>" 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))))

6
tools/clog-builder-settings.lisp
View file

@ -12,10 +12,12 @@
;; Open panels and files in new browser tabs by default ;; Open panels and files in new browser tabs by default
(defparameter *open-external* nil) (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) (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) (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 ;; Use emacs instead of the source-editor when openning external
(defparameter *open-external-with-emacs* nil) (defparameter *open-external-with-emacs* nil)
;; Best Light Theme for Lisp ;; Best Light Theme for Lisp

15
tools/clog-builder.lisp
View file

@ -352,11 +352,10 @@ clog-builder window.")
(win (create-gui-menu-drop-down menu :content "Window")) (win (create-gui-menu-drop-down menu :content "Window"))
(help (create-gui-menu-drop-down menu :content "Help"))) (help (create-gui-menu-drop-down menu :content "Help")))
(declare (ignore icon)) (declare (ignore icon))
(create-gui-menu-item file :content "New CLOG-GUI Panel" :on-click 'on-new-builder-panel) (add-class menu "w3-small")
(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 CLOG Panel" :on-click 'on-new-builder-panel)
(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 Panel External Edit" :on-click 'on-new-builder-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 HTML Panel External Edit" :on-click 'on-new-builder-basic-page)
(create-gui-menu-item file :content "New Custom Boot Page in New Tab" :on-click 'on-new-builder-custom)
(create-gui-menu-item file :content "New Application Template" :on-click 'on-new-app-template) (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 "Project Window" :on-click 'on-show-project)
(create-gui-menu-item src :content "Directory Window" :on-click 'on-dir-win) (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"))) (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 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 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 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 "List Callees" :on-click 'on-show-callees)
(create-gui-menu-item tools :content "Thread Viewer" :on-click 'on-show-thread-viewer) (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*) (setf port clog:*clog-port*)
(set-on-new-window 'on-new-builder :path "/builder") (set-on-new-window 'on-new-builder :path "/builder")
(set-on-new-window 'on-new-db-admin :path "/dbadmin") (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-convert-image :path "/image-to-data")
(set-on-new-window 'on-open-panel-window :path "/panel-editor") (set-on-new-window 'on-open-panel-window :path "/panel-editor")
(set-on-new-window 'on-open-file-window :path "/source-editor") (set-on-new-window 'on-open-file-window :path "/source-editor")
(enable-clog-popup)
(when clogframe (when clogframe
(uiop:run-program (list "./clogframe" (uiop:run-program (list "./clogframe"
"CLOG Builder" "CLOG Builder"