[slime-cvs] CVS slime
heller
heller at common-lisp.net
Sat Feb 9 18:47:09 UTC 2008
Update of /project/slime/cvsroot/slime
In directory clnet:/tmp/cvs-serv21820
Modified Files:
ChangeLog swank-abcl.lisp swank-allegro.lisp
swank-backend.lisp swank-clisp.lisp swank-cmucl.lisp
swank-corman.lisp swank-ecl.lisp swank-lispworks.lisp
swank-openmcl.lisp swank-sbcl.lisp swank-scl.lisp swank.lisp
Log Message:
Drop the first return value of emacs-inspect.
* swank.lisp (emacs-inspect): Drop the first return value. It
wasn't used anymore. Update all methods and callers.
--- /project/slime/cvsroot/slime/ChangeLog 2008/02/09 18:45:39 1.1287
+++ /project/slime/cvsroot/slime/ChangeLog 2008/02/09 18:47:05 1.1288
@@ -1,5 +1,12 @@
2008-02-09 Helmut Eller <heller at common-lisp.net>
+ Drop the first return value of emacs-inspect.
+
+ * swank.lisp (emacs-inspect): Drop the first return value. It
+ wasn't used anymore. Update all methods and callers.
+
+2008-02-09 Helmut Eller <heller at common-lisp.net>
+
Remove obsolete *slime-inspect-contents-limit*.
* swank.lisp (*slime-inspect-contents-limit*): Deleted and all its
@@ -37,7 +44,7 @@
Inspector cleanups.
* swank.lisp (emacs-inspect): Renamed from inspect-for-emacs.
- Changed all method-defs acordingly.
+ Changed all method-defs accordingly.
(common-seperated-spec, inspector-princ): Moved to
swank-fancy-inspector.lisp.
(inspector-content): Renamed from inspector-content-for-emacs.
--- /project/slime/cvsroot/slime/swank-abcl.lisp 2008/02/09 18:38:58 1.46
+++ /project/slime/cvsroot/slime/swank-abcl.lisp 2008/02/09 18:47:05 1.47
@@ -422,7 +422,6 @@
;;;; Inspecting
(defmethod emacs-inspect ((slot mop::slot-definition))
- (values "A slot."
`("Name: " (:value ,(mop::%slot-definition-name slot))
(:newline)
"Documentation:" (:newline)
@@ -434,10 +433,9 @@
`(:value ,(mop::%slot-definition-initform slot))
"#<unspecified>") (:newline)
" Function: " (:value ,(mop::%slot-definition-initfunction slot))
- (:newline))))
+ (:newline)))
(defmethod emacs-inspect ((f function))
- (values "A function."
`(,@(when (function-name f)
`("Name: "
,(princ-to-string (function-name f)) (:newline)))
@@ -449,19 +447,18 @@
`("Documentation:" (:newline) ,(documentation f t) (:newline)))
,@(when (function-lambda-expression f)
`("Lambda expression:"
- (:newline) ,(princ-to-string (function-lambda-expression f)) (:newline))))))
+ (:newline) ,(princ-to-string (function-lambda-expression f)) (:newline)))))
#|
(defmethod emacs-inspect ((o t))
(let* ((class (class-of o))
(slots (mop::class-slots class)))
- (values (format nil "~A~% is a ~A" o class)
(mapcar (lambda (slot)
(let ((name (mop::slot-definition-name slot)))
(cons (princ-to-string name)
(slot-value o name))))
- slots))))
+ slots)))
|#
;;;; Multithreading
--- /project/slime/cvsroot/slime/swank-allegro.lisp 2008/02/09 18:38:58 1.100
+++ /project/slime/cvsroot/slime/swank-allegro.lisp 2008/02/09 18:47:05 1.101
@@ -565,22 +565,21 @@
;;;; Inspecting
(defmethod emacs-inspect ((f function))
- (values "A function."
(append
(label-value-line "Name" (function-name f))
`("Formals" ,(princ-to-string (arglist f)) (:newline))
(let ((doc (documentation (excl::external-fn_symdef f) 'function)))
(when doc
- `("Documentation:" (:newline) ,doc))))))
+ `("Documentation:" (:newline) ,doc)))))
(defmethod emacs-inspect ((o t))
- (values "A value." (allegro-inspect o)))
+ (allegro-inspect o))
(defmethod emacs-inspect ((o function))
- (values "A function." (allegro-inspect o)))
+ (allegro-inspect o))
(defmethod emacs-inspect ((o standard-object))
- (values (format nil "~A is a standard-object." o) (allegro-inspect o)))
+ (allegro-inspect o))
(defun allegro-inspect (o)
(loop for (d dd) on (inspect::inspect-ctl o)
--- /project/slime/cvsroot/slime/swank-backend.lisp 2008/02/09 18:38:58 1.128
+++ /project/slime/cvsroot/slime/swank-backend.lisp 2008/02/09 18:47:05 1.129
@@ -840,9 +840,7 @@
(:documentation
"Explain to Emacs how to inspect OBJECT.
-Returns two values: a string which will be used as the title of
-the inspector buffer and a list specifying how to render the
-object for inspection.
+Returns a list specifying how to render the object for inspection.
Every element of the list must be either a string, which will be
inserted into the buffer as is, or a list of the form:
@@ -857,20 +855,17 @@
string) which when clicked will call LAMBDA. If REFRESH is
non-NIL the currently inspected object will be re-inspected
after calling the lambda.
-
- NIL - do nothing."))
+"))
(defmethod emacs-inspect ((object t))
"Generic method for inspecting any kind of object.
Since we don't know how to deal with OBJECT we simply dump the
output of CL:DESCRIBE."
- (values
- "A value."
`("Type: " (:value ,(type-of object)) (:newline)
"Don't know how to inspect the object, dumping output of CL:DESCRIBE:"
(:newline) (:newline)
- ,(with-output-to-string (desc) (describe object desc)))))
+ ,(with-output-to-string (desc) (describe object desc))))
;;; Utilities for inspector methods.
;;;
--- /project/slime/cvsroot/slime/swank-clisp.lisp 2008/02/09 18:38:58 1.66
+++ /project/slime/cvsroot/slime/swank-clisp.lisp 2008/02/09 18:47:05 1.67
@@ -638,9 +638,10 @@
(*package* tmp-pack)
(sys::*inspect-unbound-value* (intern "#<unbound>" tmp-pack)))
(let ((inspection (sys::inspect-backend o)))
- (values (format nil "~S~% ~A~{~%~A~}" o
+ (append (list
+ (format nil "~S~% ~A~{~%~A~}~%" o
(sys::insp-title inspection)
- (sys::insp-blurb inspection))
+ (sys::insp-blurb inspection)))
(loop with count = (sys::insp-num-slots inspection)
for i below count
append (multiple-value-bind (value name)
--- /project/slime/cvsroot/slime/swank-cmucl.lisp 2008/02/09 18:38:58 1.177
+++ /project/slime/cvsroot/slime/swank-cmucl.lisp 2008/02/09 18:47:05 1.178
@@ -1822,11 +1822,6 @@
;;;; Inspecting
-(defclass cmucl-inspector (backend-inspector) ())
-
-(defimplementation make-default-inspector ()
- (make-instance 'cmucl-inspector))
-
(defconstant +lowtag-symbols+
'(vm:even-fixnum-type
vm:function-pointer-type
@@ -1871,8 +1866,7 @@
(defmethod emacs-inspect ((o t))
(cond ((di::indirect-value-cell-p o)
- (values (format nil "~A is a value cell." o)
- `("Value: " (:value ,(c:value-cell-ref o)))))
+ `("Value: " (:value ,(c:value-cell-ref o))))
((alien::alien-value-p o)
(inspect-alien-value o))
(t
@@ -1880,63 +1874,59 @@
(defun cmucl-inspect (o)
(destructuring-bind (text labeledp . parts) (inspect::describe-parts o)
- (values (format nil "~A~%" text)
- (if labeledp
- (loop for (label . value) in parts
- append (label-value-line label value))
- (loop for value in parts for i from 0
- append (label-value-line i value))))))
+ (list* (format nil "~A~%" text)
+ (if labeledp
+ (loop for (label . value) in parts
+ append (label-value-line label value))
+ (loop for value in parts for i from 0
+ append (label-value-line i value))))))
(defmethod emacs-inspect ((o function))
(let ((header (kernel:get-type o)))
(cond ((= header vm:function-header-type)
- (values (format nil "~A is a function." o)
- (append (label-value-line*
- ("Self" (kernel:%function-self o))
- ("Next" (kernel:%function-next o))
- ("Name" (kernel:%function-name o))
- ("Arglist" (kernel:%function-arglist o))
- ("Type" (kernel:%function-type o))
- ("Code" (kernel:function-code-header o)))
- (list
- (with-output-to-string (s)
- (disassem:disassemble-function o :stream s))))))
+ (append (label-value-line*
+ ("Self" (kernel:%function-self o))
+ ("Next" (kernel:%function-next o))
+ ("Name" (kernel:%function-name o))
+ ("Arglist" (kernel:%function-arglist o))
+ ("Type" (kernel:%function-type o))
+ ("Code" (kernel:function-code-header o)))
+ (list
+ (with-output-to-string (s)
+ (disassem:disassemble-function o :stream s)))))
((= header vm:closure-header-type)
- (values (format nil "~A is a closure" o)
- (append
- (label-value-line "Function" (kernel:%closure-function o))
- `("Environment:" (:newline))
- (loop for i from 0 below (1- (kernel:get-closure-length o))
- append (label-value-line
- i (kernel:%closure-index-ref o i))))))
+ (list* (format nil "~A is a closure.~%" o)
+ (append
+ (label-value-line "Function" (kernel:%closure-function o))
+ `("Environment:" (:newline))
+ (loop for i from 0 below (1- (kernel:get-closure-length o))
+ append (label-value-line
+ i (kernel:%closure-index-ref o i))))))
((eval::interpreted-function-p o)
(cmucl-inspect o))
(t
(call-next-method)))))
(defmethod emacs-inspect ((o kernel:funcallable-instance))
- (values
- (format nil "~A is a funcallable-instance." o)
- (append (label-value-line*
- (:function (kernel:%funcallable-instance-function o))
- (:lexenv (kernel:%funcallable-instance-lexenv o))
- (:layout (kernel:%funcallable-instance-layout o)))
- (nth-value 1 (cmucl-inspect o)))))
+ (append (label-value-line*
+ (:function (kernel:%funcallable-instance-function o))
+ (:lexenv (kernel:%funcallable-instance-lexenv o))
+ (:layout (kernel:%funcallable-instance-layout o)))
+ (cmucl-inspect o)))
(defmethod emacs-inspect ((o kernel:code-component))
- (values (format nil "~A is a code data-block." o)
- (append
- (label-value-line*
- ("code-size" (kernel:%code-code-size o))
- ("entry-points" (kernel:%code-entry-points o))
- ("debug-info" (kernel:%code-debug-info o))
- ("trace-table-offset" (kernel:code-header-ref
- o vm:code-trace-table-offset-slot)))
- `("Constants:" (:newline))
- (loop for i from vm:code-constants-offset
- below (kernel:get-header-data o)
- append (label-value-line i (kernel:code-header-ref o i)))
- `("Code:" (:newline)
+ (append
+ (label-value-line*
+ ("code-size" (kernel:%code-code-size o))
+ ("entry-points" (kernel:%code-entry-points o))
+ ("debug-info" (kernel:%code-debug-info o))
+ ("trace-table-offset" (kernel:code-header-ref
+ o vm:code-trace-table-offset-slot)))
+ `("Constants:" (:newline))
+ (loop for i from vm:code-constants-offset
+ below (kernel:get-header-data o)
+ append (label-value-line i (kernel:code-header-ref o i)))
+ `("Code:" (:newline)
, (with-output-to-string (s)
(cond ((kernel:%code-debug-info o)
(disassem:disassemble-code-component o :stream s))
@@ -1948,63 +1938,57 @@
(* vm:code-constants-offset vm:word-bytes))
(ash 1 vm:lowtag-bits))
(ash (kernel:%code-code-size o) vm:word-shift)
- :stream s))))))))
+ :stream s)))))))
(defmethod emacs-inspect ((o kernel:fdefn))
- (values (format nil "~A is a fdenf object." o)
- (label-value-line*
- ("name" (kernel:fdefn-name o))
- ("function" (kernel:fdefn-function o))
- ("raw-addr" (sys:sap-ref-32
- (sys:int-sap (kernel:get-lisp-obj-address o))
- (* vm:fdefn-raw-addr-slot vm:word-bytes))))))
+ (label-value-line*
+ ("name" (kernel:fdefn-name o))
+ ("function" (kernel:fdefn-function o))
+ ("raw-addr" (sys:sap-ref-32
+ (sys:int-sap (kernel:get-lisp-obj-address o))
+ (* vm:fdefn-raw-addr-slot vm:word-bytes)))))
+#+(or)
(defmethod emacs-inspect ((o array))
(if (typep o 'simple-array)
(call-next-method)
- (values (format nil "~A is an array." o)
- (label-value-line*
- (:header (describe-primitive-type o))
- (:rank (array-rank o))
- (:fill-pointer (kernel:%array-fill-pointer o))
- (:fill-pointer-p (kernel:%array-fill-pointer-p o))
- (:elements (kernel:%array-available-elements o))
- (:data (kernel:%array-data-vector o))
- (:displacement (kernel:%array-displacement o))
- (:displaced-p (kernel:%array-displaced-p o))
- (:dimensions (array-dimensions o))))))
+ (label-value-line*
+ (:header (describe-primitive-type o))
+ (:rank (array-rank o))
+ (:fill-pointer (kernel:%array-fill-pointer o))
+ (:fill-pointer-p (kernel:%array-fill-pointer-p o))
+ (:elements (kernel:%array-available-elements o))
+ (:data (kernel:%array-data-vector o))
+ (:displacement (kernel:%array-displacement o))
+ (:displaced-p (kernel:%array-displaced-p o))
+ (:dimensions (array-dimensions o)))))
(defmethod emacs-inspect ((o simple-vector))
- (values (format nil "~A is a simple-vector." o)
- (append
- (label-value-line*
- (:header (describe-primitive-type o))
- (:length (c::vector-length o)))
- (loop for i below (length o)
- append (label-value-line i (aref o i))))))
+ (append
+ (label-value-line*
+ (:header (describe-primitive-type o))
+ (:length (c::vector-length o)))
+ (loop for i below (length o)
+ append (label-value-line i (aref o i)))))
(defun inspect-alien-record (alien)
- (values
- (format nil "~A is an alien value." alien)
- (with-struct (alien::alien-value- sap type) alien
- (with-struct (alien::alien-record-type- kind name fields) type
- (append
- (label-value-line*
- (:sap sap)
- (:kind kind)
- (:name name))
- (loop for field in fields
- append (let ((slot (alien::alien-record-field-name field)))
- (label-value-line slot (alien:slot alien slot)))))))))
+ (with-struct (alien::alien-value- sap type) alien
+ (with-struct (alien::alien-record-type- kind name fields) type
+ (append
+ (label-value-line*
+ (:sap sap)
+ (:kind kind)
+ (:name name))
+ (loop for field in fields
+ append (let ((slot (alien::alien-record-field-name field)))
+ (label-value-line slot (alien:slot alien slot))))))))
(defun inspect-alien-pointer (alien)
- (values
- (format nil "~A is an alien value." alien)
- (with-struct (alien::alien-value- sap type) alien
- (label-value-line*
- (:sap sap)
- (:type type)
- (:to (alien::deref alien))))))
+ (with-struct (alien::alien-value- sap type) alien
+ (label-value-line*
+ (:sap sap)
+ (:type type)
+ (:to (alien::deref alien)))))
(defun inspect-alien-value (alien)
(typecase (alien::alien-value-type alien)
--- /project/slime/cvsroot/slime/swank-corman.lisp 2008/02/09 18:38:58 1.14
+++ /project/slime/cvsroot/slime/swank-corman.lisp 2008/02/09 18:47:05 1.15
@@ -394,7 +394,6 @@
collect ", ")))
(defmethod emacs-inspect ((class standard-class))
- (values "A class."
`("Name: " (:value ,(class-name class))
(:newline)
"Super classes: "
@@ -428,12 +427,11 @@
(lambda (class)
`(:value ,class ,(princ-to-string (class-name class)))))
'("#<N/A (class not finalized)>"))
- (:newline))))
+ (:newline)))
(defmethod emacs-inspect ((slot cons))
;; Inspects slot definitions
(if (eq (car slot) :name)
- (values "A slot."
`("Name: " (:value ,(swank-mop:slot-definition-name slot))
(:newline)
,@(when (swank-mop:slot-definition-documentation slot)
@@ -445,13 +443,14 @@
`(:value ,(swank-mop:slot-definition-initform slot))
"#<unspecified>") (:newline)
"Init function: " (:value ,(swank-mop:slot-definition-initfunction slot))
- (:newline)))
+ (:newline))
(call-next-method)))
(defmethod emacs-inspect ((pathname pathnames::pathname-internal))
- (values (if (wild-pathname-p pathname)
+ (list* (if (wild-pathname-p pathname)
"A wild pathname."
"A pathname.")
+ '(:newline)
(append (label-value-line*
("Namestring" (namestring pathname))
("Host" (pathname-host pathname))
@@ -469,8 +468,6 @@
(t (call-next-method))))
(defun inspect-structure (o)
- (values
- (format nil "~A is a structure" o)
(let* ((template (cl::uref o 1))
(num-slots (cl::struct-template-num-slots template)))
(cond ((symbolp template)
@@ -479,7 +476,7 @@
(t
(loop for i below num-slots
append (label-value-line (elt template (+ 6 (* i 5)))
- (cl::uref o (+ 2 i)))))))))
+ (cl::uref o (+ 2 i))))))))
;;; Threads
--- /project/slime/cvsroot/slime/swank-ecl.lisp 2008/02/09 18:38:58 1.13
+++ /project/slime/cvsroot/slime/swank-ecl.lisp 2008/02/09 18:47:05 1.14
@@ -252,8 +252,8 @@
; ecl clos support leaves some to be desired
(cond
((streamp o)
- (values
- (format nil "~S is an ordinary stream" o)
+ (list*
+ (format nil "~S is an ordinary stream~%" o)
(append
(list
"Open for "
@@ -285,7 +285,7 @@
(t
(let* ((cl (si:instance-class o))
(slots (clos:class-slots cl)))
- (values (format nil "~S is an instance of class ~A"
+ (list* (format nil "~S is an instance of class ~A~%"
o (clos::class-name cl))
(loop for x in slots append
(let* ((name (clos:slot-definition-name x))
--- /project/slime/cvsroot/slime/swank-lispworks.lisp 2008/02/09 18:39:02 1.95
+++ /project/slime/cvsroot/slime/swank-lispworks.lisp 2008/02/09 18:47:05 1.96
@@ -644,12 +644,11 @@
(multiple-value-bind (names values _getter _setter type)
(lw:get-inspector-values o nil)
(declare (ignore _getter _setter))
- (values "A value."
(append
(label-value-line "Type" type)
(loop for name in names
for value in values
- append (label-value-line name value))))))
+ append (label-value-line name value)))))
;;; Miscellaneous
--- /project/slime/cvsroot/slime/swank-openmcl.lisp 2008/02/09 18:39:02 1.123
+++ /project/slime/cvsroot/slime/swank-openmcl.lisp 2008/02/09 18:47:05 1.124
@@ -814,24 +814,16 @@
collect " = "
collect `(:value ,value)
collect '(:newline))))
- (values (with-output-to-string (s)
- (let ((*print-lines* 1)
- (*print-right-margin* 80))
- (pprint o s)))
- lines)))
+ lines))
(defmethod emacs-inspect :around ((o t))
(if (or (uvector-inspector-p o)
(not (ccl:uvectorp o)))
(call-next-method)
- (multiple-value-bind (title content)
- (call-next-method)
- (values
- title
- (append content
+ (append (call-next-method)
`((:newline)
(:value ,(make-instance 'uvector-inspector :object o)
- "Underlying UVECTOR")))))))
+ "Underlying UVECTOR")))))
(defclass uvector-inspector ()
((object :initarg :object)))
@@ -843,12 +835,11 @@
(defmethod emacs-inspect ((uv uvector-inspector))
(with-slots (object)
uv
- (values (format nil "The UVECTOR for ~S." object)
(loop
for index below (ccl::uvsize object)
collect (format nil "~D: " index)
collect `(:value ,(ccl::uvref object index))
- collect `(:newline)))))
+ collect `(:newline))))
(defun closure-closed-over-values (closure)
(let ((howmany (nth-value 8 (ccl::function-args (ccl::closure-function closure)))))
@@ -861,8 +852,8 @@
(list label (if cellp (ccl::closed-over-value value) value))))))
(defmethod emacs-inspect ((c ccl::compiled-lexical-closure))
- (values
- (format nil "A closure: ~a" c)
+ (list*
+ (format nil "A closure: ~a~%" c)
`(,@(if (arglist c)
(list "Its argument list is: "
(funcall (intern "INSPECTOR-PRINC" 'swank) (arglist c)))
--- /project/slime/cvsroot/slime/swank-sbcl.lisp 2008/02/09 18:39:02 1.190
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp 2008/02/09 18:47:05 1.191
@@ -1003,39 +1003,36 @@
(defmethod emacs-inspect ((o t))
(cond ((sb-di::indirect-value-cell-p o)
- (values "A value cell." (label-value-line*
- (:value (sb-kernel:value-cell-ref o)))))
+ (label-value-line* (:value (sb-kernel:value-cell-ref o))))
(t
(multiple-value-bind (text label parts) (sb-impl::inspected-parts o)
- (if label
- (values text (loop for (l . v) in parts
- append (label-value-line l v)))
- (values text (loop for value in parts for i from 0
- append (label-value-line i value))))))))
+ (list* (format nil "~a~%" text)
+ (if label
+ (loop for (l . v) in parts
+ append (label-value-line l v))
+ (loop for value in parts for i from 0
+ append (label-value-line i value))))))))
(defmethod emacs-inspect ((o function))
(let ((header (sb-kernel:widetag-of o)))
(cond ((= header sb-vm:simple-fun-header-widetag)
- (values "A simple-fun."
(label-value-line*
(:name (sb-kernel:%simple-fun-name o))
(:arglist (sb-kernel:%simple-fun-arglist o))
(:self (sb-kernel:%simple-fun-self o))
(:next (sb-kernel:%simple-fun-next o))
(:type (sb-kernel:%simple-fun-type o))
- (:code (sb-kernel:fun-code-header o)))))
+ (:code (sb-kernel:fun-code-header o))))
((= header sb-vm:closure-header-widetag)
- (values "A closure."
(append
(label-value-line :function (sb-kernel:%closure-fun o))
`("Closed over values:" (:newline))
(loop for i below (1- (sb-kernel:get-closure-length o))
append (label-value-line
- i (sb-kernel:%closure-index-ref o i))))))
+ i (sb-kernel:%closure-index-ref o i)))))
(t (call-next-method o)))))
(defmethod emacs-inspect ((o sb-kernel:code-component))
- (values (format nil "~A is a code data-block." o)
(append
(label-value-line*
(:code-size (sb-kernel:%code-code-size o))
@@ -1060,28 +1057,24 @@
sb-vm:n-word-bytes))
(ash 1 sb-vm:n-lowtag-bits))
(ash (sb-kernel:%code-code-size o) sb-vm:word-shift)
- :stream s))))))))
+ :stream s)))))))
(defmethod emacs-inspect ((o sb-ext:weak-pointer))
- (values "A weak pointer."
(label-value-line*
- (:value (sb-ext:weak-pointer-value o)))))
+ (:value (sb-ext:weak-pointer-value o))))
(defmethod emacs-inspect ((o sb-kernel:fdefn))
- (values "A fdefn object."
(label-value-line*
(:name (sb-kernel:fdefn-name o))
- (:function (sb-kernel:fdefn-fun o)))))
+ (:function (sb-kernel:fdefn-fun o))))
(defmethod emacs-inspect :around ((o generic-function))
- (multiple-value-bind (title contents) (call-next-method)
- (values title
(append
- contents
+ (call-next-method)
(label-value-line*
(:pretty-arglist (sb-pcl::generic-function-pretty-arglist o))
(:initial-methods (sb-pcl::generic-function-initial-methods o))
- )))))
+ )))
;;;; Multiprocessing
--- /project/slime/cvsroot/slime/swank-scl.lisp 2008/02/09 18:39:02 1.16
+++ /project/slime/cvsroot/slime/swank-scl.lisp 2008/02/09 18:47:05 1.17
@@ -1742,8 +1742,7 @@
(defmethod emacs-inspect ((o t))
(cond ((di::indirect-value-cell-p o)
- (values (format nil "~A is a value cell." o)
- `("Value: " (:value ,(c:value-cell-ref o)))))
+ `("Value: " (:value ,(c:value-cell-ref o))))
((alien::alien-value-p o)
(inspect-alien-value o))
(t
@@ -1752,7 +1751,7 @@
(defun scl-inspect (o)
(destructuring-bind (text labeledp . parts)
(inspect::describe-parts o)
- (values (format nil "~A~%" text)
+ (list* (format nil "~A~%" text)
(if labeledp
(loop for (label . value) in parts
append (label-value-line label value))
@@ -1762,7 +1761,7 @@
(defmethod emacs-inspect ((o function))
(let ((header (kernel:get-type o)))
(cond ((= header vm:function-header-type)
- (values (format nil "~A is a function." o)
+ (list* (format nil "~A is a function.~%" o)
(append (label-value-line*
("Self" (kernel:%function-self o))
("Next" (kernel:%function-next o))
@@ -1774,7 +1773,7 @@
(with-output-to-string (s)
(disassem:disassemble-function o :stream s))))))
((= header vm:closure-header-type)
- (values (format nil "~A is a closure" o)
+ (list* (format nil "~A is a closure.~%" o)
(append
(label-value-line "Function" (kernel:%closure-function o))
`("Environment:" (:newline))
@@ -1789,7 +1788,6 @@
(defmethod emacs-inspect ((o kernel:code-component))
- (values (format nil "~A is a code data-block." o)
(append
(label-value-line*
("code-size" (kernel:%code-code-size o))
@@ -1813,20 +1811,19 @@
(* vm:code-constants-offset vm:word-bytes))
(ash 1 vm:lowtag-bits))
(ash (kernel:%code-code-size o) vm:word-shift)
- :stream s))))))))
+ :stream s)))))))
(defmethod emacs-inspect ((o kernel:fdefn))
- (values (format nil "~A is a fdenf object." o)
- (label-value-line*
+ (label-value-line*
("name" (kernel:fdefn-name o))
("function" (kernel:fdefn-function o))
("raw-addr" (sys:sap-ref-32
(sys:int-sap (kernel:get-lisp-obj-address o))
- (* vm:fdefn-raw-addr-slot vm:word-bytes))))))
+ (* vm:fdefn-raw-addr-slot vm:word-bytes)))))
(defmethod emacs-inspect ((o array))
(cond ((kernel:array-header-p o)
- (values (format nil "~A is an array." o)
+ (list* (format nil "~A is an array.~%" o)
(label-value-line*
(:header (describe-primitive-type o))
(:rank (array-rank o))
@@ -1838,13 +1835,13 @@
(:displaced-p (kernel:%array-displaced-p o))
(:dimensions (array-dimensions o)))))
(t
- (values (format nil "~A is an simple-array." o)
+ (list* (format nil "~A is an simple-array.~%" o)
(label-value-line*
(:header (describe-primitive-type o))
(:length (length o)))))))
(defmethod emacs-inspect ((o simple-vector))
- (values (format nil "~A is a vector." o)
+ (list* (format nil "~A is a vector.~%" o)
(append
(label-value-line*
(:header (describe-primitive-type o))
@@ -1854,8 +1851,6 @@
append (label-value-line i (aref o i)))))))
(defun inspect-alien-record (alien)
- (values
- (format nil "~A is an alien value." alien)
(with-struct (alien::alien-value- sap type) alien
(with-struct (alien::alien-record-type- kind name fields) type
(append
@@ -1865,16 +1860,14 @@
(:name name))
(loop for field in fields
append (let ((slot (alien::alien-record-field-name field)))
- (label-value-line slot (alien:slot alien slot)))))))))
+ (label-value-line slot (alien:slot alien slot))))))))
(defun inspect-alien-pointer (alien)
- (values
- (format nil "~A is an alien value." alien)
- (with-struct (alien::alien-value- sap type) alien
+ (with-struct (alien::alien-value- sap type) alien
(label-value-line*
(:sap sap)
(:type type)
- (:to (alien::deref alien))))))
+ (:to (alien::deref alien)))))
(defun inspect-alien-value (alien)
(typecase (alien::alien-value-type alien)
--- /project/slime/cvsroot/slime/swank.lisp 2008/02/09 18:45:39 1.530
+++ /project/slime/cvsroot/slime/swank.lisp 2008/02/09 18:47:05 1.531
@@ -2704,8 +2704,7 @@
(let ((*print-pretty* nil) ; print everything in the same line
(*print-circle* t)
(*print-readably* nil))
- (setq *inspectee-content*
- (inspector-content (nth-value 1 (emacs-inspect o)))))
+ (setq *inspectee-content* (inspector-content (emacs-inspect o))))
(list :title (with-output-to-string (s)
(print-unreadable-object (o s :type t :identity t)))
:id (assign-index o *inspectee-parts*)
@@ -2780,10 +2779,10 @@
(defslimefun inspector-next ()
"Inspect the next element in the *inspector-history*."
(with-buffer-syntax ()
- (let ((position (position *inspectee* *inspector-history*)))
- (cond ((= (1+ position) (length *inspector-history*))
+ (let ((pos (position *inspectee* *inspector-history*)))
+ (cond ((= (1+ pos) (length *inspector-history*))
nil)
- (t (inspect-object (aref *inspector-history* (1+ position))))))))
+ (t (inspect-object (aref *inspector-history* (1+ pos))))))))
(defslimefun inspector-reinspect ()
(inspect-object *inspectee*))
@@ -2825,10 +2824,9 @@
(inspect-cons o)))
(defun inspect-cons (cons)
- (values "A cons cell."
- (label-value-line*
- ('car (car cons))
- ('cdr (cdr cons)))))
+ (label-value-line*
+ ('car (car cons))
+ ('cdr (cdr cons))))
;; (inspect-list '#1=(a #1# . #1# ))
;; (inspect-list (list* 'a 'b 'c))
@@ -2837,8 +2835,7 @@
(defun inspect-list (list)
(multiple-value-bind (length tail) (safe-length list)
(flet ((frob (title list)
- (values nil (append `(,title (:newline))
- (inspect-list-aux list)))))
+ (list* title '(:newline) (inspect-list-aux list))))
(cond ((not length)
(frob "A circular list:"
(cons (car list)
@@ -2875,58 +2872,55 @@
;;;;; Hashtables
(defmethod emacs-inspect ((ht hash-table))
- (values (prin1-to-string ht)
- (append
- (label-value-line*
- ("Count" (hash-table-count ht))
- ("Size" (hash-table-size ht))
- ("Test" (hash-table-test ht))
- ("Rehash size" (hash-table-rehash-size ht))
- ("Rehash threshold" (hash-table-rehash-threshold ht)))
- (let ((weakness (hash-table-weakness ht)))
- (when weakness
- `("Weakness: " (:value ,weakness) (:newline))))
- (unless (zerop (hash-table-count ht))
- `((:action "[clear hashtable]"
- ,(lambda () (clrhash ht))) (:newline)
- "Contents: " (:newline)))
- (loop for key being the hash-keys of ht
- for value being the hash-values of ht
- append `((:value ,key) " = " (:value ,value)
- " " (:action "[remove entry]"
+ (append
+ (label-value-line*
+ ("Count" (hash-table-count ht))
+ ("Size" (hash-table-size ht))
+ ("Test" (hash-table-test ht))
+ ("Rehash size" (hash-table-rehash-size ht))
+ ("Rehash threshold" (hash-table-rehash-threshold ht)))
+ (let ((weakness (hash-table-weakness ht)))
+ (when weakness
+ (label-value-line "Weakness:" weakness)))
+ (unless (zerop (hash-table-count ht))
+ `((:action "[clear hashtable]"
+ ,(lambda () (clrhash ht))) (:newline)
+ "Contents: " (:newline)))
+ (loop for key being the hash-keys of ht
+ for value being the hash-values of ht
+ append `((:value ,key) " = " (:value ,value)
+ " " (:action "[remove entry]"
,(let ((key key))
- (lambda () (remhash key ht))))
- (:newline))))))
+ (lambda () (remhash key ht))))
+ (:newline)))))
;;;;; Arrays
(defmethod emacs-inspect ((array array))
- (values "An array."
- (append
- (label-value-line*
- ("Dimensions" (array-dimensions array))
- ("Element type" (array-element-type array))
- ("Total size" (array-total-size array))
- ("Adjustable" (adjustable-array-p array)))
- (when (array-has-fill-pointer-p array)
- (label-value-line "Fill pointer" (fill-pointer array)))
- '("Contents:" (:newline))
- (loop for i below (array-total-size array)
- append (label-value-line i (row-major-aref array i))))))
+ (append
+ (label-value-line*
+ ("Dimensions" (array-dimensions array))
+ ("Element type" (array-element-type array))
+ ("Total size" (array-total-size array))
+ ("Adjustable" (adjustable-array-p array)))
+ (when (array-has-fill-pointer-p array)
+ (label-value-line "Fill pointer" (fill-pointer array)))
+ '("Contents:" (:newline))
+ (loop for i below (array-total-size array)
+ append (label-value-line i (row-major-aref array i)))))
;;;;; Chars
(defmethod emacs-inspect ((char character))
- (values "A character."
- (append
- (label-value-line*
- ("Char code" (char-code char))
- ("Lower cased" (char-downcase char))
- ("Upper cased" (char-upcase char)))
- (if (get-macro-character char)
- `("In the current readtable ("
- (:value ,*readtable*) ") it is a macro character: "
- (:value ,(get-macro-character char)))))))
+ (append
+ (label-value-line*
+ ("Char code" (char-code char))
+ ("Lower cased" (char-downcase char))
+ ("Upper cased" (char-upcase char)))
+ (if (get-macro-character char)
+ `("In the current readtable ("
+ (:value ,*readtable*) ") it is a macro character: "
+ (:value ,(get-macro-character char))))))
;;;; Thread listing
More information about the slime-cvs
mailing list