diff lisp/prim/macros.el @ 173:8eaf7971accc r20-3b13

Import from CVS: tag r20-3b13
author cvs
date Mon, 13 Aug 2007 09:49:09 +0200
parents 0d2f883870bc
children
line wrap: on
line diff
--- a/lisp/prim/macros.el	Mon Aug 13 09:47:55 2007 +0200
+++ b/lisp/prim/macros.el	Mon Aug 13 09:49:09 2007 +0200
@@ -22,7 +22,7 @@
 ;; Free Software Foundation, 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 
-;;; Synched up with: FSF 19.30.
+;;; Synched up with: FSF 19.34.
 
 ;;; Commentary:
 
@@ -50,93 +50,44 @@
        (not (vectorp (symbol-function symbol)))
        (error "Function %s is already defined and not a keyboard macro."
 	      symbol))
+  (if (string-equal symbol "")
+      (error "No command name given"))
   (fset symbol last-kbd-macro))
 
-;(defun insert-kbd-macro-pretty-string (string)
-;  ;; Convert control characters to the traditional readable representation:
-;  ;; put the four characters \M-x in the buffer instead of the one char \370,
-;  ;; which would deceptively print as `oslash' with the default settings.
-;  (save-restriction
-;    (narrow-to-region (point) (point))
-;    (prin1 string (current-buffer))
-;    (goto-char (1+ (point-min)))
-;    (while (not (eobp))
-;      (cond ((= (following-char)   0) (insert "\\C-@") (delete-char 1))
-;	    ((= (following-char) ?\n) (insert "\\n") (delete-char 1))
-;	    ((= (following-char) ?\r) (insert "\\r") (delete-char 1))
-;	    ((= (following-char) ?\t) (insert "\\t") (delete-char 1))
-;	    ((= (following-char) ?\e) (insert "\\e") (delete-char 1))
-;	    ((= (following-char) 127) (insert "\\C-?") (delete-char 1))
-;	    ((= (following-char) 128) (insert "\\M-\\C-@") (delete-char 1))
-;	    ((= (following-char) 255) (insert "\\M-\\C-?") (delete-char 1))
-;	    ((and (> (following-char) 127) (< (following-char) 155))
-;	     (insert "\\M-\\C-")
-;	     (insert (- (following-char) 32))
-;	     (delete-char 1)
-;	     (forward-char -1))
-;	    ((and (>= (following-char) 155) (< (following-char) 160))
-;	     (insert "\\M-\\C-")
-;	     (insert (- (following-char) 64))
-;	     (delete-char 1)
-;	     (forward-char -1))
-;	    ((>= (following-char) 160)
-;	     (insert "\\M-")
-;	     (insert (- (following-char) 128))
-;	     (delete-char 1)
-;	     (forward-char -1))
-;	    ((< (following-char) 27)
-;	     ;;(insert "\\^") (insert (+ (following-char) 64))
-;	     (insert "\\C-") (insert (+ (following-char) 96))
-;	     (delete-char 1)
-;	     (forward-char -1))
-;	    ((< (following-char) 32)
-;	     ;;(insert "\\^") (insert (+ (following-char) 64))
-;	     (insert "\\C-") (insert (+ (following-char) 64))
-;	     (delete-char 1)
-;	     (forward-char -1))
-;	    (t
-;	     (forward-char 1))))))
+;;; Moved here from edmacro.el:
+
+;;;###autoload
+(defun insert-kbd-macro (macroname &optional keys)
+  "Insert in buffer the definition of kbd macro NAME, as Lisp code.
+Optional second arg KEYS means also record the keys it is on
+\(this is the prefix argument, when calling interactively).
+
+This Lisp code will, when executed, define the kbd macro with the same
+definition it has now.  If you say to record the keys, the Lisp code
+will also rebind those keys to the macro.  Only global key bindings
+are recorded since executing this Lisp code always makes global
+bindings.
 
-;; ;;;###autoload
-;(defun insert-kbd-macro (macroname &optional keys)
-;  "Insert in buffer the definition of kbd macro NAME, as Lisp code.
-;Optional second argument KEYS means also record the keys it is on
-;\(this is the prefix argument, when calling interactively).
-
-;This Lisp code will, when executed, define the kbd macro with the
-;same definition it has now.  If you say to record the keys,
-;the Lisp code will also rebind those keys to the macro.
-;Only global key bindings are recorded since executing this Lisp code
-;always makes global 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 "CInsert kbd macro (name): \nP")
-;  (let (definition)
-;    (if (string= (symbol-name macroname) "")
-;	(progn
-;	  (setq macroname 'last-kbd-macro 
-;                definition last-kbd-macro)
-;	  (insert "(setq "))
-;        (progn
-;          (setq definition (symbol-function macroname))
-;          (insert "(fset '")))
-;  (prin1 macroname (current-buffer))
-;  (insert "\n   ")
-;  (let ((string (events-to-keys definition t)))
-;    (if (stringp string)
-;	(insert-kbd-macro-pretty-string string)
-;      (prin1 string (current-buffer))))
-;  (insert ")\n")
-;  (if keys
-;      (let ((keys (where-is-internal macroname)))
-;	(while keys
-;	  (insert "(global-set-key ")
-;	  (prin1 (car keys) (current-buffer))
-;	  (insert " '")
-;	  (prin1 macroname (current-buffer))
-;	  (insert ")\n")
-;            (setq keys (cdr keys)))))))
+To save a kbd macro, visit a file of Lisp code such as your `~/.emacs',
+use this command, and then save the file."
+  (interactive "CInsert kbd macro (name): \nP")
+  (let (definition)
+    (if (string= (symbol-name macroname) "")
+	(progn
+	  (setq definition (format-kbd-macro))
+	  (insert "(setq last-kbd-macro"))
+      (setq definition (format-kbd-macro macroname))
+      (insert (format "(defalias '%s" macroname)))
+    (if (> (length definition) 50)
+	(insert " (read-kbd-macro\n")
+      (insert "\n  (read-kbd-macro "))
+    (prin1 definition (current-buffer))
+    (insert "))\n")
+    (if keys
+	(let ((keys (where-is-internal macroname)))
+	  (while keys
+	    (insert (format "(global-set-key %S '%s)\n" (car keys) macroname))
+	    (pop keys))))))
 
 ;;;###autoload
 (defun kbd-macro-query (flag)
@@ -152,23 +103,24 @@
 \\[recenter]	Redisplay the frame, then ask again.
 \\[edit]	Enter recursive edit; ask again when you exit from that."
   (interactive "P")
-  (or executing-macro
+  (or executing-kbd-macro
       defining-kbd-macro
       (error "Not defining or executing kbd macro"))
   (if flag
-      (let (executing-macro defining-kbd-macro)
+      (let (executing-kbd-macro defining-kbd-macro)
 	(recursive-edit))
-    (if (not executing-macro)
+    (if (not executing-kbd-macro)
 	nil
       (let ((loop t)
 	    (msg (substitute-command-keys
                   "Proceed with macro?\\<query-replace-map>\
  (\\[act], \\[skip], \\[exit], \\[recenter], \\[edit]) ")))
 	(while loop
-	  (let ((key (let ((executing-macro nil)
+	  (let ((key (let ((executing-kbd-macro nil)
 			    (defining-kbd-macro nil))
-                       (message msg)
-                       (read-char)))
+                       (message "%s" msg)
+		       ;; XEmacs: avoid `read-char'.
+                       (read-char-exclusive)))
                 def)
 	    (setq key (vector key))
 	    (setq def (lookup-key query-replace-map key))
@@ -176,14 +128,14 @@
 		   (setq loop nil))
 		  ((eq def 'skip)
 		   (setq loop nil)
-		   (setq executing-macro ""))
+		   (setq executing-kbd-macro ""))
 		  ((eq def 'exit)
 		   (setq loop nil)
-		   (setq executing-macro t))
+		   (setq executing-kbd-macro t))
 		  ((eq def 'recenter)
 		   (recenter nil))
 		  ((eq def 'edit)
-		   (let (executing-macro defining-kbd-macro)
+		   (let (executing-kbd-macro defining-kbd-macro)
 		     (recursive-edit)))
 		  ((eq def 'quit)
 		   (setq quit-flag t))