From 8b1c80e970d1830984c1106bb2492ebc2b51ea2c Mon Sep 17 00:00:00 2001 From: David Botton Date: Thu, 6 Jun 2024 20:32:34 -0400 Subject: [PATCH] make sure macro compiled before probe panel --- tools/clog-builder-probe.lisp | 146 +++++++++++++-------------- tools/clog-builder-project-tree.lisp | 4 +- tools/clog-builder-scope.lisp | 5 +- tools/clog-builder-shell.lisp | 14 +++ 4 files changed, 89 insertions(+), 80 deletions(-) diff --git a/tools/clog-builder-probe.lisp b/tools/clog-builder-probe.lisp index e6a6c1b..1247f59 100644 --- a/tools/clog-builder-probe.lisp +++ b/tools/clog-builder-probe.lisp @@ -1,81 +1,5 @@ (in-package :clog-tools) -(defparameter *inspectors* - `((:name "CLOG Object Scope" - :func ,(lambda (object title value clog-obj) - (declare (ignore value)) - (on-object-scope clog-obj :object object :title title))) - (:name "Set object to clog-gui:*probe*" - :func ,(lambda (object title value clog-obj) - (declare (ignore title value clog-obj)) - (setf clog-gui:*probe* object))) - (:name "Print to Console" - :func ,(lambda (object title value clog-obj) - (declare (ignore object)) - (on-open-console clog-obj) - (print title) - (print value))) - (:name "Console Inspector" - :func ,(lambda (object title value clog-obj) - (declare (ignore title value)) - (on-open-console clog-obj) - (let ((*default-title-class* *builder-title-class*) - (*default-border-class* *builder-border-class*) - (*standard-input* (make-instance 'console-in-stream :clog-obj clog-obj))) - (inspect object)))) - (:name "Emacs Inspect" - :func ,(lambda (object 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 object)))))) - -(defun on-probe-panel (obj) - (let ((app (connection-data-item obj "builder-app-data"))) - (if (probe-win app) - (window-focus (probe-win app)) - (let* ((*default-title-class* *builder-title-class*) - (*default-border-class* *builder-border-class*) - (win (create-gui-window obj :title "CLOG Probe Panel" - :width 300 - :has-pinner t - :keep-on-top t - :client-movement *client-side-movement*)) - (npanel (create-div (window-content win) :class "w3-small")) - (evaltxt (create-form-element npanel :text)) - (pac-line (create-form-element npanel :text :value "clog-user"))) - (setf (positioning evaltxt) :absolute) - (setf (positioning pac-line) :absolute) - (setf (height npanel) "57px") - (set-geometry evaltxt :height 27 :width "100%" :top 0 :left 0 :right 0) - (set-geometry pac-line :height 27 :width "100%" :top 27 :left 0 :right 0) - (setf (place-holder evaltxt) "Enter a form to evaluate to a probe") - (set-on-change evaltxt (lambda (obj) - (declare (ignore obj)) - (let ((txt (text-value evaltxt))) - (when (not (equal txt "")) - (let* ((*package* (find-package (string-upcase (text-value pac-line)))) - (aprobe (format nil "(clog-builder-probe ~A :title \"~A\")" - txt txt))) - (eval (read-from-string aprobe))))))) - (create-div (window-content win) :class "w3-tiny w3-center" - :content "or use CLOG-TOOL:CLOG-BUILDER-PROBE to add probes") - (setf (probe-win app) win) - (set-geometry win :top (menu-bar-height win) :left 0 :height "" :bottom 5 :right "") - (set-on-window-move win (lambda (obj) - (setf (height obj) (height obj)))) - (set-on-window-close win (lambda (obj) - (declare (ignore obj)) - (setf (probe-win app) nil))) - (set-on-click (create-span (window-icon-area win) :content "← " :auto-place :top) - (lambda (obj) - (declare (ignore obj)) - (set-geometry win :top (menu-bar-height win) :left 0 :height "" :bottom 5 :right ""))))))) - -;;;;;;;;;;;;;;;;;;;;;;;; -;; clog-builder-probe ;; -;;;;;;;;;;;;;;;;;;;;;;;; - (defmacro clog-builder-probe (symbol &key clog-body (title "") auto-probe) @@ -159,3 +83,73 @@ symbol is used for title." (refresh))) :name (format nil "clog-builder-probe ~A" title)))))) +(defparameter *inspectors* + `((:name "CLOG Object Scope" + :func ,(lambda (object title value clog-obj) + (declare (ignore value)) + (on-object-scope clog-obj :object object :title title))) + (:name "Set object to clog-gui:*probe*" + :func ,(lambda (object title value clog-obj) + (declare (ignore title value clog-obj)) + (setf clog-gui:*probe* object))) + (:name "Print to Console" + :func ,(lambda (object title value clog-obj) + (declare (ignore object)) + (on-open-console clog-obj) + (print title) + (print value))) + (:name "Console Inspector" + :func ,(lambda (object title value clog-obj) + (declare (ignore title value)) + (on-open-console clog-obj) + (let ((*default-title-class* *builder-title-class*) + (*default-border-class* *builder-border-class*) + (*standard-input* (make-instance 'console-in-stream :clog-obj clog-obj))) + (inspect object)))) + (:name "Emacs Inspect" + :func ,(lambda (object 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 object)))))) + +(defun on-probe-panel (obj) + (let ((app (connection-data-item obj "builder-app-data"))) + (if (probe-win app) + (window-focus (probe-win app)) + (let* ((*default-title-class* *builder-title-class*) + (*default-border-class* *builder-border-class*) + (win (create-gui-window obj :title "CLOG Probe Panel" + :width 300 + :has-pinner t + :keep-on-top t + :client-movement *client-side-movement*)) + (npanel (create-div (window-content win) :class "w3-small")) + (evaltxt (create-form-element npanel :text)) + (pac-line (create-form-element npanel :text :value "clog-user"))) + (setf (positioning evaltxt) :absolute) + (setf (positioning pac-line) :absolute) + (setf (height npanel) "57px") + (set-geometry evaltxt :height 27 :width "100%" :top 0 :left 0 :right 0) + (set-geometry pac-line :height 27 :width "100%" :top 27 :left 0 :right 0) + (setf (place-holder evaltxt) "Enter a form to evaluate to a probe") + (set-on-change evaltxt (lambda (obj) + (declare (ignore obj)) + (let ((txt (text-value evaltxt))) + (when (not (equal txt "")) + (let* ((*package* (find-package (string-upcase (text-value pac-line)))) + (result (eval (read-from-string txt)))) + (clog-builder-probe result :title txt)))))) + (create-div (window-content win) :class "w3-tiny w3-center" + :content "or use CLOG-TOOL:CLOG-BUILDER-PROBE to add probes") + (setf (probe-win app) win) + (set-geometry win :top (menu-bar-height win) :left 0 :height "" :bottom 5 :right "") + (set-on-window-move win (lambda (obj) + (setf (height obj) (height obj)))) + (set-on-window-close win (lambda (obj) + (declare (ignore obj)) + (setf (probe-win app) nil))) + (set-on-click (create-span (window-icon-area win) :content "← " :auto-place :top) + (lambda (obj) + (declare (ignore obj)) + (set-geometry win :top (menu-bar-height win) :left 0 :height "" :bottom 5 :right ""))))))) diff --git a/tools/clog-builder-project-tree.lisp b/tools/clog-builder-project-tree.lisp index fde97a0..f746786 100644 --- a/tools/clog-builder-project-tree.lisp +++ b/tools/clog-builder-project-tree.lisp @@ -222,7 +222,7 @@ (project-tree-select obj (format nil "~A" item))) :content (file-namestring item)))))) (load-proj (sel) - (setf (text-value load-btn) "loading") + (setf (text-value load-btn) "working") (setf (background-color load-btn) :yellow) (handler-case (projects-load (format nil "~A/tools" sel)) @@ -241,7 +241,7 @@ (setf (background-color load-btn) load-np) (setf (current-project app) nil)) (t - (setf (text-value load-btn) "loading") + (setf (text-value load-btn) "working") (setf (background-color load-btn) :yellow) (let* ((root (quicklisp:where-is-system sel)) (dir (directory-namestring (uiop:truename* root)))) diff --git a/tools/clog-builder-scope.lisp b/tools/clog-builder-scope.lisp index 17e2be1..567da64 100644 --- a/tools/clog-builder-scope.lisp +++ b/tools/clog-builder-scope.lisp @@ -190,7 +190,8 @@ (add-class tree class object))) (set-on-change root-obj (lambda (obj) (declare (ignore obj)) - (on-change (let ((*package* (find-package (string-upcase (text-value pac-line))))) - (eval (read-from-string (text-value root-obj))))))) + (when (not (equal (text-value root-obj) "")) + (on-change (let ((*package* (find-package (string-upcase (text-value pac-line))))) + (eval (read-from-string (text-value root-obj)))))))) (when object (on-change object))))) \ No newline at end of file diff --git a/tools/clog-builder-shell.lisp b/tools/clog-builder-shell.lisp index cc51db3..c2a5cd9 100644 --- a/tools/clog-builder-shell.lisp +++ b/tools/clog-builder-shell.lisp @@ -9,6 +9,20 @@ (uiop:hostname)) :width 600 :height 400 :client-movement *client-side-movement*))) + (set-on-click (create-span (window-icon-area win) + :content (format nil "~A " (code-char #x26F6)) + :auto-place :top) + (lambda (obj) + (declare (ignore obj)) + (set-geometry win + :top (menu-bar-height win) + :left 300 + :height "" :width "" + :bottom 5 :right 0) + (set-on-window-move win nil) + (set-on-window-move win (lambda (obj) + (setf (width obj) (width obj)) + (setf (height obj) (height obj)))))) (when dir (uiop:chdir (uiop:native-namestring dir))) (set-geometry (create-clog-builder-shell (window-content win))