mirror of
https://github.com/rabbibotton/clog.git
synced 2025-12-06 10:40:45 -08:00
full project support
This commit is contained in:
parent
9a7607dfb4
commit
2befb3ff46
6 changed files with 258 additions and 107 deletions
15
README.md
15
README.md
|
|
@ -125,20 +125,6 @@ CL-USER> (ql:quickload :clog)
|
|||
CL-USER> (clog:run-demo 1)
|
||||
```
|
||||
|
||||
The clog-new-app tool can be run with:
|
||||
|
||||
```
|
||||
CL-USER> (ql:quickload :clog/tools)
|
||||
CL-USER> (clog-tools:clog-new-app)
|
||||
```
|
||||
|
||||
The clog-db-admin tool can be run with:
|
||||
|
||||
```
|
||||
CL-USER> (ql:quickload :clog/tools)
|
||||
CL-USER> (clog-tools:clog-db-admin)
|
||||
```
|
||||
|
||||
The CLOG Builder tool can be run with:
|
||||
|
||||
```
|
||||
|
|
@ -297,7 +283,6 @@ Tool Summary
|
|||
|
||||
- clog-builder - Rapid visual interactive development for Web and GUIs
|
||||
- clog-db-admin - SQLite3 admin tool
|
||||
- clog-new-app - New application template tool
|
||||
|
||||
High Order Extensions to CLOG
|
||||
|
||||
|
|
|
|||
|
|
@ -18,8 +18,7 @@
|
|||
(:export :clog-builder
|
||||
:add-supported-controls
|
||||
:control-info
|
||||
:clog-db-admin
|
||||
:clog-new-app))
|
||||
:clog-db-admin))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Implementation - CLOG Utilities
|
||||
|
|
|
|||
|
|
@ -7,6 +7,8 @@
|
|||
|
||||
(in-package :clog-tools)
|
||||
|
||||
(defparameter *start-project* nil)
|
||||
|
||||
;; Per instance app data
|
||||
|
||||
(defclass builder-app-data ()
|
||||
|
|
@ -34,6 +36,10 @@
|
|||
:accessor properties-list
|
||||
:initform nil
|
||||
:documentation "Property list in properties window")
|
||||
(current-project
|
||||
:accessor current-project
|
||||
:initform *start-project*
|
||||
:documentation "Current Project")
|
||||
(project-win
|
||||
:accessor project-win
|
||||
:initform nil
|
||||
|
|
@ -164,7 +170,8 @@
|
|||
(check-type action-if-exists (member nil :error :new-version :rename :rename-and-delete
|
||||
:overwrite :append :supersede))
|
||||
(with-open-file (outstream outfile :direction :output :if-exists action-if-exists)
|
||||
(write-sequence string outstream)))
|
||||
(when outstream
|
||||
(write-sequence string outstream))))
|
||||
|
||||
(defun panel-snap-shot (content panel-id hide-loc)
|
||||
"Take a snap shot of panel"
|
||||
|
|
@ -1218,15 +1225,18 @@ of controls and double click to select control."
|
|||
(setf (clog-ace:mode editor) "ace/mode/lisp")
|
||||
(setf (clog-ace:tab-size editor) 2)))
|
||||
|
||||
(defun on-show-project (obj)
|
||||
(defun on-show-project (obj &key project)
|
||||
(let ((app (connection-data-item obj "builder-app-data")))
|
||||
(when project
|
||||
(setf (current-project app) project))
|
||||
(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 375
|
||||
:width 643 :height 400
|
||||
:has-pinner t :client-movement t)))
|
||||
(create-projects (window-content win))
|
||||
(setf (project-win app) win)
|
||||
(set-on-window-close win (lambda (obj)
|
||||
(setf (project-win app) nil)))))))
|
||||
|
||||
|
|
@ -1594,7 +1604,8 @@ of controls and double click to select control."
|
|||
(setf file-name fname)
|
||||
(setf render-file-name "")
|
||||
(setf (inner-html content)
|
||||
(read-file fname))
|
||||
(or (read-file fname)
|
||||
""))
|
||||
(clrhash (get-control-list app panel-id))
|
||||
(on-populate-loaded-window content :win win)
|
||||
(setf (window-title win) (attribute content "data-clog-name"))
|
||||
|
|
@ -2056,7 +2067,8 @@ of controls and double click to select control."
|
|||
|
||||
(defun fill-button-clicked (panel)
|
||||
"Template fill botton clicked"
|
||||
(let* ((tmpl-rec (find-if (lambda (x)
|
||||
(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*))
|
||||
|
|
@ -2079,6 +2091,9 @@ of controls and double click to select control."
|
|||
(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)))))))
|
||||
|
|
@ -2190,7 +2205,7 @@ of controls and double click to select control."
|
|||
(setf file-name fname)
|
||||
(setf (window-title win) fname)
|
||||
(setf (clog-ace:text-value ace)
|
||||
(read-file fname)))))
|
||||
(or (read-file fname) "")))))
|
||||
(when open-file
|
||||
(open-file-name open-file))
|
||||
(set-on-click btn-load (lambda (obj)
|
||||
|
|
@ -2263,13 +2278,14 @@ of controls and double click to select control."
|
|||
(asdf-browser-populate panel))))
|
||||
|
||||
(defun asdf-browser-reset (panel)
|
||||
(let* ((app (connection-data-item panel "builder-app-data")))
|
||||
(setf (inner-html (loaded-systems panel)) "")
|
||||
(dolist (n (sort (asdf:already-loaded-systems) #'string-lessp))
|
||||
(add-select-option (loaded-systems panel) n n))
|
||||
(if *start-project*
|
||||
(setf (text-value (loaded-systems panel)) *start-project*)
|
||||
(if (current-project app)
|
||||
(setf (text-value (project-list panel)) (current-project app))
|
||||
(setf (text-value (loaded-systems panel)) "clog"))
|
||||
(asdf-browser-populate panel))
|
||||
(asdf-browser-populate panel)))
|
||||
|
||||
(Defun asdf-browser-populate (panel)
|
||||
(setf (text-value (source-file panel))
|
||||
|
|
@ -2423,23 +2439,33 @@ of controls and double click to select control."
|
|||
(create-br body)
|
||||
(create-div body :content (format nil "For example:<br>(create-img body :url-src \"~A\")" pic-data))))))
|
||||
|
||||
(defparameter *start-project* nil)
|
||||
|
||||
(defun projects-setup (panel)
|
||||
(let* ((app (connection-data-item panel "builder-app-data")))
|
||||
(pushnew #P"~/common-lisp/" ql:*local-project-directories*)
|
||||
(add-select-option (project-list panel) "None" "None")
|
||||
(dolist (n (sort (ql:list-local-systems) #'string-lessp))
|
||||
(add-select-option (project-list panel) n n))
|
||||
(if *start-project*
|
||||
(setf (text-value (project-list panel)) *start-project*)
|
||||
(setf (text-value (project-list panel)) "None")))
|
||||
(cond((current-project app)
|
||||
(setf (text-value (project-list panel)) (current-project app))
|
||||
(projects-populate panel))
|
||||
(t
|
||||
(setf (text-value (project-list panel)) "None")))))
|
||||
|
||||
(defun projects-populate (panel)
|
||||
(let ((already (asdf/operate:already-loaded-systems))
|
||||
(let ((app (connection-data-item panel "builder-app-data"))
|
||||
(already (asdf/operate:already-loaded-systems))
|
||||
(sel (text-value (project-list panel))))
|
||||
(setf (inner-html (runtime-list panel)) "")
|
||||
(setf (inner-html (designtime-list panel)) "")
|
||||
(unless (equal sel "None")
|
||||
(setf (disabledp (runtime-add-lisp panel)) t)
|
||||
(setf (disabledp (runtime-delete panel)) t)
|
||||
(setf (disabledp (designtime-add-lisp panel)) t)
|
||||
(setf (disabledp (designtime-add-clog panel)) t)
|
||||
(setf (disabledp (designtime-delete panel)) t)
|
||||
(setf (current-project app) (if (equal sel "None")
|
||||
nil
|
||||
sel))
|
||||
(when (current-project app)
|
||||
(cond ((member sel already :test #'equal)
|
||||
;; fill runtime
|
||||
(dolist (n (asdf:module-components
|
||||
|
|
@ -2449,12 +2475,22 @@ of controls and double click to select control."
|
|||
(add-select-option (runtime-list panel) path name)))
|
||||
;; fill designtime)
|
||||
(handler-case
|
||||
(dolist (n (asdf:module-components
|
||||
(asdf:find-system (format nil "~A/tools" sel))))
|
||||
(let ((sys (asdf:find-system (format nil "~A/tools" sel))))
|
||||
(dolist (n (asdf:module-components sys))
|
||||
(let ((name (asdf:component-relative-pathname n))
|
||||
(path (asdf:component-pathname n)))
|
||||
(add-select-option (designtime-list panel) path name)))
|
||||
(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))
|
||||
(t
|
||||
(alert-toast panel "Warning" "Missing :defsystem-depends-on (:clog)"
|
||||
:color-class "w3-yellow" :time-out 2))))
|
||||
(t (c)
|
||||
(declare (ignore c))
|
||||
(add-select-option (designtime-list panel) "" "Missing /tools"))))
|
||||
(t
|
||||
(confirm-dialog panel "Load project?"
|
||||
|
|
@ -2463,12 +2499,88 @@ of controls and double click to select control."
|
|||
(handler-case
|
||||
(ql:quickload (format nil "~A/tools" sel))
|
||||
(t (c)
|
||||
(declare (ignore c))
|
||||
(ql:quickload sel)))
|
||||
(projects-populate panel))
|
||||
(t
|
||||
(setf (current-project app) nil)
|
||||
(setf (text-value (project-list panel)) "None"))))
|
||||
:title "System not loaded"))))))
|
||||
|
||||
(defun projects-add-lisp (panel sys)
|
||||
(input-dialog panel "Enter lisp component name (with out .lisp):"
|
||||
(lambda (result)
|
||||
(when result
|
||||
(let ((path (asdf:component-pathname
|
||||
(asdf:find-system sys))))
|
||||
(write-file "" (format nil "~A~A.lisp"
|
||||
path result)
|
||||
:action-if-exists nil)
|
||||
(add-file-to-defsystem sys result :file)
|
||||
(ql:quickload sys)
|
||||
(projects-populate panel))))
|
||||
:height 230)
|
||||
(ql:quickload sys))
|
||||
|
||||
(defun projects-add-clog (panel sys)
|
||||
(input-dialog panel (format nil "Enter clog component name (with out .clog), ~
|
||||
a lisp component will also be created in the runtime system:")
|
||||
(lambda (result)
|
||||
(when result
|
||||
(let* ((s (format nil "~A/tools" sys))
|
||||
(path (asdf:component-pathname
|
||||
(asdf:find-system s))))
|
||||
(write-file "" (format nil "~A~A.clog"
|
||||
path result)
|
||||
:action-if-exists nil)
|
||||
(add-file-to-defsystem s result :clog-file)
|
||||
(ql:quickload s))
|
||||
(let ((path (asdf:component-pathname
|
||||
(asdf:find-system sys))))
|
||||
(write-file "" (format nil "~A~A.lisp"
|
||||
path result)
|
||||
:action-if-exists nil)
|
||||
(add-file-to-defsystem sys result :file)
|
||||
(ql:quickload sys)
|
||||
(projects-populate panel))))
|
||||
:height 250))
|
||||
|
||||
(defun add-file-to-defsystem (system file ftype)
|
||||
(let ((fname (asdf:system-source-file (asdf:find-system system)))
|
||||
(sys-list '()))
|
||||
(with-open-file (s fname)
|
||||
(loop
|
||||
(let* ((line (read s nil)))
|
||||
(unless line (return))
|
||||
(when (equalp (format nil "~A" (second line)) system)
|
||||
(push `(,ftype ,file) (getf line :components)))
|
||||
(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-file-from-defsystem (system file ftype)
|
||||
(let ((fname (asdf:system-source-file (asdf:find-system system)))
|
||||
(sys-list '()))
|
||||
(with-open-file (s fname)
|
||||
(loop
|
||||
(let* ((line (read s nil)))
|
||||
(unless line (return))
|
||||
(when (equalp (format nil "~A" (second line)) system)
|
||||
(let (new-comp)
|
||||
(dolist (n (getf line :components))
|
||||
(unless (and (equal (first n) ftype)
|
||||
(equalp (second n) file))
|
||||
(push n new-comp)))
|
||||
(setf (getf line :components) (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)))))
|
||||
(ql:quickload system))
|
||||
|
||||
(defun open-projects-component (target system list)
|
||||
(let ((disp (select-text target))
|
||||
(item (text-value target)))
|
||||
|
|
@ -2573,9 +2685,7 @@ of controls and double click to select control."
|
|||
(on-show-control-events-win body)
|
||||
(on-show-copy-history-win body)
|
||||
(on-new-builder-panel body)
|
||||
(on-show-project body)
|
||||
(when *start-project*
|
||||
(on-new-asdf-browser body :project *start-project*))
|
||||
(on-show-project body :project *start-project*)
|
||||
(set-on-before-unload (window body) (lambda(obj)
|
||||
(declare (ignore obj))
|
||||
;; return empty string to prevent nav off page
|
||||
|
|
@ -2583,13 +2693,9 @@ of controls and double click to select control."
|
|||
|
||||
(defun clog-builder (&key (port 8080) project static-root system)
|
||||
"Start clog-builder."
|
||||
(cond (project
|
||||
(if project
|
||||
(setf *start-project* (string-downcase (format nil "~A" project)))
|
||||
(ignore-errors
|
||||
(ql:quickload project)
|
||||
(ql:quickload (format nil "~A/tools" project))))
|
||||
(t
|
||||
(setf *start-project* nil)))
|
||||
(setf *start-project* nil))
|
||||
(when system
|
||||
(setf static-root (merge-pathnames "./www/"
|
||||
(asdf:system-source-directory system))))
|
||||
|
|
|
|||
|
|
@ -1,35 +0,0 @@
|
|||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;;; CLOG New App - New CLOG App Templates ;;;;
|
||||
;;;; (c) 2020-2022 David Botton ;;;;
|
||||
;;;; License BSD 3 Clause ;;;;
|
||||
;;;; ;;;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(in-package :clog-tools)
|
||||
|
||||
(defun on-new-app (body)
|
||||
"Launch instance of CLOG New Appp"
|
||||
(set-html-on-close body "Connection Lost")
|
||||
(let ((app (make-instance 'builder-app-data)))
|
||||
(setf (connection-data-item body "builder-app-data") app)
|
||||
(setf (title (html-document body)) "CLOG New App")
|
||||
(clog-gui-initialize body)
|
||||
(add-class body "w3-blue-grey")
|
||||
(let* ((menu (create-gui-menu-bar body))
|
||||
(icon (create-gui-menu-icon menu :on-click #'on-help-about-builder))
|
||||
(file (create-gui-menu-drop-down menu :content "New App")))
|
||||
(declare (ignore icon))
|
||||
(create-gui-menu-item file :content "New Application Template" :on-click 'on-new-app-template)
|
||||
(create-gui-menu-full-screen menu))
|
||||
(set-on-before-unload (window body) (lambda(obj)
|
||||
(declare (ignore obj))
|
||||
;; return empty string to prevent nav off page
|
||||
""))))
|
||||
|
||||
(defun clog-new-app (&key (port 8080) static-root)
|
||||
"Start clog-new-app."
|
||||
(if static-root
|
||||
(initialize nil :port port :static-root static-root)
|
||||
(initialize nil :port port))
|
||||
(set-on-new-window 'on-new-app :path "/new")
|
||||
(open-browser :url (format nil "http://127.0.0.1:~A/new" port)))
|
||||
|
|
@ -1,7 +1,25 @@
|
|||
<data id="I3868394912" data-in-package="clog-tools" data-custom-slots="" data-clog-next-id="19" data-clog-title="projects"></data><label for="undefined" data-clog-type="label" data-clog-for="projects-list" data-clog-name="projects-label" style="box-sizing: content-box; position: absolute; left: 5px; top: 6.99858px;">Current Project</label><select data-clog-type="dropdown" data-clog-name="project-list" style="box-sizing: content-box; position: absolute; left: 5px; top: 35px; width: 386.54px; height: 22px; bottom: 309.041px;" data-on-create="(projects-setup panel)" data-on-change="(projects-populate panel)"></select><button data-clog-type="button" data-clog-name="edit-asd" style="box-sizing: content-box; position: absolute; left: 400px; top: 32px; height: 22px; width: 90px;" data-on-click="(let ((sel (text-value (project-list panel))))
|
||||
<data id="I3868475410" data-in-package="clog-tools" data-custom-slots="" data-clog-next-id="22" data-clog-title="projects"></data><label for="undefined" data-clog-type="label" data-clog-for="projects-list" data-clog-name="projects-label" style="box-sizing: content-box; position: absolute; left: 5px; top: 6.99858px;">Current Project</label><select data-clog-type="dropdown" data-clog-name="project-list" style="box-sizing: content-box; position: absolute; left: 5px; top: 35px; width: 386.54px; height: 22px; bottom: 309.041px;" data-on-create="(projects-setup panel)" data-on-change="(projects-populate panel)"></select><button data-clog-type="button" data-clog-name="edit-asd" style="box-sizing: content-box; position: absolute; left: 400px; top: 32px; height: 22px; width: 90px;" data-on-click="(let ((sel (text-value (project-list panel))))
|
||||
(on-open-file panel :open-file (asdf:system-source-file
|
||||
(asdf:find-system sel))))">Edit .asd</button><label for="CLOGB3868393710" data-clog-type="label" data-clog-for="runtime-list" data-clog-name="runtime-label" style="box-sizing: content-box; position: absolute; left: 5px; top: 64.9943px;">Runtime System</label><label for="CLOGB3868393704" data-clog-type="label" data-clog-for="designtime-list" data-clog-name="designtime-label" style="box-sizing: content-box; position: absolute; left: 290.007px; top: 66.9986px;">Design Time System (/tools)</label><select data-clog-type="listbox" size="4" data-clog-name="runtime-list" style="box-sizing: content-box; position: absolute; left: 5px; top: 95px; width: 265px; height: 196px;" data-on-double-click="(open-projects-component target (text-value (project-list panel)) target)"></select><select data-clog-type="listbox" size="4" data-clog-name="designtime-list" style="box-sizing: content-box; position: absolute; left: 290.007px; top: 96px; width: 265px; height: 195.545px;" data-on-double-click="(open-projects-component target
|
||||
(format nil "~A/tools" (text-value (project-list panel))) target)"></select><button data-clog-type="button" data-clog-name="new-project-button" style="box-sizing: content-box; position: absolute; left: 520px; top: 9.99574px; width: 100px; height: 22px;" data-on-click="(on-new-app-template panel)">New</button><button data-clog-type="button" data-clog-name="unload-project-button" style="box-sizing: content-box; position: absolute; left: 520px; top: 44.9957px; width: 100px; height: 22px; bottom: 309.041px;" data-on-click="(let ((sel (text-value (project-list panel))))
|
||||
(asdf:find-system sel))))">Edit .asd</button><label for="CLOGB3868393710" data-clog-type="label" data-clog-for="runtime-list" data-clog-name="runtime-label" style="box-sizing: content-box; position: absolute; left: 5px; top: 65px;">Runtime System</label><label for="CLOGB3868452429" data-clog-type="label" data-clog-for="runtime-list" data-clog-name="dbl-click1" style="box-sizing: content-box; position: absolute; left: 5px; top: 85px;">(double click to launch)</label><label for="CLOGB3868393704" data-clog-type="label" data-clog-for="designtime-list" data-clog-name="designtime-label" style="box-sizing: content-box; position: absolute; left: 290.007px; top: 65px;">Design Time System (/tools)</label><label for="CLOGB3868452430" data-clog-type="label" data-clog-for="designtime-list" data-clog-name="dbl-click2" style="box-sizing: content-box; position: absolute; left: 290px; top: 85px;">(double click to launch)</label><select data-clog-type="listbox" size="4" data-clog-name="runtime-list" style="box-sizing: content-box; position: absolute; left: 5px; top: 115px; width: 265px; height: 196px;" data-on-double-click="(open-projects-component target (text-value (project-list panel)) target)"></select><select data-clog-type="listbox" size="4" data-clog-name="designtime-list" style="box-sizing: content-box; position: absolute; left: 290px; top: 115px; width: 265px; height: 195.545px;" data-on-double-click="(open-projects-component target
|
||||
(format nil "~A/tools" (text-value (project-list panel))) target)"></select><button data-clog-type="button" data-clog-name="runtime-add-lisp" style="box-sizing: content-box; position: absolute; left: 5px; top: 320px;" data-on-click="(let ((sys (text-value (project-list panel))))
|
||||
(projects-add-lisp panel sys))">Add .lisp</button><button data-clog-type="button" data-clog-name="runtime-delete" style="box-sizing: content-box; position: absolute; left: 92.9801px; top: 320px; width: 65px; height: 22px;" data-on-click="(let ((sys (text-value (project-list panel)))
|
||||
(file (select-text (runtime-list panel))))
|
||||
(unless (equal file "")
|
||||
(setf file (subseq file 0 (- (length file) 5)))
|
||||
(remove-file-from-defsystem sys file :file)
|
||||
(projects-populate panel)))">Remove</button><button data-clog-type="button" data-clog-name="designtime-add-clog" style="box-sizing: content-box; position: absolute; left: 290px; top: 320px;" data-on-click="(let ((sys (text-value (project-list panel))))
|
||||
(projects-add-clog panel sys))
|
||||
">Add .clog</button><button data-clog-type="button" data-clog-name="designtime-add-lisp" style="box-sizing: content-box; position: absolute; left: 385px; top: 320px;" data-on-click="(let ((sys (format nil "~A/tools" (text-value (project-list panel)))))
|
||||
(projects-add-lisp panel sys))">Add .lisp</button><button data-clog-type="button" data-clog-name="designtime-delete" style="box-sizing: content-box; position: absolute; left: 473px; top: 320px; width: 65px; height: 22px;" data-on-click="(let ((sys (format nil "~A/tools" (text-value (project-list panel))))
|
||||
(file (select-text (designtime-list panel)))
|
||||
ext)
|
||||
(unless (equal file "")
|
||||
(setf ext (subseq file (- (length file) 5)))
|
||||
(setf file (subseq file 0 (- (length file) 5)))
|
||||
(remove-file-from-defsystem sys file (if (equalp ext ".clog")
|
||||
:clog-file
|
||||
:file))
|
||||
(projects-populate panel)))">Remove</button><button data-clog-type="button" data-clog-name="new-project-button" style="box-sizing: content-box; position: absolute; left: 520px; top: 9.99574px; width: 100px; height: 22px;" data-on-click="(on-new-app-template panel)">New</button><button data-clog-type="button" data-clog-name="unload-project-button" style="box-sizing: content-box; position: absolute; left: 520px; top: 44.9957px; width: 100px; height: 22px; bottom: 309.041px;" data-on-click="(let ((sel (text-value (project-list panel))))
|
||||
(asdf:clear-system sel)
|
||||
(setf (text-value (project-list panel)) "None")
|
||||
(projects-populate panel))">Unload</button>
|
||||
|
|
@ -1,11 +1,16 @@
|
|||
|
||||
(in-package "CLOG-TOOLS")
|
||||
(defclass projects (clog:clog-panel)
|
||||
((unload-project-button :reader unload-project-button)
|
||||
(new-project-button :reader new-project-button)
|
||||
(designtime-delete :reader designtime-delete)
|
||||
(designtime-add-lisp :reader designtime-add-lisp)
|
||||
(designtime-add-clog :reader designtime-add-clog)
|
||||
(runtime-delete :reader runtime-delete)
|
||||
(runtime-add-lisp :reader runtime-add-lisp)
|
||||
(designtime-list :reader designtime-list)
|
||||
(runtime-list :reader runtime-list)
|
||||
(runtime-list :reader runtime-list) (dbl-click2 :reader dbl-click2)
|
||||
(designtime-label :reader designtime-label)
|
||||
(dbl-click1 :reader dbl-click1)
|
||||
(runtime-label :reader runtime-label) (edit-asd :reader edit-asd)
|
||||
(project-list :reader project-list)
|
||||
(projects-label :reader projects-label)))
|
||||
|
|
@ -14,36 +19,57 @@
|
|||
(let ((panel
|
||||
(change-class
|
||||
(clog:create-div clog-obj :content
|
||||
"<label for=\"undefined\" style=\"box-sizing: content-box; position: absolute; left: 5px; top: 6.99858px;\" id=\"CLOGB3868394887\" data-clog-name=\"projects-label\">Current Project</label><select style=\"box-sizing: content-box; position: absolute; left: 5px; top: 35px; width: 386.54px; height: 22px; bottom: 309.041px;\" id=\"CLOGB3868394888\" data-clog-name=\"project-list\"></select><button style=\"box-sizing: content-box; position: absolute; left: 400px; top: 32px; height: 22px; width: 90px;\" id=\"CLOGB3868394889\" data-clog-name=\"edit-asd\">Edit .asd</button><label for=\"CLOGB3868393710\" style=\"box-sizing: content-box; position: absolute; left: 5px; top: 64.9943px;\" id=\"CLOGB3868394890\" data-clog-name=\"runtime-label\">Runtime System</label><label for=\"CLOGB3868393704\" style=\"box-sizing: content-box; position: absolute; left: 290.007px; top: 66.9986px;\" id=\"CLOGB3868394891\" data-clog-name=\"designtime-label\">Design Time System (/tools)</label><select size=\"4\" style=\"box-sizing: content-box; position: absolute; left: 5px; top: 95px; width: 265px; height: 196px;\" id=\"CLOGB3868394892\" data-clog-name=\"runtime-list\"></select><select size=\"4\" style=\"box-sizing: content-box; position: absolute; left: 290.007px; top: 96px; width: 265px; height: 195.545px;\" id=\"CLOGB3868394893\" data-clog-name=\"designtime-list\"></select><button style=\"box-sizing: content-box; position: absolute; left: 520px; top: 9.99574px; width: 100px; height: 22px;\" id=\"CLOGB3868394899\" data-clog-name=\"new-project-button\">New</button><button style=\"box-sizing: content-box; position: absolute; left: 520px; top: 44.9957px; width: 100px; height: 22px; bottom: 309.041px;\" id=\"CLOGB3868394900\" data-clog-name=\"unload-project-button\">Unload</button>"
|
||||
"<label for=\"undefined\" style=\"box-sizing: content-box; position: absolute; left: 5px; top: 6.99858px;\" id=\"CLOGB3868475339\" data-clog-name=\"projects-label\">Current Project</label><select style=\"box-sizing: content-box; position: absolute; left: 5px; top: 35px; width: 386.54px; height: 22px; bottom: 309.041px;\" id=\"CLOGB3868475340\" data-clog-name=\"project-list\"></select><button style=\"box-sizing: content-box; position: absolute; left: 400px; top: 32px; height: 22px; width: 90px;\" id=\"CLOGB3868475341\" data-clog-name=\"edit-asd\">Edit .asd</button><label for=\"CLOGB3868393710\" style=\"box-sizing: content-box; position: absolute; left: 5px; top: 65px;\" id=\"CLOGB3868475342\" data-clog-name=\"runtime-label\">Runtime System</label><label for=\"CLOGB3868452429\" style=\"box-sizing: content-box; position: absolute; left: 5px; top: 85px;\" id=\"CLOGB3868475343\" data-clog-name=\"dbl-click1\">(double click to launch)</label><label for=\"CLOGB3868393704\" style=\"box-sizing: content-box; position: absolute; left: 290.007px; top: 65px;\" id=\"CLOGB3868475344\" data-clog-name=\"designtime-label\">Design Time System (/tools)</label><label for=\"CLOGB3868452430\" style=\"box-sizing: content-box; position: absolute; left: 290px; top: 85px;\" id=\"CLOGB3868475345\" data-clog-name=\"dbl-click2\">(double click to launch)</label><select size=\"4\" style=\"box-sizing: content-box; position: absolute; left: 5px; top: 115px; width: 265px; height: 196px;\" id=\"CLOGB3868475346\" data-clog-name=\"runtime-list\"></select><select size=\"4\" style=\"box-sizing: content-box; position: absolute; left: 290px; top: 115px; width: 265px; height: 195.545px;\" id=\"CLOGB3868475347\" data-clog-name=\"designtime-list\"></select><button style=\"box-sizing: content-box; position: absolute; left: 5px; top: 320px;\" id=\"CLOGB3868475348\" data-clog-name=\"runtime-add-lisp\">Add .lisp</button><button style=\"box-sizing: content-box; position: absolute; left: 92.9801px; top: 320px; width: 65px; height: 22px;\" id=\"CLOGB3868475349\" data-clog-name=\"runtime-delete\">Remove</button><button style=\"box-sizing: content-box; position: absolute; left: 290px; top: 320px;\" id=\"CLOGB3868475350\" data-clog-name=\"designtime-add-clog\">Add .clog</button><button style=\"box-sizing: content-box; position: absolute; left: 385px; top: 320px;\" id=\"CLOGB3868475351\" data-clog-name=\"designtime-add-lisp\">Add .lisp</button><button style=\"box-sizing: content-box; position: absolute; left: 473px; top: 320px; width: 65px; height: 22px;\" id=\"CLOGB3868475352\" data-clog-name=\"designtime-delete\">Remove</button><button style=\"box-sizing: content-box; position: absolute; left: 520px; top: 9.99574px; width: 100px; height: 22px;\" id=\"CLOGB3868475353\" data-clog-name=\"new-project-button\">New</button><button style=\"box-sizing: content-box; position: absolute; left: 520px; top: 44.9957px; width: 100px; height: 22px; bottom: 309.041px;\" id=\"CLOGB3868475354\" data-clog-name=\"unload-project-button\">Unload</button>"
|
||||
:hidden hidden :class class :html-id html-id
|
||||
:auto-place auto-place)
|
||||
'projects)))
|
||||
(setf (slot-value panel 'unload-project-button)
|
||||
(attach-as-child clog-obj "CLOGB3868394900" :clog-type
|
||||
(attach-as-child clog-obj "CLOGB3868475354" :clog-type
|
||||
'clog:clog-button :new-id t))
|
||||
(setf (slot-value panel 'new-project-button)
|
||||
(attach-as-child clog-obj "CLOGB3868394899" :clog-type
|
||||
(attach-as-child clog-obj "CLOGB3868475353" :clog-type
|
||||
'clog:clog-button :new-id t))
|
||||
(setf (slot-value panel 'designtime-delete)
|
||||
(attach-as-child clog-obj "CLOGB3868475352" :clog-type
|
||||
'clog:clog-button :new-id t))
|
||||
(setf (slot-value panel 'designtime-add-lisp)
|
||||
(attach-as-child clog-obj "CLOGB3868475351" :clog-type
|
||||
'clog:clog-button :new-id t))
|
||||
(setf (slot-value panel 'designtime-add-clog)
|
||||
(attach-as-child clog-obj "CLOGB3868475350" :clog-type
|
||||
'clog:clog-button :new-id t))
|
||||
(setf (slot-value panel 'runtime-delete)
|
||||
(attach-as-child clog-obj "CLOGB3868475349" :clog-type
|
||||
'clog:clog-button :new-id t))
|
||||
(setf (slot-value panel 'runtime-add-lisp)
|
||||
(attach-as-child clog-obj "CLOGB3868475348" :clog-type
|
||||
'clog:clog-button :new-id t))
|
||||
(setf (slot-value panel 'designtime-list)
|
||||
(attach-as-child clog-obj "CLOGB3868394893" :clog-type
|
||||
(attach-as-child clog-obj "CLOGB3868475347" :clog-type
|
||||
'clog:clog-select :new-id t))
|
||||
(setf (slot-value panel 'runtime-list)
|
||||
(attach-as-child clog-obj "CLOGB3868394892" :clog-type
|
||||
(attach-as-child clog-obj "CLOGB3868475346" :clog-type
|
||||
'clog:clog-select :new-id t))
|
||||
(setf (slot-value panel 'dbl-click2)
|
||||
(attach-as-child clog-obj "CLOGB3868475345" :clog-type
|
||||
'clog:clog-label :new-id t))
|
||||
(setf (slot-value panel 'designtime-label)
|
||||
(attach-as-child clog-obj "CLOGB3868394891" :clog-type
|
||||
(attach-as-child clog-obj "CLOGB3868475344" :clog-type
|
||||
'clog:clog-label :new-id t))
|
||||
(setf (slot-value panel 'dbl-click1)
|
||||
(attach-as-child clog-obj "CLOGB3868475343" :clog-type
|
||||
'clog:clog-label :new-id t))
|
||||
(setf (slot-value panel 'runtime-label)
|
||||
(attach-as-child clog-obj "CLOGB3868394890" :clog-type
|
||||
(attach-as-child clog-obj "CLOGB3868475342" :clog-type
|
||||
'clog:clog-label :new-id t))
|
||||
(setf (slot-value panel 'edit-asd)
|
||||
(attach-as-child clog-obj "CLOGB3868394889" :clog-type
|
||||
(attach-as-child clog-obj "CLOGB3868475341" :clog-type
|
||||
'clog:clog-button :new-id t))
|
||||
(setf (slot-value panel 'project-list)
|
||||
(attach-as-child clog-obj "CLOGB3868394888" :clog-type
|
||||
(attach-as-child clog-obj "CLOGB3868475340" :clog-type
|
||||
'clog:clog-select :new-id t))
|
||||
(setf (slot-value panel 'projects-label)
|
||||
(attach-as-child clog-obj "CLOGB3868394887" :clog-type
|
||||
(attach-as-child clog-obj "CLOGB3868475339" :clog-type
|
||||
'clog:clog-label :new-id t))
|
||||
(let ((target (projects-label panel)))
|
||||
(declare (ignorable target))
|
||||
|
|
@ -58,11 +84,21 @@
|
|||
(setf (attribute target "for")
|
||||
(clog:js-query target
|
||||
"$('[data-clog-name=\\'runtime-list\\']').attr('id')")))
|
||||
(let ((target (dbl-click1 panel)))
|
||||
(declare (ignorable target))
|
||||
(setf (attribute target "for")
|
||||
(clog:js-query target
|
||||
"$('[data-clog-name=\\'runtime-list\\']').attr('id')")))
|
||||
(let ((target (designtime-label panel)))
|
||||
(declare (ignorable target))
|
||||
(setf (attribute target "for")
|
||||
(clog:js-query target
|
||||
"$('[data-clog-name=\\'designtime-list\\']').attr('id')")))
|
||||
(let ((target (dbl-click2 panel)))
|
||||
(declare (ignorable target))
|
||||
(setf (attribute target "for")
|
||||
(clog:js-query target
|
||||
"$('[data-clog-name=\\'designtime-list\\']').attr('id')")))
|
||||
(clog:set-on-change (project-list panel)
|
||||
(lambda (target)
|
||||
(declare (ignorable target))
|
||||
|
|
@ -86,6 +122,48 @@
|
|||
(format nil "~A/tools"
|
||||
(text-value (project-list panel)))
|
||||
target)))
|
||||
(clog:set-on-click (runtime-add-lisp panel)
|
||||
(lambda (target)
|
||||
(declare (ignorable target))
|
||||
(let ((sys (text-value (project-list panel))))
|
||||
(projects-add-lisp panel sys))))
|
||||
(clog:set-on-click (runtime-delete panel)
|
||||
(lambda (target)
|
||||
(declare (ignorable target))
|
||||
(let ((sys (text-value (project-list panel)))
|
||||
(file (select-text (runtime-list panel))))
|
||||
(unless (equal file "")
|
||||
(setf file (subseq file 0 (- (length file) 5)))
|
||||
(remove-file-from-defsystem sys file :file)
|
||||
(projects-populate panel)))))
|
||||
(clog:set-on-click (designtime-add-clog panel)
|
||||
(lambda (target)
|
||||
(declare (ignorable target))
|
||||
(let ((sys (text-value (project-list panel))))
|
||||
(projects-add-clog panel sys))))
|
||||
(clog:set-on-click (designtime-add-lisp panel)
|
||||
(lambda (target)
|
||||
(declare (ignorable target))
|
||||
(let ((sys
|
||||
(format nil "~A/tools"
|
||||
(text-value (project-list panel)))))
|
||||
(projects-add-lisp panel sys))))
|
||||
(clog:set-on-click (designtime-delete panel)
|
||||
(lambda (target)
|
||||
(declare (ignorable target))
|
||||
(let ((sys
|
||||
(format nil "~A/tools"
|
||||
(text-value (project-list panel))))
|
||||
(file (select-text (designtime-list panel)))
|
||||
ext)
|
||||
(unless (equal file "")
|
||||
(setf ext (subseq file (- (length file) 5)))
|
||||
(setf file (subseq file 0 (- (length file) 5)))
|
||||
(remove-file-from-defsystem sys file
|
||||
(if (equalp ext ".clog")
|
||||
:clog-file
|
||||
:file))
|
||||
(projects-populate panel)))))
|
||||
(clog:set-on-click (new-project-button panel)
|
||||
(lambda (target)
|
||||
(declare (ignorable target))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue