Mercurial > hg > xemacs-beta
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))