system browser

clog.asd

@@ -48,7 +48,8 @@
   :components ((:file "clog-docs")))
 
 (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/"
   :components ((:file "clog-db-admin")
 	       (:file "clog-builder-settings")
@@ -59,4 +60,5 @@
 	       (:file "image-to-data")
 	       (:file "quick-start")
 	       (:file "threads")
+               (:file "sys-browser")
 	       (:file "clog-builder-images")))

tools/clog-builder.lisp

@@ -1111,7 +1111,8 @@ of controls and double click to select control."
     (setf (positioning control-list) :absolute)
     (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"))
+  (let ((app (connection-data-item editor "builder-app-data")))
     (js-execute editor
                 (format nil
                         "~A.commands.addCommand({
@@ -1192,7 +1193,7 @@ of controls and double click to select control."
     (clog-ace:set-auto-completion editor t)
     (setf (clog-ace:theme editor) "ace/theme/xcode")
     (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)
   "Show control events window"
@@ -1253,7 +1254,7 @@ of controls and double click to select control."
           (setf (positioning status) :absolute)
           (setf (width status) "")
           (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)
                                          (declare (ignore obj))
                                          (clog-ace:resize (event-editor app))))
@@ -2109,7 +2110,7 @@ of controls and double click to select control."
     (clog-ace:resize ace)
     (set-geometry status :units "" :width "" :height "20px"
                          :bottom "0px" :left "0px" :right "0px")
-    (setup-ada-ace app ace status)
+    (setup-lisp-ace ace status)
     (set-on-window-size-done win
                              (lambda (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))
                   :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)
   "Launch instance of the CLOG Builder"
   (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 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 "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 "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 "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
                             (lambda (obj)
                               (declare (ignore obj))
                               (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-window-select win)
       (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))
   (set-on-new-window 'on-new-builder :path "/builder")
   (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-convert-image :path "/image-to-data")
   (open-browser :url (format nil "http://127.0.0.1:~A/builder" port)))

tools/sys-browser.clog

@@ -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>

tools/sys-browser.lisp

@@ -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))