Configurable look and feel

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")
+                                   (class *menu-item-class*)
-                                   (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")
                                    (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
-          " <span class='w3-bar-item w3-right' style='user-select:none;'
+                (format nil
-             onClick='if (document.fullscreenElement==null) {
+                        " <span class='w3-bar-item w3-right' style='user-select:none;'
-                         documentElement.requestFullscreen()
+                            onClick='if (document.fullscreenElement==null) {
-                      } else {document.exitFullscreen();}'>⤢</span>"
+                              documentElement.requestFullscreen()
+                            } else {document.exitFullscreen();}'>~A</span>"
+                        *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")
+                                               (border-class *default-border-class*)
-                                               (title-class "w3-black")
+                                               (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")

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))

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))

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 "<ctrl/cmd> place static~%<shift> 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

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))))
 

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)))
+           (tool-bar  (create-div (top-panel box) :class title-class))
-           (btn-class "w3-button w3-white w3-border w3-border-black w3-ripple")
+           (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)

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)))
+           (tool-bar  (create-div (top-panel box) :class *builder-title-class*))
-           (btn-class "w3-button w3-white w3-border w3-border-black w3-ripple")
+           (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"
+  (let* ((*default-title-class*      *builder-title-class*)
-                                     :top 40 :left 225
+         (*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))))

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*)))

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")

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))

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 "<div class='w3-black'>
                                          <center><img src='~A'></center>
@@ -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 :"
+  (let ((*default-title-class*      *builder-title-class*)
-                (lambda (result)
+        (*default-border-class*     *builder-border-class*))
-                  (when result
+    (input-dialog body "Enter package:function-name :"
-                    (handler-case
+                  (lambda (result)
-                        (on-open-file body :title (format nil "Callers of ~A" result)
+                    (when result
-                                           :title-class "w3-orange"
+                      (handler-case
-                                           :text (swank::list-callers (read-from-string result)))
+                          (on-open-file body :title (format nil "Callers of ~A" result)
-                      (t (c)
+                                             :title-class *builder-show-callers-class*
-                        (on-open-file body :title "Error - Callers"
+                                             :text (swank::list-callers (read-from-string result)))
-                                           :title-class "w3-red"
+                        (t (c)
-                                           :text 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 :"
+  (let ((*default-title-class*      *builder-title-class*)
-                (lambda (result)
+        (*default-border-class*     *builder-border-class*))
-                  (when result
+    (input-dialog body "Enter package:function-name :"
-                    (handler-case
+                  (lambda (result)
-                        (on-open-file body :title (format nil "Callees of ~A" result)
+                    (when result
-                                           :title-class "w3-orange"
+                      (handler-case
-                                           :text (swank::list-callees (read-from-string result)))
+                          (on-open-file body :title (format nil "Callees of ~A" result)
-                      (t (c)
+                                             :title-class *builder-show-callees-class*
-                        (on-open-file body :title "Error - Callees"
+                                             :text (swank::list-callees (read-from-string result)))
-                                           :title-class "w3-red"
+                        (t (c)
-                                           :text 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")
+    (add-class body *builder-window-desktop-class*)
-    (setf (z-index (create-panel body :positioning :fixed
+    (when *builder-window-show-static-root-class*
-                                      :bottom 0 :left 0
+      (setf (z-index (create-panel body :positioning :fixed
-                                      :class "w3-gray"
+                                        :bottom 0 :left 0
-                                      :content (format nil "static-root: ~A" clog::*static-root*)))
+                                        :class *builder-window-show-static-root-class*
-          -9999)
+                                        :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 *builder-menu-button-class*)))
-      (let ((exter (create-button file :content "-" :class "w3-input w3-button w3-ripple")))
         (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

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")