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

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

2 files changed, 30 insertions, 15 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 5168f53d1cb..fab95b30909 100644
--- 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 d6f601cd121..e2aac327ddc 100644
--- 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.