mirrors/clog
1
Fork 0
mirror of https://github.com/rabbibotton/clog.git synced 2025-12-24 11:00:41 -08:00
Code Issues Projects Releases Wiki Activity

Restructure windows

Browse source
This commit is contained in:
David Botton 2024-03-19 20:49:33 -04:00
parent b6137e4cd1
commit 249e8450b8
8 changed files with 1711 additions and 1698 deletions
Download patch file Download diff file Expand all files Collapse all files

47
tools/clog-builder-control-properties.lisp Normal file
View file

@ -0,0 +1,47 @@
(in-package :clog-tools)
(defun on-show-control-properties-win (obj)
"Show control properties window"
(let* ((app (connection-data-item obj "builder-app-data"))
(is-hidden nil)
(auto-mode nil)
(panel (create-panel (connection-body obj) :positioning :fixed
:width 400
:top 40
:right 0 :bottom 0
:class "w3-border-left"))
(content (create-panel panel :width 390 :top 0 :right 0 :bottom 0))
(side-panel (create-panel panel :top 0 :left 0 :bottom 0 :width 10))
(pin (create-div side-panel :content "☑" :class "w3-small"))
(control-list (create-table content)))
(setf (background-color side-panel) :black)
(setf (background-color content) :gray)
(setf (right-panel app) panel)
(setf (hiddenp (right-panel app)) t)
(setf (control-properties-win app) content)
(setf (properties-list app) control-list)
(set-on-click side-panel (lambda (obj)
(declare (ignore obj))
(cond (auto-mode
(setf auto-mode nil)
(setf (text-value pin) "☑")
(setf (width panel) "400px")
(setf is-hidden nil))
(t
(setf auto-mode t)
(setf (text-value pin) "☐")
(setf (width panel) "400px")
(setf is-hidden nil)))))
(set-on-mouse-leave side-panel (lambda (obj)
(declare (ignore obj))
(when auto-mode
(cond (is-hidden
(setf (width panel) "400px")
(setf is-hidden nil))
(t
(setf (width panel) "10px")
(setf is-hidden t))))))
(setf (overflow content) :auto)
(setf (positioning control-list) :absolute)
(set-geometry control-list :left 0 :top 0 :right 0)))