Mercurial > hg > xemacs-beta

comparison lisp/modes/abbrev.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children ac2d302a0011
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;; abbrev.el --- abbrev mode commands for Emacs
2
3 ;; Copyright (C) 1985, 1986, 1992, 1993 Free Software Foundation, Inc.
4 ;; Keywords: internal, abbrev
5
6 ;; This file is part of XEmacs.
7
8 ;; XEmacs is free software; you can redistribute it and/or modify it
9 ;; under the terms of the GNU General Public License as published by
10 ;; the Free Software Foundation; either version 2, or (at your option)
11 ;; any later version.
12
13 ;; XEmacs is distributed in the hope that it will be useful, but
14 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
16 ;; General Public License for more details.
17
18 ;; You should have received a copy of the GNU General Public License
19 ;; along with XEmacs; see the file COPYING. If not, write to the Free
20 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
21
22 ;jwz: this is preloaded so don't ;;;###autoload
23 (defconst only-global-abbrevs nil
24 "*t means user plans to use global abbrevs only.
25 Makes the commands to define mode-specific abbrevs define global ones instead."
26 )
27
28 (defvar abbrev-table-name-list '()
29 "List of symbols whose values are abbrev tables.")
30
31 (defvar abbrevs-changed nil
32 "Set non-nil by defining or altering any word abbrevs.
33 This causes `save-some-buffers' to offer to save the abbrevs.")
34
35 (defun make-abbrev-table ()
36 "Create a new, empty abbrev table object."
37 (make-vector 59 0)) ; 59 is prime
38
39 (defun clear-abbrev-table (table)
40 "Undefine all abbrevs in abbrev table TABLE, leaving it empty."
41 (fillarray table 0)
42 (setq abbrevs-changed t)
43 nil)
44
45
46 (defun define-abbrev-table (name defs)
47 "Define TABNAME (a symbol) as an abbrev table name.
48 Define abbrevs in it according to DEFINITIONS, which is a list of elements
49 of the form (ABBREVNAME EXPANSION HOOK USECOUNT)."
50 (let ((table (and (boundp name) (symbol-value name))))
51 (cond ((vectorp table))
52 ((not table)
53 (setq table (make-abbrev-table))
54 (set name table)
55 (setq abbrev-table-name-list (cons name abbrev-table-name-list)))
56 (t
57 (setq table (signal 'wrong-type-argument (list 'vectorp table)))
58 (set name table)))
59 (while defs
60 (apply (function define-abbrev) table (car defs))
61 (setq defs (cdr defs)))))
62
63 (defun define-abbrev (table name &optional expansion hook count)
64 "Define an abbrev in TABLE named NAME, to expand to EXPANSION or call HOOK.
65 NAME and EXPANSION are strings. Hook is a function or `nil'.
66 To undefine an abbrev, define with the an expansion of `nil'."
67 (or (not expansion)
68 (stringp expansion)
69 (setq expansion (signal 'wrong-type-argument
70 (list 'stringp expansion))))
71 (or (not count)
72 (integerp count)
73 (setq count (signal 'wrong-type-argument
74 (list 'fixnump count))))
75 (let* ((sym (intern name table))
76 (oexp (and (boundp sym) (symbol-value sym)))
77 (ohook (and (fboundp sym) (symbol-function sym))))
78 (if (not (and (equal ohook hook)
79 (stringp oexp)
80 (stringp expansion)
81 (string-equal oexp expansion)))
82 (setq abbrevs-changed t))
83 (set sym expansion)
84 (fset sym hook)
85 (setplist sym (or count 0))
86 name))
87
88
89 ;; Fixup stuff from bootstrap def of define-abbrev-table in subr.el
90 (let ((l abbrev-table-name-list))
91 (while l
92 (let ((fixup (car l)))
93 (if (consp fixup)
94 (progn
95 (setq abbrev-table-name-list (delq fixup abbrev-table-name-list))
96 (define-abbrev-table (car fixup) (cdr fixup))))
97 (setq l (cdr l))))
98 ;; These are no longer initialised by C code
99 (if (not global-abbrev-table)
100 (progn
101 (setq global-abbrev-table (make-abbrev-table))
102 (setq abbrev-table-name-list (cons 'global-abbrev-table
103 abbrev-table-name-list))))
104 (if (not fundamental-mode-abbrev-table)
105 (progn
106 (setq fundamental-mode-abbrev-table (make-abbrev-table))
107 (setq abbrev-table-name-list (cons 'fundamental-mode-abbrev-table
108 abbrev-table-name-list))))
109 (and (eq major-mode 'fundamental-mode)
110 (not local-abbrev-table)
111 (setq local-abbrev-table fundamental-mode-abbrev-table)))
112
113
114 (defun define-global-abbrev (name expansion)
115 "Define ABBREV as a global abbreviation for EXPANSION."
116 (interactive "sDefine global abbrev: \nsExpansion for %s: ")
117 (define-abbrev global-abbrev-table
118 (downcase name) expansion nil 0))
119
120 (defun define-mode-abbrev (name expansion)
121 "Define ABBREV as a mode-specific abbreviation for EXPANSION."
122 (interactive "sDefine mode abbrev: \nsExpansion for %s: ")
123 (define-abbrev (or local-abbrev-table
124 (error "Major mode has no abbrev table"))
125 (downcase name) nil 0))
126
127 (defun abbrev-symbol (abbrev &optional table)
128 "Return the symbol representing abbrev named ABBREV.
129 This symbol's name is ABBREV, but it is not the canonical symbol of that name;
130 it is interned in an abbrev-table rather than the normal obarray.
131 The value is nil if that abbrev is not defined.
132 Optional second arg TABLE is abbrev table to look it up in.
133 The default is to try buffer's mode-specific abbrev table, then global table."
134 (let ((frob (function (lambda (table)
135 (let ((sym (intern-soft abbrev table)))
136 (if (and (boundp sym)
137 (stringp (symbol-value sym)))
138 sym
139 nil))))))
140 (if table
141 (funcall frob table)
142 (or (and local-abbrev-table
143 (funcall frob local-abbrev-table))
144 (funcall frob global-abbrev-table)))))
145
146 (defun abbrev-expansion (abbrev &optional table)
147 "Return the string that ABBREV expands into in the current buffer.
148 Optionally specify an abbrev table as second arg;
149 then ABBREV is looked up in that table only."
150 (let ((sym (abbrev-symbol abbrev table)))
151 (if sym
152 (symbol-value sym)
153 nil)))
154
155 (defun unexpand-abbrev ()
156 "Undo the expansion of the last abbrev that expanded.
157 This differs from ordinary undo in that other editing done since then
158 is not undone."
159 (interactive)
160 (if (or (< last-abbrev-location (point-min))
161 (> last-abbrev-location (point-max))
162 (not (stringp last-abbrev-text)))
163 nil
164 (let* ((opoint (point))
165 (val (symbol-value last-abbrev))
166 (adjust (length val)))
167 ;; This isn't correct if (symbol-function last-abbrev-text)
168 ;; was used to do the expansion
169 (goto-char last-abbrev-location)
170 (delete-region last-abbrev-location (+ last-abbrev-location adjust))
171 (insert last-abbrev-text)
172 (setq adjust (- adjust (length last-abbrev-text)))
173 (setq last-abbrev-text nil)
174 (if (< last-abbrev-location opoint)
175 (goto-char (- opoint adjust))
176 (goto-char opoint)))))
177
178
179
180 (defun insert-abbrev-table-description (name human-readable)
181 "Insert before point a full description of abbrev table named NAME.
182 NAME is a symbol whose value is an abbrev table.
183 If optional 2nd arg HUMAN is non-nil, insert a human-readable description.
184 Otherwise the description is an expression,
185 a call to `define-abbrev-table', which would
186 define the abbrev table NAME exactly as it is currently defined."
187 (let ((table (symbol-value name))
188 (stream (current-buffer)))
189 (message "Abbrev-table %s..." name)
190 (if human-readable
191 (progn
192 (prin1 (list name) stream)
193 ;; Need two terpri's or cretinous edit-abbrevs blows out
194 (terpri stream)
195 (terpri stream)
196 (mapatoms (function (lambda (sym)
197 (if (symbol-value sym)
198 (let* ((n (prin1-to-string (symbol-name sym)))
199 (pos (length n)))
200 (princ n stream)
201 (while (< pos 14)
202 (write-char ?\ stream)
203 (setq pos (1+ pos)))
204 (princ (format " %-5S " (symbol-plist sym))
205 stream)
206 (if (not (symbol-function sym))
207 (prin1 (symbol-value sym) stream)
208 (progn
209 (setq n (prin1-to-string (symbol-value sym))
210 pos (+ pos 6 (length n)))
211 (princ n stream)
212 (while (< pos 45)
213 (write-char ?\ stream)
214 (setq pos (1+ pos)))
215 (prin1 (symbol-function sym) stream)))
216 (terpri stream)))))
217 table)
218 (terpri stream))
219 (progn
220 (princ "\(define-abbrev-table '" stream)
221 (prin1 name stream)
222 (princ " '\(\n" stream)
223 (mapatoms (function (lambda (sym)
224 (if (symbol-value sym)
225 (progn
226 (princ " " stream)
227 (prin1 (list (symbol-name sym)
228 (symbol-value sym)
229 (symbol-function sym)
230 (symbol-plist sym))
231 stream)
232 (terpri stream)))))
233 table)
234 (princ " \)\)\n" stream)))
235 (terpri stream))
236 (message ""))
237
238
239 (defun abbrev-mode (arg)
240 "Toggle abbrev mode.
241 With arg, turn abbrev mode on iff arg is positive.
242 In abbrev mode, inserting an abbreviation causes it to expand
243 and be replaced by its expansion."
244 (interactive "P")
245 (setq abbrev-mode
246 (if (null arg) (not abbrev-mode)
247 (> (prefix-numeric-value arg) 0)))
248 (redraw-modeline))
249
250
251 (defvar edit-abbrevs-map nil
252 "Keymap used in edit-abbrevs.")
253 (if edit-abbrevs-map
254 nil
255 (setq edit-abbrevs-map (make-sparse-keymap))
256 (set-keymap-name edit-abbrevs-map 'edit-abbrevs-map)
257 (define-key edit-abbrevs-map "\C-x\C-s" 'edit-abbrevs-redefine)
258 (define-key edit-abbrevs-map "\C-c\C-c" 'edit-abbrevs-redefine))
259
260 (defun kill-all-abbrevs ()
261 "Undefine all defined abbrevs."
262 (interactive)
263 (let ((tables abbrev-table-name-list))
264 (while tables
265 (clear-abbrev-table (symbol-value (car tables)))
266 (setq tables (cdr tables)))))
267
268 (defun insert-abbrevs ()
269 "Insert after point a description of all defined abbrevs.
270 Mark is set after the inserted text."
271 (interactive)
272 (push-mark
273 (save-excursion
274 (let ((tables abbrev-table-name-list))
275 (while tables
276 (insert-abbrev-table-description (car tables) t)
277 (setq tables (cdr tables))))
278 (point))))
279
280 (defun list-abbrevs ()
281 "Display a list of all defined abbrevs."
282 (interactive)
283 (display-buffer (prepare-abbrev-list-buffer)))
284
285 (defun prepare-abbrev-list-buffer ()
286 (save-excursion
287 (set-buffer (get-buffer-create "*Abbrevs*"))
288 (erase-buffer)
289 (let ((tables abbrev-table-name-list))
290 (while tables
291 (insert-abbrev-table-description (car tables) t)
292 (setq tables (cdr tables))))
293 (goto-char (point-min))
294 (set-buffer-modified-p nil)
295 (edit-abbrevs-mode))
296 (get-buffer-create "*Abbrevs*"))
297
298 (defun edit-abbrevs-mode ()
299 "Major mode for editing the list of abbrev definitions.
300 \\{edit-abbrevs-map}"
301 (interactive)
302 (setq major-mode 'edit-abbrevs-mode)
303 (setq mode-name "Edit-Abbrevs")
304 (use-local-map edit-abbrevs-map))
305
306 (defun edit-abbrevs ()
307 "Alter abbrev definitions by editing a list of them.
308 Selects a buffer containing a list of abbrev definitions.
309 You can edit them and type C-c C-c to redefine abbrevs
310 according to your editing.
311 Buffer contains a header line for each abbrev table,
312 which is the abbrev table name in parentheses.
313 This is followed by one line per abbrev in that table:
314 NAME USECOUNT EXPANSION HOOK
315 where NAME and EXPANSION are strings with quotes,
316 USECOUNT is an integer, and HOOK is any valid function
317 or may be omitted (it is usually omitted)."
318 (interactive)
319 (switch-to-buffer (prepare-abbrev-list-buffer)))
320
321 (defun edit-abbrevs-redefine ()
322 "Redefine abbrevs according to current buffer contents."
323 (interactive)
324 (define-abbrevs t)
325 (set-buffer-modified-p nil))
326
327 (defun define-abbrevs (&optional arg)
328 "Define abbrevs according to current visible buffer contents.
329 See documentation of edit-abbrevs for info on the format of the
330 text you must have in the buffer.
331 With argument, eliminate all abbrev definitions except
332 the ones defined from the buffer now."
333 (interactive "P")
334 (if arg (kill-all-abbrevs))
335 (save-excursion
336 (goto-char (point-min))
337 (while (and (not (eobp)) (re-search-forward "^(" nil t))
338 (let* ((buf (current-buffer))
339 (table (read buf))
340 (abbrevs '()))
341 (forward-line 1)
342 (while (progn (forward-line 1)
343 (not (eolp)))
344 (let* ((name (read buf))
345 (count (read buf))
346 (exp (read buf))
347 hook)
348 (skip-chars-backward " \t\n\f")
349 (setq hook (if (not (eolp)) (read buf)))
350 (skip-chars-backward " \t\n\f")
351 (setq abbrevs (cons (list name exp hook count) abbrevs))))
352 (define-abbrev-table table abbrevs)))))
353
354 (defun read-abbrev-file (&optional file quietly)
355 "Read abbrev definitions from file written with write-abbrev-file.
356 Takes file name as argument.
357 Optional second argument non-nil means don't print anything."
358 (interactive "fRead abbrev file: ")
359 (load (if (and file (> (length file) 0)) file abbrev-file-name)
360 nil quietly)
361 (setq save-abbrevs t abbrevs-changed nil))
362
363 (defun quietly-read-abbrev-file (&optional file)
364 "Read abbrev definitions from file written with write-abbrev-file.
365 Takes file name as argument. Does not print anything."
366 ;(interactive "fRead abbrev file: ")
367 (read-abbrev-file file t))
368
369 (defun write-abbrev-file (file)
370 "Write all abbrev definitions to file of Lisp code.
371 The file can be loaded to define the same abbrevs."
372 (interactive
373 (list
374 (read-file-name "Write abbrev file: "
375 (file-name-directory (expand-file-name abbrev-file-name))
376 abbrev-file-name)))
377 (or (and file (> (length file) 0))
378 (setq file abbrev-file-name))
379 (save-excursion
380 (set-buffer (get-buffer-create " write-abbrev-file"))
381 (erase-buffer)
382 (let ((tables abbrev-table-name-list))
383 (while tables
384 (insert-abbrev-table-description (car tables) nil)
385 (setq tables (cdr tables))))
386 (write-region 1 (point-max) file)
387 (erase-buffer)))
388
389 (defun add-mode-abbrev (arg)
390 "Define mode-specific abbrev for region or last word(s) before point.
391 Argument is how many words before point form the expansion;
392 or zero means the region is the expansion.
393 A negative argument means to undefine the specified abbrev.
394 Reads the abbreviation in the minibuffer.
395
396 Don't use this function in a Lisp program; use define-abbrev instead."
397 ;; XEmacs change:
398 (interactive "P")
399 (add-abbrev (if only-global-abbrevs
400 global-abbrev-table
401 (or local-abbrev-table
402 (error "No per-mode abbrev table.")))
403 "Mode"
404 arg))
405
406 (defun add-global-abbrev (arg)
407 "Define global (all modes) abbrev for region or last word(s) before point.
408 Argument is how many words before point form the expansion;
409 or zero means the region is the expansion.
410 A negative argument means to undefine the specified abbrev.
411 Reads the abbreviation in the minibuffer.
412
413 Don't use this function in a Lisp program; use define-abbrev instead."
414 ;; XEmacs change:
415 (interactive "P")
416 (add-abbrev global-abbrev-table "Global" arg))
417
418 (defun add-abbrev (table type arg)
419 ;; XEmacs change:
420 (if (and (not arg) (region-active-p)) (setq arg 0)
421 (setq arg (prefix-numeric-value arg)))
422 (let ((exp (and (>= arg 0)
423 (buffer-substring
424 (point)
425 (if (= arg 0) (mark)
426 (save-excursion (forward-word (- arg)) (point))))))
427 name)
428 (setq name
429 (read-string (format (if exp "%s abbrev for \"%s\": "
430 "Undefine %s abbrev: ")
431 type exp)))
432 (if (or (null exp)
433 (not (abbrev-expansion name table))
434 (y-or-n-p (format "%s expands to \"%s\"; redefine? "
435 name (abbrev-expansion name table))))
436 (define-abbrev table (downcase name) exp))))
437
438 (defun inverse-add-mode-abbrev (arg)
439 "Define last word before point as a mode-specific abbrev.
440 With argument N, defines the Nth word before point.
441 Reads the expansion in the minibuffer.
442 Expands the abbreviation after defining it."
443 (interactive "p")
444 (inverse-add-abbrev (if only-global-abbrevs
445 global-abbrev-table
446 (or local-abbrev-table
447 (error "No per-mode abbrev table.")))
448 "Mode"
449 arg))
450
451 (defun inverse-add-global-abbrev (arg)
452 "Define last word before point as a global (mode-independent) abbrev.
453 With argument N, defines the Nth word before point.
454 Reads the expansion in the minibuffer.
455 Expands the abbreviation after defining it."
456 (interactive "p")
457 (inverse-add-abbrev global-abbrev-table "Global" arg))
458
459 (defun inverse-add-abbrev (table type arg)
460 (let (name nameloc exp)
461 (save-excursion
462 (forward-word (- arg))
463 (setq name (buffer-substring (point) (progn (forward-word 1)
464 (setq nameloc (point))))))
465 (setq exp (read-string (format "%s expansion for \"%s\": "
466 type name)))
467 (if (or (not (abbrev-expansion name table))
468 (y-or-n-p (format "%s expands to \"%s\"; redefine? "
469 name (abbrev-expansion name table))))
470 (progn
471 (define-abbrev table (downcase name) exp)
472 (save-excursion
473 (goto-char nameloc)
474 (expand-abbrev))))))
475
476 (defun abbrev-prefix-mark (&optional arg)
477 "Mark current point as the beginning of an abbrev.
478 Abbrev to be expanded starts here rather than at
479 beginning of word. This way, you can expand an abbrev
480 with a prefix: insert the prefix, use this command,
481 then insert the abbrev."
482 (interactive "P")
483 (or arg (expand-abbrev))
484 (setq abbrev-start-location (point-marker)
485 abbrev-start-location-buffer (current-buffer))
486 (insert "-"))
487
488 (defun expand-region-abbrevs (start end &optional noquery)
489 "For abbrev occurrence in the region, offer to expand it.
490 The user is asked to type y or n for each occurrence.
491 A numeric argument means don't query; expand all abbrevs.
492 Calling from a program, arguments are START END &optional NOQUERY."
493 (interactive "r\nP")
494 (save-excursion
495 (goto-char start)
496 (let ((lim (- (point-max) end))
497 pnt string)
498 (while (and (not (eobp))
499 (progn (forward-word 1)
500 (<= (setq pnt (point)) (- (point-max) lim))))
501 (if (abbrev-expansion
502 (setq string
503 (buffer-substring
504 (save-excursion (forward-word -1) (point))
505 pnt)))
506 (if (or noquery (y-or-n-p (format "Expand `%s'? " string)))
507 (expand-abbrev)))))))