[slime-cvs] CVS slime/contrib

[CVS User trittweiler]

Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv20552/contrib

Modified Files:
	ChangeLog swank-fancy-inspector.lisp 
Log Message:
	Perform PATHNAME on file-streams safely.

	* swank-fancy-inspector.lisp (make-visit-file-thunk): Deleted.
	(make-pathname-ispec): New helper.
	(make-file-stream-ispec): New helper.
	(emacs-inspect file-stream): Use them.
	(emacs-inspect stream-error): Ditto.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2010/05/13 15:31:07	1.379
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2010/05/14 03:20:04	1.380
@@ -1,5 +1,15 @@
 2010-05-13  Tobias C. Rittweiler <tcr at freebits.de>
 
+	Perform PATHNAME on file-streams safely.
+
+	* swank-fancy-inspector.lisp (make-visit-file-thunk): Deleted.
+	(make-pathname-ispec): New helper.
+	(make-file-stream-ispec): New helper.
+	(emacs-inspect file-stream): Use them.
+	(emacs-inspect stream-error): Ditto.
+
+2010-05-13  Tobias C. Rittweiler <tcr at freebits.de>
+
 	* slime-autodoc.el, slime-c-p-c.el, slime-compiler-notes-tree.el,
 	slime-enclosing-context.el, slime-fancy.el, slime-fuzzy.el,
 	slime-hyperdoc.el, slime-mdot-fu.el, slime-mrepl.el,
--- /project/slime/cvsroot/slime/contrib/swank-fancy-inspector.lisp	2010/04/19 00:42:29	1.26
+++ /project/slime/cvsroot/slime/contrib/swank-fancy-inspector.lisp	2010/05/14 03:20:04	1.27
@@ -819,42 +819,36 @@
                 (label-value-line "Digits" (float-digits f))
                 (label-value-line "Precision" (float-precision f)))))))
 
-(defun make-visit-file-thunk (stream)
-  (let ((pathname (pathname stream))
-        (position (file-position stream)))
-    (lambda ()
-      (ed-in-emacs `(,pathname :charpos ,position)))))
+(defun make-pathname-ispec (pathname position)
+  `("Pathname: "
+    (:value ,pathname)
+    (:newline) "  "
+    ,@(when position
+        `((:action "[visit file and show current position]"
+                   ,(lambda () (ed-in-emacs `(,pathname :charpos ,position)))
+                   :refreshp nil)
+          (:newline)))))
+
+(defun make-file-stream-ispec (stream)
+  ;; SBCL's socket stream are file-stream but are not associated to
+  ;; any pathname.
+  (let ((pathname (ignore-errors (pathname stream))))
+    (when pathname
+      (make-pathname-ispec pathname (and (open-stream-p stream)
+                                         (file-position stream))))))
 
 (defmethod emacs-inspect ((stream file-stream))
   (multiple-value-bind (content)
       (call-next-method)
-            (append
-             `("Pathname: "
-               (:value ,(pathname stream))
-               (:newline) "  "
-               ,@(when (open-stream-p stream)
-                   `((:action "[visit file and show current position]"
-                              ,(make-visit-file-thunk stream)
-                              :refreshp nil)
-                     (:newline))))
-             content)))
+    (append (make-file-stream-ispec stream) content)))
 
 (defmethod emacs-inspect ((condition stream-error))
   (multiple-value-bind (content)
       (call-next-method)
     (let ((stream (stream-error-stream condition)))
-      (if (typep stream 'file-stream)
-                  (append
-                   `("Pathname: "
-                     (:value ,(pathname stream))
-                     (:newline) "  "
-                     ,@(when (open-stream-p stream)
-                         `((:action "[visit file and show current position]"
-                                    ,(make-visit-file-thunk stream)
-                                    :refreshp nil)
-                           (:newline))))
-                   content)
-          content))))
+      (append (when (typep stream 'file-stream)
+                (make-file-stream-ispec stream))
+              content))))
 
 (defun common-seperated-spec (list &optional (callback (lambda (v) 
 							 `(:value ,v))))