[slime-devel] (un)trace-package

[William Bland]

I've found this feature quite useful in the couple of days since I
implemented it.  Thought it might be worth posting it to the list in
case it's useful for others too.

The feature adds slime commands (un)trace-package, with menu entries
under "Debugging".  These commands (un)trace all fbound symbols in the
named package, which defaults to (slime-current-package).

Attached is a diff against current cvs slime.  It works for me with a
recent cvs emacs and sbcl.

Cheers,
Bill.
-- 
William Bland: http://www.abstractnonsense.org/
Lisp documentation: http://www.lispdoc.com/
-------------- next part --------------
Index: slime.el
===================================================================
RCS file: /project/slime/cvsroot/slime/slime.el,v
retrieving revision 1.687
diff -u -r1.687 slime.el
--- slime.el	7 Nov 2006 07:42:51 -0000	1.687
+++ slime.el	10 Nov 2006 19:30:48 -0000
@@ -905,6 +905,8 @@
        [ "Macroexpand Once..."     slime-macroexpand-1 ,C ]
        [ "Macroexpand All..."      slime-macroexpand-all ,C ]
        [ "Toggle Trace..."         slime-toggle-trace-fdefinition ,C ]
+       [ "Trace Package..."        slime-trace-package ,C ]
+       [ "Untrace Package..."      slime-untrace-package ,C ]
        [ "Disassemble..."          slime-disassemble-symbol ,C ]
        [ "Inspect..."              slime-inspect ,C ])
       ("Compilation"
@@ -7080,6 +7082,18 @@
 

 ;;;; Tracing
 
+(defun slime-trace-package ()
+  "Trace all functions in a package."
+  (interactive)
+  (let ((package (slime-read-from-minibuffer "Package: " (slime-current-package))))
+    (message "%s" (slime-eval `(swank:swank-trace-package ,package)))))
+
+(defun slime-untrace-package ()
+  "Untrace all functions in a package."
+  (interactive)
+  (let ((package (slime-read-from-minibuffer "Package: " (slime-current-package))))
+    (message "%s" (slime-eval `(swank:swank-untrace-package ,package)))))
+
 (defun slime-untrace-all ()
   "Untrace all functions."
   (interactive)
Index: swank.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank.lisp,v
retrieving revision 1.417
diff -u -r1.417 swank.lisp
--- swank.lisp	4 Nov 2006 12:02:29 -0000	1.417
+++ swank.lisp	10 Nov 2006 19:30:49 -0000
@@ -3979,6 +3979,22 @@
            (eval `(trace ,spec))
 	   (format nil "~S is now traced." spec)))))
 
+(defun find-fbound-symbols (package-name)
+  (let ((result nil)
+        (p (parse-package package-name)))
+    (do-symbols (s p result)
+      (when (and (equal (symbol-package s) p)
+                 (fboundp s))
+        (push s result)))))
+
+(defslimefun swank-trace-package (package)
+  (eval `(trace ,@(find-fbound-symbols package)))
+  (format nil "Package ~A is now traced." package))
+
+(defslimefun swank-untrace-package (package)
+  (eval `(untrace ,@(find-fbound-symbols package)))
+  (format nil "Package ~A is now untraced." package))
+
 (defslimefun untrace-all ()
   (untrace))