From 4fc57d42bb91cd9cd645fca6fa857ddba71b8c73 Mon Sep 17 00:00:00 2001 From: David Botton Date: Fri, 5 Aug 2022 11:35:27 -0400 Subject: [PATCH] evaluate curent form btns --- tools/clog-builder.lisp | 36 ++++++++-- tools/sys-browser.clog | 52 ++++++++++---- tools/sys-browser.lisp | 155 ++++++++++++++++++++++++---------------- 3 files changed, 162 insertions(+), 81 deletions(-) diff --git a/tools/clog-builder.lisp b/tools/clog-builder.lisp index 5c8bfe3..710b6d0 100644 --- a/tools/clog-builder.lisp +++ b/tools/clog-builder.lisp @@ -1215,9 +1215,6 @@ of controls and double click to select control." (let ((result (capture-eval (format nil "~A" lf) :clog-obj (connection-body editor) :eval-in-package (format nil "~A" pk)))) - (print pk) - (print lf) - (print result) (clog-web-alert (connection-body editor) "Result" (format nil "~&result: ~A" result) :color-class "w3-green" @@ -2205,6 +2202,7 @@ of controls and double click to select control." (btn-save (create-img tool-bar :alt-text "save" :url-src img-btn-save :class btn-class)) (btn-load (create-img tool-bar :alt-text "load" :url-src img-btn-load :class btn-class)) (spacer (create-span tool-bar :content " ")) + (btn-efrm (create-button tool-bar :content "Eval Form" :class (format nil "w3-tiny ~A" btn-class))) (btn-esel (create-button tool-bar :content "Eval Sel" :class (format nil "w3-tiny ~A" btn-class))) (btn-test (create-button tool-bar :content "Eval" :class (format nil "w3-tiny ~A" btn-class))) (content (center-panel box)) @@ -2227,6 +2225,7 @@ of controls and double click to select control." (setf (advisory-title btn-redo) "redo") (setf (advisory-title btn-save) "save") (setf (advisory-title btn-load) "load") + (setf (advisory-title btn-efrm) "evaluate form") (setf (advisory-title btn-esel) "evaluate selection") (setf (advisory-title btn-test) "evaluate") (setf (height btn-copy) "12px") @@ -2237,10 +2236,12 @@ of controls and double click to select control." (setf (height btn-redo) "12px") (setf (height btn-save) "12px") (setf (height btn-load) "12px") + (setf (height btn-efrm) "12px") (setf (height btn-esel) "12px") (setf (height btn-test) "12px") - (setf (width btn-esel) "40px") - (setf (width btn-test) "40px") + (setf (width btn-efrm) "43px") + (setf (width btn-esel) "43px") + (setf (width btn-test) "43px") (setf (positioning ace) :absolute) (setf (positioning status) :absolute) (set-geometry pac-line :units "" :top "20px" :left "0px" @@ -2309,6 +2310,29 @@ of controls and double click to select control." (set-on-click btn-redo (lambda (obj) (declare (ignore obj)) (clog-ace:execute-command ace "redo"))) + (set-on-click btn-efrm (lambda (obj) + (let ((p (parse-integer + (js-query obj + (format nil "~A.session.doc.positionToIndex (~A.selection.getCursor(), 0);" + (clog-ace::js-ace ace) + (clog-ace::js-ace ace))) + :junk-allowed t)) + (tv (text-value ace)) + (pk (text-value pac-line)) + (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 (format nil "~A" lf) + :clog-obj (connection-body obj) + :eval-in-package (format nil "~A" pk)))) + (clog-web-alert (connection-body obj) "Result" + (format nil "~&result: ~A" result) + :color-class "w3-green" + :time-out 3)))))) (set-on-click btn-esel (lambda (obj) (let ((val (clog-ace:selected-text ace))) (unless (equal val "") @@ -2451,6 +2475,7 @@ of controls and double click to select control." (setf (text-value (file-name panel)) (fname panel)) (setf (disabledp (eval-button panel)) nil) (setf (disabledp (eval-sel-button panel)) nil) + (setf (disabledp (eval-form-button panel)) nil) (setf (state panel) nil) (let* ((type (type-of item)) (name (format nil "~A" (definitions:designator item)))) @@ -2498,6 +2523,7 @@ of controls and double click to select control." (setf (text-value (file-name panel)) "") (setf (disabledp (eval-button panel)) t) (setf (disabledp (eval-sel-button panel)) t) + (setf (disabledp (eval-form-button panel)) t) (setf (disabledp (save-button panel)) t) (setf (state panel) t) (setf (text-value (src-box panel)) "No file information"))))) diff --git a/tools/sys-browser.clog b/tools/sys-browser.clog index 51a5127..595d997 100644 --- a/tools/sys-browser.clog +++ b/tools/sys-browser.clog @@ -1,4 +1,4 @@ -
status
 
 
\ No newline at end of file + :time-out 3))))" placeholder="" disabled="disabled">
status
\ No newline at end of file diff --git a/tools/sys-browser.lisp b/tools/sys-browser.lisp index 8708f45..b028441 100644 --- a/tools/sys-browser.lisp +++ b/tools/sys-browser.lisp @@ -1,65 +1,70 @@ (in-package :clog-tools) (defclass sys-browser (clog:clog-panel) - ((file-name :reader file-name) + ((status-box :reader status-box) (save-button :reader save-button) + (eval-button :reader eval-button) (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) + (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) (package-box :reader package-box) - (type-box :reader type-box) (classes :accessor classes) - (fname :accessor fname) (state :accessor state :initform t))) + (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
 
" + "
 
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 "CLOGB3868649904" :clog-type + (setf (slot-value panel 'status-box) + (attach-as-child clog-obj "CLOGB3868698958" :clog-type 'clog:clog-div :new-id t)) - (setf (slot-value panel 'eval-sel-button) - (attach-as-child clog-obj "CLOGB3868649903" :clog-type + (setf (slot-value panel 'save-button) + (attach-as-child clog-obj "CLOGB3868698957" :clog-type 'clog:clog-form-element :new-id t)) (setf (slot-value panel 'eval-button) - (attach-as-child clog-obj "CLOGB3868649902" :clog-type + (attach-as-child clog-obj "CLOGB3868698956" :clog-type 'clog:clog-form-element :new-id t)) - (setf (slot-value panel 'save-button) - (attach-as-child clog-obj "CLOGB3868649901" :clog-type + (setf (slot-value panel 'eval-sel-button) + (attach-as-child clog-obj "CLOGB3868698955" :clog-type 'clog:clog-form-element :new-id t)) - (setf (slot-value panel 'search-box) - (attach-as-child clog-obj "CLOGB3868649900" :clog-type + (setf (slot-value panel 'eval-form-button) + (attach-as-child clog-obj "CLOGB3868698954" :clog-type 'clog:clog-form-element :new-id t)) - (setf (slot-value panel 'class-only) - (attach-as-child clog-obj "CLOGB3868649899" :clog-type - 'clog:clog-form-element :new-id t)) - (setf (slot-value panel 'label-class-only) - (attach-as-child clog-obj "CLOGB3868649898" :clog-type - 'clog:clog-label :new-id t)) - (setf (slot-value panel 'status-box) - (attach-as-child clog-obj "CLOGB3868649897" :clog-type + (setf (slot-value panel 'file-name) + (attach-as-child clog-obj "CLOGB3868698953" :clog-type 'clog:clog-div :new-id t)) (setf (slot-value panel 'src-box) - (attach-as-child clog-obj "CLOGB3868649896" :clog-type + (attach-as-child clog-obj "CLOGB3868698952" :clog-type 'clog-ace:clog-ace-element :new-id t)) (setf (slot-value panel 'pac-box) - (attach-as-child clog-obj "CLOGB3868649895" :clog-type + (attach-as-child clog-obj "CLOGB3868698951" :clog-type 'clog:clog-form-element :new-id t)) (setf (slot-value panel 'doc-box) - (attach-as-child clog-obj "CLOGB3868649894" :clog-type + (attach-as-child clog-obj "CLOGB3868698950" :clog-type 'clog:clog-text-area :new-id t)) (setf (slot-value panel 'class-box) - (attach-as-child clog-obj "CLOGB3868649893" :clog-type + (attach-as-child clog-obj "CLOGB3868698949" :clog-type 'clog:clog-select :new-id t)) + (setf (slot-value panel 'search-box) + (attach-as-child clog-obj "CLOGB3868698948" :clog-type + 'clog:clog-form-element :new-id t)) + (setf (slot-value panel 'class-only) + (attach-as-child clog-obj "CLOGB3868698947" :clog-type + 'clog:clog-form-element :new-id t)) + (setf (slot-value panel 'label-class-only) + (attach-as-child clog-obj "CLOGB3868698946" :clog-type + 'clog:clog-label :new-id t)) (setf (slot-value panel 'package-box) - (attach-as-child clog-obj "CLOGB3868649892" :clog-type + (attach-as-child clog-obj "CLOGB3868698945" :clog-type 'clog:clog-select :new-id t)) (setf (slot-value panel 'type-box) - (attach-as-child clog-obj "CLOGB3868649891" :clog-type + (attach-as-child clog-obj "CLOGB3868698944" :clog-type 'clog:clog-select :new-id t)) (let ((target (type-box panel))) (declare (ignorable target)) @@ -81,6 +86,11 @@ (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) @@ -88,11 +98,6 @@ (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)) @@ -101,17 +106,6 @@ (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)) @@ -124,24 +118,42 @@ (when (equalp "enter" (getf data :key)) (sys-browser-populate panel))) (t (sys-browser-populate panel))))) - (clog:set-on-click (save-button 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)) - (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) + (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 ((pac (text-value (pac-box panel))) - (val (clog-ace:selected-text (src-box panel)))) - (unless (equal val "") + (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 val :clog-obj panel - :eval-in-package - (text-value (package-box panel))))) + (capture-eval (format nil "~A" 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)))))) @@ -157,4 +169,25 @@ (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))