mirrors/clog
1
Fork 0
mirror of https://github.com/rabbibotton/clog.git synced 2025-12-06 10:40:45 -08:00
Code Issues Projects Releases Wiki Activity

system browser

Browse source
This commit is contained in:
David Botton 2022-07-27 19:12:58 -04:00
parent 4611123f82
commit 7ddb322bbf
4 changed files with 196 additions and 51 deletions
Download patch file Download diff file Expand all files Collapse all files

4
clog.asd
View file

@ -48,7 +48,8 @@
:components ((:file "clog-docs"))) :components ((:file "clog-docs")))
(asdf:defsystem #:clog/tools (asdf:defsystem #:clog/tools
:depends-on (#:clog #:clog-ace #:clog-terminal #:s-base64 #:swank) :depends-on (#:clog #:clog-ace #:clog-terminal #:s-base64 #:swank
#:definitions)
:pathname "tools/" :pathname "tools/"
:components ((:file "clog-db-admin") :components ((:file "clog-db-admin")
(:file "clog-builder-settings") (:file "clog-builder-settings")
@ -59,4 +60,5 @@
(:file "image-to-data") (:file "image-to-data")
(:file "quick-start") (:file "quick-start")
(:file "threads") (:file "threads")
(:file "sys-browser")
(:file "clog-builder-images"))) (:file "clog-builder-images")))

132
tools/clog-builder.lisp
View file

@ -1111,10 +1111,11 @@ of controls and double click to select control."
(setf (positioning control-list) :absolute) (setf (positioning control-list) :absolute)
(set-geometry control-list :left 0 :top 0 :right 0))) (set-geometry control-list :left 0 :top 0 :right 0)))
(defun setup-ada-ace (app editor status &key (package "CLOG-USER")) (defun setup-lisp-ace (editor status &key (package "CLOG-USER"))
(js-execute editor (let ((app (connection-data-item editor "builder-app-data")))
(format nil (js-execute editor
"~A.commands.addCommand({ (format nil
"~A.commands.addCommand({
name: 'find-definition', name: 'find-definition',
bindKey: {win: 'Alt-.', mac: 'Command-.'}, bindKey: {win: 'Alt-.', mac: 'Command-.'},
exec: function(editor) { exec: function(editor) {
@ -1137,24 +1138,24 @@ of controls and double click to select control."
}, },
readOnly: true, readOnly: true,
});" });"
(clog-ace::js-ace editor) (clog-ace::js-ace editor)
(jquery editor))) (jquery editor)))
(set-on-event-with-data editor "clog-find" (set-on-event-with-data editor "clog-find"
(lambda (obj data) (lambda (obj data)
(declare (ignore obj)) (declare (ignore obj))
(when (current-editor-is-lisp app) (when (current-editor-is-lisp app)
(ignore-errors (ignore-errors
(let* ((*PACKAGE* (find-package package)) (let* ((*PACKAGE* (find-package package))
(SWANK::*buffer-package* (find-package package)) (SWANK::*buffer-package* (find-package package))
(SWANK::*buffer-readtable* *readtable*) (SWANK::*buffer-readtable* *readtable*)
(loc (swank:find-definitions-for-emacs data))) (loc (swank:find-definitions-for-emacs data)))
(when loc (when loc
(swank:ed-in-emacs (list (second (second (second (car loc)))) (swank:ed-in-emacs (list (second (second (second (car loc))))
:position (second (third (second (car loc)))))))))))) :position (second (third (second (car loc))))))))))))
(set-on-change editor (set-on-change editor
(lambda (obj) (lambda (obj)
(let ((s (js-query obj (format nil (let ((s (js-query obj (format nil
"var row = ~A.selection.getCursor().row; ~ "var row = ~A.selection.getCursor().row; ~
var column = ~A.selection.getCursor().column; ~ var column = ~A.selection.getCursor().column; ~
var o = column; var o = column;
var c; var charRange; var b=0; ~ var c; var charRange; var b=0; ~
@ -1168,31 +1169,31 @@ of controls and double click to select control."
c = ~A.session.getTextRange(charRange);} ~ c = ~A.session.getTextRange(charRange);} ~
if (c=='(' && b > 0) { b-- } }~ if (c=='(' && b > 0) { b-- } }~
c" c"
(clog-ace::js-ace obj) (clog-ace::js-ace obj)
(clog-ace::js-ace obj) (clog-ace::js-ace obj)
(clog-ace::js-ace obj) (clog-ace::js-ace obj)
(clog-ace::js-ace obj))))) (clog-ace::js-ace obj)))))
(unless (equal s "") (unless (equal s "")
(with-input-from-string (i s) (with-input-from-string (i s)
(ignore-errors (ignore-errors
(let* ((m (read i)) (let* ((m (read i))
(*PACKAGE* (find-package package)) (*PACKAGE* (find-package package))
(SWANK::*buffer-package* (find-package package)) (SWANK::*buffer-package* (find-package package))
(SWANK::*buffer-readtable* *readtable*) (SWANK::*buffer-readtable* *readtable*)
(ms (format nil "~A" m)) (ms (format nil "~A" m))
r) r)
(ignore-errors (ignore-errors
(setf r (swank::autodoc `(,ms swank::%CURSOR-MARKER%)))) (setf r (swank::autodoc `(,ms swank::%CURSOR-MARKER%))))
(if r (if r
(setf r (car r)) (setf r (car r))
(setf r (swank:operator-arglist ms package))) (setf r (swank:operator-arglist ms package)))
(setf (advisory-title status) (documentation (find-symbol ms) 'function)) (setf (advisory-title status) (documentation (find-symbol ms) 'function))
(when r (when r
(setf (text status) (string-downcase r)))))))))) (setf (text status) (string-downcase r))))))))))
(clog-ace:set-auto-completion editor t) (clog-ace:set-auto-completion editor t)
(setf (clog-ace:theme editor) "ace/theme/xcode") (setf (clog-ace:theme editor) "ace/theme/xcode")
(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 on-show-control-events-win (obj) (defun on-show-control-events-win (obj)
"Show control events window" "Show control events window"
@ -1253,7 +1254,7 @@ of controls and double click to select control."
(setf (positioning status) :absolute) (setf (positioning status) :absolute)
(setf (width status) "") (setf (width status) "")
(set-geometry status :height 20 :left 5 :right 5 :bottom 5) (set-geometry status :height 20 :left 5 :right 5 :bottom 5)
(setup-ada-ace app (event-editor app) status :package "CLOG-USER") (setup-lisp-ace (event-editor app) status :package "CLOG-USER")
(set-on-window-size-done win (lambda (obj) (set-on-window-size-done win (lambda (obj)
(declare (ignore obj)) (declare (ignore obj))
(clog-ace:resize (event-editor app)))) (clog-ace:resize (event-editor app))))
@ -2109,7 +2110,7 @@ of controls and double click to select control."
(clog-ace:resize ace) (clog-ace:resize ace)
(set-geometry status :units "" :width "" :height "20px" (set-geometry status :units "" :width "" :height "20px"
:bottom "0px" :left "0px" :right "0px") :bottom "0px" :left "0px" :right "0px")
(setup-ada-ace app ace status) (setup-lisp-ace ace status)
(set-on-window-size-done win (set-on-window-size-done win
(lambda (obj) (lambda (obj)
(declare (ignore obj)) (declare (ignore obj))
@ -2173,6 +2174,31 @@ 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-new-sys-browser (obj)
(let* ((app (connection-data-item obj "builder-app-data"))
(win (create-gui-window obj :title "System Browser"
:top 40 :left 225
:width 665 :height 430
:client-movement t))
(panel (create-sys-browser (window-content win))))
(set-on-window-size-done win (lambda (obj)
(clog-ace:resize (src-box panel))))))
(defun sys-browser-populate (panel)
(setf (inner-html (class-box panel)) "")
(setf (text-value (src-box panel)) "")
(setf (text-value (doc-box panel)) "")
(setf (classes panel) (definitions:find-definitions
(text-value (package-box panel))
:type (find-symbol
(text-value (type-box panel))
(find-package :definitions))))
(let ((i 0))
(dolist (c (classes panel))
(add-select-option (class-box panel) i
(definitions:designator c))
(incf i))))
(defun on-new-builder (body) (defun on-new-builder (body)
"Launch instance of the CLOG Builder" "Launch instance of the CLOG Builder"
(set-html-on-close body "Connection Lost") (set-html-on-close body "Connection Lost")
@ -2204,14 +2230,19 @@ of controls and double click to select control."
(create-gui-menu-item src :content "New Source Editor" :on-click 'on-open-file) (create-gui-menu-item src :content "New Source Editor" :on-click 'on-open-file)
(create-gui-menu-item tools :content "Control Events" :on-click 'on-show-control-events-win) (create-gui-menu-item tools :content "Control Events" :on-click 'on-show-control-events-win)
(create-gui-menu-item tools :content "Thread Viewer" :on-click 'on-show-thread-viewer) (create-gui-menu-item tools :content "Thread Viewer" :on-click 'on-show-thread-viewer)
(create-gui-menu-item tools :content "New System Browser" :on-click 'on-new-sys-browser)
(create-gui-menu-item tools :content "CLOG Builder REPL" :on-click 'on-repl) (create-gui-menu-item tools :content "CLOG Builder REPL" :on-click 'on-repl)
(create-gui-menu-item tools :content "Copy/Cut History" :on-click 'on-show-copy-history-win) (create-gui-menu-item tools :content "Copy/Cut History" :on-click 'on-show-copy-history-win)
(create-gui-menu-item tools :content "Image to HTML Data" :on-click 'on-image-to-data) (create-gui-menu-item tools :content "Image to HTML Data" :on-click 'on-image-to-data)
(create-gui-menu-item tools :content "Launch System Browser" :on-click
(lambda (obj)
(declare (ignore obj))
(open-window (window body) "/sysbrowser")))
(create-gui-menu-item tools :content "Launch DB Admin" :on-click (create-gui-menu-item tools :content "Launch DB Admin" :on-click
(lambda (obj) (lambda (obj)
(declare (ignore obj)) (declare (ignore obj))
(open-window (window body) "/dbadmin"))) (open-window (window body) "/dbadmin")))
(create-gui-menu-item win :content "Maximize All" :on-click #'maximize-all-windows) (Create-gui-menu-item win :content "Maximize All" :on-click #'maximize-all-windows)
(create-gui-menu-item win :content "Normalize All" :on-click #'normalize-all-windows) (create-gui-menu-item win :content "Normalize All" :on-click #'normalize-all-windows)
(create-gui-menu-window-select win) (create-gui-menu-window-select win)
(create-gui-menu-item help :content "CLOG Quick Start" :on-click 'on-quick-start) (create-gui-menu-item help :content "CLOG Quick Start" :on-click 'on-quick-start)
@ -2282,6 +2313,7 @@ of controls and double click to select control."
(initialize nil :port port)) (initialize nil :port port))
(set-on-new-window 'on-new-builder :path "/builder") (set-on-new-window 'on-new-builder :path "/builder")
(set-on-new-window 'on-new-db-admin :path "/dbadmin") (set-on-new-window 'on-new-db-admin :path "/dbadmin")
(set-on-new-window 'create-sys-browser :path "/sysbrowser")
(set-on-new-window 'on-attach-builder-page :path "/builder-page") (set-on-new-window 'on-attach-builder-page :path "/builder-page")
(set-on-new-window 'on-convert-image :path "/image-to-data") (set-on-new-window 'on-convert-image :path "/image-to-data")
(open-browser :url (format nil "http://127.0.0.1:~A/builder" port))) (open-browser :url (format nil "http://127.0.0.1:~A/builder" port)))

42
tools/sys-browser.clog Normal file
View file

@ -0,0 +1,42 @@
<data id="I3867951545" data-in-package="clog-tools" data-custom-slots="(classes :accessor classes)" data-clog-next-id="12" data-clog-title="sys-browser"></data><select data-clog-type="dropdown" data-clog-name="type-box" style="box-sizing: content-box; position: absolute; left: 5px; top: 10px; width: 190px; height: 20px;" data-on-create="(add-select-options target '(ALIEN-TYPE
CALLABLE
CLASS
COMPILER-MACRO
CONDITION
CONSTANT
DECLARATION
DEFINITION
FUNCTION
GENERIC-FUNCTION
GLOBAL-DEFINITION
IR1-CONVERT
MACRO
METHOD
METHOD-COMBINATION
OPTIMIZER
SETF-EXPANDER
SOURCE-TRANSFORM
SPECIAL-OPERATOR
STRUCTURE
SYMBOL-MACRO
TRANSFORM
TYPE
TYPE-DEFINITION
VARIABLE
VOP))
(setf (value target) &quot;CALLABLE&quot;)
" data-on-change="(sys-browser-populate panel)"></select><select data-clog-type="dropdown" data-clog-name="package-box" style="box-sizing: content-box; position: absolute; left: 205px; top: 10px; width: 300px; height: 20px; bottom: 335.028px;" data-on-create="(dolist (p (sort (list-all-packages) (lambda (a b)
(string-greaterp (package-name a)
(package-name b)))))
(add-select-option target (package-name p)
(package-name p)))
(setf (value target) &quot;CLOG-USER&quot;)
(sys-browser-populate panel)" data-on-change="(sys-browser-populate panel)"></select><select data-clog-type="listbox" size="4" data-clog-name="class-box" style="box-sizing: content-box; position: absolute; left: 5px; top: 45px; width: 350px; height: 145px;" data-on-change="(let* ((item (nth (parse-integer (text-value (class-box panel))) (classes panel)))
(fname (getf (definitions:source-location item) :file)))
(setf (text-value (doc-box panel))
(or (definitions:documentation item)
&quot;No documentation&quot;))
(if fname
(setf (text-value (src-box panel)) (read-file fname))
(setf (text-value (src-box panel)) &quot;No file information&quot;)))
" class="w3-small"></select><textarea name="" cols="20" rows="2" data-clog-type="textarea" data-clog-name="doc-box" style="box-sizing: content-box; position: absolute; inset: 45px 5px 176.051px 365px; height: 139.989px; resize: none; min-width: 0px;" class="&nbsp;w3-small"></textarea><div class="ace_editor ace_hidpi ace-xcode ace-tm" data-clog-type="clog-ace" data-clog-composite-control="t" data-clog-ace-theme="ace/theme/xcode" data-clog-ace-mode="ace/mode/lisp" data-clog-ace-tab-size="2" data-clog-name="src-box" style="border: thin solid black; box-sizing: content-box; position: absolute; inset: 199.991px 5px 30px;" data-on-create="(setup-lisp-ace target (status-box panel))"></div><div data-clog-type="div" data-clog-name="status-box" style="box-sizing: content-box; position: absolute; left: 5px; bottom: 5px; right: 5px;" class="w3-tiny w3-border">status</div>

69
tools/sys-browser.lisp Normal file
View file

@ -0,0 +1,69 @@
(in-package "CLOG-TOOLS")
(defclass sys-browser (clog:clog-panel)
( (status-box :reader status-box)
(src-box :reader src-box)
(doc-box :reader doc-box)
(class-box :reader class-box)
(package-box :reader package-box)
(type-box :reader type-box)
(classes :accessor classes)))
(defun create-sys-browser (clog-obj &key (hidden nil) (class nil) (html-id nil) (auto-place t))
(let ((panel (change-class (clog:create-div clog-obj :content "<select id=\"CLOGB386794791511\" style=\"box-sizing: content-box; position: absolute; left: 5px; top: 10px; width: 190px; height: 20px;\" data-clog-name=\"type-box\"></select><select style=\"box-sizing: content-box; position: absolute; left: 205px; top: 10px; width: 300px; height: 20px; bottom: 335.028px;\" id=\"CLOGB3867947746\" data-clog-name=\"package-box\"></select><select size=\"4\" style=\"box-sizing: content-box; position: absolute; left: 5px; top: 45px; width: 190px; height: 145px;\" class=\"w3-small\" id=\"CLOGB3867947747\" data-clog-name=\"class-box\"></select><textarea name=\"\" cols=\"20\" rows=\"2\" style=\"box-sizing: content-box; position: absolute; left: 205px; top: 45px; height: 139.989px; right: 5px; resize: none; min-width: 0px;\" class=\"&nbsp;w3-small\" id=\"CLOGB3867947748\" data-clog-name=\"doc-box\"></textarea><div class=\"ace_editor ace_hidpi ace-xcode ace-tm\" style=\"border: thin solid black; box-sizing: content-box; position: absolute; inset: 199.991px 5px 30px;\" id=\"CLOGB3867947749\" data-clog-name=\"src-box\"></div><div style=\"box-sizing: content-box; position: absolute; left: 5px; bottom: 5px; right: 5px;\" class=\"w3-tiny w3-border\" id=\"CLOGB3867947750\" data-clog-name=\"status-box\">status</div>"
:hidden hidden :class class :html-id html-id :auto-place auto-place) 'sys-browser)))
(setf (slot-value panel 'status-box) (attach-as-child clog-obj "CLOGB3867947750" :clog-type 'CLOG:CLOG-DIV :new-id t))
(setf (slot-value panel 'src-box) (attach-as-child clog-obj "CLOGB3867947749" :clog-type 'CLOG-ACE:CLOG-ACE-ELEMENT :new-id t))
(setf (slot-value panel 'doc-box) (attach-as-child clog-obj "CLOGB3867947748" :clog-type 'CLOG:CLOG-TEXT-AREA :new-id t))
(setf (slot-value panel 'class-box) (attach-as-child clog-obj "CLOGB3867947747" :clog-type 'CLOG:CLOG-SELECT :new-id t))
(setf (slot-value panel 'package-box) (attach-as-child clog-obj "CLOGB3867947746" :clog-type 'CLOG:CLOG-SELECT :new-id t))
(setf (slot-value panel 'type-box) (attach-as-child clog-obj "CLOGB386794791511" :clog-type 'CLOG:CLOG-SELECT :new-id t))
(let ((target (type-box panel))) (declare (ignorable target)) (add-select-options target '(ALIEN-TYPE
CALLABLE
CLASS
COMPILER-MACRO
CONDITION
CONSTANT
DECLARATION
DEFINITION
FUNCTION
GENERIC-FUNCTION
GLOBAL-DEFINITION
IR1-CONVERT
MACRO
METHOD
METHOD-COMBINATION
OPTIMIZER
SETF-EXPANDER
SOURCE-TRANSFORM
SPECIAL-OPERATOR
STRUCTURE
SYMBOL-MACRO
TRANSFORM
TYPE
TYPE-DEFINITION
VARIABLE
VOP))
(setf (value target) "CALLABLE")
)
(let ((target (package-box panel))) (declare (ignorable target)) (dolist (p (sort (list-all-packages) (lambda (a b)
(string-greaterp (package-name a)
(package-name b)))))
(add-select-option target (package-name p)
(package-name p)))
(setf (value target) "CLOG-USER")
(sys-browser-populate panel))
(let ((target (src-box panel))) (declare (ignorable target)) (clog-ace:attach-clog-ace target)
(setf (clog-ace:theme target) "ace/theme/xcode")
(setf (clog-ace:mode target) "ace/mode/lisp")
(setf (clog-ace:tab-size target) 2)(setup-lisp-ace target (status-box panel)))
(clog:set-on-change (type-box panel) (lambda (target) (declare (ignorable target)) (sys-browser-populate panel)))
(clog:set-on-change (package-box panel) (lambda (target) (declare (ignorable target)) (sys-browser-populate panel)))
(clog:set-on-change (class-box panel) (lambda (target) (declare (ignorable target)) (let* ((item (nth (parse-integer (text-value (class-box panel))) (classes panel)))
(fname (getf (definitions:source-location item) :file)))
(setf (text-value (doc-box panel))
(or (definitions:documentation item)
"No documentation"))
(if fname
(setf (text-value (src-box panel)) (read-file fname))
(setf (text-value (src-box panel)) "No file information")))
))
panel))