[slime-cvs] CVS slime

[trittweiler]

Update of /project/slime/cvsroot/slime
In directory clnet:/tmp/cvs-serv22152

Modified Files:
	swank.lisp 
Log Message:

* swank.lisp (read-softly-from-string, unintern-in-home-package):
  Moved from `contrib/swank-arglist.lisp'.
  (parse-package): Use them. (Removes FIXME about interning
  symbols.)  Also changed the logic somewhat to avoid passing :|| to
  FIND-PACKAGE as ECL chokes on that.


--- /project/slime/cvsroot/slime/swank.lisp	2007/09/19 11:12:07	1.511
+++ /project/slime/cvsroot/slime/swank.lisp	2007/10/22 11:33:54	1.512
@@ -1517,6 +1517,30 @@
     (let ((*read-suppress* nil))
       (read-from-string string))))
 
+(defun read-softly-from-string (string)
+  "Returns three values:
+
+     1. the object resulting from READing STRING.
+
+     2. The index of the first character in STRING that was not read.
+
+     3. T if the object is a symbol that had to be newly interned
+        in some package. (This does not work for symbols in
+        compound forms like lists or vectors.)"
+  (multiple-value-bind (symbol found? symbol-name package) (parse-symbol string)
+    (if found?
+        (values symbol nil)
+        (multiple-value-bind (sexp pos) (read-from-string string)
+          (values sexp pos
+                  (when (symbolp sexp)
+                    (prog1 t
+                      ;; assert that PARSE-SYMBOL didn't parse incorrectly.
+                      (assert (and (equal symbol-name (symbol-name sexp))
+                                   (eq package (symbol-package sexp)))))))))))
+
+(defun unintern-in-home-package (symbol)
+  (unintern symbol (symbol-package symbol)))
+
 ;; FIXME: deal with #\| etc.  hard to do portably.
 (defun tokenize-symbol (string)
   "STRING is interpreted as the string representation of a symbol
@@ -1602,20 +1626,23 @@
         (values symbol status)
         (error "Unknown symbol: ~A [in ~A]" string package))))
 
-;; FIXME: interns the name
 (defun parse-package (string)
   "Find the package named STRING.
 Return the package or nil."
-  (multiple-value-bind (name pos) 
-      (if (zerop (length string))
-          (values :|| 0)
+  (check-type string (or string null))
+  (if (zerop (length string))
+      nil
+      (multiple-value-bind (name pos interned?) 
           (let ((*package* *swank-io-package*))
-            (ignore-errors (read-from-string string))))
-    (and name
-         (or (symbolp name) 
-             (stringp name))
-         (= (length string) pos)
-         (find-package name))))
+            (ignore-errors (read-softly-from-string string)))
+        (unwind-protect
+             (and name
+                  (or (symbolp name) 
+                      (stringp name))
+                  (= (length string) pos)
+                  (find-package name))
+          (when interned?
+            (unintern-in-home-package name))))))
 
 (defun unparse-name (string)
   "Print the name STRING according to the current printer settings."