? swank-pxref.lisp
Index: swank.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank.lisp,v
retrieving revision 1.278
diff -C5 -d -r1.278 swank.lisp
*** swank.lisp	27 Jan 2005 19:56:06 -0000	1.278
--- swank.lisp	3 Feb 2005 20:16:42 -0000
***************
*** 1261,1270 ****
--- 1261,1273 ----
    "Return a package for STRING. 
  Fall back to the the current if no such package exists."
    (or (guess-package-from-string string nil)
        *package*))
  
+ (defvar *emacs-print-length* nil
+   "Maximum length of result to send to Emacs.")
+ 
  (defun eval-for-emacs (form buffer-package id)
    "Bind *BUFFER-PACKAGE* BUFFER-PACKAGE and evaluate FORM.
  Return the result to the continuation ID.
  Errors are trapped and invoke our debugger."
    (let ((*debugger-hook* #'swank-debugger-hook))
***************
*** 1278,1290 ****
               (setq result (eval form))
               (force-output)
               (run-hook *pre-reply-hook*)
               (setq ok t))
          (force-user-output)
!         (send-to-emacs `(:return ,(current-thread)
!                                  ,(if ok `(:ok ,result) '(:abort)) 
!                                  ,id))))))
  
  (defun format-values-for-echo-area (values)
    (with-buffer-syntax ()
      (let ((*print-readably* nil))
        (cond ((null values) "; No value")
--- 1281,1304 ----
               (setq result (eval form))
               (force-output)
               (run-hook *pre-reply-hook*)
               (setq ok t))
          (force-user-output)
!         (flet ((limit (result)
!                  (if (and (stringp result)
!                           *emacs-print-length*
!                           (> (length result) *emacs-print-length*))
!                      (let ((copy (make-string (+ *emacs-print-length* 3))))
!                        (loop for i from 0 below (length copy)
!                             if (< i *emacs-print-length*)
!                             do (setf (aref copy i) (aref result i))
!                             else do (setf (aref copy i) #\.)
!                             finally (return copy)))
!                      result)))
!           (send-to-emacs `(:return ,(current-thread)
!                                    ,(if ok `(:ok ,(limit result)) '(:abort)) 
!                                    ,id)))))))
  
  (defun format-values-for-echo-area (values)
    (with-buffer-syntax ()
      (let ((*print-readably* nil))
        (cond ((null values) "; No value")