[slime-cvs] CVS slime
dcrosher
dcrosher at common-lisp.net
Sat Feb 25 12:10:34 UTC 2006
Update of /project/slime/cvsroot/slime
In directory clnet:/tmp/cvs-serv20405
Modified Files:
ChangeLog swank-backend.lisp swank.lisp swank-scl.lisp
Log Message:
* swank-backend.lisp (operate-on-system): symbol case fix for
SCL's lowercase mode.
* swak.lisp (setup-stream-indirection)
(globally-redirect-io-to-connection)
(revert-global-io-redirection): symbol case fixes.
* swank-scl.lisp: (inspect-for-emacs): Fixes for the inspect
standard-objects, and inspect array. Plus misc symbol case fixes.
--- /project/slime/cvsroot/slime/ChangeLog 2006/02/22 23:43:18 1.845
+++ /project/slime/cvsroot/slime/ChangeLog 2006/02/25 12:10:33 1.846
@@ -1,3 +1,14 @@
+2006-02-25 Douglas Crosher <dcrosher at common-lisp.net>
+ * swank-backend.lisp (operate-on-system): symbol case fix for
+ SCL's lowercase mode.
+
+ * swak.lisp (setup-stream-indirection)
+ (globally-redirect-io-to-connection)
+ (revert-global-io-redirection): symbol case fixes.
+
+ * swank-scl.lisp: (inspect-for-emacs): Fixes for the inspect
+ standard-objects, and inspect array. Plus misc symbol case fixes.
+
2006-02-22 Matthias Koeppe <mkoeppe at mail.math.uni-magdeburg.de>
* slime.el (slime-repl-send-input): Don't include the final
--- /project/slime/cvsroot/slime/swank-backend.lisp 2006/01/30 19:56:55 1.95
+++ /project/slime/cvsroot/slime/swank-backend.lisp 2006/02/25 12:10:33 1.96
@@ -315,7 +315,7 @@
(unless (member :asdf *features*)
(error "ASDF is not loaded."))
(with-compilation-hooks ()
- (let ((operate (find-symbol "OPERATE" :asdf))
+ (let ((operate (find-symbol (symbol-name '#:operate) :asdf))
(operation (find-symbol operation-name :asdf)))
(when (null operation)
(error "Couldn't find ASDF operation ~S" operation-name))
--- /project/slime/cvsroot/slime/swank.lisp 2006/02/21 06:44:52 1.362
+++ /project/slime/cvsroot/slime/swank.lisp 2006/02/25 12:10:33 1.363
@@ -902,8 +902,8 @@
effective global value for *STANDARD-INPUT*. This way we can assign
the effective global value even when *STANDARD-INPUT* is shadowed by a
dynamic binding."
- (let ((real-stream-var (prefixed-var "REAL" stream-var))
- (current-stream-var (prefixed-var "CURRENT" stream-var)))
+ (let ((real-stream-var (prefixed-var '#:real stream-var))
+ (current-stream-var (prefixed-var '#:current stream-var)))
`(progn
;; Save the real stream value for the future.
(defvar ,real-stream-var ,stream-var)
@@ -945,7 +945,7 @@
"Set the standard I/O streams to redirect to CONNECTION.
Assigns *CURRENT-<STREAM>* for all standard streams."
(dolist (o *standard-output-streams*)
- (set (prefixed-var "CURRENT" o)
+ (set (prefixed-var '#:current o)
(connection.user-output connection)))
;; FIXME: If we redirect standard input to Emacs then we get the
;; regular Lisp top-level trying to read from our REPL.
@@ -958,10 +958,10 @@
;; Meanwhile we just leave *standard-input* alone.
#+NIL
(dolist (i *standard-input-streams*)
- (set (prefixed-var "CURRENT" i)
+ (set (prefixed-var '#:current i)
(connection.user-input connection)))
(dolist (io *standard-io-streams*)
- (set (prefixed-var "CURRENT" io)
+ (set (prefixed-var '#:current io)
(connection.user-io connection))))
(defun revert-global-io-redirection ()
@@ -969,8 +969,8 @@
(dolist (stream-var (append *standard-output-streams*
*standard-input-streams*
*standard-io-streams*))
- (set (prefixed-var "CURRENT" stream-var)
- (symbol-value (prefixed-var "REAL" stream-var)))))
+ (set (prefixed-var '#:current stream-var)
+ (symbol-value (prefixed-var '#:real stream-var)))))
;;;;; Global redirection hooks
--- /project/slime/cvsroot/slime/swank-scl.lisp 2005/11/13 22:31:45 1.3
+++ /project/slime/cvsroot/slime/swank-scl.lisp 2006/02/25 12:10:33 1.4
@@ -1422,7 +1422,7 @@
(mapcar #'car (di:frame-catches (nth-frame index))))
(defimplementation return-from-frame (index form)
- (let ((sym (find-symbol (string 'find-debug-tag-for-frame)
+ (let ((sym (find-symbol (symbol-name '#:find-debug-tag-for-frame)
:debug-internals)))
(if sym
(let* ((frame (nth-frame index))
@@ -1567,7 +1567,8 @@
(list (1st sc)))))))))
(defun mv-function-end-breakpoint-values (sigcontext)
- (let ((sym (find-symbol "FUNCTION-END-BREAKPOINT-VALUES/STANDARD" :di)))
+ (let ((sym (find-symbol (symbol-name '#:function-end-breakpoint-values/standard)
+ :debug-internals)))
(cond (sym (funcall sym sigcontext))
(t (di::get-function-end-breakpoint-values sigcontext)))))
@@ -1746,8 +1747,29 @@
(t
(scl-inspect o))))
+(defimplementation inspect-for-emacs ((o standard-object)
+ (inspector scl-inspector))
+ (declare (ignore inspector))
+ (let ((c (class-of o)))
+ (values "An object."
+ `("Class: " (:value ,c) (:newline)
+ "Slots:" (:newline)
+ ,@(loop for slotd in (clos:class-slots c)
+ for name = (clos:slot-definition-name slotd)
+ collect `(:value ,slotd ,(string name))
+ collect " = "
+ collect (if (clos:slot-boundp-using-class c o name)
+ `(:value ,(clos:slot-value-using-class
+ c o name))
+ "#<unbound>")
+ collect '(:newline))))))
+
(defun scl-inspect (o)
- (destructuring-bind (text labeledp . parts) (inspect::describe-parts o)
+ (destructuring-bind (text labeledp . parts)
+ (inspect::describe-parts o)
+ (loop for value in parts
+ for i from 0
+ do (format stream " ~S~%" (label-value-line i value)))
(values (format nil "~A~%" text)
(if labeledp
(loop for (label . value) in parts
@@ -1824,17 +1846,23 @@
(defmethod inspect-for-emacs ((o array) (inspector scl-inspector))
inspector
- (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)))))
+ (cond ((kernel:array-header-p o)
+ (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)))))
+ (t
+ (values (format nil "~A is an simple-array." o)
+ (label-value-line*
+ (:header (describe-primitive-type o))
+ (:length (length o)))))))
(defmethod inspect-for-emacs ((o simple-vector) (inspector scl-inspector))
inspector
More information about the slime-cvs
mailing list