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