diff --git a/source/clog-gui.lisp b/source/clog-gui.lisp index 8d13583..1765be4 100644 --- a/source/clog-gui.lisp +++ b/source/clog-gui.lisp @@ -85,13 +85,47 @@ (input-dialog function) (confirm-dialog function) (form-dialog function) - (server-file-dialog function)) + (server-file-dialog function) + + "CLOG-GUI - Look and Feel" + (*menu-bar-class variable) + (*menu-bar-class* variable) + (*menu-bar-drop-down-class* variable) + (*menu-item-class* variable) + (*menu-window-select-class* variable) + (*menu-full-screen-item* variable) + (*menu-icon-image-class* variable) + (*top-bar-height* variable) + (*default-title-class* variable) + (*default-border-class* variable)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Default Settings +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Menus +(defparameter *menu-bar-class* "w3-bar w3-black w3-card-4") +(defparameter *menu-bar-drop-down-class* "w3-dropdown-content w3-bar-block w3-card-4") +(defparameter *menu-item-class* "w3-bar-item w3-button") +(defparameter *menu-window-select-class* "w3-bar-item w3-button") +(defparameter *menu-full-screen-item* "⤢") +(defparameter *menu-icon-image-class* "w3-button w3-bar-item") + +;; New Window placement +(defparameter *top-bar-height* 20 + "Overlap on new windows created with top set as nil") + +;; Window treatements +(defparameter *default-title-class* "w3-black" + "Window title bar class") +(defparameter *default-border-class* "w3-card-4 w3-white w3-border" + "Window frame border") + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Implementation - clog-gui - Desktop GUI abstraction ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defconstant top-bar-height 20 "Overlap on new windows with nil set for top") (defclass clog-gui () ((body @@ -405,7 +439,7 @@ in on-resize, on-full-screen-change and on-orientation-change events.")) clog-body. If main-menu add as main menu bar.")) (defmethod create-gui-menu-bar ((obj clog-obj) - &key (class "w3-bar w3-black w3-card-4") + &key (class *menu-bar-class*) (html-id nil) (main-menu t)) (let* ((div (create-div obj :class class :html-id html-id)) @@ -430,7 +464,7 @@ clog-body. If main-menu add as main menu bar.")) (defmethod create-gui-menu-drop-down ((obj clog-gui-menu-bar) &key (content "") - (class "w3-dropdown-content w3-bar-block w3-card-4") + (class *menu-bar-drop-down-class*) (html-id nil)) (let* ((hover (create-div obj :class "w3-dropdown-hover")) (button (create-button hover :class "w3-button" :content content)) @@ -455,31 +489,7 @@ clog-body. If main-menu add as main menu bar.")) (defmethod create-gui-menu-item ((obj clog-obj) &key (content "") (on-click nil) - (class "w3-bar-item w3-button") - (html-id nil)) - (let ((span - (create-span obj :content content :class class :html-id html-id))) - (set-on-click span on-click) - (change-class span 'clog-gui-menu-item))) - -;;;;;;;;;;;;;;;;;;;;;;;;;; -;; create-gui-menu-item ;; -;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defclass clog-gui-menu-item (clog-span)() - (:documentation "Menu item")) - -(defgeneric create-gui-menu-item (clog-gui-menu-drop-down - &key content - on-click - class - html-id) - (:documentation "Attached a menu item to a CLOG-GUI-MENU-DROP-DOWN")) - -(defmethod create-gui-menu-item ((obj clog-obj) - &key (content "") - (on-click nil) - (class "w3-bar-item w3-button") + (class *menu-item-class*) (html-id nil)) (let ((span (create-span obj :content content :class class :html-id html-id))) @@ -502,7 +512,7 @@ Only one instance allowed.")) (defmethod create-gui-menu-window-select ((obj clog-obj) - &key (class "w3-bar-item w3-button") + &key (class *menu-window-select-class*) content (html-id nil)) (let ((window-select (create-select obj :html-id html-id :class class)) @@ -525,15 +535,17 @@ Only one instance allowed.")) (defgeneric create-gui-menu-full-screen (clog-gui-menu-bar &key html-id) (:documentation "Add as last item in menu bar to allow for a full screen -icon ⤢ and full screen mode.")) +icon ⤢ (*menu-full-screen-item* default) and full screen mode.")) (defmethod create-gui-menu-full-screen ((obj clog-gui-menu-bar) &key (html-id nil)) (create-child obj - " ⤢" + (format nil + " ~A" + *menu-full-screen-item*) :html-id html-id :clog-type 'clog-gui-menu-item)) @@ -548,9 +560,9 @@ icon ⤢ and full screen mode.")) (:documentation "Add icon as menu bar item.")) (defmethod create-gui-menu-icon ((obj clog-gui-menu-bar) - &key (image-url "/img/clogwicon.png") + &key (image-url *default-icon*) (on-click nil) - (class "w3-button w3-bar-item") + (class *menu-icon-image-class*) (html-id nil)) (set-on-click (create-child obj @@ -846,8 +858,8 @@ window-to-top-by-param or window-by-param.")) (window-param nil) (hidden nil) (client-movement nil) - (border-class "w3-card-4 w3-white w3-border") - (title-class "w3-black") + (border-class *default-border-class*) + (title-class *default-title-class*) (html-id nil)) (let ((app (connection-data-item obj "clog-gui"))) (unless html-id @@ -865,7 +877,7 @@ window-to-top-by-param or window-by-param.")) (when (eql (last-y app) 0) (setf (last-y app) (menu-bar-height obj))) (setf top (last-y app)) - (incf (last-y app) top-bar-height) + (incf (last-y app) *top-bar-height*) (when (> top (- (inner-height (window (body app))) (last-y app))) (setf (last-y app) (menu-bar-height obj)))) (let ((win (create-child (body app) @@ -1994,3 +2006,43 @@ machine, upon close ON-FILE-NAME called with filename or nil if failure." (window-close win) (funcall on-file-name (value input))) :one-time t))) + +(defparameter *default-icon* + "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAACAAAAAcCAYAAAAAwr0iAAAAAXNSR0IArs4c6QAAAKZlWElmTU0A +KgAAAAgABwEGAAMAAAABAAIAAAESAAMAAAABAAEAAAEaAAUAAAABAAAAYgEbAAUAAAABAAAAagEo +AAMAAAABAAIAAAExAAIAAAAVAAAAcodpAAQAAAABAAAAiAAAAAAAAABIAAAAAQAAAEgAAAABUGl4 +ZWxtYXRvciBQcm8gMi4wLjUAAAACoAIABAAAAAEAAAAgoAMABAAAAAEAAAAcAAAAAMSXmL0AAAAJ +cEhZcwAACxMAAAsTAQCanBgAAAQRaVRYdFhNTDpjb20uYWRvYmUueG1wAAAAAAA8eDp4bXBtZXRh +IHhtbG5zOng9ImFkb2JlOm5zOm1ldGEvIiB4OnhtcHRrPSJYTVAgQ29yZSA2LjAuMCI+CiAgIDxy +ZGY6UkRGIHhtbG5zOnJkZj0iaHR0cDovL3d3dy53My5vcmcvMTk5OS8wMi8yMi1yZGYtc3ludGF4 +LW5zIyI+CiAgICAgIDxyZGY6RGVzY3JpcHRpb24gcmRmOmFib3V0PSIiCiAgICAgICAgICAgIHht +bG5zOmV4aWY9Imh0dHA6Ly9ucy5hZG9iZS5jb20vZXhpZi8xLjAvIgogICAgICAgICAgICB4bWxu +czp4bXA9Imh0dHA6Ly9ucy5hZG9iZS5jb20veGFwLzEuMC8iCiAgICAgICAgICAgIHhtbG5zOnRp +ZmY9Imh0dHA6Ly9ucy5hZG9iZS5jb20vdGlmZi8xLjAvIj4KICAgICAgICAgPGV4aWY6Q29sb3JT +cGFjZT4xPC9leGlmOkNvbG9yU3BhY2U+CiAgICAgICAgIDxleGlmOlBpeGVsWERpbWVuc2lvbj4z +MjwvZXhpZjpQaXhlbFhEaW1lbnNpb24+CiAgICAgICAgIDxleGlmOlBpeGVsWURpbWVuc2lvbj4y +ODwvZXhpZjpQaXhlbFlEaW1lbnNpb24+CiAgICAgICAgIDx4bXA6Q3JlYXRvclRvb2w+UGl4ZWxt +YXRvciBQcm8gMi4wLjU8L3htcDpDcmVhdG9yVG9vbD4KICAgICAgICAgPHhtcDpNZXRhZGF0YURh +dGU+MjAyMS0wMi0wNFQwMzo0MDoxOVo8L3htcDpNZXRhZGF0YURhdGU+CiAgICAgICAgIDx0aWZm +OlJlc29sdXRpb25Vbml0PjI8L3RpZmY6UmVzb2x1dGlvblVuaXQ+CiAgICAgICAgIDx0aWZmOlBo +b3RvbWV0cmljSW50ZXJwcmV0YXRpb24+MjwvdGlmZjpQaG90b21ldHJpY0ludGVycHJldGF0aW9u +PgogICAgICAgICA8dGlmZjpDb21wcmVzc2lvbj4xPC90aWZmOkNvbXByZXNzaW9uPgogICAgICAg +ICA8dGlmZjpPcmllbnRhdGlvbj4xPC90aWZmOk9yaWVudGF0aW9uPgogICAgICAgICA8dGlmZjpY +UmVzb2x1dGlvbj43MjAwMDAvMTAwMDA8L3RpZmY6WFJlc29sdXRpb24+CiAgICAgICAgIDx0aWZm +OllSZXNvbHV0aW9uPjcyMDAwMC8xMDAwMDwvdGlmZjpZUmVzb2x1dGlvbj4KICAgICAgPC9yZGY6 +RGVzY3JpcHRpb24+CiAgIDwvcmRmOlJERj4KPC94OnhtcG1ldGE+CjH2KYwAAAMuSURBVEgN7Za7 +a1RBFId3N3GjUQMJNuIDGwVFRW0sFBTRNpWVhYKFWtko2PgH2NgpgtgERK1EUQSxsBIMYpAIgsRX +o4WFYNS8k/X7zc7vOrmbZO+uYOWBb8+ZM3PmzOvObKn0X/7hCtRqtXI+XYMj3+BvyySt0kcFpqEG +y2J5slwuz2G3L3RegW7ozPeCr2shv9tRV4ZK2ytAsGYywyw0qxLlbtQkyD+LXzOWfx1qF2yGLbAc +blP/BB2WRrolodOqEig5sg0q2GOgxBMwjW8TnKTjfuiADzAIK+AudWfQrQuBXY7Cvg6/4BFslx+9 +D87CeTgCvW5vje8ODINWq7gQEJKjte+PIZVvFC7DQTgEG9OeKetMhIToAfgEPWmbJW0a6zRrhr3w +HCQzMA5acstFd4SjB1ZHrTOieA1O8gJ0HpoLDZ18DfYrkEyBBiCZg4lg1X9uovryPeM7ACMguQfN +t8CN0H2gfZNMwmyw6smjmQ1I5ddwAnZDP1yDH2C5mh9gQ5mW3vOV2EMxUjN18uiap9LtUMUoaIUs +jj3VkNAOWnbCqqT8NEYredpZdDcoJfH2pJVegS84t7r/TOOsQjgscmLr5D4Aifbcow+OAj8ahFZE +KFYHVnIlS2oDp+7rTCgfgzcgUXCryUNg8vM92h/RG5QIXb9TMMKVjD4KN+AlWLTk7Sb3rL30urT2 +x+R/vgCcYfZofRqpqIMie57G2M4fxhEq9sTkHdhh0vlXbFwNkAnQt69G7TxYUzF+Fn0JhmCYN+Id +ifUuzGGHRyw/gPdUSpR03pkI3mI/Tq4Ex0l0y2Fx1lly+3UYvAWHsSW+1Vpd/nTZLygBfek/g57N +QJY0NVTpMrYP4E/sVkSD9cDvJ/2Fa9zlRTXBXoWd2J65Tq1m5TLmgqI2Y7FG+7xWidDFHhuPigAP +Qvf3W7BoALr/jS4lobJnjVkbhPAMo7P/De6/kCbQg9Cnchr0bDaTrzQ4B47NH+5Fc2d7n7ZQR5ze +7B8rZd3be2EHrAe9E/rP9xmewUPaj6LDoUtj5WtLSKpTG2ZUpAO1VUyRtmmbQgGxYw8mXCCxE8c3 +fttpliXs3y+7fSKpo8d7AAAAAElFTkSuQmCC") diff --git a/tools/clog-builder-asdf-browser.lisp b/tools/clog-builder-asdf-browser.lisp index b49b615..1360ff7 100644 --- a/tools/clog-builder-asdf-browser.lisp +++ b/tools/clog-builder-asdf-browser.lisp @@ -1,7 +1,9 @@ (in-package :clog-tools) (defun on-new-asdf-browser (obj &key (project nil)) - (let* ((win (create-gui-window obj :title "ASDF System Browser" + (let* ((*default-title-class* *builder-title-class*) + (*default-border-class* *builder-border-class*) + (win (create-gui-window obj :title "ASDF System Browser" :top 40 :left 225 :width 592 :height 435 :client-movement t)) diff --git a/tools/clog-builder-control-events.lisp b/tools/clog-builder-control-events.lisp index 0881e87..eaf92a7 100644 --- a/tools/clog-builder-control-events.lisp +++ b/tools/clog-builder-control-events.lisp @@ -5,7 +5,9 @@ (let ((app (connection-data-item obj "builder-app-data"))) (if (control-events-win app) (window-focus (control-events-win app)) - (let* ((win (create-gui-window obj :title "Control CLOG Events" + (let* ((*default-title-class* *builder-title-class*) + (*default-border-class* *builder-border-class*) + (win (create-gui-window obj :title "Control CLOG Events" :left 225 :height 200 :width 645 :has-pinner t :client-movement *client-side-movement*)) @@ -18,7 +20,7 @@ (declare (ignore obj)) (setf (current-editor-is-lisp app) t))) (setf (control-events-win app) win) - (setf (events-list app) (create-select content :name "clog-events" :class "w3-gray w3-text-white")) + (setf (events-list app) (create-select content :name "clog-events" :class *builder-event-list-class*)) (setf (positioning (events-list app)) :absolute) (set-geometry (events-list app) :top 5 :left 5 :right 5) (setf (event-editor app) (clog-ace:create-clog-ace-element content)) @@ -54,7 +56,9 @@ (let ((app (connection-data-item obj "builder-app-data"))) (if (control-js-events-win app) (window-focus (control-js-events-win app)) - (let* ((win (create-gui-window obj :title "Control Client JavaScript Events" + (let* ((*default-title-class* *builder-title-class*) + (*default-border-class* *builder-border-class*) + (win (create-gui-window obj :title "Control Client JavaScript Events" :left 225 :height 200 :width 645 :has-pinner t :client-movement *client-side-movement*)) @@ -67,7 +71,7 @@ (declare (ignore obj)) (setf (current-editor-is-lisp app) nil))) (setf (control-js-events-win app) win) - (setf (events-js-list app) (create-select content :name "clog-js-events" :class "w3-gray w3-text-white")) + (setf (events-js-list app) (create-select content :name "clog-js-events" :class *builder-event-list-class*)) (setf (positioning (events-js-list app)) :absolute) (set-geometry (events-js-list app) :top 5 :left 5 :right 5) (setf (event-js-editor app) (clog-ace:create-clog-ace-element content)) @@ -105,7 +109,9 @@ (let ((app (connection-data-item obj "builder-app-data"))) (if (control-ps-events-win app) (window-focus (control-ps-events-win app)) - (let* ((win (create-gui-window obj :title "Control Client ParenScript Events" + (let* ((*default-title-class* *builder-title-class*) + (*default-border-class* *builder-border-class*) + (win (create-gui-window obj :title "Control Client ParenScript Events" :left 225 :height 200 :width 645 :has-pinner t :client-movement *client-side-movement*)) @@ -118,7 +124,7 @@ (declare (ignore obj)) (setf (current-editor-is-lisp app) nil))) (setf (control-ps-events-win app) win) - (setf (events-ps-list app) (create-select content :name "clog-ps-events" :class "w3-gray w3-text-white")) + (setf (events-ps-list app) (create-select content :name "clog-ps-events" :class *builder-event-list-class*)) (setf (positioning (events-ps-list app)) :absolute) (set-geometry (events-ps-list app) :top 5 :left 5 :right 5) (setf (event-ps-editor app) (clog-ace:create-clog-ace-element content)) diff --git a/tools/clog-builder-control-list.lisp b/tools/clog-builder-control-list.lisp index af7f241..ab6efc1 100644 --- a/tools/clog-builder-control-list.lisp +++ b/tools/clog-builder-control-list.lisp @@ -44,15 +44,18 @@ "Show control list for selecting and manipulating controls by name" (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)) + (let* ((*default-title-class* *builder-title-class*) + (*default-border-class* *builder-border-class*) + (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)) + (divider (create-panel content :top sheight :height 10 :left 0 :right 10 + :class *builder-title-class*)) (control-list (create-panel content :height (- sheight 10) :left 0 :bottom 0 :right 10)) - (pallete (create-select content)) + (pallete (create-select content :class *builder-pallete-class*)) (adj-size 0)) - (add-class content "w3-small") + (add-class content *builder-pallete-class*) (setf (controls-win app) win) (setf (control-list-win app) control-list) (setf (select-tool app) pallete) @@ -62,13 +65,10 @@ (setf (control-list-win app) nil))) (reset-control-pallete pallete) (window-toggle-pinned win :state nil) - (set-geometry win :units "" :top "33px" :left 0 :height "" :bottom "5px" :right "") + (set-geometry win :top (menu-bar-height win) :left 0 :height "" :bottom 5 :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")) @@ -141,7 +141,7 @@ of controls and double click to select control." (status (hiddenp (get-placer control)))) (if status (setf (color list-item) :darkred) - (setf (background-color list-item) :grey)) + (setf (css-class-name list-item) *builder-pallete-class*)) (setf (draggablep list-item) t) (setf (attribute list-item "data-clog-control") (html-id control)) ;; click to select item diff --git a/tools/clog-builder-control-properties.lisp b/tools/clog-builder-control-properties.lisp index bc4ecf6..1fa5c66 100644 --- a/tools/clog-builder-control-properties.lisp +++ b/tools/clog-builder-control-properties.lisp @@ -4,10 +4,12 @@ "Show control properties window" (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)) + (let* ((*default-title-class* *builder-title-class*) + (*default-border-class* *builder-border-class*) + (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") + (add-class content *builder-pallete-class*) (set-on-window-close win (lambda (obj) (setf (control-properties-win app) nil))) (set-on-window-move win (lambda (obj) @@ -15,10 +17,9 @@ (window-toggle-pinned win :state nil) (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 win :top (menu-bar-height win) :left "" :height "" :bottom 5 :right 0) (set-geometry control-list :left 0 :top 0 :right 0))) (window-focus (control-properties-win app)))) diff --git a/tools/clog-builder-files.lisp b/tools/clog-builder-files.lisp index 5486328..399ea92 100644 --- a/tools/clog-builder-files.lisp +++ b/tools/clog-builder-files.lisp @@ -45,11 +45,17 @@ (defun on-open-file (obj &key open-file (title "New Source Editor") text - (title-class "w3-black") + (title-class *builder-title-class*) maximized) "Open a new text editor" (unless (window-to-top-by-title obj open-file) (let* ((app (connection-data-item obj "builder-app-data")) + (*menu-bar-class* *builder-menu-bar-class*) + (*menu-bar-drop-down-class* *builder-menu-bar-drop-down-class*) + (*menu-item-class* *builder-menu-item-class*) + (*menu-window-select-class* *builder-menu-window-select-class*) + (*default-title-class* *builder-title-class*) + (*default-border-class* *builder-border-class*) (win (create-gui-window obj :title title :title-class title-class :width 700 :height 480 @@ -81,8 +87,8 @@ (m-ppr (create-gui-menu-item m-lisp :content "pretty print")) (m-help (create-gui-menu-drop-down menu :content "Help")) (m-helpk (create-gui-menu-item m-help :content "keyboard help")) - (tool-bar (create-div (top-panel box))) - (btn-class "w3-button w3-white w3-border w3-border-black w3-ripple") + (tool-bar (create-div (top-panel box) :class title-class)) + (btn-class *builder-icons-class*) (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)) @@ -98,7 +104,7 @@ (spacer2 (create-span tool-bar :content "  ")) (btn-help (create-span tool-bar :content "?" :class "w3-tiny w3-ripple")) (content (center-panel box)) - (pac-line (create-form-element content :text :class "w3-black")) + (pac-line (create-form-element content :text :class *builder-package-class*)) (ace (clog-ace:create-clog-ace-element content)) (status (create-div content :class "w3-tiny w3-border")) (lisp-file t) diff --git a/tools/clog-builder-panels.lisp b/tools/clog-builder-panels.lisp index afe983f..21877af 100644 --- a/tools/clog-builder-panels.lisp +++ b/tools/clog-builder-panels.lisp @@ -497,6 +497,12 @@ not a temporarily attached one when using select-control." (unless (and open-file (window-to-top-by-param obj open-file)) (let* ((app (connection-data-item obj "builder-app-data")) + (*menu-bar-class* *builder-menu-bar-class*) + (*menu-bar-drop-down-class* *builder-menu-bar-drop-down-class*) + (*menu-item-class* *builder-menu-item-class*) + (*menu-window-select-class* *builder-menu-window-select-class*) + (*default-title-class* *builder-title-class*) + (*default-border-class* *builder-border-class*) ext-panel (win (create-gui-window obj :top 40 :left 225 :width 645 :height 430 @@ -532,8 +538,8 @@ not a temporarily attached one when using select-control." (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))) - (btn-class "w3-button w3-white w3-border w3-border-black w3-ripple") + (tool-bar (create-div (top-panel box) :class *builder-title-class*)) + (btn-class *builder-icons-class*) (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)) @@ -545,9 +551,9 @@ not a temporarily attached one when using select-control." (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)) (cbox (create-form-element tool-bar :checkbox :class "w3-margin-left")) - (cbox-lbl (create-label tool-bar :content " auto render" :label-for cbox :class "w3-black")) + (cbox-lbl (create-label tool-bar :content " auto render" :label-for cbox)) (spacer (create-span tool-bar :content "   ")) - (btn-help (create-span tool-bar :content "?" :class "w3-tiny w3-ripple w3-black")) + (btn-help (create-span tool-bar :content "?" :class "w3-tiny w3-ripple")) (content (center-panel box)) (in-simulation nil) (undo-chain nil) @@ -560,6 +566,7 @@ not a temporarily attached one when using select-control." (declare (ignore spacer)) (add-class menu "w3-small") (setf (overflow (top-panel box)) :visible) ; let menus leave the top panel + (add-class (top-panel box) *builder-title-class*) (setf (background-color (top-panel box)) :black) (setf (checkedp cbox) t) (setf (advisory-title btn-copy) "copy") @@ -983,8 +990,9 @@ not a temporarily attached one when using select-control." (defun on-quick-start (obj) "Open quick start help" - (let* ((win (create-gui-window obj :title "Quick Start" - :top 40 :left 225 + (let* ((*default-title-class* *builder-title-class*) + (*default-border-class* *builder-border-class*) + (win (create-gui-window obj :title "Quick Start" :width 600 :height 400 :client-movement *client-side-movement*))) - (create-quick-start (window-content win)))) \ No newline at end of file + (create-quick-start (window-content win)))) diff --git a/tools/clog-builder-projects.lisp b/tools/clog-builder-projects.lisp index 99bca85..25e6a13 100644 --- a/tools/clog-builder-projects.lisp +++ b/tools/clog-builder-projects.lisp @@ -6,7 +6,9 @@ (setf (current-project app) project)) (if (project-win app) (window-focus (project-win app)) - (let* ((win (create-gui-window obj :title "Project Window" + (let* ((*default-title-class* *builder-title-class*) + (*default-border-class* *builder-border-class*) + (win (create-gui-window obj :title "Project Window" :top 60 :left 232 :width 643 :height 625 :has-pinner t :client-movement *client-side-movement*))) diff --git a/tools/clog-builder-settings.lisp b/tools/clog-builder-settings.lisp index 944fc31..e5958ac 100644 --- a/tools/clog-builder-settings.lisp +++ b/tools/clog-builder-settings.lisp @@ -38,3 +38,25 @@ showGutter : true, enableBasicAutocompletion: true, enableLiveAutocompletion : true") + +;; Builder Look and Feel + +(defparameter *builder-window-desktop-class* "w3-blue-grey") +(defparameter *builder-window-show-static-root-class* "w3-grey") +(defparameter *builder-show-callers-class* "w3-orange") +(defparameter *builder-show-callees-class* "w3-orange") +(defparameter *builder-menu-button-class* "w3-input w3-grey w3-button w3-ripple") +(defparameter *builder-pallete-class* "w3-light-grey w3-small") +(defparameter *builder-event-list-class* "w3-light-grey w3-small") + +;; Menus +(defparameter *builder-menu-bar-class* "w3-bar w3-round w3-small w3-blue-grey w3-card-4") +(defparameter *builder-menu-bar-drop-down-class* "w3-dropdown-content w3-bar-block w3-card-4") +(defparameter *builder-menu-item-class* "w3-bar-item w3-blue-grey w3-button") +(defparameter *builder-menu-window-select-class* "w3-grey w3-bar-item w3-button") + +;; Window treatements +(defparameter *builder-title-class* "w3-blue-grey w3-round") +(defparameter *builder-border-class* "w3-card-4 w3-white w3-border w3-round") +(defparameter *builder-package-class* "w3-white w3-round") +(defparameter *builder-icons-class* "w3-button w3-white w3-round w3-border w3-border-black w3-ripple") diff --git a/tools/clog-builder-sys-browser.lisp b/tools/clog-builder-sys-browser.lisp index bfdf7eb..0c6880c 100644 --- a/tools/clog-builder-sys-browser.lisp +++ b/tools/clog-builder-sys-browser.lisp @@ -1,7 +1,9 @@ (in-package :clog-tools) (defun on-new-sys-browser (obj &key (search nil)) - (let* ((win (create-gui-window obj :title "System Browser" + (let* ((*default-title-class* *builder-title-class*) + (*default-border-class* *builder-border-class*) + (win (create-gui-window obj :title "System Browser" :top 40 :left 225 :width 685 :height 530 :client-movement t)) diff --git a/tools/clog-builder.lisp b/tools/clog-builder.lisp index 95d40ca..49a399a 100644 --- a/tools/clog-builder.lisp +++ b/tools/clog-builder.lisp @@ -172,7 +172,9 @@ clog-builder window.") (defun on-show-copy-history-win (obj) "Create and show copy/but history" - (let ((app (connection-data-item obj "builder-app-data"))) + (let ((app (connection-data-item obj "builder-app-data")) + (*default-title-class* *builder-title-class*) + (*default-border-class* *builder-border-class*)) (if (copy-history-win app) (progn (setf (hiddenp (copy-history-win app)) nil) @@ -193,7 +195,9 @@ clog-builder window.") (defun on-help-about-builder (obj) "Open about box" - (let ((about (create-gui-window obj + (let ((*default-title-class* *builder-title-class*) + (*default-border-class* *builder-border-class*) + (about (create-gui-window obj :title "About" :content (format nil "
@@ -215,7 +219,9 @@ clog-builder window.") (defun on-new-app-template (obj) "Menu option to create new project from template" - (let* ((win (create-gui-window obj :title "New Application Template" + (let* ((*default-title-class* *builder-title-class*) + (*default-border-class* *builder-border-class*) + (win (create-gui-window obj :title "New Application Template" :width 500 :height 400)) (ct (create-clog-templates (window-content win)))) (window-center win) @@ -227,14 +233,18 @@ clog-builder window.") (defun on-image-to-data (obj) "Menu option to create new project from template" - (let* ((win (create-gui-window obj :title "Convert Images to Data" + (let* ((*default-title-class* *builder-title-class*) + (*default-border-class* *builder-border-class*) + (win (create-gui-window obj :title "Convert Images to Data" :width 450 :height 200))) (create-image-to-data (window-content win)) (window-center win))) (defun on-convert-image (body) "Convert image from form input from on-image-to-data" - (let ((params (form-multipart-data body))) + (let ((*default-title-class* *builder-title-class*) + (*default-border-class* *builder-border-class*) + (params (form-multipart-data body))) (create-div body :content params) (destructuring-bind (stream fname content-type) (form-data-item params "filename") @@ -253,7 +263,9 @@ clog-builder window.") (defun on-show-thread-viewer (obj) "Open thread views" - (let* ((win (create-gui-window obj :title "Thread Viewer" + (let* ((*default-title-class* *builder-title-class*) + (*default-border-class* *builder-border-class*) + (win (create-gui-window obj :title "Thread Viewer" :top 40 :left 225 :width 600 :height 400 :client-movement *client-side-movement*))) @@ -262,7 +274,9 @@ clog-builder window.") (defun on-repl (obj) "Open a REPL" - (let* ((win (create-gui-window obj :title "CLOG Builder REPL" + (let* ((*default-title-class* *builder-title-class*) + (*default-border-class* *builder-border-class*) + (win (create-gui-window obj :title "CLOG Builder REPL" :top 40 :left 225 :width 600 :height 400 :client-movement *client-side-movement*))) @@ -271,35 +285,41 @@ clog-builder window.") (defun on-show-callers (body) "Open callers window" - (input-dialog body "Enter package:function-name :" - (lambda (result) - (when result - (handler-case - (on-open-file body :title (format nil "Callers of ~A" result) - :title-class "w3-orange" - :text (swank::list-callers (read-from-string result))) - (t (c) - (on-open-file body :title "Error - Callers" - :title-class "w3-red" - :text c))))))) + (let ((*default-title-class* *builder-title-class*) + (*default-border-class* *builder-border-class*)) + (input-dialog body "Enter package:function-name :" + (lambda (result) + (when result + (handler-case + (on-open-file body :title (format nil "Callers of ~A" result) + :title-class *builder-show-callers-class* + :text (swank::list-callers (read-from-string result))) + (t (c) + (on-open-file body :title "Error - Callers" + :title-class "w3-red" + :text c)))))))) (defun on-show-callees (body) "Open callees window" - (input-dialog body "Enter package:function-name :" - (lambda (result) - (when result - (handler-case - (on-open-file body :title (format nil "Callees of ~A" result) - :title-class "w3-orange" - :text (swank::list-callees (read-from-string result))) - (t (c) - (on-open-file body :title "Error - Callees" - :title-class "w3-red" - :text c))))))) + (let ((*default-title-class* *builder-title-class*) + (*default-border-class* *builder-border-class*)) + (input-dialog body "Enter package:function-name :" + (lambda (result) + (when result + (handler-case + (on-open-file body :title (format nil "Callees of ~A" result) + :title-class *builder-show-callees-class* + :text (swank::list-callees (read-from-string result))) + (t (c) + (on-open-file body :title "Error - Callees" + :title-class "w3-red" + :text c)))))))) (defun on-dir-win (obj &key dir top left) "Open dir window" - (let* ((win (create-gui-window obj :title "Directory Window" + (let* ((*default-title-class* *builder-title-class*) + (*default-border-class* *builder-border-class*) + (win (create-gui-window obj :title "Directory Window" :top top :left left :width 600 :height 400 :has-pinner t @@ -329,18 +349,25 @@ clog-builder window.") "Launch instance of the CLOG Builder" (set-html-on-close body "Connection Lost") (let ((app (make-instance 'builder-app-data)) + (*menu-bar-class* *builder-menu-bar-class*) + (*menu-bar-drop-down-class* *builder-menu-bar-drop-down-class*) + (*menu-item-class* *builder-menu-item-class*) + (*menu-window-select-class* *builder-menu-window-select-class*) + (*default-title-class* *builder-title-class*) + (*default-border-class* *builder-border-class*) (open-file (form-data-item (form-get-data body) "open-file")) (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) - (add-class body "w3-blue-grey") - (setf (z-index (create-panel body :positioning :fixed - :bottom 0 :left 0 - :class "w3-gray" - :content (format nil "static-root: ~A" clog::*static-root*))) - -9999) + (add-class body *builder-window-desktop-class*) + (when *builder-window-show-static-root-class* + (setf (z-index (create-panel body :positioning :fixed + :bottom 0 :left 0 + :class *builder-window-show-static-root-class* + :content (format nil "static-root: ~A" clog::*static-root*))) + -9999)) (let* ((menu (create-gui-menu-bar body)) (icon (create-gui-menu-icon menu :image-url img-clog-icon :on-click #'on-help-about-builder)) @@ -351,8 +378,7 @@ clog-builder window.") (win (create-gui-menu-drop-down menu :content "Window")) (help (create-gui-menu-drop-down menu :content "Help"))) (declare (ignore icon)) - (add-class menu "w3-small") - (let ((exter (create-button file :content "-" :class "w3-input w3-button w3-ripple"))) + (let ((exter (create-button file :content "-" :class *builder-menu-button-class*))) (flet ((exter-text () (if *open-external* "open external tab" @@ -435,7 +461,7 @@ clog-builder window.") (declare (ignore obj)) (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-window-select menu :class "w3-bar-item w3-button w3-black") + (create-gui-menu-window-select menu) (create-gui-menu-full-screen menu)) (on-show-copy-history-win body) (cond @@ -465,7 +491,7 @@ clog-builder window.") (handler-case (on-dir-win body :dir *start-dir*) (error (msg) - (alert-toast body "Directory Error" (format nil "Unable to open directory ~A. " *start-dir*)) + (alert-toast body "Directory Error" (format nil "Unable to open directory ~A. ~A" *start-dir* msg)) (setf *start-dir* nil))) (set-geometry (current-window body) :top 38 :left "" :right 5 :height "" :bottom 22) (set-geometry (current-window body) :height (height (current-window body)) @@ -519,10 +545,10 @@ instead of the project window will be displayed." (initialize nil :port port)) (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-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") + (set-on-new-window 'on-convert-image :path "/image-to-data") + (set-on-new-window 'on-new-db-admin :path "/dbadmin") (enable-clog-popup) (setf *clogframe-mode* clogframe) (when clogframe diff --git a/tools/preferences.lisp.sample b/tools/preferences.lisp.sample index 1c4fe4e..84ea573 100644 --- a/tools/preferences.lisp.sample +++ b/tools/preferences.lisp.sample @@ -31,3 +31,25 @@ showGutter : true, enableBasicAutocompletion: true, enableLiveAutocompletion : true") + +;; Builder Look and Feel + +(setf *builder-window-desktop-class* "w3-blue-grey") +(setf *builder-window-show-static-root-class* "w3-grey") +(setf *builder-show-callers-class* "w3-orange") +(setf *builder-show-callees-class* "w3-orange") +(setf *builder-menu-button-class* "w3-input w3-grey w3-button w3-ripple") +(setf *builder-pallete-class* "w3-light-grey w3-small") +(setf *builder-event-list-class* "w3-light-grey w3-small") + +;; Menus +(setf *builder-menu-bar-class* "w3-bar w3-round w3-small w3-blue-grey w3-card-4") +(setf *builder-menu-bar-drop-down-class* "w3-dropdown-content w3-bar-block w3-card-4") +(setf *builder-menu-item-class* "w3-bar-item w3-blue-grey w3-button") +(setf *builder-menu-window-select-class* "w3-grey w3-bar-item w3-button") + +;; Window treatements +(setf *builder-title-class* "w3-blue-grey w3-round") +(setf *builder-border-class* "w3-card-4 w3-white w3-border w3-round") +(setf *builder-package-class* "w3-white w3-round") +(setf *builder-icons-class* "w3-button w3-white w3-round w3-border w3-border-black w3-ripple")