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

change static-root on load, better handle new projects

Browse source
This commit is contained in:
David Botton 2024-07-01 11:36:02 -04:00
parent 3c0a262ee7
commit 4bcbc646fc
3 changed files with 37 additions and 37 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -27,6 +27,14 @@
(set-on-window-move win (lambda (obj) (set-on-window-move win (lambda (obj)
(setf (width obj) (width obj)) (setf (width obj) (width obj))
(setf (height obj) (height obj)))))))))))))) (setf (height obj) (height obj))))))))))))))
(defun update-static-root (app)
(setf *static-root*
(merge-pathnames (if (equal (current-project app) "clog")
"./static-root/"
"./www/")
(format nil "~A" (asdf:system-source-directory (current-project app)))))
(when (static-root-display app)
(setf (text-value (static-root-display app)) (format nil "static-root: ~A" *static-root*))))
(defun on-project-tree (obj &key project) (defun on-project-tree (obj &key project)
(let ((app (connection-data-item obj "builder-app-data"))) (let ((app (connection-data-item obj "builder-app-data")))
@ -86,13 +94,7 @@
(lambda (obj) (lambda (obj)
(let* ((*default-title-class* *builder-title-class*) (let* ((*default-title-class* *builder-title-class*)
(*default-border-class* *builder-border-class*)) (*default-border-class* *builder-border-class*))
(setf *static-root* (update-static-root app)
(merge-pathnames (if (equal (current-project app) "clog")
"./static-root/"
"./www/")
(format nil "~A" (asdf:system-source-directory (current-project app)))))
(when (static-root-display app)
(setf (text-value (static-root-display app)) (format nil "static-root: ~A" *static-root*)))
(input-dialog obj "Run form:" (input-dialog obj "Run form:"
(lambda (result) (lambda (result)
(when result (when result
@ -236,7 +238,9 @@
(setf (text-value load-btn) "working") (setf (text-value load-btn) "working")
(setf (background-color load-btn) :yellow) (setf (background-color load-btn) :yellow)
(handler-case (handler-case
(projects-load (format nil "~A/tools" sel)) (progn
(projects-load (format nil "~A/tools" sel))
(update-static-root app))
(error () (error ()
(projects-load sel))) (projects-load sel)))
(setf (text-value load-btn) "loaded") (setf (text-value load-btn) "loaded")

47
tools/clog-builder-projects.lisp
View file

@ -81,15 +81,7 @@
(let ((app (connection-data-item panel "builder-app-data")) (let ((app (connection-data-item panel "builder-app-data"))
(val (text-value (entry-point panel)))) (val (text-value (entry-point panel))))
(unless (equal val "") (unless (equal val "")
(setf *static-root* (update-static-root app)
(merge-pathnames (if (equal (current-project app) "clog")
"./static-root/"
"./www/")
(format nil "~A" (asdf:system-source-directory (current-project app)))))
(when (static-root-display app)
(setf (text-value (static-root-display app)) (format nil "static-root: ~A" *static-root*)))
(alert-toast panel "Static Root Set"
*static-root* :color-class "w3-yellow")
(setf clog:*clog-debug* (setf clog:*clog-debug*
(lambda (event data) (lambda (event data)
(with-clog-debugger (panel (with-clog-debugger (panel
@ -99,7 +91,9 @@
(capture-eval (format nil "(~A)" val) :clog-obj panel (capture-eval (format nil "(~A)" val) :clog-obj panel
:capture-console nil :capture-console nil
:capture-result nil :capture-result nil
:eval-in-package "clog-user")))) :eval-in-package "clog-user")
(alert-toast panel "Static Root Set"
*static-root* :color-class "w3-yellow" :time-out 3))))
(defun projects-entry-point-change (panel) (defun projects-entry-point-change (panel)
(let* ((sys (text-value (project-list panel))) (let* ((sys (text-value (project-list panel)))
@ -212,22 +206,19 @@
(add-select-option (designtime-list panel) path name))) (add-select-option (designtime-list panel) path name)))
(dolist (n (asdf:system-depends-on sys)) (dolist (n (asdf:system-depends-on sys))
(add-select-option (design-deps panel) n n)) (add-select-option (design-deps panel) n n))
(cond ((member "clog" (asdf:system-defsystem-depends-on sys) :test #'equal) (when (member "clog" (asdf:system-defsystem-depends-on sys) :test #'equal)
(setf (disabledp (runtime-add-lisp panel)) nil) (setf (disabledp (runtime-add-lisp panel)) nil)
(setf (disabledp (runtime-delete panel)) nil) (setf (disabledp (runtime-delete panel)) nil)
(setf (disabledp (designtime-add-lisp panel)) nil) (setf (disabledp (designtime-add-lisp panel)) nil)
(setf (disabledp (designtime-add-clog panel)) nil) (setf (disabledp (designtime-add-clog panel)) nil)
(setf (disabledp (designtime-delete panel)) nil) (setf (disabledp (designtime-delete panel)) nil)
(setf (disabledp (runtime-add-dep panel)) nil) (setf (disabledp (runtime-add-dep panel)) nil)
(setf (disabledp (runtime-del-dep panel)) nil) (setf (disabledp (runtime-del-dep panel)) nil)
(setf (disabledp (design-add-dep panel)) nil) (setf (disabledp (design-add-dep panel)) nil)
(setf (disabledp (design-del-dep panel)) nil) (setf (disabledp (design-del-dep panel)) nil)
(setf (disabledp (design-plugin panel)) nil) (setf (disabledp (design-plugin panel)) nil)
(setf (disabledp (entry-point panel)) nil) (setf (disabledp (entry-point panel)) nil)
(setf (disabledp (run-button panel)) nil)) (setf (disabledp (run-button panel)) nil)))
(t
(alert-toast panel "Warning" "Missing :defsystem-depends-on (:clog)"
:color-class "w3-yellow" :time-out 1))))
(t (c) (t (c)
(declare (ignore c)) (declare (ignore c))
(add-select-option (designtime-list panel) "" "Missing /tools") (add-select-option (designtime-list panel) "" "Missing /tools")
@ -236,7 +227,9 @@
(flet ((load-proj (answer) (flet ((load-proj (answer)
(cond (answer (cond (answer
(handler-case (handler-case
(projects-load (format nil "~A/tools" sel)) (progn
(projects-load (format nil "~A/tools" sel))
(update-static-root app))
(error () (error ()
(projects-load sel))) (projects-load sel)))
(window-focus (parent (parent panel))) (window-focus (parent (parent panel)))

7
tools/clog-builder-templates.lisp
View file

@ -95,8 +95,11 @@ create-div's"
(template-copy sys-name www-dir filename :panel (window-content (win panel)))) (template-copy sys-name www-dir filename :panel (window-content (win panel))))
(asdf:clear-source-registry) (asdf:clear-source-registry)
(when (project-win app) (when (project-win app)
(clog-gui:window-close (project-win app))) (window-close (project-win app)))
(on-show-project panel :project sys-name) (on-show-project panel :project sys-name)
(when (project-tree-win app)
(window-close (project-tree-win app))
(on-project-tree panel))
(create-div (window-content (win panel)) :content "<hr><b>done.</b>")))) (create-div (window-content (win panel)) :content "<hr><b>done.</b>"))))
(t (t
(window-close (win panel))))))))) (window-close (win panel)))))))))