(prin1-char): Don't turn S-a into A.

Don't return a string that would read as the wrong character code.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 5168f53d1cb80264ac1807f77e4578ed9d3cf4d9..fab95b30909b1c4130c7f80dabc369c204677e02 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,8 @@
+2004-08-30  Richard M. Stallman  <rms@gnu.org>
+
+       * emacs-lisp/lisp-mode.el (prin1-char): Don't turn S-a into A.
+       Don't return a string that would read as the wrong character code.
+
 2004-08-29  Kim F. Storm  <storm@cua.dk>
 
        * emulation/cua-base.el (cua-auto-expand-rectangles): Remove

diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index d6f601cd1216c398f5e06636dfe42d8a86905d0e..e2aac327ddc74786f93e7a3aa3ea438352abddd5 100644 (file)
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -460,26 +460,36 @@ If CHAR is not a character, return nil."
   (and (integerp char)
        (eventp char)
        (let ((c (event-basic-type char))
-            (mods (event-modifiers char)))
+            (mods (event-modifiers char))
+            string)
         ;; Prevent ?A from turning into ?\S-a.
         (if (and (memq 'shift mods)
+                 (zerop (logand char ?\S-\^@))
                  (not (let ((case-fold-search nil))
                         (char-equal c (upcase c)))))
             (setq c (upcase c) mods nil))
-        (concat
-         "?"
-         (mapconcat
-          (lambda (modif)
-            (cond ((eq modif 'super) "\\s-")
-                  (t (string ?\\ (upcase (aref (symbol-name modif) 0)) ?-))))
-          mods "")
-         (cond
-          ((memq c '(?\; ?\( ?\) ?\{ ?\} ?\[ ?\] ?\" ?\' ?\\)) (string ?\\ c))
-          ((eq c 127) "\\C-?")
-          (t
-           (condition-case nil
-               (string c)
-             (error nil))))))))
+        ;; What string are we considering using?
+        (condition-case nil
+            (setq string
+                  (concat
+                   "?"
+                   (mapconcat
+                    (lambda (modif)
+                      (cond ((eq modif 'super) "\\s-")
+                            (t (string ?\\ (upcase (aref (symbol-name modif) 0)) ?-))))
+                    mods "")
+                   (cond
+                    ((memq c '(?\; ?\( ?\) ?\{ ?\} ?\[ ?\] ?\" ?\' ?\\)) (string ?\\ c))
+                    ((eq c 127) "\\C-?")
+                    (t
+                     (string c)))))
+          (error nil))
+        ;; Verify the string reads a CHAR, not to some other character.
+        ;; If it doesn't, return nil instead.
+        (and string
+             (= (car (read-from-string string)) char)
+             string))))
+        
 
 (defun eval-last-sexp-1 (eval-last-sexp-arg-internal)
   "Evaluate sexp before point; print value in minibuffer.