diff lisp/macros.el @ 12923:f1e05398634b

(insert-kbd-macro): Express vector char modifiers with escape prefixes. Express big basic char codes in octal.
author Richard M. Stallman <rms@gnu.org>
date Tue, 22 Aug 1995 16:47:19 +0000
parents e6bdaaa6ce1b
children 83f275dcd93a
line wrap: on
line diff
--- a/lisp/macros.el	Tue Aug 22 16:46:45 1995 +0000
+++ b/lisp/macros.el	Tue Aug 22 16:47:19 1995 +0000
@@ -116,39 +116,42 @@
 		     (delete-region (point) (1+ (point)))
 		     (insert "\\M-\\C-?"))))))
       (if (vectorp definition)
-	  (let ((len (length definition)) (i 0) char)
+	  (let ((len (length definition)) (i 0) char mods)
 	    (while (< i len)
 	      (insert (if (zerop i) ?\[ ?\ ))
 	      (setq char (aref definition i)
 		    i (1+ i))
-	      (cond ((not (and (wholenump char) (< char 256)))
+	      (cond ((not (numberp char))
 		     (prin1 char (current-buffer)))
-		    ((= char 0)
-		     (insert "?\\C-@"))
-		    ((< char 27)
-		     (insert "?\\C-" (+ 96 char)))
-		    ((= char ?\C-\\)
-		     (insert "?\\C-\\\\"))
-		    ((< char 32)
-		     (insert "?\\C-" (+ 64 char)))
-		    ((< char 127)
-		     (insert ?? char))
-		    ((= char 127)
-		     (insert "?\\C-?"))
-		    ((= char 128)
-		     (insert "?\\M-\\C-@"))
-		    ((= char (aref "\M-\C-\\" 0))
-		     (insert "?\\M-\\C-\\\\"))
-		    ((< char 155)
-		     (insert "?\\M-\\C-" (- char 32)))
-		    ((< char 160)
-		     (insert "?\\M-\\C-" (- char 64)))
-		    ((= char (aref "\M-\\" 0))
-		     (insert "?\\M-\\\\"))
-		    ((< char 255)
-		     (insert "?\\M-" (- char 128)))
-		    ((= char 255)
-		     (insert "?\\M-\\C-?"))))
+		    (t
+		     (insert "?")
+		     (setq mods (event-modifiers char)
+			   char (event-basic-type char))
+		     (while mods
+		       (cond ((eq (car mods) 'control)
+			      (insert "\\C-"))
+			     ((eq (car mods) 'meta)
+			      (insert "\\M-"))
+			     ((eq (car mods) 'hyper)
+			      (insert "\\H-"))
+			     ((eq (car mods) 'super)
+			      (insert "\\s-"))
+			     ((eq (car mods) 'alt)
+			      (insert "\\A-"))
+			     ((and (eq (car mods) 'shift)
+				   (>= char ?a)
+				   (<= char ?z))
+			      (setq char (upcase char)))
+			     ((eq (car mods) 'shift)
+			      (insert "\\S-")))
+		       (setq mods (cdr mods)))
+		     (cond ((= char ?\\)
+			    (insert "\\\\"))
+			   ((= char 127)
+			    (insert "\\C-?"))
+			   ((< char 127)
+			    (insert char))
+			   (t (insert "\\" (format "%o" char)))))))
 	    (insert ?\]))
 	(prin1 definition (current-buffer))))
     (insert ")\n")