[mcclim-cvs] CVS update: mcclim/Apps/Inspector/inspector.lisp

Peter Scott pscott at common-lisp.net
Tue Mar 8 22:11:35 UTC 2005


Update of /project/mcclim/cvsroot/mcclim/Apps/Inspector
In directory common-lisp.net:/tmp/cvs-serv8325

Modified Files:
	inspector.lisp 
Log Message:
Now you can trace and untrace fbound symbols.

Date: Tue Mar  8 23:11:30 2005
Author: pscott

Index: mcclim/Apps/Inspector/inspector.lisp
diff -u mcclim/Apps/Inspector/inspector.lisp:1.25 mcclim/Apps/Inspector/inspector.lisp:1.26
--- mcclim/Apps/Inspector/inspector.lisp:1.25	Mon Mar  7 21:46:43 2005
+++ mcclim/Apps/Inspector/inspector.lisp	Tue Mar  8 23:11:28 2005
@@ -669,7 +669,6 @@
 
 (define-inspector-command (com-disassemble :name t)
     ((obj 'inspected-function
-	  :menu "Disassemble"
 	  :prompt "Select a function"))
   (when (typep obj 'function)
     (togglef (gethash obj (disassembly-dico *application-frame*)))))
@@ -677,6 +676,45 @@
 (define-presentation-to-command-translator disassemble-function
     (inspected-function com-disassemble inspector
 			:documentation "Toggle Disassembly"
+			:gesture :menu
 			:menu t)
+    (object)
+  (list object))
+
+(defun tracedp (symbol)
+  "Is SYMBOL currently traced?"
+  (member symbol (trace)))
+
+(define-inspector-command (com-trace :name t)
+    ((obj 'symbol
+	  :prompt "Select an fbound symbol"))
+  (when (fboundp obj)
+    (eval `(trace ,obj))))
+
+(define-inspector-command (com-untrace :name t)
+    ((obj 'symbol
+	  :prompt "Select an fbound symbol"))
+  (when (fboundp obj)
+    (eval `(untrace ,obj))))
+
+(define-presentation-to-command-translator trace-symbol
+    (symbol com-trace inspector
+	    :documentation "Trace"
+	    :gesture :menu
+	    :menu t
+	    :tester ((object) (and object
+				   (fboundp object)
+				   (not (tracedp object)))))
+    (object)
+  (list object))
+
+(define-presentation-to-command-translator untrace-symbol
+    (symbol com-untrace inspector
+	    :documentation "Untrace"
+	    :gesture :menu
+	    :menu t
+	    :tester ((object) (and object
+				   (fboundp object)
+				   (tracedp object))))
     (object)
   (list object))




More information about the Mcclim-cvs mailing list