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