]> code.delx.au - gnu-emacs/blobdiff - lisp/macros.el
(rmail-forward): Delete trailing blank lines.
[gnu-emacs] / lisp / macros.el
index 0fe325aadd3bf8ad1c48032da791fd7b4e028804..d834dca8806f5fad135fb4f697d7cf201f7f6851 100644 (file)
@@ -1,6 +1,6 @@
 ;;; macros.el --- non-primitive commands for keyboard macros.
 
-;; Copyright (C) 1985, 1986, 1987, 1992, 1994 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 86, 87, 92, 94, 95 Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: abbrev
@@ -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")