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