[slime-cvs] CVS slime/contrib

[CVS User sboukarev]

Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv24255/contrib

Modified Files:
	ChangeLog slime-sprof.el swank-sprof.lisp 
Log Message:
* contrib{slime-sprof.el,swank-sprof.lisp}: Add ability to exclude functions which symbols
are from swank package.
* doc/slime.texi: document it.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/10/09 13:36:38	1.251
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/10/09 14:57:45	1.252
@@ -1,5 +1,12 @@
 2009-10-09  Stas Boukarev  <stassats at gmail.com>
 
+	* swank-sprof.lisp: Add ability to exclude functions which symbols
+	are from swank package.
+	* slime-sprof.el (slime-sprof-toggle-swank-exclusion): New function.
+	Bound to s in the slime-sprof buffer.
+	* slime-sprof.el (slime-sprof-exclude-swank): New variable for
+	controlling exclusion of swank functions.
+
 	* slime-sprof.el: Slightly factor code, add menu entries.
 
 2009-09-29  Stas Boukarev  <stassats at gmail.com>
--- /project/slime/cvsroot/slime/contrib/slime-sprof.el	2009/10/09 13:36:39	1.2
+++ /project/slime/cvsroot/slime/contrib/slime-sprof.el	2009/10/09 14:57:45	1.3
@@ -12,6 +12,9 @@
 
 (slime-require :swank-sprof)
 
+(defvar slime-sprof-exclude-swank nil
+  "*Display swank functions in the report.")
+
 (define-derived-mode slime-sprof-browser-mode fundamental-mode
   "slprof"
   "Mode for browsing profiler data\
@@ -25,6 +28,7 @@
   ("d" 'slime-sprof-browser-disassemble-function)
   ("g" 'slime-sprof-browser-go-to)
   ("v" 'slime-sprof-browser-view-source)
+  ("s" 'slime-sprof-toggle-swank-exclusion)
   ((kbd "RET") 'slime-sprof-browser-toggle))
 
 ;; Start / stop profiling
@@ -53,9 +57,9 @@
         (slime-sprof-browser-insert-line data 54))))
   (goto-line 2))
 
-(defun slime-sprof-update ()
-  (interactive)
-  (slime-eval-async `(swank:swank-sprof-get-call-graph)
+(defun* slime-sprof-update (&optional (exclude-swank slime-sprof-exclude-swank))
+  (slime-eval-async `(swank:swank-sprof-get-call-graph
+                      :exclude-swank ,exclude-swank)
                     'slime-sprof-format))
 
 (defun slime-sprof-browser ()
@@ -72,6 +76,12 @@
           (setq slime-buffer-connection connection)
           (current-buffer)))))
 
+(defun slime-sprof-toggle-swank-exclusion ()
+  (interactive)
+  (setq slime-sprof-exclude-swank
+        (not slime-sprof-exclude-swank))
+  (slime-sprof-update))
+
 (defun slime-sprof-browser-insert-line (data name-length)
   (destructuring-bind (index name self cumul total)
       data
--- /project/slime/cvsroot/slime/contrib/swank-sprof.lisp	2009/10/09 13:36:39	1.2
+++ /project/slime/cvsroot/slime/contrib/swank-sprof.lisp	2009/10/09 14:57:45	1.3
@@ -7,7 +7,7 @@
 
 (in-package :swank)
 
-#-sbcl
+#+sbcl
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (require :sb-sprof))
 
@@ -38,12 +38,22 @@
           (samples-percent (sb-sprof::node-count node))
           (samples-percent (sb-sprof::node-accrued-count node))))
 
-(defun serialize-call-graph ()
-  (let ((nodes (sort (copy-list
-                      (sb-sprof::call-graph-flat-nodes *call-graph*))
-                     #'>
-;;                     :key #'sb-sprof::node-count)))
-                     :key #'sb-sprof::node-accrued-count)))
+(defun filter-swank-nodes (nodes)
+  (let ((swank-package (find-package :swank)))
+    (remove-if (lambda (node)
+                 (let ((name (sb-sprof::node-name node)))
+                   (and (symbolp name)
+                        (eql (symbol-package name)
+                             swank-package))))
+               nodes)))
+
+(defun serialize-call-graph (&key exclude-swank)
+  (let ((nodes (sb-sprof::call-graph-flat-nodes *call-graph*)))
+    (when exclude-swank
+      (setf nodes (filter-swank-nodes nodes)))
+    (setf nodes (sort (copy-list nodes) #'>
+                      ;; :key #'sb-sprof::node-count)))
+                      :key #'sb-sprof::node-accrued-count))
     (setf *number-nodes* (make-hash-table))
     (setf *node-numbers* (make-hash-table))
     (loop for node in nodes
@@ -60,10 +70,9 @@
                       (return (append list
                                       `((nil "Elsewhere" ,rest nil nil)))))))))
 
-(defslimefun swank-sprof-get-call-graph ()
+(defslimefun swank-sprof-get-call-graph (&key exclude-swank)
   (setf *call-graph* (sb-sprof:report :type nil))
-  (serialize-call-graph))
-
+  (serialize-call-graph :exclude-swank exclude-swank))
 
 (defslimefun swank-sprof-expand-node (index)
   (let* ((node (gethash index *number-nodes*)))