|
|
1.1 root 1: ;; Abbrev mode commands for Emacs
2:
3: ;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
4:
5: ;; This file is part of GNU Emacs.
6:
7: ;; GNU Emacs is distributed in the hope that it will be useful,
8: ;; but WITHOUT ANY WARRANTY. No author or distributor
9: ;; accepts responsibility to anyone for the consequences of using it
10: ;; or for whether it serves any particular purpose or works at all,
11: ;; unless he says so in writing. Refer to the GNU Emacs General Public
12: ;; License for full details.
13:
14: ;; Everyone is granted permission to copy, modify and redistribute
15: ;; GNU Emacs, but only under the conditions described in the
16: ;; GNU Emacs General Public License. A copy of this license is
17: ;; supposed to have been given to you along with GNU Emacs so you
18: ;; can know your rights and responsibilities. It should be in a
19: ;; file named COPYING. Among other things, the copyright notice
20: ;; and this notice must be preserved on all copies.
21:
22:
23: (defun abbrev-mode (arg)
24: "Toggle abbrev mode.
25: With arg, turn abbrev mode on iff arg is positive.
26: In abbrev mode, inserting an abbreviation causes it to expand
27: and be replaced by its expansion."
28: (interactive "P")
29: (setq abbrev-mode
30: (if (null arg) (not abbrev-mode)
31: (> (prefix-numeric-value arg) 0)))
32: (set-buffer-modified-p (buffer-modified-p))) ;No-op, but updates mode line.
33:
34: (defvar edit-abbrevs-map nil
35: "Keymap used in edit-abbrevs.")
36: (if edit-abbrevs-map
37: nil
38: (setq edit-abbrevs-map (make-sparse-keymap))
39: (define-key edit-abbrevs-map "\C-x\C-s" 'edit-abbrevs-redefine)
40: (define-key edit-abbrevs-map "\C-c\C-c" 'edit-abbrevs-redefine))
41:
42: (defun kill-all-abbrevs ()
43: "Undefine all defined abbrevs."
44: (interactive)
45: (let ((tables abbrev-table-name-list))
46: (while tables
47: (clear-abbrev-table (symbol-value (car tables)))
48: (setq tables (cdr tables)))))
49:
50: (defun insert-abbrevs ()
51: "Insert after point a description of all defined abbrevs.
52: Mark is set after the inserted text."
53: (interactive)
54: (push-mark
55: (save-excursion
56: (let ((tables abbrev-table-name-list))
57: (while tables
58: (insert-abbrev-table-description (car tables) t)
59: (setq tables (cdr tables))))
60: (point))))
61:
62: (defun list-abbrevs ()
63: "Display a list of all defined abbrevs."
64: (interactive)
65: (display-buffer (prepare-abbrev-list-buffer)))
66:
67: (defun prepare-abbrev-list-buffer ()
68: (save-excursion
69: (set-buffer (get-buffer-create "*Abbrevs*"))
70: (erase-buffer)
71: (let ((tables abbrev-table-name-list))
72: (while tables
73: (insert-abbrev-table-description (car tables) t)
74: (setq tables (cdr tables))))
75: (goto-char (point-min))
76: (set-buffer-modified-p nil)
77: (edit-abbrevs-mode))
78: (get-buffer-create "*Abbrevs*"))
79:
80: (defun edit-abbrevs-mode ()
81: "Major mode for editing the list of abbrev definitions.
82: \\{edit-abbrevs-map}"
83: (interactive)
84: (setq major-mode 'edit-abbrevs-mode)
85: (setq mode-name "Edit-Abbrevs")
86: (use-local-map edit-abbrevs-map))
87:
88: (defun edit-abbrevs ()
89: "Alter abbrev definitions by editing a list of them.
90: Selects a buffer containing a list of abbrev definitions.
91: You can edit them and type C-c C-c to redefine abbrevs
92: according to your editing.
93: Buffer contains a header line for each abbrev table,
94: which is the abbrev table name in parentheses.
95: This is followed by one line per abbrev in that table:
96: NAME USECOUNT EXPANSION HOOK
97: where NAME and EXPANSION are strings with quotes,
98: USECOUNT is an integer, and HOOK is any valid function
99: or may be omitted (it is usually omitted)."
100: (interactive)
101: (switch-to-buffer (prepare-abbrev-list-buffer)))
102:
103: (defun edit-abbrevs-redefine ()
104: "Redefine abbrevs according to current buffer contents."
105: (interactive)
106: (define-abbrevs t)
107: (set-buffer-modified-p nil))
108:
109: (defun define-abbrevs (&optional arg)
110: "Define abbrevs according to current visible buffer contents.
111: See documentation of edit-abbrevs for info on the format of the
112: text you must have in the buffer.
113: With argument, eliminate all abbrev definitions except
114: the ones defined from the buffer now."
115: (interactive "P")
116: (if arg (kill-all-abbrevs))
117: (save-excursion
118: (goto-char (point-min))
119: (while (and (not (eobp)) (re-search-forward "^(" nil t))
120: (let* ((buf (current-buffer))
121: (table (read buf))
122: abbrevs)
123: (forward-line 1)
124: (while (progn (forward-line 1)
125: (not (eolp)))
126: (setq name (read buf) count (read buf) exp (read buf))
127: (skip-chars-backward " \t\n\f")
128: (setq hook (if (not (eolp)) (read buf)))
129: (skip-chars-backward " \t\n\f")
130: (setq abbrevs (cons (list name exp hook count) abbrevs)))
131: (define-abbrev-table table abbrevs)))))
132:
133: (defun read-abbrev-file (file &optional quietly)
134: "Read abbrev definitions from file written with write-abbrev-file.
135: Takes file name as argument.
136: Optional second argument non-nil means don't print anything."
137: (interactive "fRead abbrev file: ")
138: (load (if (and file (> (length file) 0)) file abbrev-file-name)
139: nil quietly)
140: (setq save-abbrevs t abbrevs-changed nil))
141:
142: (defun quietly-read-abbrev-file (file)
143: "Read abbrev definitions from file written with write-abbrev-file.
144: Takes file name as argument. Does not print anything."
145: ;(interactive "fRead abbrev file: ")
146: (read-abbrev-file file t))
147:
148: (defun write-abbrev-file (file)
149: "Write all abbrev definitions to file of Lisp code.
150: The file can be loaded to define the same abbrevs."
151: (interactive "FWrite abbrev file: ")
152: (or (and file (> (length file) 0))
153: (setq file abbrev-file-name))
154: (save-excursion
155: (set-buffer (get-buffer-create " write-abbrev-file"))
156: (erase-buffer)
157: (let ((tables abbrev-table-name-list))
158: (while tables
159: (insert-abbrev-table-description (car tables) nil)
160: (setq tables (cdr tables))))
161: (write-region 1 (point-max) file)
162: (erase-buffer)))
163:
164: (defun add-mode-abbrev (arg)
165: "Define mode-specific abbrev for last word(s) before point.
166: Argument is how many words before point form the expansion;
167: or zero means the region is the expansion.
168: A negative argument means to undefine the specified abbrev.
169: Reads the abbreviation in the minibuffer."
170: (interactive "p")
171: (add-abbrev
172: (if only-global-abbrevs
173: global-abbrev-table
174: (or local-abbrev-table
175: (error "No per-mode abbrev table.")))
176: "Mode" arg))
177:
178: (defun add-global-abbrev (arg)
179: "Define global (all modes) abbrev for last word(s) before point.
180: Argument is how many words before point form the expansion;
181: or zero means the region is the expansion.
182: A negative argument means to undefine the specified abbrev.
183: Reads the abbreviation in the minibuffer."
184: (interactive "p")
185: (add-abbrev global-abbrev-table "Global" arg))
186:
187: (defun add-abbrev (table type arg)
188: (let ((exp (and (>= arg 0)
189: (buffer-substring
190: (point)
191: (if (= arg 0) (mark)
192: (save-excursion (forward-word (- arg)) (point))))))
193: name)
194: (setq name (read-string (format "%s abbrev for \"%s\": "
195: type exp)))
196: (if (or (null exp)
197: (not (abbrev-expansion name table))
198: (y-or-n-p (format "%s expands to \"%s\"; redefine? "
199: name (abbrev-expansion name table))))
200: (define-abbrev table (downcase name) exp))))
201:
202: (defun inverse-add-mode-abbrev (arg)
203: "Define last word before point as a mode-specific abbrev.
204: With argument N, defines the Nth word before point.
205: Reads the expansion in the minibuffer.
206: Expands the abbreviation after defining it."
207: (interactive "p")
208: (inverse-add-abbrev
209: (if only-global-abbrevs
210: global-abbrev-table
211: (or local-abbrev-table
212: (error "No per-mode abbrev table.")))
213: "Mode" arg))
214:
215: (defun inverse-add-global-abbrev (arg)
216: "Define last word before point as a global (mode-independent) abbrev.
217: With argument N, defines the Nth word before point.
218: Reads the expansion in the minibuffer.
219: Expands the abbreviation after defining it."
220: (interactive "p")
221: (inverse-add-abbrev global-abbrev-table "Global" arg))
222:
223: (defun inverse-add-abbrev (table type arg)
224: (let (name nameloc exp)
225: (save-excursion
226: (forward-word (- arg))
227: (setq name (buffer-substring (point) (progn (forward-word 1)
228: (setq nameloc (point))))))
229: (setq exp (read-string (format "%s expansion for \"%s\": "
230: type name)))
231: (if (or (not (abbrev-expansion name table))
232: (y-or-n-p (format "%s expands to \"%s\"; redefine? "
233: name (abbrev-expansion name table))))
234: (progn
235: (define-abbrev table (downcase name) exp)
236: (save-excursion
237: (goto-char nameloc)
238: (expand-abbrev))))))
239:
240: (defun abbrev-prefix-mark (&optional arg)
241: "Mark current point as the beginning of an abbrev.
242: Abbrev to be expanded starts here rather than at
243: beginning of word. This way, you can expand an abbrev
244: with a prefix: insert the prefix, use this command,
245: then insert the abbrev."
246: (interactive "P")
247: (or arg (expand-abbrev))
248: (setq abbrev-start-location (point-marker)
249: abbrev-start-location-buffer (current-buffer))
250: (insert "-"))
251:
252: (defun expand-region-abbrevs (start end &optional noquery)
253: "For abbrev occurrence in the region, offer to expand it.
254: The user is asked to type y or n for each occurrence.
255: A numeric argument means don't query; expand all abbrevs.
256: Calling from a program, arguments are START END &optional NOQUERY."
257: (interactive "r")
258: (save-excursion
259: (goto-char (min start end))
260: (let ((lim (- (point-max) (max start end))))
261: (while (and (not (eobp))
262: (progn (forward-word 1)
263: (<= (point) (- (point-max) lim))))
264: (let ((modp (buffer-modified-p)))
265: (if (expand-abbrev)
266: (progn
267: (set-buffer-modified-p modp)
268: (unexpand-abbrev)
269: (if (or noquery (y-or-n-p "Expand this? "))
270: (expand-abbrev)))))))))
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.