X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/e41b2db1da153e3ead4a01cb6e729cb99cad78ae..713cb18dec3ee8f53fa987b50de7002c298f3170:/lisp/macros.el

diff --git a/lisp/macros.el b/lisp/macros.el
index 41c021897c..55916ba80d 100644
--- a/lisp/macros.el
+++ b/lisp/macros.el
@@ -1,6 +1,7 @@
-;;; macros.el --- non-primitive commands for keyboard macros.
+;;; macros.el --- non-primitive commands for keyboard macros
 
-;; Copyright (C) 1985, 1986, 1987, 1992 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1995, 2002, 2003,
+;;   2004, 2005, 2006 Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: abbrev
@@ -18,8 +19,9 @@
 ;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
@@ -41,8 +43,11 @@ Such a \"function\" cannot be called from Lisp, but it is a valid editor command
       (error "No keyboard macro defined"))
   (and (fboundp symbol)
        (not (stringp (symbol-function symbol)))
-       (error "Function %s is already defined and not a keyboard macro."
+       (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))
 
 ;;;###autoload
@@ -59,7 +64,15 @@ 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")
+  (interactive (list (intern (completing-read "Insert kbd macro (name): "
+					      obarray
+					      (lambda (elt)
+						(and (fboundp elt)
+						     (or (stringp (symbol-function elt))
+							 (vectorp (symbol-function elt))
+							 (get elt 'kmacro))))
+					      t))
+		     current-prefix-arg))
   (let (definition)
     (if (string= (symbol-name macroname) "")
 	(progn
@@ -69,32 +82,97 @@ 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)
-      (while (< (point) end)
-	(let ((char (following-char)))
-	  (cond ((< char 32)
-		 (delete-region (point) (1+ (point)))
-		 (insert "\\C-" (+ 96 char)))
-		((< char 127)
-		 (forward-char 1))
-		((= char 127)
-		 (delete-region (point) (1+ (point)))
-		 (insert "\\C-?"))
-		((< char 160)
-		 (delete-region (point) (1+ (point)))
-		 (insert "\\M-C-" (- char 32)))
-		((< char 255)
-		 (delete-region (point) (1+ (point)))
-		 (insert "\\M-" (- char 128)))
-		((= char 255)
-		 (delete-region (point) (1+ (point)))
-		 (insert "\\M-C-?"))))))
+    (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)
+		     (delete-region (point) (1+ (point)))
+		     (insert "\\C-@"))
+		    ((< char 27)
+		     (delete-region (point) (1+ (point)))
+		     (insert "\\C-" (+ 96 char)))
+		    ((= char ?\C-\\)
+		     (delete-region (point) (1+ (point)))
+		     (insert "\\C-\\\\"))
+		    ((< char 32)
+		     (delete-region (point) (1+ (point)))
+		     (insert "\\C-" (+ 64 char)))
+		    ((< char 127)
+		     (forward-char 1))
+		    ((= char 127)
+		     (delete-region (point) (1+ (point)))
+		     (insert "\\C-?"))
+		    ((= char 128)
+		     (delete-region (point) (1+ (point)))
+		     (insert "\\M-\\C-@"))
+		    ((= char (aref "\M-\C-\\" 0))
+		     (delete-region (point) (1+ (point)))
+		     (insert "\\M-\\C-\\\\"))
+		    ((< char 155)
+		     (delete-region (point) (1+ (point)))
+		     (insert "\\M-\\C-" (- char 32)))
+		    ((< char 160)
+		     (delete-region (point) (1+ (point)))
+		     (insert "\\M-\\C-" (- char 64)))
+		    ((= char (aref "\M-\\" 0))
+		     (delete-region (point) (1+ (point)))
+		     (insert "\\M-\\\\"))
+		    ((< char 255)
+		     (delete-region (point) (1+ (point)))
+		     (insert "\\M-" (- char 128)))
+		    ((= char 255)
+		     (delete-region (point) (1+ (point)))
+		     (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 ?\")
+                            (insert "\\\""))
+			   ((= 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 nil)))
+	(let ((keys (where-is-internal macroname '(keymap))))
 	  (while keys
 	    (insert "(global-set-key ")
 	    (prin1 (car keys) (current-buffer))
@@ -109,45 +187,71 @@ use this command, and then save the file."
   With prefix argument, enters recursive edit, reading keyboard
 commands even within a kbd macro.  You can give different commands
 each time the macro executes.
-  Without prefix argument, reads a character.  Your options are:
-Space -- execute the rest of the macro.
-DEL -- skip the rest of the macro; start next repetition.
-C-d -- skip rest of the macro and don't repeat it any more.
-C-r -- enter a recursive edit, then on exit ask again for a character
-C-l -- redisplay screen and ask again."
+  Without prefix argument, asks whether to continue running the macro.
+Your options are: \\<query-replace-map>
+\\[act]	Finish this iteration normally and continue with the next.
+\\[skip]	Skip the rest of this iteration, and start the next.
+\\[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."
   (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))
+      (let ((loop t)
+	    (msg (substitute-command-keys
+		  "Proceed with macro?\\<query-replace-map>\
+ (\\[act], \\[skip], \\[exit], \\[recenter], \\[edit]) ")))
 	(while loop
-	  (let ((char (let ((executing-macro nil)
-			    (defining-kbd-macro nil))
-			(message "Proceed with macro? (Space, DEL, C-d, C-r or C-l) ")
-			(read-char))))
-	    (cond ((= char ? )
+	  (let ((key (let ((executing-kbd-macro nil)
+			   (defining-kbd-macro nil))
+		       (message "%s" msg)
+		       (read-event)))
+		def)
+	    (setq key (vector key))
+	    (setq def (lookup-key query-replace-map key))
+	    (cond ((eq def 'act)
 		   (setq loop nil))
-		  ((= char ?\177)
+		  ((eq def 'skip)
 		   (setq loop nil)
-		   (setq executing-macro ""))
-		  ((= char ?\C-d)
+		   (setq executing-kbd-macro ""))
+		  ((eq def 'exit)
 		   (setq loop nil)
-		   (setq executing-macro t))
-		  ((= char ?\C-l)
+		   (setq executing-kbd-macro t))
+		  ((eq def 'recenter)
 		   (recenter nil))
-		  ((= char ?\C-r)
-		   (let (executing-macro defining-kbd-macro)
-		     (recursive-edit))))))))))
+		  ((eq def 'edit)
+		   (let (executing-kbd-macro defining-kbd-macro)
+		     (recursive-edit)))
+		  ((eq def 'quit)
+		   (setq quit-flag t))
+		  (t
+		   (or (eq def 'help)
+		       (ding))
+		   (with-output-to-temp-buffer "*Help*"
+		     (princ
+		      (substitute-command-keys
+		       "Specify how to proceed with keyboard macro execution.
+Possibilities: \\<query-replace-map>
+\\[act]	Finish this iteration normally and continue with the next.
+\\[skip]	Skip the rest of this iteration, and start the next.
+\\[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)
+		       (help-mode)))))))))))
 
 ;;;###autoload
 (defun apply-macro-to-region-lines (top bottom &optional macro)
-  "For each complete line between point and mark, move to the beginning
-of the line, and run the last keyboard macro.
+  "Apply last keyboard macro to all lines in the region.
+For each line that begins in the region, move to the beginning of
+the line, and run the last keyboard macro.
 
 When called from lisp, this function takes two arguments TOP and
 BOTTOM, describing the current region.  TOP must be before BOTTOM.
@@ -166,7 +270,7 @@ and mark at opposite ends of the quoted section, and use
 Suppose you wanted to build a keyword table in C where each entry
 looked like this:
 
-    { \"foo\", foo_data, foo_function }, 
+    { \"foo\", foo_data, foo_function },
     { \"bar\", bar_data, bar_function },
     { \"baz\", baz_data, baz_function },
 
@@ -183,19 +287,15 @@ and write a macro to massage a word into a table entry:
     \\C-x )
 
 and then select the region of un-tablified names and use
-`\\[apply-macro-to-region-lines]' to build the table from the names.
-"
+`\\[apply-macro-to-region-lines]' to build the table from the names."
   (interactive "r")
   (or macro
       (progn
 	(if (null last-kbd-macro)
-	    (error "No keyboard macro has been defined."))
+	    (error "No keyboard macro has been defined"))
 	(setq macro last-kbd-macro)))
   (save-excursion
-    (let ((end-marker (progn
-			(goto-char bottom)
-			(beginning-of-line)
-			(point-marker)))
+    (let ((end-marker (copy-marker bottom))
 	  next-line-marker)
       (goto-char top)
       (if (not (bolp))
@@ -207,11 +307,14 @@ and then select the region of un-tablified names and use
 	  (forward-line 1)
 	  (set-marker next-line-marker (point)))
 	(save-excursion
-	  (execute-kbd-macro (or macro last-kbd-macro))))
+	  (let ((mark-active nil))
+	    (execute-kbd-macro (or macro last-kbd-macro)))))
       (set-marker end-marker nil)
       (set-marker next-line-marker nil))))
 
-;;;###autoload
-(define-key ctl-x-map "q" 'kbd-macro-query)
+;;;###autoload (define-key ctl-x-map "q" 'kbd-macro-query)
+
+(provide 'macros)
 
+;;; arch-tag: 346ed1a5-1220-4bc8-b533-961ee704361f
 ;;; macros.el ends here