mirrors/clog
1
Fork 0
mirror of https://github.com/rabbibotton/clog.git synced 2025-12-06 02:30:42 -08:00
Code Issues Projects Releases Wiki Activity

emacs inspector

Browse source
This commit is contained in:
David Botton 2024-05-29 17:07:27 -04:00
parent 0e05ed7a38
commit b7fc4a78d8
1 changed files with 32 additions and 29 deletions
Download patch file Download diff file Expand all files Collapse all files

61
tools/clog-builder-probe.lisp
View file

@ -14,30 +14,38 @@
(let ((*default-title-class* *builder-title-class*) (let ((*default-title-class* *builder-title-class*)
(*default-border-class* *builder-border-class*) (*default-border-class* *builder-border-class*)
(*standard-input* (make-instance 'console-in-stream :clog-obj clog-obj))) (*standard-input* (make-instance 'console-in-stream :clog-obj clog-obj)))
(inspect symbol)))))) (inspect symbol))))
(:name "Emacs Inspect"
:func ,(lambda (symbol title value clog-obj)
(declare (ignore title value clog-obj))
(let ((SWANK::*BUFFER-PACKAGE* (find-package (string-upcase "clog-user")))
(SWANK::*BUFFER-READTABLE* *READTABLE*))
(swank:inspect-in-emacs symbol))))))
(defun on-probe-panel (obj) (defun on-probe-panel (obj)
(let ((app (connection-data-item obj "builder-app-data"))) (let ((app (connection-data-item obj "builder-app-data")))
(let* ((*default-title-class* *builder-title-class*) (if (probe-win app)
(*default-border-class* *builder-border-class*) (window-focus (probe-win app))
(win (create-gui-window obj :title "CLOG Probe Panel" (let* ((*default-title-class* *builder-title-class*)
:width 300 (*default-border-class* *builder-border-class*)
:has-pinner t (win (create-gui-window obj :title "CLOG Probe Panel"
:keep-on-top t :width 300
:client-movement *client-side-movement*))) :has-pinner t
(create-div (window-content win) :style "left:0px;right:0px" :class "w3-tiny w3-center" :keep-on-top t
:content "use CLOG-TOOL:CLOG-BUILDER-PROBE to add probes") :client-movement *client-side-movement*)))
(setf (probe-win app) win) (create-div (window-content win) :style "left:0px;right:0px" :class "w3-tiny w3-center"
(set-geometry win :top (menu-bar-height win) :left 0 :height "" :bottom 5 :right "") :content "use CLOG-TOOL:CLOG-BUILDER-PROBE to add probes")
(set-on-window-move win (lambda (obj) (setf (probe-win app) win)
(setf (height obj) (height obj)))) (set-geometry win :top (menu-bar-height win) :left 0 :height "" :bottom 5 :right "")
(set-on-window-close win (lambda (obj) (set-on-window-move win (lambda (obj)
(declare (ignore obj)) (setf (height obj) (height obj))))
(setf (probe-win app) nil))) (set-on-window-close win (lambda (obj)
(set-on-click (create-span (window-icon-area win) :content "← " :auto-place :top) (declare (ignore obj))
(lambda (obj) (setf (probe-win app) nil)))
(declare (ignore obj)) (set-on-click (create-span (window-icon-area win) :content "← " :auto-place :top)
(set-geometry win :top (menu-bar-height win) :left 0 :height "" :bottom 5 :right "")))))) (lambda (obj)
(declare (ignore obj))
(set-geometry win :top (menu-bar-height win) :left 0 :height "" :bottom 5 :right "")))))))
;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;
;; clog-builder-probe ;; ;; clog-builder-probe ;;
@ -57,19 +65,14 @@ used for title."
,title)) ,title))
(freq ,auto-probe) (freq ,auto-probe)
probe probe
row
entry) entry)
(unless (probe-win app) (on-probe-panel body)
(on-probe-panel body))
(setf probe (create-div (window-content (probe-win app)) (setf probe (create-div (window-content (probe-win app))
:style "border-style:solid;overflow:auto;" :style "border-style:solid;overflow:auto;"
:class "w3-small")) :class "w3-small"))
(setf row (create-table-row (create-table probe))) (setf entry (create-div probe :class "w3-small"))
(create-table-column row :content (format nil "<b>~A</b> = " title))
(setf entry (create-table-column row
:class "w3-small"))
(flet ((refresh () (flet ((refresh ()
(let ((value (format nil "~A" ,symbol))) (let ((value (format nil "~A = ~A" title ,symbol)))
(setf (text entry) (format nil "~A" (setf (text entry) (format nil "~A"
value))))) value)))))
(refresh) (refresh)