From 4f4ce5976e0922de725f83663a7975b387356d86 Mon Sep 17 00:00:00 2001
From: "Richard M. Stallman" <rms@gnu.org>
Date: Mon, 30 Aug 2004 16:05:47 +0000
Subject: [PATCH] (prin1-char): Don't turn S-a into A. Don't return a string
 that would read as the wrong character code.

---
 lisp/ChangeLog               |  5 +++++
 lisp/emacs-lisp/lisp-mode.el | 40 ++++++++++++++++++++++--------------
 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.
-- 
2.39.5