(in-package :clog-tools) (defclass sys-browser (clog:clog-panel) ((status-box :reader status-box) (save-button :reader save-button) (eval-button :reader eval-button) (eval-sel-button :reader eval-sel-button) (eval-form-button :reader eval-form-button) (file-name :reader file-name) (src-box :reader src-box) (pac-box :reader pac-box) (doc-box :reader doc-box) (class-box :reader class-box) (search-box :reader search-box) (class-only :reader class-only) (label-class-only :reader label-class-only) (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 'status-box) (attach-as-child clog-obj "CLOGB3868704979" :clog-type 'clog:clog-div :new-id t)) (setf (slot-value panel 'save-button) (attach-as-child clog-obj "CLOGB3868704978" :clog-type 'clog:clog-form-element :new-id t)) (setf (slot-value panel 'eval-button) (attach-as-child clog-obj "CLOGB3868704977" :clog-type 'clog:clog-form-element :new-id t)) (setf (slot-value panel 'eval-sel-button) (attach-as-child clog-obj "CLOGB3868704976" :clog-type 'clog:clog-form-element :new-id t)) (setf (slot-value panel 'eval-form-button) (attach-as-child clog-obj "CLOGB3868704975" :clog-type 'clog:clog-form-element :new-id t)) (setf (slot-value panel 'file-name) (attach-as-child clog-obj "CLOGB3868704974" :clog-type 'clog:clog-div :new-id t)) (setf (slot-value panel 'src-box) (attach-as-child clog-obj "CLOGB3868704973" :clog-type 'clog-ace:clog-ace-element :new-id t)) (setf (slot-value panel 'pac-box) (attach-as-child clog-obj "CLOGB3868704972" :clog-type 'clog:clog-form-element :new-id t)) (setf (slot-value panel 'doc-box) (attach-as-child clog-obj "CLOGB3868704971" :clog-type 'clog:clog-text-area :new-id t)) (setf (slot-value panel 'class-box) (attach-as-child clog-obj "CLOGB3868704970" :clog-type 'clog:clog-select :new-id t)) (setf (slot-value panel 'search-box) (attach-as-child clog-obj "CLOGB3868704969" :clog-type 'clog:clog-form-element :new-id t)) (setf (slot-value panel 'class-only) (attach-as-child clog-obj "CLOGB3868704968" :clog-type 'clog:clog-form-element :new-id t)) (setf (slot-value panel 'label-class-only) (attach-as-child clog-obj "CLOGB3868704967" :clog-type 'clog:clog-label :new-id t)) (setf (slot-value panel 'package-box) (attach-as-child clog-obj "CLOGB3868704966" :clog-type 'clog:clog-select :new-id t)) (setf (slot-value panel 'type-box) (attach-as-child clog-obj "CLOGB3868704965" :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 (label-class-only panel))) (declare (ignorable target)) (setf (attribute target "for") (clog:js-query target "$('[data-clog-name=\\'class-only\\']').attr('id')"))) (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-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-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-click (eval-form-button panel) (lambda (target) (declare (ignorable target)) (let ((p (parse-integer (js-query panel (format nil "~A.session.doc.positionToIndex (~A.selection.getCursor(), 0);" (clog-ace::js-ace (src-box panel)) (clog-ace::js-ace (src-box panel)))) :junk-allowed t)) (tv (text-value (src-box panel))) (pk (text-value (pac-box panel))) (lf nil) (cp 0)) (loop (setf (values lf cp) (read-from-string tv nil nil :start cp)) (unless lf (return nil)) (when (> cp p) (return lf))) (when lf (let ((result (capture-eval lf :clog-obj (connection-body panel) :eval-in-package (format nil "~A" pk)))) (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 (pac-box panel))) (val (clog-ace:selected-text (src-box panel)))) (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)))))) (clog:set-on-click (eval-button panel) (lambda (target) (declare (ignorable target)) (let ((pac (text-value (pac-box panel))) (val (clog-ace:selected-text (src-box panel)))) (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 (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)))) panel))