[slime-devel] REPL-specific printer control variables

[Robert J. Macomber]

This patch adds two variables to swank: *listener-print-level* and
*listener-print-length*, analogous to the standard Lisp variables
*print-level* and *print-length*, used to control how much of a form's
return values get printed at the REPL but not of things printed
directly by user code.  If they're bound (by default, they aren't)
then swank uses them when preparing the presentation of an
evaluation's result for sending to Emacs.  When they're unbound, the
values of the standard CL depth and length variables instead.

I've written this because of one too many "oops, I forgot to wrap that
form in a (progn ... nil)" mistakes on my part.  Not a fatal error,
but it can be inconvenient.
-- 
Robert Macomber
slime at rojoma.com
-------------- next part --------------
Index: swank.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank.lisp,v
retrieving revision 1.378
diff -u -r1.378 swank.lisp
--- swank.lisp	12 May 2006 12:21:45 -0000	1.378
+++ swank.lisp	23 May 2006 22:10:35 -0000
@@ -100,6 +100,18 @@
     (*print-escape*           . t))
   "A set of printer variables used in the debugger.")
 
+(defvar *listener-print-level*)
+(setf (documentation '*listener-print-level* 'variable)
+  "The number of levels of a compound object which will print at
+the Slime REPL.  If unbound, the value of CL:*PRINT-LEVEL* is
+used instead.")
+
+(defvar *listener-print-length*)
+(setf (documentation '*listener-print-length* 'variable)
+  "The number of elements of a compound object at a given level
+which will print at the Slime REPL.  If unbound, the value of
+CL:*PRINT-LENGTH* is used instead.")
+
 (defvar *default-worker-thread-bindings* '()
   "An alist to initialize dynamic variables in worker threads.  
 The list has the form ((VAR . VALUE) ...).  Each variable VAR will be
@@ -2382,9 +2394,15 @@
 	(setq +++ ++  ++ +  + last-form)
         (cond ((eq *slime-repl-suppress-output* t) '(:suppress-output))
               (*record-repl-results*
-               `(:present ,(loop for x in values 
-                                 collect (cons (prin1-to-string x) 
-                                               (save-presented-object x)))))
+               (let ((*print-level* (if (boundp '*listener-print-level*)
+                                        *listener-print-level*
+                                        *print-level*))
+                     (*print-length* (if (boundp '*listener-print-length*)
+                                         *listener-print-length*
+                                         *print-length*)))
+                 `(:present ,(loop for x in values 
+                                collect (cons (prin1-to-string x) 
+                                              (save-presented-object x))))))
               (t 
                `(:values ,(mapcar #'prin1-to-string values))))))))