[slime-cvs] CVS update: slime/swank-cmucl.lisp slime/swank-sbcl.lisp slime/swank-openmcl.lisp

[Helmut Eller]

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv17032

Modified Files:
	swank-cmucl.lisp swank-sbcl.lisp swank-openmcl.lisp 
Log Message:
(arglist-string): Don't intern the function name.  Use find-symbol-designator
instead.

Date: Mon Nov  3 18:22:41 2003
Author: heller

Index: slime/swank-cmucl.lisp
diff -u slime/swank-cmucl.lisp:1.16 slime/swank-cmucl.lisp:1.17
--- slime/swank-cmucl.lisp:1.16	Sun Nov  2 18:08:03 2003
+++ slime/swank-cmucl.lisp	Mon Nov  3 18:22:41 2003
@@ -23,11 +23,16 @@
 		       (lisp::misc #'sos/misc)
 		       (lisp::out #'sos/out)
 		       (lisp::sout #'sos/sout))
-	     (:conc-name sos.))
+	     (:conc-name sos.)
+	     (:print-function %print-slime-output-stream))
   (buffer (make-string 512) :type string)
   (index 0 :type kernel:index)
   (column 0 :type kernel:index))
 
+(defun %print-slime-output-stream (s stream d)
+  (declare (ignore d))
+  (print-unreadable-object (s stream :type t :identity t)))
+
 (defun sos/out (stream char)
   (let ((buffer (sos.buffer stream))
 	(index (sos.index stream)))
@@ -48,7 +53,7 @@
 (defun sos/misc (stream operation &optional arg1 arg2)
   (declare (ignore arg1 arg2))
   (case operation
-    (:force-output
+    ((:force-output :finish-output)
      (let ((end (sos.index stream)))
        (unless (zerop end)
 	 (send-to-emacs `(:read-output ,(subseq (sos.buffer stream) 0 end)))
@@ -64,7 +69,8 @@
 	     (:include string-stream
 		       (lisp::in #'sis/in)
 		       (lisp::misc #'sis/misc))
-	     (:conc-name sis.))
+	     (:conc-name sis.)
+	     (:print-function %print-slime-output-stream))
   (buffer "" :type string)
   (index 0 :type kernel:index))
 
@@ -94,47 +100,6 @@
     (:get-command nil)
     (:element-type 'base-char)))
 
-
-;; (eval-when (:load-toplevel :compile-toplevel :execute)
-;;   (require :gray-streams))
-;; 
-;; (defclass slime-input-stream (ext:fundamental-character-input-stream)
-;;   ((buffer :initform "") (index :initform 0)))
-;; 
-;; (defmethod ext:stream-read-char ((s slime-input-stream))
-;;   (with-slots (buffer index) s
-;;     (when (= index (length buffer))
-;; 	 (setf buffer (slime-read-string))
-;; 	 (setf index 0))
-;;     (assert (plusp (length buffer)))
-;;     (prog1 (aref buffer index) (incf index))))
-;; 
-;; (defmethod ext:stream-listen ((s slime-input-stream))
-;;   (with-slots (buffer index) s
-;;     (< index (length buffer))))
-;; 
-;; (defmethod ext:stream-unread-char ((s slime-input-stream) char)
-;;   (with-slots (buffer index) s
-;;     (setf (aref buffer (decf index)) char))
-;;   nil)
-;; 
-;; (defmethod ext:stream-clear-input ((s slime-input-stream))
-;;   (with-slots (buffer index) s 
-;;     (setf buffer ""  
-;; 	     index 0))
-;;   nil)
-;; 
-;; (defmethod ext:stream-line-column ((s slime-input-stream))
-;;   nil)
-;; 
-;; (defmethod ext:stream-line-length ((s slime-input-stream))
-;;   75)
-;; 
-;; (defun make-slime-input-stream ()
-;;   (make-instance 'slime-input-stream))
-
-
-
 (defun create-swank-server (port &key reuse-address (address "localhost"))
   "Create a SWANK TCP server."
   (let* ((hostent (ext:lookup-host-entry address))
@@ -325,7 +290,7 @@
 The result has the format \"(...)\"."
   (declare (type string fname))
   (multiple-value-bind (function condition)
-      (ignore-errors (values (from-string fname)))
+      (ignore-errors (values (find-symbol-designator fname *buffer-package*)))
     (when condition
       (return-from arglist-string (format nil "(-- ~A)" condition)))
     (let ((arglist


Index: slime/swank-sbcl.lisp
diff -u slime/swank-sbcl.lisp:1.18 slime/swank-sbcl.lisp:1.19
--- slime/swank-sbcl.lisp:1.18	Sun Nov  2 18:08:03 2003
+++ slime/swank-sbcl.lisp	Mon Nov  3 18:22:41 2003
@@ -240,7 +240,7 @@
 (defslimefun arglist-string (fname)
   (let ((*print-case* :downcase))
     (multiple-value-bind (function condition)
-        (ignore-errors (values (from-string fname)))
+        (ignore-errors (values (find-symbol-designator fname)))
       (when condition
         (return-from arglist-string (format nil "(-- ~A)" condition)))
       (let ((arglist


Index: slime/swank-openmcl.lisp
diff -u slime/swank-openmcl.lisp:1.17 slime/swank-openmcl.lisp:1.18
--- slime/swank-openmcl.lisp:1.17	Sun Nov  2 18:08:03 2003
+++ slime/swank-openmcl.lisp	Mon Nov  3 18:22:41 2003
@@ -13,7 +13,7 @@
 ;;; The LLGPL is also available online at
 ;;; http://opensource.franz.com/preamble.html
 ;;;
-;;;   $Id: swank-openmcl.lisp,v 1.17 2003/11/02 23:08:03 heller Exp $
+;;;   $Id: swank-openmcl.lisp,v 1.18 2003/11/03 23:22:41 heller Exp $
 ;;;
 
 ;;;
@@ -176,7 +176,7 @@
   "Return the lambda list for function FNAME as a string."
   (let ((*print-case* :downcase))
     (multiple-value-bind (function condition)
-        (ignore-errors (values (from-string fname)))
+        (ignore-errors (values (find-symbol-designator fname)))
       (when condition
         (return-from arglist-string (format nil "(-- ~A)" condition)))
       (let ((arglist (ccl:arglist function)))