mirrors/clog
1
Fork 0
mirror of https://github.com/rabbibotton/clog.git synced 2025-12-06 02:30:42 -08:00
Code Issues Projects Releases Wiki Activity

advisory titles added on project tree

Browse source
This commit is contained in:
David Botton 2024-06-16 09:38:12 -04:00
parent c78061b811
commit 53d314e156
1 changed files with 10 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

11
tools/clog-builder-project-tree.lisp
View file

@ -234,21 +234,25 @@
(setf (background-color load-btn) load-np) (setf (background-color load-btn) load-np)
(window-focus win)) (window-focus win))
(on-change (obj) (on-change (obj)
(declare (ignore obj))
(setf (text tree) "") (setf (text tree) "")
(browser-gc obj) (browser-gc tree)
(let* ((sel (value projects))) (let* ((sel (value projects)))
(setf entry-point "") (setf entry-point "")
(cond ((equal sel "") (cond ((equal sel "")
(setf (text-value load-btn) "no project") (setf (text-value load-btn) "no project")
(setf (advisory-title load-btn) "Choose project in drop down")
(setf (background-color load-btn) load-np) (setf (background-color load-btn) load-np)
(setf (current-project app) nil)) (setf (current-project app) nil))
(t (t
(setf (text-value load-btn) "working") (setf (text-value load-btn) "working")
(setf (background-color load-btn) :yellow) (setf (background-color load-btn) :yellow)
(setf (advisory-title load-btn) "")
(let* ((root (quicklisp:where-is-system sel)) (let* ((root (quicklisp:where-is-system sel))
(dir (directory-namestring (uiop:truename* root)))) (dir (directory-namestring (uiop:truename* root))))
(cond (root (cond (root
(setf (text-value load-btn) "not loaded") (setf (text-value load-btn) "not loaded")
(setf (advisory-title load-btn) "Click to load")
(setf (background-color load-btn) :tomato) (setf (background-color load-btn) :tomato)
(setf (current-project app) sel) (setf (current-project app) sel)
(create-clog-tree tree (create-clog-tree tree
@ -302,9 +306,11 @@
(if (member sel already :test #'equalp) (if (member sel already :test #'equalp)
(progn (progn
(setf (text-value load-btn) "loaded") (setf (text-value load-btn) "loaded")
(setf (advisory-title load-btn) "Click to unload")
(setf (background-color load-btn) load-np)) (setf (background-color load-btn) load-np))
(progn (progn
(setf (text-value load-btn) "not loaded") (setf (text-value load-btn) "not loaded")
(setf (advisory-title load-btn) "Click to load")
(setf (background-color load-btn) :tomato)))) (setf (background-color load-btn) :tomato))))
(setf entry-point (format nil "(~A)" (setf entry-point (format nil "(~A)"
(or (asdf/system:component-entry-point (asdf:find-system sel)) (or (asdf/system:component-entry-point (asdf:find-system sel))
@ -313,6 +319,7 @@
(setf entry-point "") (setf entry-point "")
(setf (current-project app) nil) (setf (current-project app) nil)
(setf (text-value load-btn) "no project") (setf (text-value load-btn) "no project")
(setf (advisory-title load-btn) "Choose project in drop down")
(setf (background-color load-btn) :load-np)))))))) (setf (background-color load-btn) :load-np))))))))
(fill-projects () (fill-projects ()
(setf (text projects) "") (setf (text projects) "")
@ -326,8 +333,10 @@
(cond ((equalp (text-value load-btn) "loaded") (cond ((equalp (text-value load-btn) "loaded")
(asdf:clear-system (value projects)) (asdf:clear-system (value projects))
(setf (text-value load-btn) "not loaded") (setf (text-value load-btn) "not loaded")
(setf (advisory-title load-btn) "Click to load")
(setf (background-color load-btn) :tomato)) (setf (background-color load-btn) :tomato))
((equalp (text-value load-btn) "not loaded") ((equalp (text-value load-btn) "not loaded")
(setf (advisory-title load-btn) "Click to unload")
(load-proj (value projects)))))) (load-proj (value projects))))))
(set-on-click refresh-btn (lambda (obj) (set-on-click refresh-btn (lambda (obj)
(declare (ignore obj)) (declare (ignore obj))