[slime-cvs] CVS slime

[CVS User sboukarev]

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

Modified Files:
	ChangeLog swank-ccl.lisp 
Log Message:
* swank-ccl.lisp (emacs-inspect function): Print closed over variables
in case of closure.


--- /project/slime/cvsroot/slime/ChangeLog	2010/03/09 14:10:37	1.2031
+++ /project/slime/cvsroot/slime/ChangeLog	2010/03/10 00:02:53	1.2032
@@ -1,5 +1,10 @@
 2010-03-09  Stas Boukarev  <stassats at gmail.com>
 
+	* swank-ccl.lisp (emacs-inspect function): Print closed over variables
+	in case of closure.
+
+2010-03-09  Stas Boukarev  <stassats at gmail.com>
+
 	* slime.el (slime-parse-context): Add defclass.
 
 2010-03-09  Helmut Eller  <heller at common-lisp.net>
--- /project/slime/cvsroot/slime/swank-ccl.lisp	2010/03/05 17:45:34	1.18
+++ /project/slime/cvsroot/slime/swank-ccl.lisp	2010/03/10 00:02:53	1.19
@@ -628,6 +628,26 @@
                                  "Underlying UVECTOR"))))
               (t value)))))
 
+(defmethod emacs-inspect ((f function))
+  (append
+   (label-value-line "Name" (function-name f))
+   `("Its argument list is: " 
+     ,(princ-to-string (arglist f)) (:newline))
+   (label-value-line "Documentation" (documentation  f t))
+   (when (function-lambda-expression f)
+     (label-value-line "Lambda Expression"
+                       (function-lambda-expression f)))
+   (when (ccl:function-source-note f)
+     (label-value-line "Source note"
+                       (ccl:function-source-note f)))
+   (when (typep f 'ccl:compiled-lexical-closure)
+     (append
+      (label-value-line "Inner function" (ccl::closure-function f))
+      '("Closed over values:" (:newline))
+      (loop for (name value) in (ccl::closure-closed-over-values f)
+            append (label-value-line (format nil " ~a" name)
+                                     value))))))
+
 (defclass uvector-inspector ()
   ((object :initarg :object)))