(xscheme-control-g-synchronization-p): Doc fix.

[gnu-emacs] / lisp / macros.el

diff --git a/lisp/macros.el b/lisp/macros.el
index ca588fa995fc3e5c3678e4536fc8820df94bcf65..d834dca8806f5fad135fb4f697d7cf201f7f6851 100644 (file)
--- a/lisp/macros.el
+++ b/lisp/macros.el
@@ -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
@@ -70,11 +70,11 @@ use this command, and then save the file."
       (insert "(fset '"))
     (prin1 macroname (current-buffer))
     (insert "\n   ")
-    (let ((beg (point)) end)
-      (prin1 definition (current-buffer))
-      (setq end (point-marker))
-      (goto-char beg)
-      (if (stringp definition)
+    (if (stringp definition)
+       (let ((beg (point)) end)
+         (prin1 definition (current-buffer))
+         (setq end (point-marker))
+         (goto-char beg)
          (while (< (point) end)
            (let ((char (following-char)))
              (cond ((= char 0)
@@ -114,7 +114,46 @@ use this command, and then save the file."
                     (insert "\\M-" (- char 128)))
                    ((= char 255)
                     (delete-region (point) (1+ (point)))
-                    (insert "\\M-\\C-?")))))))
+                    (insert "\\M-\\C-?"))))))
+      (if (vectorp definition)
+         (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 (numberp char))
+                    (prin1 char (current-buffer)))
+                   (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")
     (if keys
        (let ((keys (where-is-internal macroname '(keymap))))