From bf446f6f9fd5c69d9be83da4b20cb61039db9d12 Mon Sep 17 00:00:00 2001 From: David Botton Date: Sun, 24 Mar 2024 01:58:42 -0400 Subject: [PATCH] More design work, added popup panels option to project view --- tools/clog-builder-control-events.lisp | 172 ++++++-------- tools/clog-builder-control-list.lisp | 183 +++++++-------- tools/clog-builder-control-properties.lisp | 249 +++++++++++---------- tools/clog-builder-panels.lisp | 31 +-- tools/clog-builder-projects.lisp | 6 +- tools/clog-builder.lisp | 22 +- tools/panel-projects.clog | 6 +- tools/panel-projects.lisp | 97 ++++---- 8 files changed, 375 insertions(+), 391 deletions(-) diff --git a/tools/clog-builder-control-events.lisp b/tools/clog-builder-control-events.lisp index c0672be..0881e87 100644 --- a/tools/clog-builder-control-events.lisp +++ b/tools/clog-builder-control-events.lisp @@ -7,11 +7,11 @@ (window-focus (control-events-win app)) (let* ((win (create-gui-window obj :title "Control CLOG Events" :left 225 - :top 480 :height 200 :width 645 :has-pinner t :client-movement *client-side-movement*)) (content (window-content win)) status) + (set-geometry win :top "" :bottom 0) (setf (current-editor-is-lisp app) t) (set-on-window-focus win (lambda (obj) @@ -42,15 +42,6 @@ (set-on-window-size-done win (lambda (obj) (declare (ignore obj)) (clog-ace:resize (event-editor app)))) - (panel-mode win t) - (set-on-window-focus win - (lambda (obj) - (declare (ignore obj)) - (panel-mode win t))) - (set-on-window-blur win - (lambda (obj) - (declare (ignore obj)) - (panel-mode win nil))) (set-on-window-close win (lambda (obj) (declare (ignore obj)) (setf (event-editor app) nil) @@ -65,11 +56,11 @@ (window-focus (control-js-events-win app)) (let* ((win (create-gui-window obj :title "Control Client JavaScript Events" :left 225 - :top 700 :height 200 :width 645 :has-pinner t :client-movement *client-side-movement*)) (content (window-content win)) status) + (set-geometry win :top "" :bottom 0) (setf (current-editor-is-lisp app) nil) (set-on-window-focus win (lambda (obj) @@ -102,15 +93,6 @@ (set-on-window-size-done win (lambda (obj) (declare (ignore obj)) (clog-ace:resize (event-js-editor app)))) - (panel-mode win t) - (set-on-window-focus win - (lambda (obj) - (declare (ignore obj)) - (panel-mode win t))) - (set-on-window-blur win - (lambda (obj) - (declare (ignore obj)) - (panel-mode win nil))) (set-on-window-close win (lambda (obj) (declare (ignore obj)) (setf (event-js-editor app) nil) @@ -125,11 +107,11 @@ (window-focus (control-ps-events-win app)) (let* ((win (create-gui-window obj :title "Control Client ParenScript Events" :left 225 - :top 700 :height 200 :width 645 :has-pinner t :client-movement *client-side-movement*)) (content (window-content win)) status) + (set-geometry win :top "" :bottom 0) (setf (current-editor-is-lisp app) nil) (set-on-window-focus win (lambda (obj) @@ -161,15 +143,6 @@ (set-on-window-size-done win (lambda (obj) (declare (ignore obj)) (clog-ace:resize (event-ps-editor app)))) - (panel-mode win t) - (set-on-window-focus win - (lambda (obj) - (declare (ignore obj)) - (panel-mode win t))) - (set-on-window-blur win - (lambda (obj) - (declare (ignore obj)) - (panel-mode win nil))) (set-on-window-close win (lambda (obj) (declare (ignore obj)) (setf (event-ps-editor app) nil) @@ -179,75 +152,76 @@ (defun on-populate-control-events-win (obj) "Populate the control events for the current control" - (let* ((app (connection-data-item obj "builder-app-data")) - (event-win (control-events-win app)) - (elist (events-list app)) - (control (current-control app))) - (when event-win - (set-on-blur (event-editor app) nil) - (set-on-change elist nil) - (setf (inner-html elist) "") - (remove-attribute elist "data-current-event") - (setf (text-value (event-editor app)) "") - (setf (clog-ace:read-only-p (event-editor app)) t) - (when control - (let ((info (control-info (attribute control "data-clog-type")))) - (labels ((populate-options (&key (current "")) - (set-on-change elist nil) - (setf (inner-html elist) "") - (add-select-option elist "" "Select Event") - (dolist (event (getf info :events)) - (let ((attr (format nil "data-~A" (getf event :name)))) - (add-select-option elist - (getf event :name) - (format nil "~A ~A (panel ~A)" - (if (has-attribute control attr) - "■‎ " - "□ ") - (getf event :name) - (getf event :parameters)) - :selected (equal attr current)))) - (set-on-change elist #'on-change)) - (on-blur (obj) - (declare (ignore obj)) - (set-on-blur (event-editor app) nil) - (let ((attr (attribute elist "data-current-event"))) - (unless (equalp attr "undefined") - (let ((opt (select-text elist)) - (txt (text-value (event-editor app)))) - (setf (char opt 0) #\space) - (setf opt (string-left-trim "#\space" opt)) - (cond ((or (equal txt "") - (equalp txt "undefined")) - (setf (select-text elist) (format nil "~A ~A" (code-char 9633) opt)) - (remove-attribute control attr)) - (t - (setf (select-text elist) (format nil "~A ~A" (code-char 9632) opt)) - (setf (attribute control attr) txt)))) - (jquery-execute (get-placer control) "trigger('clog-builder-snap-shot')"))) - (set-on-blur (event-editor app) #'on-blur)) - (on-change (obj) - (declare (ignore obj)) - (set-on-blur (event-editor app) nil) - (let ((event (select-value elist "clog-events"))) - (cond ((equal event "") - (set-on-blur (event-editor app) nil) - (remove-attribute elist "data-current-event") - (setf (text-value (event-editor app)) "") - (setf (clog-ace:read-only-p (event-editor app)) t)) - (t - (setf (clog-ace:read-only-p (event-editor app)) nil) - (let* ((attr (format nil "data-~A" event)) - (txt (attribute control attr))) - (setf (text-value (event-editor app)) - (if (equalp txt "undefined") - "" - txt)) - (setf (attribute elist "data-current-event") attr) - (set-on-blur (event-editor app) #'on-blur))))))) - (populate-options)))))) - (on-populate-control-ps-events-win obj) - (on-populate-control-js-events-win obj)) + (when obj + (let* ((app (connection-data-item obj "builder-app-data")) + (event-win (control-events-win app)) + (elist (events-list app)) + (control (current-control app))) + (when event-win + (set-on-blur (event-editor app) nil) + (set-on-change elist nil) + (setf (inner-html elist) "") + (remove-attribute elist "data-current-event") + (setf (text-value (event-editor app)) "") + (setf (clog-ace:read-only-p (event-editor app)) t) + (when control + (let ((info (control-info (attribute control "data-clog-type")))) + (labels ((populate-options (&key (current "")) + (set-on-change elist nil) + (setf (inner-html elist) "") + (add-select-option elist "" "Select Event") + (dolist (event (getf info :events)) + (let ((attr (format nil "data-~A" (getf event :name)))) + (add-select-option elist + (getf event :name) + (format nil "~A ~A (panel ~A)" + (if (has-attribute control attr) + "■‎ " + "□ ") + (getf event :name) + (getf event :parameters)) + :selected (equal attr current)))) + (set-on-change elist #'on-change)) + (on-blur (obj) + (declare (ignore obj)) + (set-on-blur (event-editor app) nil) + (let ((attr (attribute elist "data-current-event"))) + (unless (equalp attr "undefined") + (let ((opt (select-text elist)) + (txt (text-value (event-editor app)))) + (setf (char opt 0) #\space) + (setf opt (string-left-trim "#\space" opt)) + (cond ((or (equal txt "") + (equalp txt "undefined")) + (setf (select-text elist) (format nil "~A ~A" (code-char 9633) opt)) + (remove-attribute control attr)) + (t + (setf (select-text elist) (format nil "~A ~A" (code-char 9632) opt)) + (setf (attribute control attr) txt)))) + (jquery-execute (get-placer control) "trigger('clog-builder-snap-shot')"))) + (set-on-blur (event-editor app) #'on-blur)) + (on-change (obj) + (declare (ignore obj)) + (set-on-blur (event-editor app) nil) + (let ((event (select-value elist "clog-events"))) + (cond ((equal event "") + (set-on-blur (event-editor app) nil) + (remove-attribute elist "data-current-event") + (setf (text-value (event-editor app)) "") + (setf (clog-ace:read-only-p (event-editor app)) t)) + (t + (setf (clog-ace:read-only-p (event-editor app)) nil) + (let* ((attr (format nil "data-~A" event)) + (txt (attribute control attr))) + (setf (text-value (event-editor app)) + (if (equalp txt "undefined") + "" + txt)) + (setf (attribute elist "data-current-event") attr) + (set-on-blur (event-editor app) #'on-blur))))))) + (populate-options)))))) + (on-populate-control-ps-events-win obj) + (on-populate-control-js-events-win obj))) (defun on-populate-control-js-events-win (obj) "Populate the control js events for the current control" diff --git a/tools/clog-builder-control-list.lisp b/tools/clog-builder-control-list.lisp index 4d5f39e..eab2230 100644 --- a/tools/clog-builder-control-list.lisp +++ b/tools/clog-builder-control-list.lisp @@ -109,97 +109,100 @@ (on-size win)))) (window-focus (controls-win app)))) -(defun on-populate-control-list-win (content &key win) +(defun on-populate-control-list-win (content &key win clear) "Populate the control-list-window to allow drag and drop adjust of order of controls and double click to select control." (when content - (with-sync-event (content) - (let ((app (connection-data-item content "builder-app-data"))) - (let ((panel-id (html-id content)) - (last-ctl nil)) + (let ((app (connection-data-item content "builder-app-data"))) + (if clear (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 (or (equal dln "undefined") - (eq dln nil)) - (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) - (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) ""))))))))) + (setf (inner-html (control-list-win app)) "")) + (with-sync-event (content) + (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 (or (equal dln "undefined") + (eq dln nil)) + (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) + (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-control-properties.lisp b/tools/clog-builder-control-properties.lisp index b7f5ece..ce14d5a 100644 --- a/tools/clog-builder-control-properties.lisp +++ b/tools/clog-builder-control-properties.lisp @@ -22,129 +22,132 @@ (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) +(defun on-populate-control-properties-win (obj &key win clear) "Populate the control properties for the current control" ;; obj if current-control is nil must be content - (with-sync-event (obj) - (bordeaux-threads:make-thread (lambda () (on-populate-control-events-win obj))) + (when obj (let ((app (connection-data-item obj "builder-app-data"))) - (let* ((prop-win (control-properties-win app)) - (control (if (current-control app) - (current-control app) - obj)) - (placer (when control - (get-placer control))) - (table (properties-list app))) - (when prop-win - (setf (inner-html table) "") - (let ((info (control-info (attribute control "data-clog-type"))) - props) - (dolist (prop (reverse (getf info :properties))) - (cond ((eq (third prop) :style) - (push `(,(getf prop :name) ,(style control (getf prop :style)) ,(getf prop :setup) - ,(lambda (obj) - (setf (style control (getf prop :style)) (text obj)))) - props)) - ((or (eq (third prop) :get) - (eq (third prop) :set) - (eq (third prop) :setup)) - (push `(,(getf prop :name) ,(when (getf prop :get) - (funcall (getf prop :get) control)) - ,(getf prop :setup) - ,(lambda (obj) - (when (getf prop :set) - (funcall (getf prop :set) control obj)))) - props)) - ((eq (third prop) :prop) - (push `(,(getf prop :name) ,(property control (getf prop :prop)) ,(getf prop :setup) - ,(lambda (obj) - (setf (property control (getf prop :prop)) (text obj)))) - props)) - ((eq (third prop) :attr) - (push `(,(getf prop :name) ,(attribute control (getf prop :attr)) ,(getf prop :setup) - ,(lambda (obj) - (setf (attribute control (getf prop :attr)) (text obj)))) - props)) - (t (print "Configuration error.")))) - (when (current-control app) - (let* (panel-controls - (cname (attribute control "data-clog-name")) - (ctype (attribute control "data-clog-type")) - (panel-id (attribute placer "data-panel-id")) - (panel (attach-as-child obj panel-id))) - (maphash (lambda (k v) - (declare (ignore k)) - (let ((n (attribute v "data-clog-name")) - (p (attribute (parent-element v) "data-clog-name"))) - (unless (or (equal cname n) - (equal cname p)) - (push n panel-controls)))) - (get-control-list app panel-id)) - (push (attribute panel "data-clog-name") panel-controls) - (push - `("parent" nil - ,(lambda (control td1 td2) - (declare (ignore td1)) - (let ((dd (create-select td2)) - (v (attribute (parent-element control) "data-clog-name"))) - (set-geometry dd :width "100%") - (add-select-options dd panel-controls) - (setf (value dd) v) - (set-on-change dd - (lambda (obj) - (place-inside-bottom-of - (attach-as-child control - (js-query - control - (format nil "$(\"[data-clog-name='~A']\").attr('id')" - (value obj)))) - control) - (place-after control placer) - (on-populate-control-list-win panel :win win)))) - nil) - nil) - props) - (push - `("type" ,ctype - :read-only - nil - nil) - props) - (push - `("name" ,cname - nil - ,(lambda (obj) - (let ((vname (text obj))) - (unless (equal vname "") - (when (equal (subseq vname 0 1) "(") - (setf vname (format nil "|~A|" vname))) - (setf (attribute control "data-clog-name") vname) - (when (equal (getf info :name) "clog-data") - (when win - (setf (window-title win) vname))))))) - props))) - (dolist (item props) - (let* ((tr (create-table-row table)) - (td1 (create-table-column tr :content (first item))) - (td2 (if (second item) - (create-table-column tr :content (second item)) - (create-table-column tr)))) - (setf (width td1) "30%") - (setf (width td2) "70%") - (setf (spellcheckp td2) nil) - (set-border td1 "1px" :dotted :black) - (cond ((third item) - (unless (eq (third item) :read-only) - (setf (editablep td2) (funcall (third item) control td1 td2)))) - (t - (setf (editablep td2) t))) - (when (fourth item) - (set-on-blur td2 - (lambda (obj) - (funcall (fourth item) obj) - (when placer - (jquery-execute placer "trigger('clog-builder-snap-shot')") - (set-geometry placer :top (position-top control) - :left (position-left control) - :width (client-width control) - :height (client-height control)))))))))))))) + (if clear + (setf (inner-html (properties-list app)) "") + (with-sync-event (obj) + (bordeaux-threads:make-thread (lambda () (on-populate-control-events-win obj))) + (let* ((prop-win (control-properties-win app)) + (control (if (current-control app) + (current-control app) + obj)) + (placer (when control + (get-placer control))) + (table (properties-list app))) + (when prop-win + (setf (inner-html table) "") + (let ((info (control-info (attribute control "data-clog-type"))) + props) + (dolist (prop (reverse (getf info :properties))) + (cond ((eq (third prop) :style) + (push `(,(getf prop :name) ,(style control (getf prop :style)) ,(getf prop :setup) + ,(lambda (obj) + (setf (style control (getf prop :style)) (text obj)))) + props)) + ((or (eq (third prop) :get) + (eq (third prop) :set) + (eq (third prop) :setup)) + (push `(,(getf prop :name) ,(when (getf prop :get) + (funcall (getf prop :get) control)) + ,(getf prop :setup) + ,(lambda (obj) + (when (getf prop :set) + (funcall (getf prop :set) control obj)))) + props)) + ((eq (third prop) :prop) + (push `(,(getf prop :name) ,(property control (getf prop :prop)) ,(getf prop :setup) + ,(lambda (obj) + (setf (property control (getf prop :prop)) (text obj)))) + props)) + ((eq (third prop) :attr) + (push `(,(getf prop :name) ,(attribute control (getf prop :attr)) ,(getf prop :setup) + ,(lambda (obj) + (setf (attribute control (getf prop :attr)) (text obj)))) + props)) + (t (print "Configuration error.")))) + (when (current-control app) + (let* (panel-controls + (cname (attribute control "data-clog-name")) + (ctype (attribute control "data-clog-type")) + (panel-id (attribute placer "data-panel-id")) + (panel (attach-as-child obj panel-id))) + (maphash (lambda (k v) + (declare (ignore k)) + (let ((n (attribute v "data-clog-name")) + (p (attribute (parent-element v) "data-clog-name"))) + (unless (or (equal cname n) + (equal cname p)) + (push n panel-controls)))) + (get-control-list app panel-id)) + (push (attribute panel "data-clog-name") panel-controls) + (push + `("parent" nil + ,(lambda (control td1 td2) + (declare (ignore td1)) + (let ((dd (create-select td2)) + (v (attribute (parent-element control) "data-clog-name"))) + (set-geometry dd :width "100%") + (add-select-options dd panel-controls) + (setf (value dd) v) + (set-on-change dd + (lambda (obj) + (place-inside-bottom-of + (attach-as-child control + (js-query + control + (format nil "$(\"[data-clog-name='~A']\").attr('id')" + (value obj)))) + control) + (place-after control placer) + (on-populate-control-list-win panel :win win)))) + nil) + nil) + props) + (push + `("type" ,ctype + :read-only + nil + nil) + props) + (push + `("name" ,cname + nil + ,(lambda (obj) + (let ((vname (text obj))) + (unless (equal vname "") + (when (equal (subseq vname 0 1) "(") + (setf vname (format nil "|~A|" vname))) + (setf (attribute control "data-clog-name") vname) + (when (equal (getf info :name) "clog-data") + (when win + (setf (window-title win) vname))))))) + props))) + (dolist (item props) + (let* ((tr (create-table-row table)) + (td1 (create-table-column tr :content (first item))) + (td2 (if (second item) + (create-table-column tr :content (second item)) + (create-table-column tr)))) + (setf (width td1) "30%") + (setf (width td2) "70%") + (setf (spellcheckp td2) nil) + (set-border td1 "1px" :dotted :black) + (cond ((third item) + (unless (eq (third item) :read-only) + (setf (editablep td2) (funcall (third item) control td1 td2)))) + (t + (setf (editablep td2) t))) + (when (fourth item) + (set-on-blur td2 + (lambda (obj) + (funcall (fourth item) obj) + (when placer + (jquery-execute placer "trigger('clog-builder-snap-shot')") + (set-geometry placer :top (position-top control) + :left (position-left control) + :width (client-width control) + :height (client-height control)))))))))))))))) diff --git a/tools/clog-builder-panels.lisp b/tools/clog-builder-panels.lisp index 114522f..98ffbda 100644 --- a/tools/clog-builder-panels.lisp +++ b/tools/clog-builder-panels.lisp @@ -481,11 +481,13 @@ not a temporarily attached one when using select-control." ;; Panel Windows -(defun on-new-builder-panel-ext (obj &key open-file popup) +(defun on-new-builder-panel-ext (obj &key open-file popup open-ext) (open-window (window (connection-body obj)) (if open-file - (format nil "/panel-editor?open-panel=~A" - open-file) + (format nil "/panel-editor?open-panel=~A~A" + open-file (if open-ext + (format nil "&open-ext=~A" open-ext) + "")) "/source-editor") :specs (if (or popup *open-external-panels-in-popup*) "width=1280,height=700" @@ -589,9 +591,10 @@ not a temporarily attached one when using select-control." (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))) + (let ((msg (create-button content :content "Panel is external. Click to bring to front."))) + (set-geometry msg :units "%" :height 100 :width 100) + (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") @@ -613,9 +616,13 @@ not a temporarily attached one when using select-control." (set-on-before-unload (window pop) (lambda (obj) (declare (ignore obj)) + (deselect-current-control app) + (on-populate-control-events-win content) + (on-populate-control-list-win content :win win :clear t) + (on-populate-control-properties-win content :win win :clear t) (setf content nil) (setf ext-panel nil) - (window-close win))) + (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" "./" @@ -649,23 +656,21 @@ not a temporarily attached one when using select-control." (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) ;; 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)) + (deselect-current-control app) + (on-populate-control-events-win content) + (on-populate-control-list-win content :win win :clear t) + (on-populate-control-properties-win content :win win :clear t) (setf (current-control app) nil) (destroy-control-list app panel-id) (when ext-panel diff --git a/tools/clog-builder-projects.lisp b/tools/clog-builder-projects.lisp index 4b3a43c..0d98dfc 100644 --- a/tools/clog-builder-projects.lisp +++ b/tools/clog-builder-projects.lisp @@ -29,6 +29,8 @@ (let* ((app (connection-data-item panel "builder-app-data"))) (when *open-external* (setf (checkedp (open-ext panel)) t)) + (when *open-panels-as-popups* + (setf (checkedp (pop-panel panel)) t)) (when (uiop:directory-exists-p #P"~/common-lisp/") (pushnew #P"~/common-lisp/" (symbol-value (read-from-string "ql:*local-project-directories*")) @@ -367,8 +369,8 @@ ((and (> (length item) 5) (equal (subseq item (- (length item) 5)) ".clog")) (if (checkedp (open-ext panel)) - (on-new-builder-panel-ext target :open-file item) - (on-new-builder-panel target :open-file item))) + (on-new-builder-panel-ext target :open-file item :open-ext (checkedp (pop-panel panel))) + (on-new-builder-panel target :open-file item :open-ext (checkedp (pop-panel panel))))) (t (if (checkedp (open-ext panel)) (on-open-file-ext target :open-file item) diff --git a/tools/clog-builder.lisp b/tools/clog-builder.lisp index 5252a29..1c120bf 100644 --- a/tools/clog-builder.lisp +++ b/tools/clog-builder.lisp @@ -100,14 +100,6 @@ clog-builder window.") :accessor project-win :initform nil :documentation "Project window") - (right-panel - :accessor right-panel - :initform nil - :documentation "Right panel") - (left-panel - :accessor left-panel - :initform nil - :documentation "Left panel") (control-properties-win :accessor control-properties-win :initform nil @@ -196,15 +188,6 @@ clog-builder window.") (setf (hiddenp win) t) nil)))))) -(defun panel-mode (obj bool) - "Set the status for display or hiding the side panels." - (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" (let ((about (create-gui-window obj @@ -342,7 +325,8 @@ clog-builder window.") (set-html-on-close body "Connection Lost") (let ((app (make-instance 'builder-app-data)) (open-file (form-data-item (form-get-data body) "open-file")) - (open-panel (form-data-item (form-get-data body) "open-panel"))) + (open-panel (form-data-item (form-get-data body) "open-panel")) + (open-ext (form-data-item (form-get-data body) "open-ext"))) (setf (connection-data-item body "builder-app-data") app) (setf (title (html-document body)) "CLOG Builder") (clog-gui-initialize body) @@ -435,7 +419,7 @@ clog-builder window.") (cond (open-panel (setf (title (html-document body)) open-panel) - (on-new-builder-panel body :open-file open-panel)) + (on-new-builder-panel body :open-file open-panel :open-ext open-ext)) (open-file (setf (title (html-document body)) open-file) (on-open-file body :open-file open-file :maximized t)) diff --git a/tools/panel-projects.clog b/tools/panel-projects.clog index 3ebfb3b..c5f788d 100644 --- a/tools/panel-projects.clog +++ b/tools/panel-projects.clog @@ -1,4 +1,4 @@ - - \ No newline at end of file + \ No newline at end of file diff --git a/tools/panel-projects.lisp b/tools/panel-projects.lisp index 7c1f413..5c828ed 100644 --- a/tools/panel-projects.lisp +++ b/tools/panel-projects.lisp @@ -1,7 +1,9 @@ ;;;; CLOG Builder generated code - modify original .clog file and rerender (in-package :clog-tools) (defclass projects (clog:clog-panel) - ((open-ext :reader open-ext) (ext-win-label :reader ext-win-label) + ((pop-panel-label :reader pop-panel-label) + (pop-panel :reader pop-panel) (open-ext :reader open-ext) + (ext-win-label :reader ext-win-label) (design-plugin :reader design-plugin) (design-del-dep :reader design-del-dep) (design-add-dep :reader design-add-dep) @@ -35,112 +37,118 @@ (let ((panel (change-class (clog:create-div clog-obj :content - "
-" + "
+" :hidden hidden :class class :html-id html-id :auto-place auto-place) 'projects))) + (setf (slot-value panel 'pop-panel-label) + (attach-as-child clog-obj "CLOGB3920248393" :clog-type + 'clog:clog-label :new-id t)) + (setf (slot-value panel 'pop-panel) + (attach-as-child clog-obj "CLOGB3920248392" :clog-type + 'clog:clog-form-element :new-id t)) (setf (slot-value panel 'open-ext) - (attach-as-child clog-obj "CLOGB3918817962" :clog-type + (attach-as-child clog-obj "CLOGB3920248391" :clog-type 'clog:clog-form-element :new-id t)) (setf (slot-value panel 'ext-win-label) - (attach-as-child clog-obj "CLOGB3918817961" :clog-type + (attach-as-child clog-obj "CLOGB3920248390" :clog-type 'clog:clog-label :new-id t)) (setf (slot-value panel 'design-plugin) - (attach-as-child clog-obj "CLOGB3918817960" :clog-type + (attach-as-child clog-obj "CLOGB3920248389" :clog-type 'clog:clog-button :new-id t)) (setf (slot-value panel 'design-del-dep) - (attach-as-child clog-obj "CLOGB3918817959" :clog-type + (attach-as-child clog-obj "CLOGB3920248388" :clog-type 'clog:clog-button :new-id t)) (setf (slot-value panel 'design-add-dep) - (attach-as-child clog-obj "CLOGB3918817958" :clog-type + (attach-as-child clog-obj "CLOGB3920248387" :clog-type 'clog:clog-button :new-id t)) (setf (slot-value panel 'design-deps) - (attach-as-child clog-obj "CLOGB3918817957" :clog-type + (attach-as-child clog-obj "CLOGB3920248386" :clog-type 'clog:clog-select :new-id t)) (setf (slot-value panel 'design-deps-label) - (attach-as-child clog-obj "CLOGB3918817956" :clog-type + (attach-as-child clog-obj "CLOGB3920248385" :clog-type 'clog:clog-label :new-id t)) (setf (slot-value panel 'designtime-delete) - (attach-as-child clog-obj "CLOGB3918817955" :clog-type + (attach-as-child clog-obj "CLOGB3920248384" :clog-type 'clog:clog-button :new-id t)) (setf (slot-value panel 'designtime-add-lisp) - (attach-as-child clog-obj "CLOGB3918817954" :clog-type + (attach-as-child clog-obj "CLOGB3920248383" :clog-type 'clog:clog-button :new-id t)) (setf (slot-value panel 'designtime-add-clog) - (attach-as-child clog-obj "CLOGB3918817953" :clog-type + (attach-as-child clog-obj "CLOGB3920248382" :clog-type 'clog:clog-button :new-id t)) (setf (slot-value panel 'designtime-list) - (attach-as-child clog-obj "CLOGB3918817952" :clog-type + (attach-as-child clog-obj "CLOGB3920248381" :clog-type 'clog:clog-select :new-id t)) (setf (slot-value panel 'designtime-label) - (attach-as-child clog-obj "CLOGB3918817951" :clog-type + (attach-as-child clog-obj "CLOGB3920248380" :clog-type 'clog:clog-label :new-id t)) (setf (slot-value panel 'runtime-del-dep) - (attach-as-child clog-obj "CLOGB3918817950" :clog-type + (attach-as-child clog-obj "CLOGB3920248379" :clog-type 'clog:clog-button :new-id t)) (setf (slot-value panel 'runtime-add-dep) - (attach-as-child clog-obj "CLOGB3918817949" :clog-type + (attach-as-child clog-obj "CLOGB3920248378" :clog-type 'clog:clog-button :new-id t)) (setf (slot-value panel 'runtime-deps) - (attach-as-child clog-obj "CLOGB3918817948" :clog-type + (attach-as-child clog-obj "CLOGB3920248377" :clog-type 'clog:clog-select :new-id t)) (setf (slot-value panel 'dbl-click2) - (attach-as-child clog-obj "CLOGB3918817947" :clog-type + (attach-as-child clog-obj "CLOGB3920248376" :clog-type 'clog:clog-label :new-id t)) (setf (slot-value panel 'runtime-deps-label) - (attach-as-child clog-obj "CLOGB3918817946" :clog-type + (attach-as-child clog-obj "CLOGB3920248375" :clog-type 'clog:clog-label :new-id t)) (setf (slot-value panel 'runtime-dir) - (attach-as-child clog-obj "CLOGB3918817945" :clog-type + (attach-as-child clog-obj "CLOGB3920248374" :clog-type 'clog:clog-button :new-id t)) (setf (slot-value panel 'runtime-delete) - (attach-as-child clog-obj "CLOGB3918817944" :clog-type + (attach-as-child clog-obj "CLOGB3920248373" :clog-type 'clog:clog-button :new-id t)) (setf (slot-value panel 'runtime-add-lisp) - (attach-as-child clog-obj "CLOGB3918817943" :clog-type + (attach-as-child clog-obj "CLOGB3920248372" :clog-type 'clog:clog-button :new-id t)) (setf (slot-value panel 'runtime-list) - (attach-as-child clog-obj "CLOGB3918817942" :clog-type + (attach-as-child clog-obj "CLOGB3920248371" :clog-type 'clog:clog-select :new-id t)) (setf (slot-value panel 'dbl-click1) - (attach-as-child clog-obj "CLOGB3918817941" :clog-type + (attach-as-child clog-obj "CLOGB3920248370" :clog-type 'clog:clog-label :new-id t)) (setf (slot-value panel 'runtime-label) - (attach-as-child clog-obj "CLOGB3918817940" :clog-type + (attach-as-child clog-obj "CLOGB3920248369" :clog-type 'clog:clog-label :new-id t)) (setf (slot-value panel 'file-group) - (attach-as-child clog-obj "CLOGB3918817939" :clog-type + (attach-as-child clog-obj "CLOGB3920248368" :clog-type 'clog:clog-div :new-id t)) (setf (slot-value panel 'rerender-button) - (attach-as-child clog-obj "CLOGB3918817938" :clog-type + (attach-as-child clog-obj "CLOGB3920248367" :clog-type 'clog:clog-button :new-id t)) (setf (slot-value panel 'reload-project-button) - (attach-as-child clog-obj "CLOGB3918817937" :clog-type + (attach-as-child clog-obj "CLOGB3920248366" :clog-type 'clog:clog-button :new-id t)) (setf (slot-value panel 'unload-project-button) - (attach-as-child clog-obj "CLOGB3918817936" :clog-type + (attach-as-child clog-obj "CLOGB3920248365" :clog-type 'clog:clog-button :new-id t)) (setf (slot-value panel 'new-project-button) - (attach-as-child clog-obj "CLOGB3918817935" :clog-type + (attach-as-child clog-obj "CLOGB3920248364" :clog-type 'clog:clog-button :new-id t)) (setf (slot-value panel 'run-button) - (attach-as-child clog-obj "CLOGB3918817934" :clog-type + (attach-as-child clog-obj "CLOGB3920248363" :clog-type 'clog:clog-button :new-id t)) (setf (slot-value panel 'entry-point) - (attach-as-child clog-obj "CLOGB3918817933" :clog-type + (attach-as-child clog-obj "CLOGB3920248362" :clog-type 'clog:clog-form-element :new-id t)) (setf (slot-value panel 'entry-point-label) - (attach-as-child clog-obj "CLOGB3918817932" :clog-type + (attach-as-child clog-obj "CLOGB3920248361" :clog-type 'clog:clog-label :new-id t)) (setf (slot-value panel 'edit-asd) - (attach-as-child clog-obj "CLOGB3918817931" :clog-type + (attach-as-child clog-obj "CLOGB3920248360" :clog-type 'clog:clog-button :new-id t)) (setf (slot-value panel 'project-list) - (attach-as-child clog-obj "CLOGB3918817930" :clog-type + (attach-as-child clog-obj "CLOGB3920248359" :clog-type 'clog:clog-select :new-id t)) (setf (slot-value panel 'projects-label) - (attach-as-child clog-obj "CLOGB3918817929" :clog-type + (attach-as-child clog-obj "CLOGB3920248358" :clog-type 'clog:clog-label :new-id t)) (let ((target (projects-label panel))) (declare (ignorable target)) @@ -190,6 +198,11 @@ (setf (attribute target "for") (clog:js-query target "$('[data-clog-name=\\'open-ext\\']').attr('id')"))) + (let ((target (pop-panel-label panel))) + (declare (ignorable target)) + (setf (attribute target "for") + (clog:js-query target + "$('[data-clog-name=\\'pop-panel\\']').attr('id')"))) (clog:set-on-change (project-list panel) (lambda (target) (declare (ignorable target)) @@ -199,8 +212,8 @@ (declare (ignorable target)) (let ((sel (text-value (project-list panel)))) (on-open-file panel :open-file - (asdf:system-source-file - (asdf:find-system sel)))))) + (asdf/system:system-source-file + (asdf/system:find-system sel)))))) (clog:set-on-change (entry-point panel) (lambda (target) (declare (ignorable target)) @@ -218,7 +231,7 @@ (declare (ignorable target)) (let ((sel (text-value (project-list panel)))) (unless (equal sel "None") - (asdf:clear-system sel) + (asdf/system-registry:clear-system sel) (setf (text-value (project-list panel)) "None") (projects-populate panel))))) (clog:set-on-click (reload-project-button panel) @@ -226,7 +239,7 @@ (declare (ignorable target)) (let ((sel (text-value (project-list panel)))) (unless (equal sel "None") - (asdf:clear-system sel) + (asdf/system-registry:clear-system sel) (projects-populate panel))))) (clog:set-on-click (rerender-button panel) (lambda (target) @@ -323,4 +336,4 @@ (declare (ignorable target)) (let ((sys (text-value (project-list panel)))) (projects-add-plugin panel sys)))) - panel)) + panel)) \ No newline at end of file