mirror of
https://github.com/rabbibotton/clog.git
synced 2025-12-06 02:30:42 -08:00
197 lines
13 KiB
Common Lisp
197 lines
13 KiB
Common Lisp
(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
|
|
"<select style=\"box-sizing: content-box; position: absolute; left: 5px; top: 10px; width: 190px; height: 20px;\" id=\"CLOGB3869649913\" 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=\"CLOGB3869649914\" data-clog-name=\"package-box\"></select><label for=\"CLOGB386795982312\" style=\"box-sizing: content-box; position: absolute; left: 535px; top: 9px;\" class=\"\" id=\"CLOGB3869649915\" data-clog-name=\"label-class-only\">pkg only</label><input type=\"CHECKBOX\" value=\"\" style=\"box-sizing: content-box; position: absolute; left: 516px; top: 15px;\" checked=\"checked\" id=\"CLOGB3869649916\" data-clog-name=\"class-only\"><input type=\"TEXT\" value=\"\" style=\"box-sizing: content-box; position: absolute; inset: 7px 5px 332.045px 605px; height: 22px;\" placeholder=\"search\" name=\"\" id=\"CLOGB3869649917\" data-clog-name=\"search-box\"><select size=\"4\" style=\"box-sizing: content-box; position: absolute; left: 5px; top: 40px; right: 5px; height: 125px;\" class=\"w3-small\" id=\"CLOGB3869649918\" data-clog-name=\"class-box\"></select><textarea name=\"\" cols=\"20\" rows=\"2\" style=\"box-sizing: content-box; position: absolute; right: 5px; height: 50px; resize: none; min-width: 0px; top: 175px; left: 5px;\" class=\" w3-small\" id=\"CLOGB3869649919\" data-clog-name=\"doc-box\"></textarea><input type=\"TEXT\" value=\"clog-user\" style=\"box-sizing: content-box; position: absolute; left: 5px; top: 239px; right: 5px; height: 18px;\" placeholder=\"Current Package\" class=\"w3-small\" id=\"CLOGB3869649920\" data-clog-name=\"pac-box\"><div class=\"ace_editor ace_hidpi ace-xcode ace-tm\" style=\"border: thin solid black; box-sizing: content-box; position: absolute; inset: 273px 5px 50px;\" id=\"CLOGB3869649921\" data-clog-name=\"src-box\"></div><div style=\"box-sizing: content-box; position: absolute; left: 5px; bottom: 27px; right: 290px;\" class=\"w3-small\" id=\"CLOGB3869649922\" data-clog-name=\"file-name\"> </div><input type=\"BUTTON\" value=\"Eval Form\" style=\"box-sizing: content-box; position: absolute; width: 50px; height: 15px; right: 215px; bottom: 24px;\" class=\"w3-tiny\" disabled=\"disabled\" id=\"CLOGB3869649923\" data-clog-name=\"eval-form-button\"><input type=\"BUTTON\" value=\"Eval Sel\" style=\"box-sizing: content-box; position: absolute; width: 50px; height: 15px; right: 145px; bottom: 25px;\" class=\"w3-tiny\" placeholder=\"\" disabled=\"disabled\" id=\"CLOGB3869649924\" data-clog-name=\"eval-sel-button\"><input type=\"BUTTON\" value=\"Eval File\" style=\"box-sizing: content-box; position: absolute; width: 50px; height: 15px; right: 75px; bottom: 25px;\" class=\"w3-tiny\" disabled=\"disabled\" id=\"CLOGB3869649925\" data-clog-name=\"eval-button\"><input type=\"BUTTON\" value=\"Save\" style=\"box-sizing: content-box; position: absolute; width: 50px; height: 15px; right: 5px; bottom: 25px;\" class=\"w3-tiny\" disabled=\"disabled\" id=\"CLOGB3869649926\" data-clog-name=\"save-button\"><div style=\"box-sizing: content-box; position: absolute; left: 5px; bottom: 5px; right: 5px;\" class=\"w3-tiny w3-border\" id=\"CLOGB3869649927\" 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 "CLOGB3869649927" :clog-type
|
|
'clog:clog-div :new-id t))
|
|
(setf (slot-value panel 'save-button)
|
|
(attach-as-child clog-obj "CLOGB3869649926" :clog-type
|
|
'clog:clog-form-element :new-id t))
|
|
(setf (slot-value panel 'eval-button)
|
|
(attach-as-child clog-obj "CLOGB3869649925" :clog-type
|
|
'clog:clog-form-element :new-id t))
|
|
(setf (slot-value panel 'eval-sel-button)
|
|
(attach-as-child clog-obj "CLOGB3869649924" :clog-type
|
|
'clog:clog-form-element :new-id t))
|
|
(setf (slot-value panel 'eval-form-button)
|
|
(attach-as-child clog-obj "CLOGB3869649923" :clog-type
|
|
'clog:clog-form-element :new-id t))
|
|
(setf (slot-value panel 'file-name)
|
|
(attach-as-child clog-obj "CLOGB3869649922" :clog-type
|
|
'clog:clog-div :new-id t))
|
|
(setf (slot-value panel 'src-box)
|
|
(attach-as-child clog-obj "CLOGB3869649921" :clog-type
|
|
'clog-ace:clog-ace-element :new-id t))
|
|
(setf (slot-value panel 'pac-box)
|
|
(attach-as-child clog-obj "CLOGB3869649920" :clog-type
|
|
'clog:clog-form-element :new-id t))
|
|
(setf (slot-value panel 'doc-box)
|
|
(attach-as-child clog-obj "CLOGB3869649919" :clog-type
|
|
'clog:clog-text-area :new-id t))
|
|
(setf (slot-value panel 'class-box)
|
|
(attach-as-child clog-obj "CLOGB3869649918" :clog-type
|
|
'clog:clog-select :new-id t))
|
|
(setf (slot-value panel 'search-box)
|
|
(attach-as-child clog-obj "CLOGB3869649917" :clog-type
|
|
'clog:clog-form-element :new-id t))
|
|
(setf (slot-value panel 'class-only)
|
|
(attach-as-child clog-obj "CLOGB3869649916" :clog-type
|
|
'clog:clog-form-element :new-id t))
|
|
(setf (slot-value panel 'label-class-only)
|
|
(attach-as-child clog-obj "CLOGB3869649915" :clog-type
|
|
'clog:clog-label :new-id t))
|
|
(setf (slot-value panel 'package-box)
|
|
(attach-as-child clog-obj "CLOGB3869649914" :clog-type
|
|
'clog:clog-select :new-id t))
|
|
(setf (slot-value panel 'type-box)
|
|
(attach-as-child clog-obj "CLOGB3869649913" :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-click (class-box panel)
|
|
(lambda (target)
|
|
(declare (ignorable target))
|
|
(sys-browser-select panel target)))
|
|
(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))
|