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

handle no project loaded better

Browse source
This commit is contained in:
David Botton 2024-05-06 14:42:19 -04:00
parent acf4cf240b
commit 260ed38e10
1 changed files with 38 additions and 32 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -117,42 +117,48 @@
(window-focus win)) (window-focus win))
(on-change (obj) (on-change (obj)
(declare (ignore obj)) (declare (ignore obj))
(setf (text-value load-btn) "loading")
(setf (text tree) "") (setf (text tree) "")
(let* ((sel (value projects)) (let* ((sel (value projects)))
(root (quicklisp:where-is-system sel)) (setf entry-point "")
(dir (directory-namestring (uiop:truename* root)))) (cond ((equal sel "")
(cond (root (setf (text-value load-btn) "no project")
(setf (current-project app) sel) (setf (current-project app) nil))
(setf (text-value load-btn) "not loaded")
(create-clog-tree tree
:fill-function (lambda (obj)
(project-tree-dir-select obj dir))
:node-html "🦎"
:content root)
(let ((already (asdf:already-loaded-systems)))
(if (member sel already :test #'equalp)
(setf (text-value load-btn) "loaded")
(let* ((*default-title-class* *builder-title-class*)
(*default-border-class* *builder-border-class*))
(setf (text-value load-btn) "loading")
(confirm-dialog win "Load project?"
(lambda (answer)
(if answer
(load-proj sel)
(setf (text-value load-btn) "not loaded")))
:title "System not loaded"))))
(setf entry-point (format nil "(~A)"
(or (asdf/system:component-entry-point (asdf:find-system sel))
""))))
(t (t
(setf entry-point "") (setf (text-value load-btn) "loading")
(setf (text-value load-btn) "no project")))))) (let* ((root (quicklisp:where-is-system sel))
(dir (directory-namestring (uiop:truename* root))))
(cond (root
(setf (text-value load-btn) "not loaded")
(setf (current-project app) sel)
(create-clog-tree tree
:fill-function (lambda (obj)
(project-tree-dir-select obj dir))
:node-html "🦎"
:content root)
(let ((already (asdf:already-loaded-systems)))
(if (member sel already :test #'equalp)
(setf (text-value load-btn) "loaded")
(let* ((*default-title-class* *builder-title-class*)
(*default-border-class* *builder-border-class*))
(setf (text-value load-btn) "loading")
(confirm-dialog win "Load project?"
(lambda (answer)
(if answer
(load-proj sel)
(setf (text-value load-btn) "not loaded")))
:title "System not loaded"))))
(setf entry-point (format nil "(~A)"
(or (asdf/system:component-entry-point (asdf:find-system sel))
""))))
(t
(setf entry-point "")
(setf (current-project app) nil)
(setf (text-value load-btn) "no project")))))))))
(set-on-click load-btn (lambda (obj) (set-on-click load-btn (lambda (obj)
(declare (ignore obj)) (declare (ignore obj))
(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"))
((equalp (text-value load-btn) "not loaded") ((equalp (text-value load-btn) "not loaded")
(load-proj (value projects)))))) (load-proj (value projects))))))
(dolist (n (quicklisp:list-local-systems)) (dolist (n (quicklisp:list-local-systems))
@ -160,4 +166,4 @@
(when (equalp n project) (when (equalp n project)
(on-change projects))) (on-change projects)))
(add-select-option projects "" "Select Project" :selected (not project)) (add-select-option projects "" "Select Project" :selected (not project))
(set-on-change projects #'on-change)))))) (set-on-change projects #'on-change))))))