From 4bcbc646fc9db61e6a19c35d7300a29d9f19d218 Mon Sep 17 00:00:00 2001 From: David Botton Date: Mon, 1 Jul 2024 11:36:02 -0400 Subject: [PATCH] change static-root on load, better handle new projects --- tools/clog-builder-project-tree.lisp | 20 +++++++----- tools/clog-builder-projects.lisp | 47 ++++++++++++---------------- tools/clog-builder-templates.lisp | 7 +++-- 3 files changed, 37 insertions(+), 37 deletions(-) diff --git a/tools/clog-builder-project-tree.lisp b/tools/clog-builder-project-tree.lisp index 7466277..4374d82 100644 --- a/tools/clog-builder-project-tree.lisp +++ b/tools/clog-builder-project-tree.lisp @@ -27,6 +27,14 @@ (set-on-window-move win (lambda (obj) (setf (width obj) (width 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) (let ((app (connection-data-item obj "builder-app-data"))) @@ -86,13 +94,7 @@ (lambda (obj) (let* ((*default-title-class* *builder-title-class*) (*default-border-class* *builder-border-class*)) - (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*))) + (update-static-root app) (input-dialog obj "Run form:" (lambda (result) (when result @@ -236,7 +238,9 @@ (setf (text-value load-btn) "working") (setf (background-color load-btn) :yellow) (handler-case - (projects-load (format nil "~A/tools" sel)) + (progn + (projects-load (format nil "~A/tools" sel)) + (update-static-root app)) (error () (projects-load sel))) (setf (text-value load-btn) "loaded") diff --git a/tools/clog-builder-projects.lisp b/tools/clog-builder-projects.lisp index 487efa8..e737a84 100644 --- a/tools/clog-builder-projects.lisp +++ b/tools/clog-builder-projects.lisp @@ -81,15 +81,7 @@ (let ((app (connection-data-item panel "builder-app-data")) (val (text-value (entry-point panel)))) (unless (equal val "") - (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*))) - (alert-toast panel "Static Root Set" - *static-root* :color-class "w3-yellow") + (update-static-root app) (setf clog:*clog-debug* (lambda (event data) (with-clog-debugger (panel @@ -99,7 +91,9 @@ (capture-eval (format nil "(~A)" val) :clog-obj panel :capture-console 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) (let* ((sys (text-value (project-list panel))) @@ -212,22 +206,19 @@ (add-select-option (designtime-list panel) path name))) (dolist (n (asdf:system-depends-on sys)) (add-select-option (design-deps panel) n n)) - (cond ((member "clog" (asdf:system-defsystem-depends-on sys) :test #'equal) - (setf (disabledp (runtime-add-lisp panel)) nil) - (setf (disabledp (runtime-delete panel)) nil) - (setf (disabledp (designtime-add-lisp panel)) nil) - (setf (disabledp (designtime-add-clog panel)) nil) - (setf (disabledp (designtime-delete panel)) nil) - (setf (disabledp (runtime-add-dep panel)) nil) - (setf (disabledp (runtime-del-dep panel)) nil) - (setf (disabledp (design-add-dep panel)) nil) - (setf (disabledp (design-del-dep panel)) nil) - (setf (disabledp (design-plugin panel)) nil) - (setf (disabledp (entry-point 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)))) + (when (member "clog" (asdf:system-defsystem-depends-on sys) :test #'equal) + (setf (disabledp (runtime-add-lisp panel)) nil) + (setf (disabledp (runtime-delete panel)) nil) + (setf (disabledp (designtime-add-lisp panel)) nil) + (setf (disabledp (designtime-add-clog panel)) nil) + (setf (disabledp (designtime-delete panel)) nil) + (setf (disabledp (runtime-add-dep panel)) nil) + (setf (disabledp (runtime-del-dep panel)) nil) + (setf (disabledp (design-add-dep panel)) nil) + (setf (disabledp (design-del-dep panel)) nil) + (setf (disabledp (design-plugin panel)) nil) + (setf (disabledp (entry-point panel)) nil) + (setf (disabledp (run-button panel)) nil))) (t (c) (declare (ignore c)) (add-select-option (designtime-list panel) "" "Missing /tools") @@ -236,7 +227,9 @@ (flet ((load-proj (answer) (cond (answer (handler-case - (projects-load (format nil "~A/tools" sel)) + (progn + (projects-load (format nil "~A/tools" sel)) + (update-static-root app)) (error () (projects-load sel))) (window-focus (parent (parent panel))) diff --git a/tools/clog-builder-templates.lisp b/tools/clog-builder-templates.lisp index 509d465..dfab487 100644 --- a/tools/clog-builder-templates.lisp +++ b/tools/clog-builder-templates.lisp @@ -95,8 +95,11 @@ create-div's" (template-copy sys-name www-dir filename :panel (window-content (win panel)))) (asdf:clear-source-registry) (when (project-win app) - (clog-gui:window-close (project-win app))) - (on-show-project panel :project sys-name) + (window-close (project-win app))) + (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 "
done.")))) (t (window-close (win panel)))))))))