diff --git a/clog.asd b/clog.asd
index 3b9fdf4..5d67851 100644
--- a/clog.asd
+++ b/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")))
diff --git a/tools/clog-builder.lisp b/tools/clog-builder.lisp
index b9ddbeb..ea5c239 100644
--- a/tools/clog-builder.lisp
+++ b/tools/clog-builder.lisp
@@ -1111,10 +1111,11 @@ 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"))
- (js-execute editor
- (format nil
- "~A.commands.addCommand({
+(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({
name: 'find-definition',
bindKey: {win: 'Alt-.', mac: 'Command-.'},
exec: function(editor) {
@@ -1137,24 +1138,24 @@ of controls and double click to select control."
},
readOnly: true,
});"
- (clog-ace::js-ace editor)
- (jquery editor)))
- (set-on-event-with-data editor "clog-find"
- (lambda (obj data)
- (declare (ignore obj))
- (when (current-editor-is-lisp app)
- (ignore-errors
- (let* ((*PACKAGE* (find-package package))
- (SWANK::*buffer-package* (find-package package))
- (SWANK::*buffer-readtable* *readtable*)
- (loc (swank:find-definitions-for-emacs data)))
- (when loc
- (swank:ed-in-emacs (list (second (second (second (car loc))))
- :position (second (third (second (car loc))))))))))))
- (set-on-change editor
- (lambda (obj)
- (let ((s (js-query obj (format nil
- "var row = ~A.selection.getCursor().row; ~
+ (clog-ace::js-ace editor)
+ (jquery editor)))
+ (set-on-event-with-data editor "clog-find"
+ (lambda (obj data)
+ (declare (ignore obj))
+ (when (current-editor-is-lisp app)
+ (ignore-errors
+ (let* ((*PACKAGE* (find-package package))
+ (SWANK::*buffer-package* (find-package package))
+ (SWANK::*buffer-readtable* *readtable*)
+ (loc (swank:find-definitions-for-emacs data)))
+ (when loc
+ (swank:ed-in-emacs (list (second (second (second (car loc))))
+ :position (second (third (second (car loc))))))))))))
+ (set-on-change editor
+ (lambda (obj)
+ (let ((s (js-query obj (format nil
+ "var row = ~A.selection.getCursor().row; ~
var column = ~A.selection.getCursor().column; ~
var o = column;
var c; var charRange; var b=0; ~
@@ -1168,31 +1169,31 @@ of controls and double click to select control."
c = ~A.session.getTextRange(charRange);} ~
if (c=='(' && b > 0) { b-- } }~
c"
- (clog-ace::js-ace obj)
- (clog-ace::js-ace obj)
- (clog-ace::js-ace obj)
- (clog-ace::js-ace obj)))))
- (unless (equal s "")
- (with-input-from-string (i s)
- (ignore-errors
- (let* ((m (read i))
- (*PACKAGE* (find-package package))
- (SWANK::*buffer-package* (find-package package))
- (SWANK::*buffer-readtable* *readtable*)
- (ms (format nil "~A" m))
- r)
- (ignore-errors
- (setf r (swank::autodoc `(,ms swank::%CURSOR-MARKER%))))
- (if r
- (setf r (car r))
- (setf r (swank:operator-arglist ms package)))
- (setf (advisory-title status) (documentation (find-symbol ms) 'function))
- (when r
- (setf (text status) (string-downcase r))))))))))
- (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))
+ (clog-ace::js-ace obj)
+ (clog-ace::js-ace obj)
+ (clog-ace::js-ace obj)
+ (clog-ace::js-ace obj)))))
+ (unless (equal s "")
+ (with-input-from-string (i s)
+ (ignore-errors
+ (let* ((m (read i))
+ (*PACKAGE* (find-package package))
+ (SWANK::*buffer-package* (find-package package))
+ (SWANK::*buffer-readtable* *readtable*)
+ (ms (format nil "~A" m))
+ r)
+ (ignore-errors
+ (setf r (swank::autodoc `(,ms swank::%CURSOR-MARKER%))))
+ (if r
+ (setf r (car r))
+ (setf r (swank:operator-arglist ms package)))
+ (setf (advisory-title status) (documentation (find-symbol ms) 'function))
+ (when r
+ (setf (text status) (string-downcase r))))))))))
+ (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)))
(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)))
diff --git a/tools/sys-browser.clog b/tools/sys-browser.clog
new file mode 100644
index 0000000..18116c9
--- /dev/null
+++ b/tools/sys-browser.clog
@@ -0,0 +1,42 @@
+status
\ No newline at end of file
diff --git a/tools/sys-browser.lisp b/tools/sys-browser.lisp
new file mode 100644
index 0000000..47412b2
--- /dev/null
+++ b/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 "status
"
+ :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))