From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 27 Jul 2010 05:15:40 +0000 (-0700)
Subject: Properly fix handling of pstring.
X-Git-Tag: 20101212-Gtk~127
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=ca54fb6a1ef74cace823224969308e54f8c84194;p=mit-scheme.git

Properly fix handling of pstring.
---

diff --git a/src/runtime/swank.scm b/src/runtime/swank.scm
index aedeeb58f..f32560fe1 100644
--- a/src/runtime/swank.scm
+++ b/src/runtime/swank.scm
@@ -209,10 +209,7 @@ USA.
 			  socket)))))))
 
 (define (emacs-rex socket sexp pstring)
-  (fluid-let ((*buffer-pstring*
-	       (cond ((elisp-false? pstring) #f)
-		     ((string? pstring) pstring)
-		     (else (error:bad-range-argument pstring 'EMACS-REX)))))
+  (fluid-let ((*buffer-pstring* pstring))
     (eval (cons* (car sexp) socket (cdr sexp))
 	  swank-env)))
 
@@ -222,24 +219,25 @@ USA.
   (the-environment))
 
 (define (buffer-env)
-  (if (or (not *buffer-pstring*)
-	  (string-ci=? *buffer-pstring* "COMMON-LISP-USER"))
-      (get-current-environment)
-      (pstring->env *buffer-pstring*)))
+  (pstring->env *buffer-pstring*))
 
 (define (pstring->env pstring)
-  (if (string-prefix? anonymous-package-prefix pstring)
-      (let ((object
-	     (object-unhash
-	      (string->number (string-tail pstring
-					   (string-length
-					    anonymous-package-prefix))
-			      10
-			      #t))))
-	(if (not (environment? object))
-	    (error:wrong-type-datum object "environment"))
-	object)
-      (package/environment (find-package (read-from-string pstring) #t))))
+  (cond ((or (not (string? pstring))
+	     (string-ci=? *buffer-pstring* "COMMON-LISP-USER"))
+	 (get-current-environment))
+	((string-prefix? anonymous-package-prefix pstring)
+	 (let ((object
+		(object-unhash
+		 (string->number (string-tail pstring
+					      (string-length
+					       anonymous-package-prefix))
+				 10
+				 #t))))
+	   (if (not (environment? object))
+	       (error:wrong-type-datum object "environment"))
+	   object))
+	(else
+	 (package/environment (find-package (read-from-string pstring) #t)))))
 
 (define (env->pstring env)
   (let ((package (environment->package env)))