mirror of
https://github.com/rabbibotton/clog.git
synced 2025-12-06 02:30:42 -08:00
Configurable look and feel
This commit is contained in:
David Botton
parent
fa0813e0fd
commit
0ed9d6d242
12 changed files with 264 additions and 115 deletions
|
|
@ -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
|
||||
" <span class='w3-bar-item w3-right' style='user-select:none;'
|
||||
onClick='if (document.fullscreenElement==null) {
|
||||
documentElement.requestFullscreen()
|
||||
} else {document.exitFullscreen();}'>⤢</span>"
|
||||
} 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")
|
||||
(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")
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
|
@ -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*)))
|
||||
|
|
|
|||
|
|
@ -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")
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
(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 "w3-orange"
|
||||
: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)))))))
|
||||
:text c))))))))
|
||||
|
||||
(defun on-show-callees (body)
|
||||
"Open callees window"
|
||||
(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 "w3-orange"
|
||||
: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)))))))
|
||||
: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*)
|
||||
(when *builder-window-show-static-root-class*
|
||||
(setf (z-index (create-panel body :positioning :fixed
|
||||
:bottom 0 :left 0
|
||||
:class "w3-gray"
|
||||
:class *builder-window-show-static-root-class*
|
||||
:content (format nil "static-root: ~A" clog::*static-root*)))
|
||||
-9999)
|
||||
-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
|
||||
|
|
|
|||
22
tools/preferences.lisp.sample
vendored
22
tools/preferences.lisp.sample
vendored
|
|
@ -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")
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue