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 @@
-Add .lispAdd .lispRemoveAdd .clogAdd .lispAdd .clogAdd .lispUnloadReload
\ No newline at end of file
+ (projects-populate panel))">ReloadAddRemoveAddRemovePlugin
\ 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
- "Edit .asdAdd .lispRemoveAdd .clogAdd .lispRemoveNewUnloadReload"
+ "Edit .asdAdd .lispRemoveAdd .clogAdd .lispRemoveNewUnloadReloadAddRemoveAddRemovePlugin"
: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))