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

[Helmut Eller]

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

Modified Files:
	swank.lisp 
Log Message:
(slime-read-string): Send a :read-aborted event for non-local exits.
(case-convert): Handle :invert case better.
Date: Tue Nov  4 17:33:32 2003
Author: heller

Index: slime/swank.lisp
diff -u slime/swank.lisp:1.54 slime/swank.lisp:1.55
--- slime/swank.lisp:1.54	Mon Nov  3 19:03:48 2003
+++ slime/swank.lisp	Tue Nov  4 17:33:31 2003
@@ -176,9 +176,14 @@
   (force-output)
   (let ((*read-input-catch-tag* (1+ *read-input-catch-tag*)))
     (send-to-emacs `(:read-string ,*read-input-catch-tag*))
-    (catch *read-input-catch-tag* 
-      (loop (read-from-emacs)))))
-
+    (let (ok)
+      (unwind-protect
+           (prog1 (catch *read-input-catch-tag* 
+                    (loop (read-from-emacs)))
+             (setq ok t))
+        (unless ok 
+          (send-to-emacs `(:read-aborted)))))))
+      
 (defslimefun take-input (tag input)
   (throw tag input))
 
@@ -376,11 +381,9 @@
     (:upcase (string-upcase string))
     (:downcase (string-downcase string))
     (:preserve string)
-    (:invert (with-output-to-string (*standard-output*)
-               (loop for c across string do
-                     (princ (if (upper-case-p c)
-                                (char-downcase c) 
-                                c)))))))
+    (:invert (cond ((every #'lower-case-p string) (string-upcase string))
+                   ((every #'upper-case-p string) (string-downcase string))
+                   (t string)))))
 
 (defslimefun completions (string default-package-name)
   "Return a list of completions for a symbol designator STRING.