(in-package "CLOG-TOOLS") (defclass sys-browser (clog:clog-panel) ((file-name :reader file-name) (eval-sel-button :reader eval-sel-button) (eval-button :reader eval-button) (save-button :reader save-button) (search-box :reader search-box) (class-only :reader class-only) (label-class-only :reader label-class-only) (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) (fname :accessor fname) (state :accessor state :initform t))) (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 'file-name) (attach-as-child clog-obj "CLOGB3868359582" :clog-type 'clog:clog-div :new-id t)) (setf (slot-value panel 'eval-sel-button) (attach-as-child clog-obj "CLOGB3868359581" :clog-type 'clog:clog-form-element :new-id t)) (setf (slot-value panel 'eval-button) (attach-as-child clog-obj "CLOGB3868359580" :clog-type 'clog:clog-form-element :new-id t)) (setf (slot-value panel 'save-button) (attach-as-child clog-obj "CLOGB3868359579" :clog-type 'clog:clog-form-element :new-id t)) (setf (slot-value panel 'search-box) (attach-as-child clog-obj "CLOGB3868359578" :clog-type 'clog:clog-form-element :new-id t)) (setf (slot-value panel 'class-only) (attach-as-child clog-obj "CLOGB3868359577" :clog-type 'clog:clog-form-element :new-id t)) (setf (slot-value panel 'label-class-only) (attach-as-child clog-obj "CLOGB3868359576" :clog-type 'clog:clog-label :new-id t)) (setf (slot-value panel 'status-box) (attach-as-child clog-obj "CLOGB3868359575" :clog-type 'clog:clog-div :new-id t)) (setf (slot-value panel 'src-box) (attach-as-child clog-obj "CLOGB3868359574" :clog-type 'clog-ace:clog-ace-element :new-id t)) (setf (slot-value panel 'doc-box) (attach-as-child clog-obj "CLOGB3868359573" :clog-type 'clog:clog-text-area :new-id t)) (setf (slot-value panel 'class-box) (attach-as-child clog-obj "CLOGB3868359572" :clog-type 'clog:clog-select :new-id t)) (setf (slot-value panel 'package-box) (attach-as-child clog-obj "CLOGB3868359571" :clog-type 'clog:clog-select :new-id t)) (setf (slot-value panel 'type-box) (attach-as-child clog-obj "CLOGB3868359570" :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) "GLOBAL-DEFINITION")) (let ((target (package-box panel))) (declare (ignorable target)) (add-select-option target "All" "All") (dolist (p (sort (list-all-packages) (lambda (a b) (string-lessp (package-name a) (package-name b))))) (add-select-option target (package-name p) (package-name p))) (setf (value target) "All") (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))) (let ((target (label-class-only panel))) (declare (ignorable target)) (setf (attribute target "for") (clog:js-query target "$('[data-clog-name=\\'class-only\\']').attr('id')"))) (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)) (sys-browser-select panel target))) (clog:set-on-input (src-box panel) (lambda (target) (declare (ignorable target)) (unless (state panel) (when (fname panel) (setf (state panel) t) (setf (disabledp (save-button panel)) nil))))) (clog:set-on-change (class-only panel) (lambda (target) (declare (ignorable target)) (sys-browser-populate panel))) (clog:set-on-key-up (search-box panel) (lambda (target data) (declare (ignorable target data)) (cond ((equal (text-value (package-box panel)) "All") (when (equalp "enter" (getf data :key)) (sys-browser-populate panel))) (t (sys-browser-populate panel))))) (clog:set-on-click (save-button panel) (lambda (target) (declare (ignorable target)) (when (fname panel) (write-file (text-value (src-box panel)) (fname panel)) (setf (state panel) nil) (setf (disabledp (save-button panel)) t)))) (clog:set-on-click (eval-button panel) (lambda (target) (declare (ignorable target)) (let ((pac (text-value (package-box panel))) (val (clog-ace:selected-text (src-box panel)))) (when (equalp "All" pac) (setf pac "CLOG-USER")) (unless (equal val "") (let ((result (capture-eval val :clog-obj panel :eval-in-package (text-value (package-box panel))))) (clog-web-alert (connection-body panel) "Result" (format nil "~&result: ~A" result) :color-class "w3-green" :time-out 3)))))) (clog:set-on-click (eval-sel-button panel) (lambda (target) (declare (ignorable target)) (let ((pac (text-value (package-box panel))) (val (clog-ace:selected-text (src-box panel)))) (when (equalp "All" pac) (setf pac "CLOG-USER")) (unless (equal val "") (let ((result (capture-eval val :clog-obj panel :eval-in-package pac))) (clog-web-alert (connection-body panel) "Result" (format nil "~&result: ~A" result) :color-class "w3-green" :time-out 3)))))) panel))