]> code.delx.au - gnu-emacs/blobdiff - lisp/macros.el
(rmail-forward): Delete trailing blank lines.
[gnu-emacs] / lisp / macros.el
index a8f9648af7f14219d836bd01554ca9676c420dee..d834dca8806f5fad135fb4f697d7cf201f7f6851 100644 (file)
@@ -116,39 +116,42 @@ use this command, and then save the file."
                     (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")