![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to macros.el CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / lisp|
Return to macros.el CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / lisp |
1.1 root 1: ;; Non-primitive commands for keyboard macros.
2: ;; Copyright (C) 1985 Richard M. Stallman.
3:
4: ;; This file is part of GNU Emacs.
5:
6: ;; GNU Emacs is distributed in the hope that it will be useful,
7: ;; but WITHOUT ANY WARRANTY. No author or distributor
8: ;; accepts responsibility to anyone for the consequences of using it
9: ;; or for whether it serves any particular purpose or works at all,
10: ;; unless he says so in writing. Refer to the GNU Emacs General Public
11: ;; License for full details.
12:
13: ;; Everyone is granted permission to copy, modify and redistribute
14: ;; GNU Emacs, but only under the conditions described in the
15: ;; GNU Emacs General Public License. A copy of this license is
16: ;; supposed to have been given to you along with GNU Emacs so you
17: ;; can know your rights and responsibilities. It should be in a
18: ;; file named COPYING. Among other things, the copyright notice
19: ;; and this notice must be preserved on all copies.
20:
21:
22: (defun append-kbd-macro (macroname filename &optional keys)
23: "Append kbd macro NAME in file FILE, as Lisp code to define the macro.
24: Use load to load the file.
25: Third argument KEYS non-nil means also record the keys it is on.
26: (This is the prefix argument, when calling interactively.)"
27: (interactive "CAppend kbd macro (name): \nFAppend kbd macro %s to file: \nP")
28: (write-kbd-macro macroname filename keys t))
29:
30: (defun write-kbd-macro (macroname filename &optional keys appendflag)
31: "Save kbd macro NAME in file FILE, as Lisp code to define the macro.
32: Use load to load the file.
33: Third argument KEYS non-nil means also record the keys it is on.
34: (This is the prefix argument, when calling interactively.)
35: Fourth argument APPENDFLAG non-nil meams append to FILE's existing contents."
36: (interactive "CWrite kbd macro (name): \nFWrite kbd macro %s to file: \nP")
37: (let ((buffer (get-buffer-create " write-kbd-macro-temp")))
38: (save-excursion
39: (set-buffer buffer)
40: (erase-buffer)
41: (insert "(fset '")
42: (prin1 macroname buffer)
43: (insert "\n ")
44: (prin1 (symbol-function macroname) buffer)
45: (insert ")\n")
46: (let ((keys (where-is-internal macroname)))
47: (while keys
48: (insert "(global-set-key ")
49: (prin1 (car keys) buffer)
50: (insert " '")
51: (prin1 macroname buffer)
52: (insert ")\n")
53: (setq keys (cdr keys))))
54: (write-region (point-min) (point-max) filename appendflag))))
55:
56: (defun kbd-macro-query (flag)
57: "Query user during kbd macro execution.
58: With prefix argument, enters recursive edit,
59: reading keyboard commands even within a kbd macro.
60: You can give different commands each time the macro executes.
61: Without prefix argument, reads a character. Your options are:
62: Space -- execute the rest of the macro.
63: DEL -- skip the rest of the macro; start next repetition.
64: C-d -- skip rest of the macro and don't repeat it any more.
65: C-r -- enter a recursive edit, then on exit ask again for a character
66: C-l -- redisplay screen and ask again."
67: (interactive "P")
68: (or executing-macro
69: defining-kbd-macro
70: (error "Not defining or executing kbd macro"))
71: (if flag
72: (let (executing-macro defining-kbd-macro)
73: (recursive-edit))
74: (if (not executing-macro)
75: nil
76: (let ((loop t))
77: (while loop
78: (let ((char (let (executing-macro defining-kbd-macro)
79: (message "Proceed with macro? (Space, DEL, C-d, C-r or C-l) ")
80: (read-char))))
81: (cond ((= char ? )
82: (setq loop nil))
83: ((= char ?\177)
84: (setq loop nil)
85: (setq executing-macro ""))
86: ((= char ?\^d)
87: (setq loop nil)
88: (setq executing-macro t))
89: ((= char ?\^l)
90: (redraw-screen))
91: ((= char ?\^r)
92: (let (executing-macro defining-kbd-macro)
93: (recursive-edit))))))))))
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.