[slime-cvs] CVS slime/contrib

[CVS User sboukarev]

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

Modified Files:
	ChangeLog swank-arglists.lisp 
Log Message:
* contrib/swank-arglists.lisp (*arglist-show-packages*): New
customization variable, when non-nil show qualified symbols.
(with-arglist-io-syntax): new macro for respecting the above variable.
(decoded-arglist-to-string, decoded-arglist-to-template-string): Use
the macro above.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2010/03/23 20:21:48	1.360
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2010/03/30 02:07:10	1.361
@@ -1,3 +1,11 @@
+2010-03-30  Stas Boukarev  <stassats at gmail.com>
+
+	* swank-arglists.lisp (*arglist-show-packages*): New
+	customization variable, when non-nil show qualified symbols.
+	(with-arglist-io-syntax): new macro for respecting the above variable.
+	(decoded-arglist-to-string, decoded-arglist-to-template-string): Use
+	the macro above.
+
 2010-03-23  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	Do not do an unnecessary autodoc RPC request in case we're not
--- /project/slime/cvsroot/slime/contrib/swank-arglists.lisp	2010/03/12 23:59:24	1.60
+++ /project/slime/cvsroot/slime/contrib/swank-arglists.lisp	2010/03/30 02:07:10	1.61
@@ -373,27 +373,38 @@
     (*print-readably* . nil)
     (*print-level*    . 10)
     (*print-length*   . 20)
-    (*print-escape*   . nil))) ; no package qualifiers.
+    (*print-escape*   . nil)))
+
+(defvar *arglist-show-packages* t)
+
+(defmacro with-arglist-io-syntax (&body body)
+  (let ((package (gensym)))
+    `(let ((,package *package*))
+       (with-standard-io-syntax
+         (let ((*package* (if *arglist-show-packages*
+                              *package*
+                              ,package)))
+           (with-bindings *arglist-pprint-bindings*
+             , at body))))))
 
 (defun decoded-arglist-to-string (decoded-arglist
                                   &key operator highlight
                                   print-right-margin print-lines)
   (with-output-to-string (*standard-output*)
-    (with-standard-io-syntax
-      (with-bindings *arglist-pprint-bindings*
-	(let ((*print-right-margin* print-right-margin)
-	      (*print-lines* print-lines))
-	  (print-decoded-arglist decoded-arglist 
-                                 :operator operator 
-                                 :highlight highlight))))))
+    (with-arglist-io-syntax
+      (let ((*print-right-margin* print-right-margin)
+            (*print-lines* print-lines))
+        (print-decoded-arglist decoded-arglist 
+                               :operator operator 
+                               :highlight highlight)))))
 
-(defun decoded-arglist-to-template-string (decoded-arglist &key (prefix "(") (suffix ")"))
+(defun decoded-arglist-to-template-string (decoded-arglist
+                                           &key (prefix "(") (suffix ")"))
   (with-output-to-string (*standard-output*)
-    (with-standard-io-syntax
-      (with-bindings *arglist-pprint-bindings*
-        (print-decoded-arglist-as-template decoded-arglist
-                                           :prefix prefix
-                                           :suffix suffix)))))
+    (with-arglist-io-syntax
+      (print-decoded-arglist-as-template decoded-arglist
+                                         :prefix prefix
+                                         :suffix suffix))))
 
 ;;;; Arglist Decoding / Encoding