From c264e34fdc14f5aab0b25bf4d82b67fe211d402e Mon Sep 17 00:00:00 2001 From: David Botton Date: Thu, 4 Aug 2022 17:00:18 -0400 Subject: [PATCH] project dependencies --- tools/clog-builder.lisp | 75 ++++++++++++++++++++++++-- tools/projects.clog | 22 +++++--- tools/projects.lisp | 117 +++++++++++++++++++++++++++++++++------- 3 files changed, 185 insertions(+), 29 deletions(-) diff --git a/tools/clog-builder.lisp b/tools/clog-builder.lisp index 595c3fc..0091a78 100644 --- a/tools/clog-builder.lisp +++ b/tools/clog-builder.lisp @@ -1232,8 +1232,8 @@ of controls and double click to select control." (if (project-win app) (window-focus (project-win app)) (let* ((win (create-gui-window obj :title "Project Window" - :top 200 :left 230 - :width 643 :height 400 + :top 100 :left 232 + :width 643 :height 560 :has-pinner t :client-movement t))) (create-projects (window-content win)) (setf (project-win app) win) @@ -2490,6 +2490,8 @@ of controls and double click to select control." (sel (text-value (project-list panel)))) (setf (inner-html (runtime-list panel)) "") (setf (inner-html (designtime-list panel)) "") + (setf (inner-html (runtime-deps panel)) "") + (setf (inner-html (design-deps panel)) "") (setf (disabledp (runtime-add-lisp panel)) t) (setf (disabledp (runtime-delete panel)) t) (setf (disabledp (designtime-add-lisp panel)) t) @@ -2506,6 +2508,9 @@ of controls and double click to select control." (let ((name (asdf:component-relative-pathname n)) (path (asdf:component-pathname n))) (add-select-option (runtime-list panel) path name))) + (dolist (n (asdf:system-depends-on + (asdf:find-system sel))) + (add-select-option (runtime-deps panel) n n)) ;; fill designtime) (handler-case (let ((sys (asdf:find-system (format nil "~A/tools" sel)))) @@ -2513,6 +2518,9 @@ of controls and double click to select control." (let ((name (asdf:component-relative-pathname n)) (path (asdf:component-pathname n))) (add-select-option (designtime-list panel) path name))) + (dolist (n (asdf:system-depends-on + (asdf:find-system 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) @@ -2524,7 +2532,8 @@ of controls and double click to select control." :color-class "w3-yellow" :time-out 2)))) (t (c) (declare (ignore c)) - (add-select-option (designtime-list panel) "" "Missing /tools")))) + (add-select-option (designtime-list panel) "" "Missing /tools") + (add-select-option (design-deps panel) "" "Missing /tools")))) (t (confirm-dialog panel "Load project?" (lambda (answer) @@ -2540,8 +2549,66 @@ of controls and double click to select control." (setf (text-value (project-list panel)) "None")))) :title "System not loaded")))))) +(defun projects-add-dep (panel sys) + (Input-dialog panel "Enter system name:" + (lambda (result) + (when result + (add-dep-to-defsystem sys result) + (ql:quickload sys) + (projects-populate panel))) + :height 230) + (ql:quickload sys)) + +(defun projects-add-plugin (panel sys) + (input-dialog panel (format nil "Enter plugin name (without /tools), ~ + plugin will be added to the runtime and designtime:") + (lambda (result) + (when result + (let* ((s (format nil "~A/tools" sys))) + (add-dep-to-defsystem s (format nil "~A/tools" result)) + (ql:quickload s)) + (add-dep-to-defsystem sys result) + (ql:quickload sys) + (projects-populate panel))) + :height 250)) + +(defun add-dep-to-defsystem (sys file) + (let ((fname (asdf:system-source-file (asdf:find-system sys))) + (sys-list '())) + (with-open-file (s fname) + (loop + (let* ((line (read s nil))) + (unless line (return)) + (when (equalp (format nil "~A" (second line)) sys) + (setf (getf line :depends-on) + (append (getf line :depends-on) `(,file)))) + (push line sys-list)))) + (with-open-file (s fname :direction :output :if-exists :rename) + (let ((*print-case* :downcase)) + (dolist (n (reverse sys-list)) + (pprint n s)))))) + +(defun remove-dep-from-defsystem (sys file) + (let ((fname (asdf:system-source-file (asdf:find-system sys))) + (sys-list '())) + (with-open-file (s fname) + (loop + (let* ((line (read s nil))) + (unless line (return)) + (when (equalp (format nil "~A" (second line)) sys) + (let (new-comp) + (dolist (n (getf line :depends-on)) + (unless (equalp (format nil "~A" n) file) + (push n new-comp))) + (setf (getf line :depends-on) (reverse new-comp)))) + (push line sys-list)))) + (with-open-file (s fname :direction :output :if-exists :rename) + (let ((*print-case* :downcase)) + (dolist (n (reverse sys-list)) + (pprint n s)))))) + (defun projects-add-lisp (panel sys) - (input-dialog panel "Enter lisp component name (with out .lisp):" + (Input-dialog panel "Enter lisp component name (with out .lisp):" (lambda (result) (when result (let ((path (asdf:component-pathname diff --git a/tools/projects.clog b/tools/projects.clog index c40d457..f7140e3 100644 --- a/tools/projects.clog +++ b/tools/projects.clog @@ -1,16 +1,16 @@ - \ No newline at end of file + (projects-populate panel))">Reload \ No newline at end of file diff --git a/tools/projects.lisp b/tools/projects.lisp index ada6ee4..822e173 100644 --- a/tools/projects.lisp +++ b/tools/projects.lisp @@ -1,6 +1,15 @@ (in-package "CLOG-TOOLS") (defclass projects (clog:clog-panel) - ((reload-project-button :reader reload-project-button) + ((design-plugin :reader design-plugin) + (design-del-dep :reader design-del-dep) + (design-add-dep :reader design-add-dep) + (runtime-del-dep :reader runtime-del-dep) + (runtime-add-dep :reader runtime-add-dep) + (design-deps :reader design-deps) + (design-deps-label :reader design-deps-label) + (runtime-deps :reader runtime-deps) + (runtime-deps-label :reader runtime-deps-label) + (reload-project-button :reader reload-project-button) (unload-project-button :reader unload-project-button) (new-project-button :reader new-project-button) (designtime-delete :reader designtime-delete) @@ -20,60 +29,87 @@ (let ((panel (change-class (clog:create-div clog-obj :content - "" + "" :hidden hidden :class class :html-id html-id :auto-place auto-place) 'projects))) + (setf (slot-value panel 'design-plugin) + (attach-as-child clog-obj "CLOGB3868634952" :clog-type + 'clog:clog-button :new-id t)) + (setf (slot-value panel 'design-del-dep) + (attach-as-child clog-obj "CLOGB3868634951" :clog-type + 'clog:clog-button :new-id t)) + (setf (slot-value panel 'design-add-dep) + (attach-as-child clog-obj "CLOGB3868634950" :clog-type + 'clog:clog-button :new-id t)) + (setf (slot-value panel 'runtime-del-dep) + (attach-as-child clog-obj "CLOGB3868634949" :clog-type + 'clog:clog-button :new-id t)) + (setf (slot-value panel 'runtime-add-dep) + (attach-as-child clog-obj "CLOGB3868634948" :clog-type + 'clog:clog-button :new-id t)) + (setf (slot-value panel 'design-deps) + (attach-as-child clog-obj "CLOGB3868634947" :clog-type + 'clog:clog-select :new-id t)) + (setf (slot-value panel 'design-deps-label) + (attach-as-child clog-obj "CLOGB3868634946" :clog-type + 'clog:clog-label :new-id t)) + (setf (slot-value panel 'runtime-deps) + (attach-as-child clog-obj "CLOGB3868634945" :clog-type + 'clog:clog-select :new-id t)) + (setf (slot-value panel 'runtime-deps-label) + (attach-as-child clog-obj "CLOGB3868634944" :clog-type + 'clog:clog-label :new-id t)) (setf (slot-value panel 'reload-project-button) - (attach-as-child clog-obj "CLOGB3868552729" :clog-type + (attach-as-child clog-obj "CLOGB3868634943" :clog-type 'clog:clog-button :new-id t)) (setf (slot-value panel 'unload-project-button) - (attach-as-child clog-obj "CLOGB3868552728" :clog-type + (attach-as-child clog-obj "CLOGB3868634942" :clog-type 'clog:clog-button :new-id t)) (setf (slot-value panel 'new-project-button) - (attach-as-child clog-obj "CLOGB3868552727" :clog-type + (attach-as-child clog-obj "CLOGB3868634941" :clog-type 'clog:clog-button :new-id t)) (setf (slot-value panel 'designtime-delete) - (attach-as-child clog-obj "CLOGB3868552726" :clog-type + (attach-as-child clog-obj "CLOGB3868634940" :clog-type 'clog:clog-button :new-id t)) (setf (slot-value panel 'designtime-add-lisp) - (attach-as-child clog-obj "CLOGB3868552725" :clog-type + (attach-as-child clog-obj "CLOGB3868634939" :clog-type 'clog:clog-button :new-id t)) (setf (slot-value panel 'designtime-add-clog) - (attach-as-child clog-obj "CLOGB3868552724" :clog-type + (attach-as-child clog-obj "CLOGB3868634938" :clog-type 'clog:clog-button :new-id t)) (setf (slot-value panel 'runtime-delete) - (attach-as-child clog-obj "CLOGB3868552723" :clog-type + (attach-as-child clog-obj "CLOGB3868634937" :clog-type 'clog:clog-button :new-id t)) (setf (slot-value panel 'runtime-add-lisp) - (attach-as-child clog-obj "CLOGB3868552722" :clog-type + (attach-as-child clog-obj "CLOGB3868634936" :clog-type 'clog:clog-button :new-id t)) (setf (slot-value panel 'designtime-list) - (attach-as-child clog-obj "CLOGB3868552721" :clog-type + (attach-as-child clog-obj "CLOGB3868634935" :clog-type 'clog:clog-select :new-id t)) (setf (slot-value panel 'runtime-list) - (attach-as-child clog-obj "CLOGB3868552720" :clog-type + (attach-as-child clog-obj "CLOGB3868634934" :clog-type 'clog:clog-select :new-id t)) (setf (slot-value panel 'dbl-click2) - (attach-as-child clog-obj "CLOGB3868552719" :clog-type + (attach-as-child clog-obj "CLOGB3868634933" :clog-type 'clog:clog-label :new-id t)) (setf (slot-value panel 'designtime-label) - (attach-as-child clog-obj "CLOGB3868552718" :clog-type + (attach-as-child clog-obj "CLOGB3868634932" :clog-type 'clog:clog-label :new-id t)) (setf (slot-value panel 'dbl-click1) - (attach-as-child clog-obj "CLOGB3868552717" :clog-type + (attach-as-child clog-obj "CLOGB3868634931" :clog-type 'clog:clog-label :new-id t)) (setf (slot-value panel 'runtime-label) - (attach-as-child clog-obj "CLOGB3868552716" :clog-type + (attach-as-child clog-obj "CLOGB3868634930" :clog-type 'clog:clog-label :new-id t)) (setf (slot-value panel 'edit-asd) - (attach-as-child clog-obj "CLOGB3868552715" :clog-type + (attach-as-child clog-obj "CLOGB3868634929" :clog-type 'clog:clog-button :new-id t)) (setf (slot-value panel 'project-list) - (attach-as-child clog-obj "CLOGB3868552714" :clog-type + (attach-as-child clog-obj "CLOGB3868634928" :clog-type 'clog:clog-select :new-id t)) (setf (slot-value panel 'projects-label) - (attach-as-child clog-obj "CLOGB3868552713" :clog-type + (attach-as-child clog-obj "CLOGB3868634927" :clog-type 'clog:clog-label :new-id t)) (let ((target (projects-label panel))) (declare (ignorable target)) @@ -103,6 +139,16 @@ (setf (attribute target "for") (clog:js-query target "$('[data-clog-name=\\'designtime-list\\']').attr('id')"))) + (let ((target (runtime-deps-label panel))) + (declare (ignorable target)) + (setf (attribute target "for") + (clog:js-query target + "$('[data-clog-name=\\'runtime-deps\\']').attr('id')"))) + (let ((target (design-deps-label panel))) + (declare (ignorable target)) + (setf (attribute target "for") + (clog:js-query target + "$('[data-clog-name=\\'design-deps\\']').attr('id')"))) (clog:set-on-change (project-list panel) (lambda (target) (declare (ignorable target)) @@ -185,4 +231,37 @@ (let ((sel (text-value (project-list panel)))) (asdf/system-registry:clear-system sel) (projects-populate panel)))) + (clog:set-on-click (runtime-add-dep panel) + (lambda (target) + (declare (ignorable target)) + (let ((sys (text-value (project-list panel)))) + (projects-add-dep panel sys)))) + (clog:set-on-click (runtime-del-dep panel) + (lambda (target) + (declare (ignorable target)) + (let ((sys (text-value (project-list panel))) + (file (select-text (runtime-deps panel)))) + (remove-dep-from-defsystem sys file) + (projects-populate panel)))) + (clog:set-on-click (design-add-dep panel) + (lambda (target) + (declare (ignorable target)) + (let ((sys + (format nil "~A/tools" + (text-value (project-list panel))))) + (projects-add-dep panel sys)))) + (clog:set-on-click (design-del-dep panel) + (lambda (target) + (declare (ignorable target)) + (let ((sys + (format nil "~A/tools" + (text-value (project-list panel)))) + (file (select-text (design-deps panel)))) + (remove-dep-from-defsystem sys file) + (projects-populate panel)))) + (clog:set-on-click (design-plugin panel) + (lambda (target) + (declare (ignorable target)) + (let ((sys (text-value (project-list panel)))) + (projects-add-plugin panel sys)))) panel))