[slime-cvs] CVS slime
CVS User heller
heller at common-lisp.net
Wed Aug 11 12:40:04 UTC 2010
Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv25390
Modified Files:
ChangeLog swank.lisp
Log Message:
Bind *print-readably* to nil when printing the title.
* swank.lisp (prepare-title): Factored out into new function.
(*inspector-printer-bindings*)
(*inspector-verbose-printer-bindings*): New.
(with-string-stream): New.
(emacs-inspect/istate): Renamed from emacs-inspect/printer-bindings.
--- /project/slime/cvsroot/slime/ChangeLog 2010/08/06 14:10:50 1.2121
+++ /project/slime/cvsroot/slime/ChangeLog 2010/08/11 12:40:03 1.2122
@@ -1,3 +1,13 @@
+2010-08-11 Helmut Eller <heller at common-lisp.net>
+
+ Bind *print-readably* to nil when printing the title.
+
+ * swank.lisp (prepare-title): Factored out into new function.
+ (*inspector-printer-bindings*)
+ (*inspector-verbose-printer-bindings*): New.
+ (with-string-stream): New.
+ (emacs-inspect/istate): Renamed from emacs-inspect/printer-bindings.
+
2010-08-06 Stas Boukarev <stassats at gmail.com>
* swank-ccl.lisp (spawn): Revert the previous change, using
--- /project/slime/cvsroot/slime/swank.lisp 2010/08/04 18:20:22 1.723
+++ /project/slime/cvsroot/slime/swank.lisp 2010/08/11 12:40:03 1.724
@@ -1945,15 +1945,6 @@
(without-printing-errors (:object object :stream nil)
(prin1-to-string object)))))
-(defun to-line (object &optional (width 75))
- "Print OBJECT to a single line. Return the string."
- (without-printing-errors (:object object :stream nil)
- (call/truncated-output-to-string
- width
- (lambda (*standard-output*)
- (write object :right-margin width :lines 1))
- "..")))
-
(defun from-string (string)
"Read string in the *BUFFER-PACKAGE*"
(with-buffer-syntax ()
@@ -2302,11 +2293,28 @@
(replace buffer ellipsis :start1 fill-pointer)
(return-from buffer-full buffer)))))
(let ((stream (make-output-stream #'write-output)))
-
(funcall function stream)
(finish-output stream)
(subseq buffer 0 fill-pointer))))))
+(defmacro with-string-stream ((var &key length bindings)
+ &body body)
+ (cond ((and (not bindings) (not length))
+ `(with-output-to-string (,var) . ,body))
+ ((not bindings)
+ `(call/truncated-output-to-string
+ ,length (lambda (,var) . ,body)))
+ (t
+ `(with-bindings ,bindings
+ (with-string-stream (,var :length ,length)
+ . ,body)))))
+
+(defun to-line (object &optional (width 75))
+ "Print OBJECT to a single line. Return the string."
+ (without-printing-errors (:object object :stream nil)
+ (with-string-stream (stream :length width)
+ (write object :stream stream :right-margin width :lines 1))))
+
(defun escape-string (string stream &key length (map '((#\" . "\\\"")
(#\\ . "\\\\"))))
"Write STRING to STREAM surronded by double-quotes.
@@ -2609,13 +2617,12 @@
((t) `((:restartable t)))))))
(defun frame-to-string (frame)
- (with-bindings *backtrace-printer-bindings*
- (call/truncated-output-to-string
- (* (or *print-lines* 1) (or *print-right-margin* 100))
- (lambda (stream)
- (handler-case (print-frame frame stream)
- (serious-condition ()
- (format stream "[error printing frame]")))))))
+ (with-string-stream (stream :length (* (or *print-lines* 1)
+ (or *print-right-margin* 100))
+ :bindings *backtrace-printer-bindings*)
+ (handler-case (print-frame frame stream)
+ (serious-condition ()
+ (format stream "[error printing frame]")))))
(defslimefun debugger-info-for-emacs (start end)
"Return debugger state, with stack frames from START to END.
@@ -3348,7 +3355,19 @@
(defvar *inspector-verbose* nil)
-(defstruct (inspector-state (:conc-name istate.))
+(defvar *inspector-printer-bindings*
+ '((*print-lines* . 1)
+ (*print-right-margin* . 75)
+ (*print-pretty* . t)
+ (*print-readably* . nil)))
+
+(defvar *inspector-verbose-printer-bindings*
+ '((*print-escape* . t)
+ (*print-circle* . t)
+ (*print-array* . nil)))
+
+(defstruct inspector-state)
+(defstruct (istate (:conc-name istate.) (:include inspector-state))
object
(verbose *inspector-verbose*)
(parts (make-array 10 :adjustable t :fill-pointer 0))
@@ -3378,34 +3397,38 @@
data)))
(defun inspect-object (o)
- ;; Set *ISTATE* first so EMACS-INSPECT can possibly look at it.
- (setq *istate* (make-inspector-state :object o :previous *istate*))
- (setf (istate.content *istate*) (emacs-inspect/printer-bindings o))
- (unless (find o *inspector-history*)
- (vector-push-extend o *inspector-history*))
- (let ((previous (istate.previous *istate*)))
- (if previous (setf (istate.next previous) *istate*)))
- (istate>elisp *istate*))
-
-(defun emacs-inspect/printer-bindings (object)
- (let ((*print-lines* 1) (*print-right-margin* 75)
- (*print-pretty* t) (*print-readably* nil))
- (emacs-inspect object)))
+ (let* ((prev *istate*)
+ (istate (make-istate :object o :previous prev
+ :verbose (cond (prev (istate.verbose prev))
+ (t *inspector-verbose*)))))
+ (setq *istate* istate)
+ (setf (istate.content istate) (emacs-inspect/istate istate))
+ (unless (find o *inspector-history*)
+ (vector-push-extend o *inspector-history*))
+ (let ((previous (istate.previous istate)))
+ (if previous (setf (istate.next previous) istate)))
+ (istate>elisp istate)))
+
+(defun emacs-inspect/istate (istate)
+ (with-bindings (if (istate.verbose istate)
+ *inspector-verbose-printer-bindings*
+ *inspector-printer-bindings*)
+ (emacs-inspect (istate.object istate))))
(defun istate>elisp (istate)
- (list :title (if (istate.verbose istate)
- (let ((*print-escape* t)
- (*print-circle* t)
- (*print-array* nil))
- (to-string (istate.object istate)))
- (call/truncated-output-to-string
- 200
- (lambda (s)
- (print-unreadable-object
- ((istate.object istate) s :type t :identity t)))))
+ (list :title (prepare-title istate)
:id (assign-index (istate.object istate) (istate.parts istate))
:content (prepare-range istate 0 500)))
+(defun prepare-title (istate)
+ (if (istate.verbose istate)
+ (with-bindings *inspector-verbose-printer-bindings*
+ (to-string (istate.object istate)))
+ (with-string-stream (stream :length 200
+ :bindings *inspector-printer-bindings*)
+ (print-unreadable-object
+ ((istate.object istate) stream :type t :identity t)))))
+
(defun prepare-range (istate start end)
(let* ((range (content-range (istate.content istate) start end))
(ps (loop for part in range append (prepare-part part istate))))
@@ -3463,8 +3486,7 @@
(defslimefun inspect-nth-part (index)
(with-buffer-syntax ()
- (let ((*inspector-verbose* (istate.verbose *istate*)))
- (inspect-object (inspector-nth-part index)))))
+ (inspect-object (inspector-nth-part index))))
(defslimefun inspector-range (from to)
(prepare-range *istate* from to))
@@ -3495,9 +3517,9 @@
(t nil))))
(defslimefun inspector-reinspect ()
- (setf (istate.content *istate*)
- (emacs-inspect/printer-bindings (istate.object *istate*)))
- (istate>elisp *istate*))
+ (let ((istate *istate*))
+ (setf (istate.content istate) (emacs-inspect/istate istate))
+ (istate>elisp istate)))
(defslimefun inspector-toggle-verbose ()
"Toggle verbosity of inspected object."
More information about the slime-cvs
mailing list