]> code.delx.au - gnu-emacs/blobdiff - lisp/macros.el
Merge from emacs-24; up to 2012-12-06T01:39:03Z!monnier@iro.umontreal.ca
[gnu-emacs] / lisp / macros.el
index bb9fda41a4552fa14399af1d8668526ac92cb8fe..b6db9bdcdef94f7c0a831ce33a287e18e709229a 100644 (file)
@@ -1,16 +1,18 @@
 ;;; macros.el --- non-primitive commands for keyboard macros
 
-;; Copyright (C) 1985, 86, 87, 92, 94, 95, 04 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1987, 1992, 1994-1995, 2001-2013 Free Software
+;; Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: abbrev
+;; Package: emacs
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -18,9 +20,7 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
@@ -63,12 +63,13 @@ bindings.
 
 To save a kbd macro, visit a file of Lisp code such as your `~/.emacs',
 use this command, and then save the file."
-  (interactive (list (intern (completing-read "Insert kbd macro (name): " 
-                                             obarray 
+  (interactive (list (intern (completing-read "Insert kbd macro (name): "
+                                             obarray
                                              (lambda (elt)
                                                (and (fboundp elt)
                                                     (or (stringp (symbol-function elt))
-                                                        (vectorp (symbol-function elt)))))
+                                                        (vectorp (symbol-function elt))
+                                                        (get elt 'kmacro))))
                                              t))
                     current-prefix-arg))
   (let (definition)
@@ -126,51 +127,20 @@ 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 mods)
+         (let ((len (length definition)) (i 0) char)
            (while (< i len)
-             (insert (if (zerop i) ?\[ ?\ ))
+             (insert (if (zerop i) ?\[ ?\s))
              (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 ?\")
-                            (insert "\\\""))
-                          ((= char ?\;)
-                           (insert "\\;"))
-                          ((= char 127)
-                           (insert "\\C-?"))
-                          ((< char 127)
-                           (insert char))
-                          (t (insert "\\" (format "%o" char)))))))
+             (if (not (numberp char))
+                  (prin1 char (current-buffer))
+                (princ (prin1-char char) (current-buffer))))
            (insert ?\]))
        (prin1 definition (current-buffer))))
     (insert ")\n")
     (if keys
-       (let ((keys (where-is-internal macroname '(keymap))))
+       (let ((keys (where-is-internal (symbol-function macroname)
+                                      '(keymap))))
          (while keys
            (insert "(global-set-key ")
            (prin1 (car keys) (current-buffer))
@@ -241,8 +211,7 @@ Possibilities: \\<query-replace-map>
 \\[exit]       Stop the macro entirely right now.
 \\[recenter]   Redisplay the screen, then ask again.
 \\[edit]       Enter recursive edit; ask again when you exit from that."))
-                    (save-excursion
-                      (set-buffer standard-output)
+                    (with-current-buffer standard-output
                       (help-mode)))))))))))
 
 ;;;###autoload
@@ -306,7 +275,7 @@ and then select the region of un-tablified names and use
          (set-marker next-line-marker (point)))
        (save-excursion
          (let ((mark-active nil))
-           (execute-kbd-macro (or macro last-kbd-macro)))))
+           (execute-kbd-macro macro))))
       (set-marker end-marker nil)
       (set-marker next-line-marker nil))))
 
@@ -314,5 +283,4 @@ and then select the region of un-tablified names and use
 
 (provide 'macros)
 
-;;; arch-tag: 346ed1a5-1220-4bc8-b533-961ee704361f
 ;;; macros.el ends here