reorg and view dir on asdf systems

This commit is contained in:
David Botton 2022-09-01 21:59:43 -04:00
parent 827460ce19
commit a95196ebd3
6 changed files with 194 additions and 204 deletions

View file

@ -68,6 +68,7 @@
;; clog-builder code ;; clog-builder code
(:file "clog-builder-settings") (:file "clog-builder-settings")
(:file "clog-builder") (:file "clog-builder")
(:file "clog-builder-templates")
(:file "clog-builder-projects") (:file "clog-builder-projects")
(:file "clog-builder-asdf-browser") (:file "clog-builder-asdf-browser")
(:file "clog-builder-sys-browser") (:file "clog-builder-sys-browser")

View file

@ -1,19 +0,0 @@
<!doctype HTML>
<HTML>
<HEAD>
<meta http-equiv="Cache-Control" content="no-cache, no-store, must-revalidate" />
<meta http-equiv="Pragma" content="no-cache" />
<meta http-equiv="Expires" content="0" />
<meta charset="utf-8">
<meta name="viewport" content="width=device-width, initial-scale=1">
<script src="/js/jquery.min.js" type="text/javascript"></script>
<script src="/js/boot.js" type="text/javascript"></script>
<link href="https://cdn.jsdelivr.net/npm/bootstrap@5.1.3/dist/css/bootstrap.min.css" rel="stylesheet" integrity="sha384-1BmE4kWBq78iYhFldvKuhfTAU6auU8tT94WrHftjDbrCEXSU1oBoqyl2QvZ6jIW3" crossorigin="anonymous">
<script src="https://cdn.jsdelivr.net/npm/bootstrap@5.0.2/dist/js/bootstrap.bundle.min.js" integrity="sha384-MrcW6ZMFYlzcLA8Nl+NtUVF0sA7MsXsP1UyJoMp4YLEuNSfAP+JcXn/tWtIaxVXM" crossorigin="anonymous"></script>
<noscript><%= (@ meta) %></noscript>
</HEAD>
<BODY>
<noscript><%= (@ body) %></noscript>
</BODY>
<noscript>Your browser must support JavaScript and be HTML 5 compilant to see this site.</noscript>
</HTML>

View file

@ -0,0 +1,44 @@
(in-package :clog-tools)
(defun fill-button-clicked (panel)
"Template fill botton clicked"
(let* ((app (connection-data-item panel "builder-app-data"))
(tmpl-rec (find-if (lambda (x)
(equal (getf x :code)
(value (template-box panel))))
*supported-templates*))
(start-dir (format nil "~A~A"
(asdf:system-source-directory :clog)
(getf tmpl-rec :loc)))
(www-dir (format nil "~A~A"
(asdf:system-source-directory :clog)
(getf tmpl-rec :www))))
(setf (hiddenp panel) t)
(input-dialog
(win panel) "Enter new system name:"
(lambda (sys-name)
(cond (sys-name
(let ((fname (if (uiop:directory-exists-p #P"~/common-lisp/")
#P"~/common-lisp/"
(car ql:*local-project-directories*))))
(server-file-dialog
(win panel) "Output Directory" fname
(lambda (filename)
(cond (filename
(cond ((uiop:directory-exists-p (format nil "~A~A" filename sys-name))
(clog-gui:alert-toast (win panel) "Cancel" "Canceled - Project directory exists")
(window-close (win panel)))
(t
(template-copy sys-name start-dir filename :panel (window-content (win panel)))
(when (getf tmpl-rec :www)
(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)
(create-div (window-content (win panel)) :content "<hr><b>done.</b>"))))
(t
(window-close (win panel))))))))
(t
(window-close (win panel))))))))

View file

@ -319,6 +319,15 @@ replaced."
*supported-controls*) *supported-controls*)
(list r))))) (list r)))))
(defun reset-control-pallete (panel)
(let* ((app (connection-data-item panel "builder-app-data"))
(pallete (select-tool app)))
(setf (inner-html pallete) "")
(dolist (control *supported-controls*)
(if (equal (getf control :name) "group")
(add-select-optgroup pallete (getf control :description))
(add-select-option pallete (getf control :name) (getf control :description))))))
(defun create-control (parent content control-record uid &key custom-query) (defun create-control (parent content control-record uid &key custom-query)
"Return a new control based on CONTROL-RECORD as a child of PARENT" "Return a new control based on CONTROL-RECORD as a child of PARENT"
(let* ((create-type (getf control-record :create-type)) (let* ((create-type (getf control-record :create-type))
@ -1102,74 +1111,7 @@ of controls and double click to select control."
(setf control (next-sibling control)))))) (setf control (next-sibling control))))))
(add-siblings (first-child content) "")))))))) (add-siblings (first-child content) ""))))))))
;; Menu handlers ;; Editor Utilities
(defun do-eval (obj form-string cname &key (package "clog-user") custom-boot)
"Render, evalute and run code for panel"
(let* ((result (capture-eval (format nil "~A~% (clog:set-on-new-window~
(lambda (body)~
(clog:debug-mode body)~
~A
(create-~A body)) ~A:path \"/test\")"
form-string
(if custom-boot
""
"(clog-gui:clog-gui-initialize body)
(clog-web:clog-web-initialize body :w3-css-url nil)")
cname
(if custom-boot
(format nil ":boot-file \"~A\" " custom-boot)
""))
:eval-in-package package)))
(open-window (window (connection-body obj)) "http://127.0.0.1:8080/test")
(on-open-file obj :title-class "w3-yellow" :title "test eval" :text result)))
(defun on-show-control-properties-win (obj)
"Show control properties window"
(let* ((app (connection-data-item obj "builder-app-data"))
(is-hidden nil)
(auto-mode nil)
(panel (create-panel (connection-body obj) :positioning :fixed
:width 400
:top 40
:right 0 :bottom 0
:class "w3-border-left"))
(content (create-panel panel :width 390 :top 0 :right 0 :bottom 0))
(side-panel (create-panel panel :top 0 :left 0 :bottom 0 :width 10))
(pin (create-div side-panel :content "☑" :class "w3-small"))
(control-list (create-table content)))
(setf (background-color side-panel) :black)
(setf (background-color content) :gray)
(setf (right-panel app) panel)
(setf (hiddenp (right-panel app)) t)
(setf (control-properties-win app) content)
(setf (properties-list app) control-list)
(set-on-click side-panel (lambda (obj)
(declare (ignore obj))
(cond (auto-mode
(setf auto-mode nil)
(setf (text-value pin) "☑")
(setf (width panel) "400px")
(setf is-hidden nil))
(t
(setf auto-mode t)
(setf (text-value pin) "☐")
(setf (width panel) "400px")
(setf is-hidden nil)))))
(set-on-mouse-leave side-panel (lambda (obj)
(declare (ignore obj))
(when auto-mode
(cond (is-hidden
(setf (width panel) "400px")
(setf (hiddenp content) nil)
(setf is-hidden nil))
(t
(setf (width panel) "10px")
(setf (hiddenp content) t)
(setf is-hidden t))))))
(setf (overflow content) :auto)
(setf (positioning control-list) :absolute)
(set-geometry control-list :left 0 :top 0 :right 0)))
(defun setup-lisp-ace (editor status &key (package "CLOG-USER")) (defun setup-lisp-ace (editor status &key (package "CLOG-USER"))
(let ((app (connection-data-item editor "builder-app-data"))) (let ((app (connection-data-item editor "builder-app-data")))
@ -1302,6 +1244,85 @@ of controls and double click to select control."
(setf (clog-ace:mode editor) "ace/mode/lisp") (setf (clog-ace:mode editor) "ace/mode/lisp")
(setf (clog-ace:tab-size editor) 2))) (setf (clog-ace:tab-size editor) 2)))
(defun get-package-from-string (c)
"Determine the currect package based on src contained in string C"
(with-input-from-string (ins c)
(loop
(let ((form (read ins nil)))
(unless form (return "clog-user"))
(unless (consp form) (return "clog-user"))
(when (eq (car form) 'in-package)
(return (string-downcase (second form))))))))
;; Menu handlers
(defun do-eval (obj form-string cname &key (package "clog-user") custom-boot)
"Render, evalute and run code for panel"
(let* ((result (capture-eval (format nil "~A~% (clog:set-on-new-window~
(lambda (body)~
(clog:debug-mode body)~
~A
(create-~A body)) ~A:path \"/test\")"
form-string
(if custom-boot
""
"(clog-gui:clog-gui-initialize body)
(clog-web:clog-web-initialize body :w3-css-url nil)")
cname
(if custom-boot
(format nil ":boot-file \"~A\" " custom-boot)
""))
:eval-in-package package)))
(open-window (window (connection-body obj)) "http://127.0.0.1:8080/test")
(on-open-file obj :title-class "w3-yellow" :title "test eval" :text result)))
(defun on-show-control-properties-win (obj)
"Show control properties window"
(let* ((app (connection-data-item obj "builder-app-data"))
(is-hidden nil)
(auto-mode nil)
(panel (create-panel (connection-body obj) :positioning :fixed
:width 400
:top 40
:right 0 :bottom 0
:class "w3-border-left"))
(content (create-panel panel :width 390 :top 0 :right 0 :bottom 0))
(side-panel (create-panel panel :top 0 :left 0 :bottom 0 :width 10))
(pin (create-div side-panel :content "☑" :class "w3-small"))
(control-list (create-table content)))
(setf (background-color side-panel) :black)
(setf (background-color content) :gray)
(setf (right-panel app) panel)
(setf (hiddenp (right-panel app)) t)
(setf (control-properties-win app) content)
(setf (properties-list app) control-list)
(set-on-click side-panel (lambda (obj)
(declare (ignore obj))
(cond (auto-mode
(setf auto-mode nil)
(setf (text-value pin) "☑")
(setf (width panel) "400px")
(setf is-hidden nil))
(t
(setf auto-mode t)
(setf (text-value pin) "☐")
(setf (width panel) "400px")
(setf is-hidden nil)))))
(set-on-mouse-leave side-panel (lambda (obj)
(declare (ignore obj))
(when auto-mode
(cond (is-hidden
(setf (width panel) "400px")
(setf (hiddenp content) nil)
(setf is-hidden nil))
(t
(setf (width panel) "10px")
(setf (hiddenp content) t)
(setf is-hidden t))))))
(setf (overflow content) :auto)
(setf (positioning control-list) :absolute)
(set-geometry control-list :left 0 :top 0 :right 0)))
(defun on-show-project (obj &key project) (defun on-show-project (obj &key project)
(let ((app (connection-data-item obj "builder-app-data"))) (let ((app (connection-data-item obj "builder-app-data")))
(when project (when project
@ -1429,15 +1450,6 @@ of controls and double click to select control."
(setf (hiddenp win) t) (setf (hiddenp win) t)
nil)))))) nil))))))
(defun reset-control-pallete (panel)
(let* ((app (connection-data-item panel "builder-app-data"))
(pallete (select-tool app)))
(setf (inner-html pallete) "")
(dolist (control *supported-controls*)
(if (equal (getf control :name) "group")
(add-select-optgroup pallete (getf control :description))
(add-select-option pallete (getf control :name) (getf control :description))))))
(defun on-show-control-list-win (obj) (defun on-show-control-list-win (obj)
"Show control list for selecting and manipulating controls by name" "Show control list for selecting and manipulating controls by name"
(let* ((app (connection-data-item obj "builder-app-data")) (let* ((app (connection-data-item obj "builder-app-data"))
@ -1528,6 +1540,7 @@ of controls and double click to select control."
(setf is-hidden t)))))))) (setf is-hidden t))))))))
(defun panel-mode (obj bool) (defun panel-mode (obj bool)
"Set the status for display or hiding the side panels."
(let ((app (connection-data-item obj "builder-app-data"))) (let ((app (connection-data-item obj "builder-app-data")))
(setf (hiddenp (right-panel app)) (not bool)) (setf (hiddenp (right-panel app)) (not bool))
(setf (hiddenp (left-panel app)) (not bool)))) (setf (hiddenp (left-panel app)) (not bool))))
@ -2184,11 +2197,6 @@ of controls and double click to select control."
(set-on-new-window 'on-attach-builder-custom :boot-file "/boot.html" :path "/builder-custom") (set-on-new-window 'on-attach-builder-custom :boot-file "/boot.html" :path "/builder-custom")
(on-new-builder-page obj :custom-boot "/boot.html" :url-launch nil)) (on-new-builder-page obj :custom-boot "/boot.html" :url-launch nil))
(defun on-new-builder-bst-page (obj)
"Menu item to open new boostrap 5 page"
(set-on-new-window 'on-attach-builder-custom :boot-file "/bootstrap.html" :path "/builder-custom")
(on-new-builder-page obj :custom-boot "/bootstrap.html" :url-launch nil))
(defun on-new-builder-launch-page (obj) (defun on-new-builder-launch-page (obj)
"Menu item to open new page" "Menu item to open new page"
(on-new-builder-page obj :url-launch t)) (on-new-builder-page obj :url-launch t))
@ -2276,48 +2284,6 @@ of controls and double click to select control."
(add-select-optgroup (template-box ct) (getf tmpl :name)) (add-select-optgroup (template-box ct) (getf tmpl :name))
(add-select-option (template-box ct) (getf tmpl :code) (getf tmpl :name)))))) (add-select-option (template-box ct) (getf tmpl :code) (getf tmpl :name))))))
(defun fill-button-clicked (panel)
"Template fill botton clicked"
(let* ((app (connection-data-item panel "builder-app-data"))
(tmpl-rec (find-if (lambda (x)
(equal (getf x :code)
(value (template-box panel))))
*supported-templates*))
(start-dir (format nil "~A~A"
(asdf:system-source-directory :clog)
(getf tmpl-rec :loc)))
(www-dir (format nil "~A~A"
(asdf:system-source-directory :clog)
(getf tmpl-rec :www))))
(setf (hiddenp panel) t)
(input-dialog
(win panel) "Enter new system name:"
(lambda (sys-name)
(cond (sys-name
(let ((fname (if (uiop:directory-exists-p #P"~/common-lisp/")
#P"~/common-lisp/"
(car ql:*local-project-directories*))))
(server-file-dialog
(win panel) "Output Directory" fname
(lambda (filename)
(cond (filename
(cond ((uiop:directory-exists-p (format nil "~A~A" filename sys-name))
(clog-gui:alert-toast (win panel) "Cancel" "Canceled - Project directory exists")
(window-close (win panel)))
(t
(template-copy sys-name start-dir filename :panel (window-content (win panel)))
(when (getf tmpl-rec :www)
(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)
(create-div (window-content (win panel)) :content "<hr><b>done.</b>"))))
(t
(window-close (win panel))))))))
(t
(window-close (win panel))))))))
(defun on-image-to-data (obj) (defun on-image-to-data (obj)
"Menu option to create new project from template" "Menu option to create new project from template"
(let* ((win (create-gui-window obj :title "Convert Images to Data" (let* ((win (create-gui-window obj :title "Convert Images to Data"
@ -2325,8 +2291,27 @@ of controls and double click to select control."
(create-image-to-data (window-content win)) (create-image-to-data (window-content win))
(window-center win))) (window-center win)))
(defun on-convert-image (body)
"Convert image from form input from on-image-to-data"
(let ((params (form-multipart-data body)))
(create-div body :content params)
(destructuring-bind (stream fname content-type)
(form-data-item params "filename")
(create-div body :content (format nil "filename = ~A - (contents printed in REPL)" fname))
(let ((s (flexi-streams:make-flexi-stream stream))
(pic-data ""))
(setf pic-data (format nil "data:~A;base64,~A" content-type
(with-output-to-string (out)
(s-base64:encode-base64 s out))))
(create-img body :url-src pic-data)
(create-br body)
(create-div body :content "User the following as a url source:")
(set-geometry (create-text-area body :value pic-data) :width 500 :height 400)
(create-br body)
(create-div body :content (format nil "For example:<br>(create-img body :url-src \"~A\")" pic-data))))))
(defun on-quick-start (obj) (defun on-quick-start (obj)
"Open quick start" "Open quick start help"
(let* ((win (create-gui-window obj :title "Quick Start" (let* ((win (create-gui-window obj :title "Quick Start"
:top 40 :left 225 :top 40 :left 225
:width 600 :height 400 :width 600 :height 400
@ -2334,23 +2319,15 @@ of controls and double click to select control."
(create-quick-start (window-content win)))) (create-quick-start (window-content win))))
(defun on-show-thread-viewer (obj) (defun on-show-thread-viewer (obj)
"Open quick start" "Open thread views"
(let* ((win (create-gui-window obj :title "Thread Viewer" (let* ((win (create-gui-window obj :title "Thread Viewer"
:top 40 :left 225 :top 40 :left 225
:width 600 :height 400 :width 600 :height 400
:client-movement t))) :client-movement t)))
(create-thread-list (window-content win)))) (create-thread-list (window-content win))))
(defun get-package-from-string (c)
(with-input-from-string (ins c)
(loop
(let ((form (read ins nil)))
(unless form (return "clog-user"))
(unless (consp form) (return "clog-user"))
(when (eq (car form) 'in-package)
(return (string-downcase (second form))))))))
(defun on-open-file (obj &key open-file (title "New Source Editor") text (title-class "w3-black")) (defun on-open-file (obj &key open-file (title "New Source Editor") text (title-class "w3-black"))
"Open a new text editor"
(let* ((app (connection-data-item obj "builder-app-data")) (let* ((app (connection-data-item obj "builder-app-data"))
(win (create-gui-window obj :title title (win (create-gui-window obj :title title
:title-class title-class :title-class title-class
@ -2535,8 +2512,9 @@ of controls and double click to select control."
(let ((result (capture-eval val :clog-obj obj (let ((result (capture-eval val :clog-obj obj
:eval-in-package (text-value pac-line)))) :eval-in-package (text-value pac-line))))
(on-open-file obj :title-class "w3-blue" :title "file eval" :text result)))))))) (on-open-file obj :title-class "w3-blue" :title "file eval" :text result))))))))
(defun on-repl (obj) (defun on-repl (obj)
"Open REPL" "Open a REPL"
(let* ((win (create-gui-window obj :title "CLOG Builder REPL" (let* ((win (create-gui-window obj :title "CLOG Builder REPL"
:top 40 :left 225 :top 40 :left 225
:width 600 :height 400 :width 600 :height 400
@ -2544,25 +2522,8 @@ of controls and double click to select control."
(set-geometry (create-clog-builder-repl (window-content win)) (set-geometry (create-clog-builder-repl (window-content win))
:units "%" :width 100 :height 100))) :units "%" :width 100 :height 100)))
(defun on-convert-image (body)
(let ((params (form-multipart-data body)))
(create-div body :content params)
(destructuring-bind (stream fname content-type)
(form-data-item params "filename")
(create-div body :content (format nil "filename = ~A - (contents printed in REPL)" fname))
(let ((s (flexi-streams:make-flexi-stream stream))
(pic-data ""))
(setf pic-data (format nil "data:~A;base64,~A" content-type
(with-output-to-string (out)
(s-base64:encode-base64 s out))))
(create-img body :url-src pic-data)
(create-br body)
(create-div body :content "User the following as a url source:")
(set-geometry (create-text-area body :value pic-data) :width 500 :height 400)
(create-br body)
(create-div body :content (format nil "For example:<br>(create-img body :url-src \"~A\")" pic-data))))))
(defun on-show-callers (body) (defun on-show-callers (body)
"Open callers window"
(input-dialog body "Enter package:function-name :" (input-dialog body "Enter package:function-name :"
(lambda (result) (lambda (result)
(when result (when result
@ -2576,6 +2537,7 @@ of controls and double click to select control."
:text c))))))) :text c)))))))
(defun on-show-callees (body) (defun on-show-callees (body)
"Open callees window"
(input-dialog body "Enter package:function-name :" (input-dialog body "Enter package:function-name :"
(lambda (result) (lambda (result)
(when result (when result
@ -2674,10 +2636,6 @@ of controls and double click to select control."
(lambda (obj) (lambda (obj)
(declare (ignore obj)) (declare (ignore obj))
(open-window (window body) "https://www.w3schools.com/w3css/"))) (open-window (window body) "https://www.w3schools.com/w3css/")))
(create-gui-menu-item help :content "Bootstrap 5.1 Manual" :on-click
(lambda (obj)
(declare (ignore obj))
(open-window (window body) "https://getbootstrap.com/docs/5.1/getting-started/introduction/")))
(create-gui-menu-item help :content "About CLOG Builder" :on-click #'on-help-about-builder) (create-gui-menu-item help :content "About CLOG Builder" :on-click #'on-help-about-builder)
(create-gui-menu-full-screen menu)) (create-gui-menu-full-screen menu))
(on-show-control-properties-win body) (on-show-control-properties-win body)
@ -2693,7 +2651,9 @@ of controls and double click to select control."
(clog:shutdown) (clog:shutdown)
(uiop:quit))) (uiop:quit)))
(defparameter *app-mode* nil) (defparameter *app-mode* nil
"If *app-mode* is t terminates the clog-builder process on exit of the first
clog-builder window.")
(defun clog-builder (&key (port 8080) (start-browser t) (defun clog-builder (&key (port 8080) (start-browser t)
app project static-root system) app project static-root system)

View file

@ -1,4 +1,4 @@
<data id="I3868573822" data-in-package="clog-tools" data-custom-slots="" data-clog-next-id="16" data-clog-title="asdf-systems"></data><label for="CLOGB38680930412" data-clog-type="label" data-clog-for="loaded-systems" data-clog-name="sys-label" style="box-sizing: content-box; position: absolute; left: 10px; top: 8px;">Loaded Systems:</label><select data-clog-type="listbox" size="4" data-clog-name="loaded-systems" style="box-sizing: content-box; position: absolute; left: 10px; top: 38px; width: 239.716px; height: 261.341px;" data-on-change="(asdf-browser-populate panel)" data-on-create="(asdf-browser-reset panel)"></select><label for="CLOGB38680988074" data-clog-type="label" data-clog-for="deps" data-clog-name="deps-label" style="box-sizing: content-box; position: absolute; left: 265px; top: 8px; width: 281.814px; height: 22.5px;" class="">Depends On: (double click to switch)</label><select data-clog-type="listbox" size="4" data-clog-name="deps" style="box-sizing: content-box; position: absolute; left: 265px; top: 39.9858px; width: 310.361px; height: 76.3494px;" data-on-double-click="(setf (text-value (loaded-systems panel)) <data id="I3871072205" data-in-package="clog-tools" data-custom-slots="" data-clog-next-id="17" data-clog-title="asdf-systems"></data><label for="CLOGB38680930412" data-clog-type="label" data-clog-for="loaded-systems" data-clog-name="sys-label" style="box-sizing: content-box; position: absolute; left: 10px; top: 8px;">Loaded Systems:</label><select data-clog-type="listbox" size="4" data-clog-name="loaded-systems" style="box-sizing: content-box; position: absolute; left: 10px; top: 38px; width: 239.716px; height: 261.341px;" data-on-change="(asdf-browser-populate panel)" data-on-create="(asdf-browser-reset panel)"></select><label for="CLOGB38680988074" data-clog-type="label" data-clog-for="deps" data-clog-name="deps-label" style="box-sizing: content-box; position: absolute; left: 265px; top: 8px; width: 281.814px; height: 22.5px;" class="">Depends On: (double click to switch)</label><select data-clog-type="listbox" size="4" data-clog-name="deps" style="box-sizing: content-box; position: absolute; left: 265px; top: 39.9858px; width: 310.361px; height: 76.3494px;" data-on-double-click="(setf (text-value (loaded-systems panel))
(text-value target)) (text-value target))
(asdf-browser-populate panel)"></select><label for="" data-clog-type="label" data-clog-for="" data-clog-name="files-label" style="box-sizing: content-box; position: absolute; left: 265px; top: 124px; width: 236.104px; height: 21.4986px;">Files: (double click to launch)</label><select data-clog-type="listbox" size="4" data-clog-name="files" style="box-sizing: content-box; position: absolute; left: 265px; top: 151.991px; width: 311.562px; height: 146.932px;" data-on-double-click="(let ((disp (select-text target)) (asdf-browser-populate panel)"></select><label for="" data-clog-type="label" data-clog-for="" data-clog-name="files-label" style="box-sizing: content-box; position: absolute; left: 265px; top: 124px; width: 236.104px; height: 21.4986px;">Files: (double click to launch)</label><select data-clog-type="listbox" size="4" data-clog-name="files" style="box-sizing: content-box; position: absolute; left: 265px; top: 151.991px; width: 311.562px; height: 146.932px;" data-on-double-click="(let ((disp (select-text target))
(item (text-value target))) (item (text-value target)))
@ -15,16 +15,15 @@
(equal (subseq item (- (length item) 5)) &quot;.clog&quot;)) (equal (subseq item (- (length item) 5)) &quot;.clog&quot;))
(on-new-builder-panel panel :open-file item)) (on-new-builder-panel panel :open-file item))
(t (t
(on-open-file panel :open-file item))))"></select><input type="TEXT" value="" data-clog-type="input" data-clog-name="source-file" style="box-sizing: content-box; position: absolute; left: 10px; top: 332px; width: 560.727px; height: 22.5px;" data-on-double-click="(on-open-file panel :open-file (text-value target))"><div data-clog-type="div" data-clog-name="button-panel" style="box-sizing: content-box; position: absolute; left: 1.0015px; top: 368.991px; width: 442.912px; height: 32.486px;"><button data-clog-type="button" data-clog-name="reset-list-button" style="box-sizing: content-box; position: absolute; left: 10px; top: 0px; width: 85px; height: 22px;" data-on-click="(asdf-browser-reset panel)">Reset List</button><button data-clog-type="button" data-clog-name="load-new-button" style="box-sizing: content-box; position: absolute; left: 119.991px; top: 0px; width: 85px; height: 22px;" class="" data-on-click="(clog-gui:input-dialog panel &quot;Load New System:&quot; (on-open-file panel :open-file item))))"></select><input type="TEXT" value="" data-clog-type="input" data-clog-name="source-file" style="box-sizing: content-box; position: absolute; left: 10px; top: 332px; width: 560.727px; height: 22.5px;" data-on-double-click="(on-open-file panel :open-file (text-value target))"><div data-clog-type="div" data-clog-name="button-panel" style="box-sizing: content-box; position: absolute; left: 1.0015px; top: 368.991px; width: 572.898px; height: 32.4844px;"><button data-clog-type="button" data-clog-name="reset-list-button" style="box-sizing: content-box; position: absolute; left: 10px; top: 0px; width: 85px; height: 22px;" data-on-click="(asdf-browser-reset panel)">Reset List</button><button data-clog-type="button" data-clog-name="load-new-button" style="box-sizing: content-box; position: absolute; left: 127px; top: 0px; width: 85px; height: 22px;" class="" data-on-click="(clog-gui:input-dialog panel &quot;Load New System:&quot;
(lambda (fname) (lambda (fname)
(ql:quickload fname) (ql:quickload fname)
(asdf-browser-reset panel) (asdf-browser-reset panel)
(setf (text-value (loaded-systems panel)) fname) (setf (text-value (loaded-systems panel)) fname)
(asdf-browser-populate panel)) (asdf-browser-populate panel))
:title &quot;Quickload&quot;) :title &quot;Quickload&quot;)
">Load New</button><button data-clog-type="button" data-clog-name="reload-button" style="box-sizing: content-box; position: absolute; left: 230.996px; top: 0px; width: 85px; height: 22px;" data-on-click="(let ((fname (text-value (loaded-systems panel)))) ">Load New</button><button data-clog-type="button" data-clog-name="reload-button" style="box-sizing: content-box; position: absolute; left: 243px; top: 0px; width: 85px; height: 22px;" data-on-click="(let ((fname (text-value (loaded-systems panel))))
(ql:quickload fname) (ql:quickload fname)
(setf (text-value (loaded-systems panel)) fname) (setf (text-value (loaded-systems panel)) fname)
(asdf-browser-populate panel)) (asdf-browser-populate panel))
">Reload</button><button data-clog-type="button" data-clog-name="remove-button" style="box-sizing: content-box; position: absolute; left: 342px; top: 0px; width: 85px; height: 22px;" data-on-click="(asdf:clear-system (text-value (loaded-systems panel))) ">Reload</button><button data-clog-type="button" data-clog-name="remove-button" style="box-sizing: content-box; position: absolute; left: 360px; top: 0px; width: 85px; height: 22px;" data-on-click="">Unload</button><button data-clog-type="button" data-clog-name="dir-button" style="box-sizing: content-box; position: absolute; left: 477px; top: 0px; width: 85px;" data-on-click="(on-dir-win panel :dir (asdf:system-source-directory (text-value (loaded-systems panel))))">View Dir</button></div><label for="" data-clog-type="label" data-clog-for="" data-clog-name="asd-label" style="box-sizing: content-box; position: absolute; left: 10px; top: 304.996px;">ASD Project: (double click to edit)</label>
(asdf-browser-reset panel)">Unload</button></div><label for="" data-clog-type="label" data-clog-for="" data-clog-name="asd-label" style="box-sizing: content-box; position: absolute; left: 10px; top: 304.996px;">ASD Project: (double click to edit)</label>

View file

@ -1,6 +1,8 @@
(in-package "CLOG-TOOLS") ;;;; CLOG Builder generated code - modify original clog file
(in-package :clog-tools)
(defclass asdf-systems (clog:clog-panel) (defclass asdf-systems (clog:clog-panel)
((asd-label :reader asd-label) (remove-button :reader remove-button) ((asd-label :reader asd-label) (dir-button :reader dir-button)
(remove-button :reader remove-button)
(reload-button :reader reload-button) (reload-button :reader reload-button)
(load-new-button :reader load-new-button) (load-new-button :reader load-new-button)
(reset-list-button :reader reset-list-button) (reset-list-button :reader reset-list-button)
@ -15,48 +17,51 @@
(let ((panel (let ((panel
(change-class (change-class
(clog:create-div clog-obj :content (clog:create-div clog-obj :content
"<label for=\"CLOGB38680930412\" style=\"box-sizing: content-box; position: absolute; left: 10px; top: 8px;\" id=\"CLOGB3868573810\" data-clog-name=\"sys-label\">Loaded Systems:</label><select size=\"4\" style=\"box-sizing: content-box; position: absolute; left: 10px; top: 38px; width: 239.716px; height: 261.341px;\" id=\"CLOGB3868573811\" data-clog-name=\"loaded-systems\"></select><label for=\"CLOGB38680988074\" style=\"box-sizing: content-box; position: absolute; left: 265px; top: 8px; width: 281.814px; height: 22.5px;\" class=\"\" id=\"CLOGB3868573812\" data-clog-name=\"deps-label\">Depends On: (double click to switch)</label><select size=\"4\" style=\"box-sizing: content-box; position: absolute; left: 265px; top: 39.9858px; width: 310.361px; height: 76.3494px;\" id=\"CLOGB3868573813\" data-clog-name=\"deps\"></select><label for=\"\" style=\"box-sizing: content-box; position: absolute; left: 265px; top: 124px; width: 236.104px; height: 21.4986px;\" id=\"CLOGB3868573814\" data-clog-name=\"files-label\">Files: (double click to launch)</label><select size=\"4\" style=\"box-sizing: content-box; position: absolute; left: 265px; top: 151.991px; width: 311.562px; height: 146.932px;\" id=\"CLOGB3868573815\" data-clog-name=\"files\"></select><input type=\"TEXT\" value=\"\" style=\"box-sizing: content-box; position: absolute; left: 10px; top: 332px; width: 560.727px; height: 22.5px;\" id=\"CLOGB3868573816\" data-clog-name=\"source-file\"><div style=\"box-sizing: content-box; position: absolute; left: 1.0015px; top: 368.991px; width: 442.912px; height: 32.486px;\" id=\"CLOGB3868573817\" data-clog-name=\"button-panel\"><button style=\"box-sizing: content-box; position: absolute; left: 10px; top: 0px; width: 85px; height: 22px;\" id=\"CLOGB3868573818\" data-clog-name=\"reset-list-button\">Reset List</button><button style=\"box-sizing: content-box; position: absolute; left: 119.991px; top: 0px; width: 85px; height: 22px;\" class=\"\" id=\"CLOGB3868573819\" data-clog-name=\"load-new-button\">Load New</button><button style=\"box-sizing: content-box; position: absolute; left: 230.996px; top: 0px; width: 85px; height: 22px;\" id=\"CLOGB3868573820\" data-clog-name=\"reload-button\">Reload</button><button style=\"box-sizing: content-box; position: absolute; left: 342px; top: 0px; width: 85px; height: 22px;\" id=\"CLOGB3868573821\" data-clog-name=\"remove-button\">Unload</button></div><label for=\"\" style=\"box-sizing: content-box; position: absolute; left: 10px; top: 304.996px;\" id=\"CLOGB3868573822\" data-clog-name=\"asd-label\">ASD Project: (double click to edit)</label>" "<label for=\"CLOGB38680930412\" style=\"box-sizing: content-box; position: absolute; left: 10px; top: 8px;\" id=\"CLOGB3871072097\" data-clog-name=\"sys-label\">Loaded Systems:</label><select size=\"4\" style=\"box-sizing: content-box; position: absolute; left: 10px; top: 38px; width: 239.716px; height: 261.341px;\" id=\"CLOGB3871072098\" data-clog-name=\"loaded-systems\"></select><label for=\"CLOGB38680988074\" style=\"box-sizing: content-box; position: absolute; left: 265px; top: 8px; width: 281.814px; height: 22.5px;\" class=\"\" id=\"CLOGB3871072099\" data-clog-name=\"deps-label\">Depends On: (double click to switch)</label><select size=\"4\" style=\"box-sizing: content-box; position: absolute; left: 265px; top: 39.9858px; width: 310.361px; height: 76.3494px;\" id=\"CLOGB3871072100\" data-clog-name=\"deps\"></select><label for=\"\" style=\"box-sizing: content-box; position: absolute; left: 265px; top: 124px; width: 236.104px; height: 21.4986px;\" id=\"CLOGB3871072101\" data-clog-name=\"files-label\">Files: (double click to launch)</label><select size=\"4\" style=\"box-sizing: content-box; position: absolute; left: 265px; top: 151.991px; width: 311.562px; height: 146.932px;\" id=\"CLOGB3871072102\" data-clog-name=\"files\"></select><input type=\"TEXT\" value=\"\" style=\"box-sizing: content-box; position: absolute; left: 10px; top: 332px; width: 560.727px; height: 22.5px;\" id=\"CLOGB3871072103\" data-clog-name=\"source-file\"><div style=\"box-sizing: content-box; position: absolute; left: 1.0015px; top: 368.991px; width: 572.898px; height: 32.4844px;\" id=\"CLOGB3871072104\" data-clog-name=\"button-panel\"><button style=\"box-sizing: content-box; position: absolute; left: 10px; top: 0px; width: 85px; height: 22px;\" id=\"CLOGB3871072105\" data-clog-name=\"reset-list-button\">Reset List</button><button style=\"box-sizing: content-box; position: absolute; left: 127px; top: 0px; width: 85px; height: 22px;\" class=\"\" id=\"CLOGB3871072106\" data-clog-name=\"load-new-button\">Load New</button><button style=\"box-sizing: content-box; position: absolute; left: 243px; top: 0px; width: 85px; height: 22px;\" id=\"CLOGB3871072107\" data-clog-name=\"reload-button\">Reload</button><button style=\"box-sizing: content-box; position: absolute; left: 360px; top: 0px; width: 85px; height: 22px;\" id=\"CLOGB3871072108\" data-clog-name=\"remove-button\">Unload</button><button style=\"box-sizing: content-box; position: absolute; left: 477px; top: 0px; width: 85px;\" id=\"CLOGB3871072109\" data-clog-name=\"dir-button\">View Dir</button></div><label for=\"\" style=\"box-sizing: content-box; position: absolute; left: 10px; top: 304.996px;\" id=\"CLOGB3871072110\" data-clog-name=\"asd-label\">ASD Project: (double click to edit)</label>"
:hidden hidden :class class :html-id html-id :hidden hidden :class class :html-id html-id
:auto-place auto-place) :auto-place auto-place)
'asdf-systems))) 'asdf-systems)))
(setf (slot-value panel 'asd-label) (setf (slot-value panel 'asd-label)
(attach-as-child clog-obj "CLOGB3868573822" :clog-type (attach-as-child clog-obj "CLOGB3871072110" :clog-type
'clog:clog-label :new-id t)) 'clog:clog-label :new-id t))
(setf (slot-value panel 'dir-button)
(attach-as-child clog-obj "CLOGB3871072109" :clog-type
'clog:clog-button :new-id t))
(setf (slot-value panel 'remove-button) (setf (slot-value panel 'remove-button)
(attach-as-child clog-obj "CLOGB3868573821" :clog-type (attach-as-child clog-obj "CLOGB3871072108" :clog-type
'clog:clog-button :new-id t)) 'clog:clog-button :new-id t))
(setf (slot-value panel 'reload-button) (setf (slot-value panel 'reload-button)
(attach-as-child clog-obj "CLOGB3868573820" :clog-type (attach-as-child clog-obj "CLOGB3871072107" :clog-type
'clog:clog-button :new-id t)) 'clog:clog-button :new-id t))
(setf (slot-value panel 'load-new-button) (setf (slot-value panel 'load-new-button)
(attach-as-child clog-obj "CLOGB3868573819" :clog-type (attach-as-child clog-obj "CLOGB3871072106" :clog-type
'clog:clog-button :new-id t)) 'clog:clog-button :new-id t))
(setf (slot-value panel 'reset-list-button) (setf (slot-value panel 'reset-list-button)
(attach-as-child clog-obj "CLOGB3868573818" :clog-type (attach-as-child clog-obj "CLOGB3871072105" :clog-type
'clog:clog-button :new-id t)) 'clog:clog-button :new-id t))
(setf (slot-value panel 'button-panel) (setf (slot-value panel 'button-panel)
(attach-as-child clog-obj "CLOGB3868573817" :clog-type (attach-as-child clog-obj "CLOGB3871072104" :clog-type
'clog:clog-div :new-id t)) 'clog:clog-div :new-id t))
(setf (slot-value panel 'source-file) (setf (slot-value panel 'source-file)
(attach-as-child clog-obj "CLOGB3868573816" :clog-type (attach-as-child clog-obj "CLOGB3871072103" :clog-type
'clog:clog-form-element :new-id t)) 'clog:clog-form-element :new-id t))
(setf (slot-value panel 'files) (setf (slot-value panel 'files)
(attach-as-child clog-obj "CLOGB3868573815" :clog-type (attach-as-child clog-obj "CLOGB3871072102" :clog-type
'clog:clog-select :new-id t)) 'clog:clog-select :new-id t))
(setf (slot-value panel 'files-label) (setf (slot-value panel 'files-label)
(attach-as-child clog-obj "CLOGB3868573814" :clog-type (attach-as-child clog-obj "CLOGB3871072101" :clog-type
'clog:clog-label :new-id t)) 'clog:clog-label :new-id t))
(setf (slot-value panel 'deps) (setf (slot-value panel 'deps)
(attach-as-child clog-obj "CLOGB3868573813" :clog-type (attach-as-child clog-obj "CLOGB3871072100" :clog-type
'clog:clog-select :new-id t)) 'clog:clog-select :new-id t))
(setf (slot-value panel 'deps-label) (setf (slot-value panel 'deps-label)
(attach-as-child clog-obj "CLOGB3868573812" :clog-type (attach-as-child clog-obj "CLOGB3871072099" :clog-type
'clog:clog-label :new-id t)) 'clog:clog-label :new-id t))
(setf (slot-value panel 'loaded-systems) (setf (slot-value panel 'loaded-systems)
(attach-as-child clog-obj "CLOGB3868573811" :clog-type (attach-as-child clog-obj "CLOGB3871072098" :clog-type
'clog:clog-select :new-id t)) 'clog:clog-select :new-id t))
(setf (slot-value panel 'sys-label) (setf (slot-value panel 'sys-label)
(attach-as-child clog-obj "CLOGB3868573810" :clog-type (attach-as-child clog-obj "CLOGB3871072097" :clog-type
'clog:clog-label :new-id t)) 'clog:clog-label :new-id t))
(let ((target (sys-label panel))) (let ((target (sys-label panel)))
(declare (ignorable target)) (declare (ignorable target))
@ -151,10 +156,10 @@
(quicklisp-client:quickload fname) (quicklisp-client:quickload fname)
(setf (text-value (loaded-systems panel)) fname) (setf (text-value (loaded-systems panel)) fname)
(asdf-browser-populate panel)))) (asdf-browser-populate panel))))
(clog:set-on-click (remove-button panel) (clog:set-on-click (dir-button panel)
(lambda (target) (lambda (target)
(declare (ignorable target)) (declare (ignorable target))
(asdf/system-registry:clear-system (on-dir-win panel :dir
(text-value (loaded-systems panel))) (asdf/system:system-source-directory
(asdf-browser-reset panel))) (text-value (loaded-systems panel))))))
panel)) panel))