diff --git a/tools/clog-builder-control-list.lisp b/tools/clog-builder-control-list.lisp index 05261fe..486f089 100644 --- a/tools/clog-builder-control-list.lisp +++ b/tools/clog-builder-control-list.lisp @@ -42,92 +42,70 @@ (defun on-show-control-list-win (obj) "Show control list for selecting and manipulating controls by name" - (let* ((app (connection-data-item obj "builder-app-data")) - (is-hidden nil) - (auto-mode nil) - (content (create-panel (connection-body obj) :positioning :fixed - :width 220 - :top 40 - :left 0 :bottom 0 - :class "w3-border-right")) - (side-panel (create-panel content :top 0 :right 0 :bottom 0 :width 10)) - (pin (create-div side-panel :content "☑" :class "w3-small")) - (sheight (floor (/ (height content) 2))) - (swidth (floor (width content))) - (divider (create-panel content :top sheight :height 10 :left 0 :right 10)) - (control-list (create-panel content :height (- sheight 10) :left 0 :bottom 0 :right 10)) - (pallete (create-select content)) - (adj-size 0)) - (set-geometry pallete :left 0 :top 0 :height sheight :width (- swidth 10)) - (setf (left-panel app) content) - (setf (hiddenp (left-panel app)) t) - (setf (background-color divider) :black) - (setf (tab-index divider) "-1") - (setf (cursor divider) :ns-resize) - (setf (background-color content) :gray) - (setf (background-color pallete) :gray) - (setf (color pallete) :white) - (setf (positioning pallete) :absolute) - (setf (size pallete) 2) - (setf (advisory-title pallete) (format nil " place static~% child to current selection")) - (setf (select-tool app) pallete) - (setf (overflow control-list) :auto) - (reset-control-pallete obj) - (setf (control-list-win app) control-list) - (setf (advisory-title content) - (format nil "Drag and drop order~%Double click non-focusable~%~ + (let* ((app (connection-data-item obj "builder-app-data"))) + (unless (controls-win app) + (let* ((win (create-gui-window obj :title "Controls" :has-pinner t :width 220)) + (content (window-content win)) + (sheight (floor (/ (height content) 2))) + (swidth (floor (width content))) + (divider (create-panel content :top sheight :height 10 :left 0 :right 10)) + (control-list (create-panel content :height (- sheight 10) :left 0 :bottom 0 :right 10)) + (pallete (create-select content)) + (adj-size 0)) + (add-class content "w3-small") + (setf (controls-win app) win) + (setf (control-list-win app) control-list) + (setf (select-tool app) pallete) + (set-on-window-close win (lambda (obj) + (setf (controls-win app) nil) + (setf (select-tool app) nil) + (setf (control-list-win app) nil))) + (reset-control-pallete pallete) + (window-toggle-pinned win :state t) + (set-geometry win :units "" :top "33px" :left 0 :height "" :bottom "5px" :right "") + (set-geometry pallete :left 0 :top 0 :height sheight :right 0);:width (- swidth 10)) + (setf (background-color divider) :black) + (setf (tab-index divider) "-1") + (setf (cursor divider) :ns-resize) + (setf (background-color pallete) :silver) + (setf (background-color content) :silver) + (setf (positioning pallete) :absolute) + (setf (size pallete) 2) + (setf (advisory-title pallete) (format nil " place static~% child to current selection")) + (setf (overflow control-list) :auto) + (reset-control-pallete obj) + (setf (advisory-title content) + (format nil "Drag and drop order~%Double click non-focusable~%~ place as static~% child to current selection")) - (setf (background-color side-panel) :black) - (flet ((on-size (obj) - (declare (ignore obj)) - (setf sheight (floor (/ (height content) 2))) - (when (and (> (- sheight adj-size) 5) - (> (+ (- sheight 10) adj-size) 5)) - (set-geometry pallete :height (- sheight adj-size)) - (set-geometry divider :top (- sheight adj-size)) - (set-geometry control-list :height (+ (- sheight 10) adj-size))))) - (set-on-resize (window (connection-body obj)) #'on-size) - (set-on-full-screen-change (html-document (connection-body obj)) #'on-size) - (set-on-orientation-change (window (connection-body obj)) #'on-size) - (set-on-pointer-down divider (lambda (obj data) - (setf (getf data :client-y) (+ adj-size - (getf data :client-y))) - (set-on-pointer-up (connection-body obj) - (lambda (obj data) - (declare (ignore data)) - (set-on-pointer-up (connection-body obj) nil) - (set-on-pointer-move (connection-body obj) nil))) - (set-on-pointer-move (connection-body obj) - (lambda (obj new-data) - (setf adj-size (- (getf data :client-y) - (getf new-data :client-y))) - (on-size obj)))) - :capture-pointer t)) - (set-on-click side-panel (lambda (obj) - (declare (ignore obj)) - (cond (auto-mode - (setf auto-mode nil) - (setf (text-value pin) "☑") - (setf (width content) "220px") - (setf (hiddenp pallete) nil) - (setf is-hidden nil)) - (t - (setf auto-mode t) - (setf (text-value pin) "☐") - (setf (width content) "10px") - (setf (hiddenp pallete) t) - (setf is-hidden t))))) - (set-on-mouse-leave side-panel (lambda (obj) - (declare (ignore obj)) - (when auto-mode - (cond (is-hidden - (setf (width content) "220px") - (setf (hiddenp pallete) nil) - (setf is-hidden nil)) - (t - (setf (width content) "10px") - (setf (hiddenp pallete) t) - (setf is-hidden t)))))))) + (flet ((on-size (obj) + (declare (ignore obj)) + (setf sheight (floor (/ (height content) 2))) + (when (and (> (- sheight adj-size) 5) + (> (+ (- sheight 10) adj-size) 5)) + (set-geometry pallete :height (- sheight adj-size)) + (set-geometry divider :top (- sheight adj-size)) + (set-geometry control-list :height (+ (- sheight 10) adj-size))))) + (set-on-resize (window (connection-body obj)) #'on-size) + (set-on-window-size win #'on-size) + (set-on-window-move win #'on-size) + (set-on-full-screen-change (html-document (connection-body obj)) #'on-size) + (set-on-orientation-change (window (connection-body obj)) #'on-size) + (set-on-pointer-down divider (lambda (obj data) + (setf (getf data :client-y) (+ adj-size + (getf data :client-y))) + (set-on-pointer-up (connection-body obj) + (lambda (obj data) + (declare (ignore data)) + (set-on-pointer-up (connection-body obj) nil) + (set-on-pointer-move (connection-body obj) nil))) + (set-on-pointer-move (connection-body obj) + (lambda (obj new-data) + (setf adj-size (- (getf data :client-y) + (getf new-data :client-y))) + (on-size obj)))) + :capture-pointer t) + (on-size win)))) + (window-focus (controls-win app)))) (defun on-populate-control-list-win (content &key win) "Populate the control-list-window to allow drag and drop adjust of order diff --git a/tools/clog-builder-control-properties.lisp b/tools/clog-builder-control-properties.lisp index b682a6d..4aba775 100644 --- a/tools/clog-builder-control-properties.lisp +++ b/tools/clog-builder-control-properties.lisp @@ -2,48 +2,23 @@ (defun on-show-control-properties-win (obj) "Show control properties window" - (let* ((app (connection-data-item obj "builder-app-data")) - (is-hidden nil) - (auto-mode nil) - (panel (create-panel (connection-body obj) :positioning :fixed - :width 400 - :top 40 - :right 0 :bottom 0 - :class "w3-border-left")) - (content (create-panel panel :width 390 :top 0 :right 0 :bottom 0)) - (side-panel (create-panel panel :top 0 :left 0 :bottom 0 :width 10)) - (pin (create-div side-panel :content "☑" :class "w3-small")) - (control-list (create-table content))) - (setf (background-color side-panel) :black) - (setf (background-color content) :gray) - (setf (right-panel app) panel) - (setf (hiddenp (right-panel app)) t) - (setf (control-properties-win app) content) - (setf (properties-list app) control-list) - (set-on-click side-panel (lambda (obj) - (declare (ignore obj)) - (cond (auto-mode - (setf auto-mode nil) - (setf (text-value pin) "☑") - (setf (width panel) "400px") - (setf is-hidden nil)) - (t - (setf auto-mode t) - (setf (text-value pin) "☐") - (setf (width panel) "400px") - (setf is-hidden nil))))) - (set-on-mouse-leave side-panel (lambda (obj) - (declare (ignore obj)) - (when auto-mode - (cond (is-hidden - (setf (width panel) "400px") - (setf is-hidden nil)) - (t - (setf (width panel) "10px") - (setf is-hidden t)))))) - (setf (overflow content) :auto) - (setf (positioning control-list) :absolute) - (set-geometry control-list :left 0 :top 0 :right 0))) + (let ((app (connection-data-item obj "builder-app-data"))) + (unless (control-properties-win app) + (let* ((win (create-gui-window obj :title "Properties" :has-pinner t :width 400)) + (content (window-content win)) + (control-list (create-table content))) + (add-class content "w3-small") + (set-on-window-close win (lambda (obj) + (setf (control-properties-win app) nil))) + (window-toggle-pinned win :state t) + (setf (control-properties-win app) win) + (setf (properties-list app) control-list) + (setf (background-color content) :silver) + (setf (overflow content) :auto) + (setf (positioning control-list) :absolute) + (set-geometry win :units "" :top "33px" :left "" :height "" :bottom "5px" :right "0px") + (set-geometry control-list :left 0 :top 0 :right 0))) + (window-focus (control-properties-win app)))) (defun on-populate-control-properties-win (obj &key win) "Populate the control properties for the current control" diff --git a/tools/clog-builder-panels.lisp b/tools/clog-builder-panels.lisp index 189bce1..114522f 100644 --- a/tools/clog-builder-panels.lisp +++ b/tools/clog-builder-panels.lisp @@ -131,38 +131,39 @@ ;; any click on panel directly will focus window (when win (window-focus win)) - (let* ((control-record (control-info (value (select-tool app)))) - (control-type-name (getf control-record :create-type))) - (cond ((eq control-type-name :custom-query) - (input-dialog win "Enter html (must have an outer element):" - (lambda (custom-query) - (when custom-query - (do-drop-new-control - app content data - :win win - :custom-query custom-query))) - :width 500 - :height 300 - :rows 5 - :size 40 - :title "Custom HTML Control" - :default-value (getf control-record :create-content))) - ((eq control-type-name :custom-block) - (input-dialog win "Enter html to create control:" - (lambda (custom-query) - (when custom-query - (do-drop-new-control - app content data - :win win - :custom-query custom-query))) - :width 500 - :height 300 - :rows 5 - :size 40 - :title "Custom HTML Block" - :default-value (getf control-record :create-content))) - (t - (do-drop-new-control app content data :win win))))) + (when (select-tool app) + (let* ((control-record (control-info (value (select-tool app)))) + (control-type-name (getf control-record :create-type))) + (cond ((eq control-type-name :custom-query) + (input-dialog win "Enter html (must have an outer element):" + (lambda (custom-query) + (when custom-query + (do-drop-new-control + app content data + :win win + :custom-query custom-query))) + :width 500 + :height 300 + :rows 5 + :size 40 + :title "Custom HTML Control" + :default-value (getf control-record :create-content))) + ((eq control-type-name :custom-block) + (input-dialog win "Enter html to create control:" + (lambda (custom-query) + (when custom-query + (do-drop-new-control + app content data + :win win + :custom-query custom-query))) + :width 500 + :height 300 + :rows 5 + :size 40 + :title "Custom HTML Block" + :default-value (getf control-record :create-content))) + (t + (do-drop-new-control app content data :win win)))))) (defun do-drop-new-control (app content data &key win custom-query) "Create new control dropped at event DATA on CONTENT of WIN)" @@ -311,7 +312,8 @@ (declare (ignore obj)) (let ((last (current-control app)) (shift (getf data :shift-key))) - (if (not (equal (value (select-tool app)) "")) + (if (and (select-tool app) + (not (equal (value (select-tool app)) ""))) (when (do-drop-new-control app content data :win win) (incf-next-id content))) (cond ((and last @@ -521,7 +523,9 @@ not a temporarily attached one when using select-control." (m-rndr (create-gui-menu-item m-lisp :content "render form to lisp")) (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")) + (m-events (create-gui-menu-drop-down menu :content "controls")) + (tmp (create-gui-menu-item m-events :content "show control properties" :on-click 'on-show-control-properties-win)) + (tmp (create-gui-menu-item m-events :content "show controls window" :on-click 'on-show-control-list-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)) @@ -643,6 +647,8 @@ not a temporarily attached one when using select-control." (setf (attribute content "data-custom-slots") "") ;; activate associated windows on open (on-show-control-events-win win) + (on-show-control-properties-win win) + (on-show-control-list-win win) (panel-mode win t) (on-populate-control-properties-win content :win win) (on-populate-control-list-win content :win win) diff --git a/tools/clog-builder.lisp b/tools/clog-builder.lisp index 48c26af..5252a29 100644 --- a/tools/clog-builder.lisp +++ b/tools/clog-builder.lisp @@ -44,11 +44,12 @@ replaced. (Exported)" (defun reset-control-pallete (panel) (let* ((app (connection-data-item panel "builder-app-data")) (pallete (select-tool app))) - (setf (inner-html pallete) "") - (dolist (control *supported-controls*) - (if (equal (getf control :name) "group") - (add-select-optgroup pallete (getf control :description)) - (add-select-option pallete (getf control :name) (getf control :description)))))) + (when pallete + (setf (inner-html pallete) "") + (dolist (control *supported-controls*) + (if (equal (getf control :name) "group") + (add-select-optgroup pallete (getf control :description)) + (add-select-option pallete (getf control :name) (getf control :description))))))) ;; Global Internal Config @@ -155,6 +156,10 @@ clog-builder window.") :accessor control-ps-events-win :initform nil :documentation "Current control events window") + (controls-win + :accessor controls-win + :initform nil + :documentation "Current controls window") (control-list-win :accessor control-list-win :initform nil @@ -193,9 +198,12 @@ clog-builder window.") (defun panel-mode (obj bool) "Set the status for display or hiding the side panels." - (let ((app (connection-data-item obj "builder-app-data"))) - (setf (hiddenp (right-panel app)) (not bool)) - (setf (hiddenp (left-panel app)) (not bool)))) + (when obj + (let ((app (connection-data-item obj "builder-app-data"))) + (when (right-panel app) + (setf (hiddenp (right-panel app)) (not bool))) + (when (left-panel app) + (setf (hiddenp (left-panel app)) (not bool)))))) (defun on-help-about-builder (obj) "Open about box" @@ -423,8 +431,6 @@ clog-builder window.") (open-window (window body) "https://www.w3schools.com/w3css/"))) (create-gui-menu-item help :content "About CLOG Builder" :on-click #'on-help-about-builder) (create-gui-menu-full-screen menu)) - (on-show-control-properties-win body) - (on-show-control-list-win body) (on-show-copy-history-win body) (cond (open-panel