Line data Source code
1 : ;;; abbrev.el --- abbrev mode commands for Emacs -*- lexical-binding: t -*-
2 :
3 : ;; Copyright (C) 1985-1987, 1992, 2001-2017 Free Software Foundation,
4 : ;; Inc.
5 :
6 : ;; Maintainer: emacs-devel@gnu.org
7 : ;; Keywords: abbrev convenience
8 : ;; Package: emacs
9 :
10 : ;; This file is part of GNU Emacs.
11 :
12 : ;; GNU Emacs is free software: you can redistribute it and/or modify
13 : ;; it under the terms of the GNU General Public License as published by
14 : ;; the Free Software Foundation, either version 3 of the License, or
15 : ;; (at your option) any later version.
16 :
17 : ;; GNU Emacs is distributed in the hope that it will be useful,
18 : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 : ;; GNU General Public License for more details.
21 :
22 : ;; You should have received a copy of the GNU General Public License
23 : ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
24 :
25 : ;;; Commentary:
26 :
27 : ;; This facility is documented in the Emacs Manual.
28 :
29 : ;; Todo:
30 :
31 : ;; - Cleanup name space.
32 :
33 : ;;; Code:
34 :
35 : (eval-when-compile (require 'cl-lib))
36 : (require 'obarray)
37 :
38 : (defgroup abbrev-mode nil
39 : "Word abbreviations mode."
40 : :link '(custom-manual "(emacs)Abbrevs")
41 : :group 'abbrev)
42 :
43 : (defcustom abbrev-file-name
44 : (locate-user-emacs-file "abbrev_defs" ".abbrev_defs")
45 : "Default name of file from which to read abbrevs."
46 : :initialize 'custom-initialize-delay
47 : :type 'file)
48 :
49 : (defcustom only-global-abbrevs nil
50 : "Non-nil means user plans to use global abbrevs only.
51 : This makes the commands that normally define mode-specific abbrevs
52 : define global abbrevs instead."
53 : :type 'boolean
54 : :group 'abbrev-mode
55 : :group 'convenience)
56 :
57 : (define-minor-mode abbrev-mode
58 : "Toggle Abbrev mode in the current buffer.
59 : With a prefix argument ARG, enable Abbrev mode if ARG is
60 : positive, and disable it otherwise. If called from Lisp, enable
61 : Abbrev mode if ARG is omitted or nil.
62 :
63 : In Abbrev mode, inserting an abbreviation causes it to expand and
64 : be replaced by its expansion."
65 : ;; It's defined in C, this stops the d-m-m macro defining it again.
66 : :variable abbrev-mode)
67 :
68 : (put 'abbrev-mode 'safe-local-variable 'booleanp)
69 :
70 :
71 : (defvar edit-abbrevs-mode-map
72 : (let ((map (make-sparse-keymap)))
73 : (define-key map "\C-x\C-s" 'abbrev-edit-save-buffer)
74 : (define-key map "\C-x\C-w" 'abbrev-edit-save-to-file)
75 : (define-key map "\C-c\C-c" 'edit-abbrevs-redefine)
76 : map)
77 : "Keymap used in `edit-abbrevs'.")
78 : (define-obsolete-variable-alias 'edit-abbrevs-map
79 : 'edit-abbrevs-mode-map "24.4")
80 :
81 : (defun kill-all-abbrevs ()
82 : "Undefine all defined abbrevs."
83 : (interactive)
84 0 : (dolist (tablesym abbrev-table-name-list)
85 0 : (clear-abbrev-table (symbol-value tablesym))))
86 :
87 : (defun copy-abbrev-table (table)
88 : "Make a new abbrev-table with the same abbrevs as TABLE.
89 : Does not copy property lists."
90 0 : (let ((new-table (make-abbrev-table)))
91 0 : (obarray-map
92 : (lambda (symbol)
93 0 : (define-abbrev new-table
94 0 : (symbol-name symbol)
95 0 : (symbol-value symbol)
96 0 : (symbol-function symbol)))
97 0 : table)
98 0 : new-table))
99 :
100 : (defun insert-abbrevs ()
101 : "Insert after point a description of all defined abbrevs.
102 : Mark is set after the inserted text."
103 : (interactive)
104 0 : (push-mark
105 0 : (save-excursion
106 0 : (dolist (tablesym abbrev-table-name-list)
107 0 : (insert-abbrev-table-description tablesym t))
108 0 : (point))))
109 :
110 : (defun list-abbrevs (&optional local)
111 : "Display a list of defined abbrevs.
112 : If LOCAL is non-nil, interactively when invoked with a
113 : prefix arg, display only local, i.e. mode-specific, abbrevs.
114 : Otherwise display all abbrevs."
115 : (interactive "P")
116 0 : (display-buffer (prepare-abbrev-list-buffer local)))
117 :
118 : (defun abbrev-table-name (table)
119 : "Value is the name of abbrev table TABLE."
120 0 : (let ((tables abbrev-table-name-list)
121 : found)
122 0 : (while (and (not found) tables)
123 0 : (when (eq (symbol-value (car tables)) table)
124 0 : (setq found (car tables)))
125 0 : (setq tables (cdr tables)))
126 0 : found))
127 :
128 : (defun prepare-abbrev-list-buffer (&optional local)
129 0 : (let ((local-table local-abbrev-table))
130 0 : (with-current-buffer (get-buffer-create "*Abbrevs*")
131 0 : (erase-buffer)
132 0 : (if local
133 0 : (insert-abbrev-table-description
134 0 : (abbrev-table-name local-table) t)
135 0 : (let (empty-tables)
136 0 : (dolist (table abbrev-table-name-list)
137 0 : (if (abbrev-table-empty-p (symbol-value table))
138 0 : (push table empty-tables)
139 0 : (insert-abbrev-table-description table t)))
140 0 : (dolist (table (nreverse empty-tables))
141 0 : (insert-abbrev-table-description table t)))
142 : ;; Note: `list-abbrevs' can display only local abbrevs, in
143 : ;; which case editing could lose abbrevs of other tables. Thus
144 : ;; enter `edit-abbrevs-mode' only if LOCAL is nil.
145 0 : (edit-abbrevs-mode))
146 0 : (goto-char (point-min))
147 0 : (set-buffer-modified-p nil)
148 0 : (current-buffer))))
149 :
150 : (defun edit-abbrevs ()
151 : "Alter abbrev definitions by editing a list of them.
152 : Selects a buffer containing a list of abbrev definitions with
153 : point located in the abbrev table of current buffer.
154 : You can edit them and type \\<edit-abbrevs-map>\\[edit-abbrevs-redefine] to redefine abbrevs
155 : according to your editing.
156 : Buffer contains a header line for each abbrev table,
157 : which is the abbrev table name in parentheses.
158 : This is followed by one line per abbrev in that table:
159 : NAME USECOUNT EXPANSION HOOK
160 : where NAME and EXPANSION are strings with quotes,
161 : USECOUNT is an integer, and HOOK is any valid function
162 : or may be omitted (it is usually omitted)."
163 : (interactive)
164 0 : (let ((table-name (abbrev-table-name local-abbrev-table)))
165 0 : (switch-to-buffer (prepare-abbrev-list-buffer))
166 0 : (when (and table-name
167 0 : (search-forward
168 0 : (concat "(" (symbol-name table-name) ")\n\n") nil t))
169 0 : (goto-char (match-end 0)))))
170 :
171 : (defun edit-abbrevs-redefine ()
172 : "Redefine abbrevs according to current buffer contents."
173 : (interactive)
174 0 : (save-restriction
175 0 : (widen)
176 0 : (define-abbrevs t)
177 0 : (set-buffer-modified-p nil)))
178 :
179 : (defun define-abbrevs (&optional arg)
180 : "Define abbrevs according to current visible buffer contents.
181 : See documentation of `edit-abbrevs' for info on the format of the
182 : text you must have in the buffer.
183 : With argument, eliminate all abbrev definitions except
184 : the ones defined from the buffer now."
185 : (interactive "P")
186 0 : (if arg (kill-all-abbrevs))
187 0 : (save-excursion
188 0 : (goto-char (point-min))
189 0 : (while (and (not (eobp)) (re-search-forward "^(" nil t))
190 0 : (let* ((buf (current-buffer))
191 0 : (table (read buf))
192 : abbrevs name hook exp count sys)
193 0 : (forward-line 1)
194 0 : (while (progn (forward-line 1)
195 0 : (not (eolp)))
196 0 : (setq name (read buf) count (read buf))
197 0 : (if (equal count '(sys))
198 0 : (setq sys t count (read buf))
199 0 : (setq sys nil))
200 0 : (setq exp (read buf))
201 0 : (skip-chars-backward " \t\n\f")
202 0 : (setq hook (if (not (eolp)) (read buf)))
203 0 : (skip-chars-backward " \t\n\f")
204 0 : (setq abbrevs (cons (list name exp hook count sys) abbrevs)))
205 0 : (define-abbrev-table table abbrevs)))))
206 :
207 : (defun read-abbrev-file (&optional file quietly)
208 : "Read abbrev definitions from file written with `write-abbrev-file'.
209 : Optional argument FILE is the name of the file to read;
210 : it defaults to the value of `abbrev-file-name'.
211 : Optional second argument QUIETLY non-nil means don't display a message."
212 : (interactive
213 0 : (list
214 0 : (read-file-name (format "Read abbrev file (default %s): "
215 0 : abbrev-file-name)
216 0 : nil abbrev-file-name t)))
217 0 : (load (or file abbrev-file-name) nil quietly)
218 0 : (setq abbrevs-changed nil))
219 :
220 : (defun quietly-read-abbrev-file (&optional file)
221 : "Read abbrev definitions from file written with `write-abbrev-file'.
222 : Optional argument FILE is the name of the file to read;
223 : it defaults to the value of `abbrev-file-name'.
224 : Does not display any message."
225 : ;(interactive "fRead abbrev file: ")
226 0 : (read-abbrev-file file t))
227 :
228 : (defun write-abbrev-file (&optional file verbose)
229 : "Write all user-level abbrev definitions to a file of Lisp code.
230 : This does not include system abbrevs; it includes only the abbrev tables
231 : listed in listed in `abbrev-table-name-list'.
232 : The file written can be loaded in another session to define the same abbrevs.
233 : The argument FILE is the file name to write. If omitted or nil, the file
234 : specified in `abbrev-file-name' is used.
235 : If VERBOSE is non-nil, display a message indicating where abbrevs
236 : have been saved."
237 : (interactive
238 0 : (list
239 0 : (read-file-name "Write abbrev file: "
240 0 : (file-name-directory (expand-file-name abbrev-file-name))
241 0 : abbrev-file-name)))
242 0 : (or (and file (> (length file) 0))
243 0 : (setq file abbrev-file-name))
244 0 : (let ((coding-system-for-write 'utf-8))
245 0 : (with-temp-buffer
246 0 : (dolist (table
247 : ;; We sort the table in order to ease the automatic
248 : ;; merging of different versions of the user's abbrevs
249 : ;; file. This is useful, for example, for when the
250 : ;; user keeps their home directory in a revision
251 : ;; control system, and is therefore keeping multiple
252 : ;; slightly-differing copies loosely synchronized.
253 0 : (sort (copy-sequence abbrev-table-name-list)
254 : (lambda (s1 s2)
255 0 : (string< (symbol-name s1)
256 0 : (symbol-name s2)))))
257 0 : (insert-abbrev-table-description table nil))
258 0 : (when (unencodable-char-position (point-min) (point-max) 'utf-8)
259 0 : (setq coding-system-for-write
260 0 : (if (> emacs-major-version 24)
261 : 'utf-8-emacs
262 : ;; For compatibility with Emacs 22 (See Bug#8308)
263 0 : 'emacs-mule)))
264 0 : (goto-char (point-min))
265 0 : (insert (format ";;-*-coding: %s;-*-\n" coding-system-for-write))
266 0 : (write-region nil nil file nil (and (not verbose) 0)))))
267 :
268 : (defun abbrev-edit-save-to-file (file)
269 : "Save all user-level abbrev definitions in current buffer to FILE."
270 : (interactive
271 0 : (list (read-file-name "Save abbrevs to file: "
272 0 : (file-name-directory
273 0 : (expand-file-name abbrev-file-name))
274 0 : abbrev-file-name)))
275 0 : (edit-abbrevs-redefine)
276 0 : (write-abbrev-file file t))
277 :
278 : (defun abbrev-edit-save-buffer ()
279 : "Save all user-level abbrev definitions in current buffer.
280 : The saved abbrevs are written to the file specified by
281 : `abbrev-file-name'."
282 : (interactive)
283 0 : (abbrev-edit-save-to-file abbrev-file-name))
284 :
285 :
286 : (defun add-mode-abbrev (arg)
287 : "Define mode-specific abbrev for last word(s) before point.
288 : Argument is how many words before point form the expansion;
289 : or zero means the region is the expansion.
290 : A negative argument means to undefine the specified abbrev.
291 : Reads the abbreviation in the minibuffer.
292 :
293 : Don't use this function in a Lisp program; use `define-abbrev' instead."
294 : (interactive "p")
295 0 : (add-abbrev
296 0 : (if only-global-abbrevs
297 0 : global-abbrev-table
298 0 : (or local-abbrev-table
299 0 : (error "No per-mode abbrev table")))
300 0 : "Mode" arg))
301 :
302 : (defun add-global-abbrev (arg)
303 : "Define global (all modes) abbrev for last word(s) before point.
304 : The prefix argument specifies the number of words before point that form the
305 : expansion; or zero means the region is the expansion.
306 : A negative argument means to undefine the specified abbrev.
307 : This command uses the minibuffer to read the abbreviation.
308 :
309 : Don't use this function in a Lisp program; use `define-abbrev' instead."
310 : (interactive "p")
311 0 : (add-abbrev global-abbrev-table "Global" arg))
312 :
313 : (defun add-abbrev (table type arg)
314 0 : (let ((exp (and (>= arg 0)
315 0 : (buffer-substring-no-properties
316 0 : (point)
317 0 : (if (= arg 0) (mark)
318 0 : (save-excursion (forward-word (- arg)) (point))))))
319 : name)
320 0 : (setq name
321 0 : (read-string (format (if exp "%s abbrev for \"%s\": "
322 0 : "Undefine %s abbrev: ")
323 0 : type exp)))
324 0 : (set-text-properties 0 (length name) nil name)
325 0 : (if (or (null exp)
326 0 : (not (abbrev-expansion name table))
327 0 : (y-or-n-p (format "%s expands to \"%s\"; redefine? "
328 0 : name (abbrev-expansion name table))))
329 0 : (define-abbrev table (downcase name) exp))))
330 :
331 : (defun inverse-add-mode-abbrev (n)
332 : "Define last word before point as a mode-specific abbrev.
333 : With prefix argument N, defines the Nth word before point.
334 : This command uses the minibuffer to read the expansion.
335 : Expands the abbreviation after defining it."
336 : (interactive "p")
337 0 : (inverse-add-abbrev
338 0 : (if only-global-abbrevs
339 0 : global-abbrev-table
340 0 : (or local-abbrev-table
341 0 : (error "No per-mode abbrev table")))
342 0 : "Mode" n))
343 :
344 : (defun inverse-add-global-abbrev (n)
345 : "Define last word before point as a global (mode-independent) abbrev.
346 : With prefix argument N, defines the Nth word before point.
347 : This command uses the minibuffer to read the expansion.
348 : Expands the abbreviation after defining it."
349 : (interactive "p")
350 0 : (inverse-add-abbrev global-abbrev-table "Global" n))
351 :
352 : (defun inverse-add-abbrev (table type arg)
353 0 : (let (name exp start end)
354 0 : (save-excursion
355 0 : (forward-word (1+ (- arg)))
356 0 : (setq end (point))
357 0 : (backward-word 1)
358 0 : (setq start (point)
359 0 : name (buffer-substring-no-properties start end)))
360 :
361 0 : (setq exp (read-string (format "%s expansion for \"%s\": " type name)
362 0 : nil nil nil t))
363 0 : (when (or (not (abbrev-expansion name table))
364 0 : (y-or-n-p (format "%s expands to \"%s\"; redefine? "
365 0 : name (abbrev-expansion name table))))
366 0 : (define-abbrev table (downcase name) exp)
367 0 : (save-excursion
368 0 : (goto-char end)
369 0 : (expand-abbrev)))))
370 :
371 : (defun abbrev-prefix-mark (&optional arg)
372 : "Mark current point as the beginning of an abbrev.
373 : Abbrev to be expanded starts here rather than at beginning of word.
374 : This way, you can expand an abbrev with a prefix: insert the prefix,
375 : use this command, then insert the abbrev. This command inserts a
376 : temporary hyphen after the prefix (until the intended abbrev
377 : expansion occurs).
378 : If the prefix is itself an abbrev, this command expands it, unless
379 : ARG is non-nil. Interactively, ARG is the prefix argument."
380 : (interactive "P")
381 0 : (or arg (expand-abbrev))
382 0 : (setq abbrev-start-location (point-marker)
383 0 : abbrev-start-location-buffer (current-buffer))
384 0 : (insert "-"))
385 :
386 : (defun expand-region-abbrevs (start end &optional noquery)
387 : "For abbrev occurrence in the region, offer to expand it.
388 : The user is asked to type `y' or `n' for each occurrence.
389 : A prefix argument means don't query; expand all abbrevs."
390 : (interactive "r\nP")
391 0 : (save-excursion
392 0 : (goto-char start)
393 0 : (let ((lim (- (point-max) end))
394 : pnt string)
395 0 : (while (and (not (eobp))
396 0 : (progn (forward-word 1)
397 0 : (<= (setq pnt (point)) (- (point-max) lim))))
398 0 : (if (abbrev-expansion
399 0 : (setq string
400 0 : (buffer-substring-no-properties
401 0 : (save-excursion (forward-word -1) (point))
402 0 : pnt)))
403 0 : (if (or noquery (y-or-n-p (format-message "Expand `%s'? " string)))
404 0 : (expand-abbrev)))))))
405 :
406 : ;;; Abbrev properties.
407 :
408 : (defun abbrev-table-get (table prop)
409 : "Get the PROP property of abbrev table TABLE."
410 150 : (let ((sym (obarray-get table "")))
411 150 : (if sym (get sym prop))))
412 :
413 : (defun abbrev-table-put (table prop val)
414 : "Set the PROP property of abbrev table TABLE to VAL."
415 8 : (let ((sym (obarray-put table "")))
416 8 : (set sym nil) ; Make sure it won't be confused for an abbrev.
417 8 : (put sym prop val)))
418 :
419 : (defalias 'abbrev-get 'get
420 : "Get the property PROP of abbrev ABBREV
421 :
422 : \(fn ABBREV PROP)")
423 :
424 : (defalias 'abbrev-put 'put
425 : "Set the property PROP of abbrev ABBREV to value VAL.
426 : See `define-abbrev' for the effect of some special properties.
427 :
428 : \(fn ABBREV PROP VAL)")
429 :
430 : ;;; Code that used to be implemented in src/abbrev.c
431 :
432 : (defvar abbrev-table-name-list '(fundamental-mode-abbrev-table
433 : global-abbrev-table)
434 : "List of symbols whose values are abbrev tables.")
435 :
436 : (defun make-abbrev-table (&optional props)
437 : "Create a new, empty abbrev table object.
438 : PROPS is a list of properties."
439 7 : (let ((table (obarray-make)))
440 : ;; Each abbrev-table has a `modiff' counter which can be used to detect
441 : ;; when an abbreviation was added. An example of use would be to
442 : ;; construct :regexp dynamically as the union of all abbrev names, so
443 : ;; `modiff' can let us detect that an abbrev was added and hence :regexp
444 : ;; needs to be refreshed.
445 : ;; The presence of `modiff' entry is also used as a tag indicating this
446 : ;; vector is really an abbrev-table.
447 7 : (abbrev-table-put table :abbrev-table-modiff 0)
448 7 : (while (consp props)
449 7 : (abbrev-table-put table (pop props) (pop props)))
450 7 : table))
451 :
452 : (defun abbrev-table-p (object)
453 : "Return non-nil if OBJECT is an abbrev table."
454 0 : (and (obarrayp object)
455 0 : (numberp (abbrev-table-get object :abbrev-table-modiff))))
456 :
457 : (defun abbrev-table-empty-p (object &optional ignore-system)
458 : "Return nil if there are no abbrev symbols in OBJECT.
459 : If IGNORE-SYSTEM is non-nil, system definitions are ignored."
460 0 : (unless (abbrev-table-p object)
461 0 : (error "Non abbrev table object"))
462 0 : (not (catch 'some
463 0 : (obarray-map (lambda (abbrev)
464 0 : (unless (or (zerop (length (symbol-name abbrev)))
465 0 : (and ignore-system
466 0 : (abbrev-get abbrev :system)))
467 0 : (throw 'some t)))
468 0 : object))))
469 :
470 : (defvar global-abbrev-table (make-abbrev-table)
471 : "The abbrev table whose abbrevs affect all buffers.
472 : Each buffer may also have a local abbrev table.
473 : If it does, the local table overrides the global one
474 : for any particular abbrev defined in both.")
475 :
476 : (defvar abbrev-minor-mode-table-alist nil
477 : "Alist of abbrev tables to use for minor modes.
478 : Each element looks like (VARIABLE . ABBREV-TABLE);
479 : ABBREV-TABLE is active whenever VARIABLE's value is non-nil.
480 : ABBREV-TABLE can also be a list of abbrev tables.")
481 :
482 : (defvar fundamental-mode-abbrev-table
483 : (let ((table (make-abbrev-table)))
484 : ;; Set local-abbrev-table's default to be fundamental-mode-abbrev-table.
485 : (setq-default local-abbrev-table table)
486 : table)
487 : "The abbrev table of mode-specific abbrevs for Fundamental Mode.")
488 :
489 : (defvar abbrevs-changed nil
490 : "Set non-nil by defining or altering any word abbrevs.
491 : This causes `save-some-buffers' to offer to save the abbrevs.")
492 :
493 : (defcustom abbrev-all-caps nil
494 : "Non-nil means expand multi-word abbrevs all caps if abbrev was so."
495 : :type 'boolean
496 : :group 'abbrev-mode)
497 :
498 : (defvar abbrev-start-location nil
499 : "Buffer position for `expand-abbrev' to use as the start of the abbrev.
500 : When nil, use the word before point as the abbrev.
501 : Calling `expand-abbrev' sets this to nil.")
502 :
503 : (defvar abbrev-start-location-buffer nil
504 : "Buffer that `abbrev-start-location' has been set for.
505 : Trying to expand an abbrev in any other buffer clears `abbrev-start-location'.")
506 :
507 : (defvar last-abbrev nil
508 : "The abbrev-symbol of the last abbrev expanded. See `abbrev-symbol'.")
509 :
510 : (defvar last-abbrev-text nil
511 : "The exact text of the last abbrev expanded.
512 : It is nil if the abbrev has already been unexpanded.")
513 :
514 : (defvar last-abbrev-location 0
515 : "The location of the start of the last abbrev expanded.")
516 :
517 : ;; (defvar local-abbrev-table fundamental-mode-abbrev-table
518 : ;; "Local (mode-specific) abbrev table of current buffer.")
519 : ;; (make-variable-buffer-local 'local-abbrev-table)
520 :
521 : (defcustom pre-abbrev-expand-hook nil
522 : "Function or functions to be called before abbrev expansion is done.
523 : This is the first thing that `expand-abbrev' does, and so this may change
524 : the current abbrev table before abbrev lookup happens."
525 : :type 'hook
526 : :group 'abbrev-mode)
527 : (make-obsolete-variable 'pre-abbrev-expand-hook 'abbrev-expand-function "23.1")
528 :
529 : (defun clear-abbrev-table (table)
530 : "Undefine all abbrevs in abbrev table TABLE, leaving it empty."
531 0 : (setq abbrevs-changed t)
532 0 : (let* ((sym (obarray-get table "")))
533 0 : (dotimes (i (length table))
534 0 : (aset table i 0))
535 : ;; Preserve the table's properties.
536 0 : (cl-assert sym)
537 0 : (let ((newsym (obarray-put table "")))
538 0 : (set newsym nil) ; Make sure it won't be confused for an abbrev.
539 0 : (setplist newsym (symbol-plist sym)))
540 0 : (abbrev-table-put table :abbrev-table-modiff
541 0 : (1+ (abbrev-table-get table :abbrev-table-modiff))))
542 : ;; For backward compatibility, always return nil.
543 : nil)
544 :
545 : (defun define-abbrev (table name expansion &optional hook &rest props)
546 : "Define an abbrev in TABLE named NAME, to expand to EXPANSION and call HOOK.
547 : NAME must be a string, and should be lower-case.
548 : EXPANSION should usually be a string.
549 : To undefine an abbrev, define it with EXPANSION = nil.
550 : If HOOK is non-nil, it should be a function of no arguments;
551 : it is called after EXPANSION is inserted.
552 : If EXPANSION is not a string (and not nil), the abbrev is a
553 : special one, which does not expand in the usual way but only
554 : runs HOOK.
555 :
556 : If HOOK is a non-nil symbol with a non-nil `no-self-insert' property,
557 : it can control whether the character that triggered abbrev expansion
558 : is inserted. If such a HOOK returns non-nil, the character is not
559 : inserted. If such a HOOK returns nil, then so does `abbrev-insert'
560 : \(and `expand-abbrev'), as if no abbrev expansion had taken place.
561 :
562 : PROPS is a property list. The following properties are special:
563 : - `:count': the value for the abbrev's usage-count, which is incremented each
564 : time the abbrev is used (the default is zero).
565 : - `:system': if non-nil, says that this is a \"system\" abbreviation
566 : which should not be saved in the user's abbreviation file.
567 : Unless `:system' is `force', a system abbreviation will not
568 : overwrite a non-system abbreviation of the same name.
569 : - `:case-fixed': non-nil means that abbreviations are looked up without
570 : case-folding, and the expansion is not capitalized/upcased.
571 : - `:enable-function': a function of no argument which returns non-nil if the
572 : abbrev should be used for a particular call of `expand-abbrev'.
573 :
574 : An obsolete but still supported calling form is:
575 :
576 : \(define-abbrev TABLE NAME EXPANSION &optional HOOK COUNT SYSTEM)."
577 0 : (when (and (consp props) (or (null (car props)) (numberp (car props))))
578 : ;; Old-style calling convention.
579 0 : (setq props `(:count ,(car props)
580 0 : ,@(if (cadr props) (list :system (cadr props))))))
581 0 : (unless (plist-get props :count)
582 0 : (setq props (plist-put props :count 0)))
583 0 : (setq props (plist-put props :abbrev-table-modiff
584 0 : (abbrev-table-get table :abbrev-table-modiff)))
585 0 : (let ((system-flag (plist-get props :system))
586 0 : (sym (obarray-put table name)))
587 : ;; Don't override a prior user-defined abbrev with a system abbrev,
588 : ;; unless system-flag is `force'.
589 0 : (unless (and (not (memq system-flag '(nil force)))
590 0 : (boundp sym) (symbol-value sym)
591 0 : (not (abbrev-get sym :system)))
592 0 : (unless (or system-flag
593 0 : (and (boundp sym)
594 : ;; load-file-name
595 0 : (equal (symbol-value sym) expansion)
596 0 : (equal (symbol-function sym) hook)))
597 0 : (setq abbrevs-changed t))
598 0 : (set sym expansion)
599 0 : (fset sym hook)
600 0 : (setplist sym
601 : ;; Don't store the `force' value of `system-flag' into
602 : ;; the :system property.
603 0 : (if (eq 'force system-flag) (plist-put props :system t) props))
604 0 : (abbrev-table-put table :abbrev-table-modiff
605 0 : (1+ (abbrev-table-get table :abbrev-table-modiff))))
606 0 : name))
607 :
608 : (defun abbrev--check-chars (abbrev global)
609 : "Check if the characters in ABBREV have word syntax in either the
610 : current (if global is nil) or standard syntax table."
611 0 : (with-syntax-table
612 0 : (cond ((null global) (syntax-table))
613 : ;; ((syntax-table-p global) global)
614 0 : (t (standard-syntax-table)))
615 0 : (when (string-match "\\W" abbrev)
616 0 : (let ((badchars ())
617 : (pos 0))
618 0 : (while (string-match "\\W" abbrev pos)
619 0 : (cl-pushnew (aref abbrev (match-beginning 0)) badchars)
620 0 : (setq pos (1+ pos)))
621 0 : (error "Some abbrev characters (%s) are not word constituents %s"
622 0 : (apply 'string (nreverse badchars))
623 0 : (if global "in the standard syntax" "in this mode"))))))
624 :
625 : (defun define-global-abbrev (abbrev expansion)
626 : "Define ABBREV as a global abbreviation for EXPANSION.
627 : The characters in ABBREV must all be word constituents in the standard
628 : syntax table."
629 : (interactive "sDefine global abbrev: \nsExpansion for %s: ")
630 0 : (abbrev--check-chars abbrev 'global)
631 0 : (define-abbrev global-abbrev-table (downcase abbrev) expansion))
632 :
633 : (defun define-mode-abbrev (abbrev expansion)
634 : "Define ABBREV as a mode-specific abbreviation for EXPANSION.
635 : The characters in ABBREV must all be word-constituents in the current mode."
636 : (interactive "sDefine mode abbrev: \nsExpansion for %s: ")
637 0 : (unless local-abbrev-table
638 0 : (error "Major mode has no abbrev table"))
639 0 : (abbrev--check-chars abbrev nil)
640 0 : (define-abbrev local-abbrev-table (downcase abbrev) expansion))
641 :
642 : (defun abbrev--active-tables (&optional tables)
643 : "Return the list of abbrev tables currently active.
644 : TABLES if non-nil overrides the usual rules. It can hold
645 : either a single abbrev table or a list of abbrev tables."
646 : ;; We could just remove the `tables' arg and let callers use
647 : ;; (or table (abbrev--active-tables)) but then they'd have to be careful
648 : ;; to treat the distinction between a single table and a list of tables.
649 0 : (cond
650 0 : ((consp tables) tables)
651 0 : ((vectorp tables) (list tables))
652 : (t
653 0 : (let ((tables (if (listp local-abbrev-table)
654 0 : (append local-abbrev-table
655 0 : (list global-abbrev-table))
656 0 : (list local-abbrev-table global-abbrev-table))))
657 : ;; Add the minor-mode abbrev tables.
658 0 : (dolist (x abbrev-minor-mode-table-alist)
659 0 : (when (and (symbolp (car x)) (boundp (car x)) (symbol-value (car x)))
660 0 : (setq tables
661 0 : (if (listp (cdr x))
662 0 : (append (cdr x) tables) (cons (cdr x) tables)))))
663 0 : tables))))
664 :
665 :
666 : (defun abbrev--symbol (abbrev table)
667 : "Return the symbol representing abbrev named ABBREV in TABLE.
668 : This symbol's name is ABBREV, but it is not the canonical symbol of that name;
669 : it is interned in the abbrev-table TABLE rather than the normal obarray.
670 : The value is nil if that abbrev is not defined."
671 0 : (let* ((case-fold (not (abbrev-table-get table :case-fixed)))
672 : ;; In case the table doesn't set :case-fixed but some of the
673 : ;; abbrevs do, we have to be careful.
674 : (sym
675 : ;; First try without case-folding.
676 0 : (or (obarray-get table abbrev)
677 0 : (when case-fold
678 : ;; We didn't find any abbrev, try case-folding.
679 0 : (let ((sym (obarray-get table (downcase abbrev))))
680 : ;; Only use it if it doesn't require :case-fixed.
681 0 : (and sym (not (abbrev-get sym :case-fixed))
682 0 : sym))))))
683 0 : (if (symbol-value sym)
684 0 : sym)))
685 :
686 : (defun abbrev-symbol (abbrev &optional table)
687 : "Return the symbol representing abbrev named ABBREV.
688 : This symbol's name is ABBREV, but it is not the canonical symbol of that name;
689 : it is interned in an abbrev-table rather than the normal obarray.
690 : The value is nil if that abbrev is not defined.
691 : Optional second arg TABLE is abbrev table to look it up in.
692 : The default is to try buffer's mode-specific abbrev table, then global table."
693 0 : (let ((tables (abbrev--active-tables table))
694 : sym)
695 0 : (while (and tables (not sym))
696 0 : (let* ((table (pop tables)))
697 0 : (setq tables (append (abbrev-table-get table :parents) tables))
698 0 : (setq sym (abbrev--symbol abbrev table))))
699 0 : sym))
700 :
701 :
702 : (defun abbrev-expansion (abbrev &optional table)
703 : "Return the string that ABBREV expands into in the current buffer.
704 : Optionally specify an abbrev table as second arg;
705 : then ABBREV is looked up in that table only."
706 0 : (symbol-value (abbrev-symbol abbrev table)))
707 :
708 :
709 : (defun abbrev--before-point ()
710 : "Try and find an abbrev before point. Return it if found, nil otherwise."
711 0 : (unless (eq abbrev-start-location-buffer (current-buffer))
712 0 : (setq abbrev-start-location nil))
713 :
714 0 : (let ((tables (abbrev--active-tables))
715 0 : (pos (point))
716 : start end name res)
717 :
718 0 : (if abbrev-start-location
719 0 : (progn
720 0 : (setq start abbrev-start-location)
721 0 : (setq abbrev-start-location nil)
722 : ;; Remove the hyphen inserted by `abbrev-prefix-mark'.
723 0 : (when (and (< start (point-max))
724 0 : (eq (char-after start) ?-))
725 0 : (delete-region start (1+ start))
726 0 : (setq pos (1- pos)))
727 0 : (skip-syntax-backward " ")
728 0 : (setq end (point))
729 0 : (when (> end start)
730 0 : (setq name (buffer-substring start end))
731 0 : (goto-char pos) ; Restore point.
732 0 : (list (abbrev-symbol name tables) name start end)))
733 :
734 0 : (while (and tables (not (car res)))
735 0 : (let* ((table (pop tables))
736 0 : (enable-fun (abbrev-table-get table :enable-function)))
737 0 : (setq tables (append (abbrev-table-get table :parents) tables))
738 0 : (setq res
739 0 : (and (or (not enable-fun) (funcall enable-fun))
740 0 : (let ((re (abbrev-table-get table :regexp)))
741 0 : (if (null re)
742 : ;; We used to default `re' to "\\<\\(\\w+\\)\\W*"
743 : ;; but when words-include-escapes is set, that
744 : ;; is not right and fixing it is boring.
745 0 : (let ((lim (point)))
746 0 : (backward-word 1)
747 0 : (setq start (point))
748 0 : (forward-word 1)
749 0 : (setq end (min (point) lim)))
750 0 : (when (looking-back re (line-beginning-position))
751 0 : (setq start (match-beginning 1))
752 0 : (setq end (match-end 1)))))
753 0 : (setq name (buffer-substring start end))
754 0 : (let ((abbrev (abbrev--symbol name table)))
755 0 : (when abbrev
756 0 : (setq enable-fun (abbrev-get abbrev :enable-function))
757 0 : (and (or (not enable-fun) (funcall enable-fun))
758 : ;; This will also look it up in parent tables.
759 : ;; This is not on purpose, but it seems harmless.
760 0 : (list abbrev name start end))))))
761 : ;; Restore point.
762 0 : (goto-char pos)))
763 0 : res)))
764 :
765 : (defun abbrev-insert (abbrev &optional name wordstart wordend)
766 : "Insert abbrev ABBREV at point.
767 : If non-nil, NAME is the name by which this abbrev was found.
768 : If non-nil, WORDSTART is the place where to insert the abbrev.
769 : If WORDEND is non-nil, the abbrev replaces the previous text between
770 : WORDSTART and WORDEND.
771 : Return ABBREV if the expansion should be considered as having taken place.
772 : The return value can be influenced by a `no-self-insert' property;
773 : see `define-abbrev' for details."
774 0 : (unless name (setq name (symbol-name abbrev)))
775 0 : (unless wordstart (setq wordstart (point)))
776 0 : (unless wordend (setq wordend wordstart))
777 : ;; Increment use count.
778 0 : (abbrev-put abbrev :count (1+ (abbrev-get abbrev :count)))
779 0 : (let ((value abbrev))
780 : ;; If this abbrev has an expansion, delete the abbrev
781 : ;; and insert the expansion.
782 0 : (when (stringp (symbol-value abbrev))
783 0 : (goto-char wordstart)
784 : ;; Insert at beginning so that markers at the end (e.g. point)
785 : ;; are preserved.
786 0 : (insert (symbol-value abbrev))
787 0 : (delete-char (- wordend wordstart))
788 0 : (let ((case-fold-search nil))
789 : ;; If the abbrev's name is different from the buffer text (the
790 : ;; only difference should be capitalization), then we may want
791 : ;; to adjust the capitalization of the expansion.
792 0 : (when (and (not (equal name (symbol-name abbrev)))
793 0 : (string-match "[[:upper:]]" name))
794 0 : (if (not (string-match "[[:lower:]]" name))
795 : ;; Abbrev was all caps. If expansion is multiple words,
796 : ;; normally capitalize each word.
797 0 : (if (and (not abbrev-all-caps)
798 0 : (save-excursion
799 0 : (> (progn (backward-word 1) (point))
800 0 : (progn (goto-char wordstart)
801 0 : (forward-word 1) (point)))))
802 0 : (upcase-initials-region wordstart (point))
803 0 : (upcase-region wordstart (point)))
804 : ;; Abbrev included some caps. Cap first initial of expansion.
805 0 : (let ((end (point)))
806 : ;; Find the initial.
807 0 : (goto-char wordstart)
808 0 : (skip-syntax-forward "^w" (1- end))
809 : ;; Change just that.
810 0 : (upcase-initials-region (point) (1+ (point)))
811 0 : (goto-char end))))))
812 : ;; Now point is at the end of the expansion and the beginning is
813 : ;; in last-abbrev-location.
814 0 : (when (symbol-function abbrev)
815 0 : (let* ((hook (symbol-function abbrev))
816 : (expanded
817 : ;; If the abbrev has a hook function, run it.
818 0 : (funcall hook)))
819 : ;; In addition, if the hook function is a symbol with
820 : ;; a non-nil `no-self-insert' property, let the value it
821 : ;; returned specify whether we consider that an expansion took
822 : ;; place. If it returns nil, no expansion has been done.
823 0 : (if (and (symbolp hook)
824 0 : (null expanded)
825 0 : (get hook 'no-self-insert))
826 0 : (setq value nil))))
827 0 : value))
828 :
829 : (defvar abbrev-expand-functions nil
830 : "Wrapper hook around `abbrev--default-expand'.")
831 : (make-obsolete-variable 'abbrev-expand-functions 'abbrev-expand-function "24.4")
832 :
833 : (defvar abbrev-expand-function #'abbrev--default-expand
834 : "Function that `expand-abbrev' uses to perform abbrev expansion.
835 : Takes no argument and should return the abbrev symbol if expansion took place.")
836 :
837 : (defun expand-abbrev ()
838 : "Expand the abbrev before point, if there is an abbrev there.
839 : Effective when explicitly called even when `abbrev-mode' is nil.
840 : Before doing anything else, runs `pre-abbrev-expand-hook'.
841 : Calls the value of `abbrev-expand-function' with no argument to do
842 : the work, and returns whatever it does. (That return value should
843 : be the abbrev symbol if expansion occurred, else nil.)"
844 : (interactive)
845 0 : (run-hooks 'pre-abbrev-expand-hook)
846 0 : (funcall abbrev-expand-function))
847 :
848 : (defun abbrev--default-expand ()
849 : "Default function to use for `abbrev-expand-function'.
850 : This also respects the obsolete wrapper hook `abbrev-expand-functions'.
851 : \(See `with-wrapper-hook' for details about wrapper hooks.)
852 : Calls `abbrev-insert' to insert any expansion, and returns what it does."
853 0 : (subr--with-wrapper-hook-no-warnings abbrev-expand-functions ()
854 : (pcase-let ((`(,sym ,name ,wordstart ,wordend) (abbrev--before-point)))
855 : (when sym
856 : (let ((startpos (copy-marker (point) t))
857 : (endmark (copy-marker wordend t)))
858 : (unless (or ;; executing-kbd-macro
859 : noninteractive
860 : (window-minibuffer-p))
861 : ;; Add an undo boundary, in case we are doing this for
862 : ;; a self-inserting command which has avoided making one so far.
863 : (undo-boundary))
864 : ;; Now sym is the abbrev symbol.
865 : (setq last-abbrev-text name)
866 : (setq last-abbrev sym)
867 : (setq last-abbrev-location wordstart)
868 : ;; If this abbrev has an expansion, delete the abbrev
869 : ;; and insert the expansion.
870 : (prog1
871 : (abbrev-insert sym name wordstart wordend)
872 : ;; Yuck!! If expand-abbrev is called with point slightly
873 : ;; further than the end of the abbrev, move point back to
874 : ;; where it started.
875 : (if (and (> startpos endmark)
876 : (= (point) endmark)) ;Obey skeletons that move point.
877 0 : (goto-char startpos))))))))
878 :
879 : (defun unexpand-abbrev ()
880 : "Undo the expansion of the last abbrev that expanded.
881 : This differs from ordinary undo in that other editing done since then
882 : is not undone."
883 : (interactive)
884 0 : (save-excursion
885 0 : (unless (or (< last-abbrev-location (point-min))
886 0 : (> last-abbrev-location (point-max)))
887 0 : (goto-char last-abbrev-location)
888 0 : (when (stringp last-abbrev-text)
889 : ;; This isn't correct if last-abbrev's hook was used
890 : ;; to do the expansion.
891 0 : (let ((val (symbol-value last-abbrev)))
892 0 : (unless (stringp val)
893 0 : (error "Value of abbrev-symbol must be a string"))
894 : ;; Don't inherit properties here; just copy from old contents.
895 0 : (insert last-abbrev-text)
896 : ;; Delete after inserting, to better preserve markers.
897 0 : (delete-region (point) (+ (point) (length val)))
898 0 : (setq last-abbrev-text nil))))))
899 :
900 : (defun abbrev--write (sym)
901 : "Write the abbrev in a `read'able form.
902 : Only writes the non-system abbrevs.
903 : Presumes that `standard-output' points to `current-buffer'."
904 0 : (unless (or (null (symbol-value sym)) (abbrev-get sym :system))
905 0 : (insert " (")
906 0 : (prin1 (symbol-name sym))
907 0 : (insert " ")
908 0 : (prin1 (symbol-value sym))
909 0 : (insert " ")
910 0 : (prin1 (symbol-function sym))
911 0 : (insert " ")
912 0 : (prin1 (abbrev-get sym :count))
913 0 : (insert ")\n")))
914 :
915 : (defun abbrev--describe (sym)
916 0 : (when (symbol-value sym)
917 0 : (prin1 (symbol-name sym))
918 0 : (if (null (abbrev-get sym :system))
919 0 : (indent-to 15 1)
920 0 : (insert " (sys)")
921 0 : (indent-to 20 1))
922 0 : (prin1 (abbrev-get sym :count))
923 0 : (indent-to 20 1)
924 0 : (prin1 (symbol-value sym))
925 0 : (when (symbol-function sym)
926 0 : (indent-to 45 1)
927 0 : (prin1 (symbol-function sym)))
928 0 : (terpri)))
929 :
930 : (defun insert-abbrev-table-description (name &optional readable)
931 : "Insert before point a full description of abbrev table named NAME.
932 : NAME is a symbol whose value is an abbrev table.
933 : If optional 2nd arg READABLE is non-nil, a human-readable description
934 : is inserted. Otherwise the description is an expression,
935 : a call to `define-abbrev-table', which would
936 : define the abbrev table NAME exactly as it is currently defined.
937 :
938 : Abbrevs marked as \"system abbrevs\" are omitted."
939 0 : (let ((table (symbol-value name))
940 : (symbols ()))
941 0 : (mapatoms (lambda (sym) (if (symbol-value sym) (push sym symbols))) table)
942 0 : (setq symbols (sort symbols 'string-lessp))
943 0 : (let ((standard-output (current-buffer)))
944 0 : (if readable
945 0 : (progn
946 0 : (insert "(")
947 0 : (prin1 name)
948 0 : (insert ")\n\n")
949 0 : (mapc 'abbrev--describe symbols)
950 0 : (insert "\n\n"))
951 0 : (insert "(define-abbrev-table '")
952 0 : (prin1 name)
953 0 : (if (null symbols)
954 0 : (insert " '())\n\n")
955 0 : (insert "\n '(\n")
956 0 : (mapc 'abbrev--write symbols)
957 0 : (insert " ))\n\n")))
958 0 : nil)))
959 :
960 : (defun define-abbrev-table (tablename definitions
961 : &optional docstring &rest props)
962 : "Define TABLENAME (a symbol) as an abbrev table name.
963 : Define abbrevs in it according to DEFINITIONS, which is a list of elements
964 : of the form (ABBREVNAME EXPANSION ...) that are passed to `define-abbrev'.
965 : PROPS is a property list to apply to the table.
966 : Properties with special meaning:
967 : - `:parents' contains a list of abbrev tables from which this table inherits
968 : abbreviations.
969 : - `:case-fixed' non-nil means that abbreviations are looked up without
970 : case-folding, and the expansion is not capitalized/upcased.
971 : - `:regexp' is a regular expression that specifies how to extract the
972 : name of the abbrev before point. The submatch 1 is treated
973 : as the potential name of an abbrev. If :regexp is nil, the default
974 : behavior uses `backward-word' and `forward-word' to extract the name
975 : of the abbrev, which can therefore only be a single word.
976 : - `:enable-function' can be set to a function of no argument which returns
977 : non-nil if and only if the abbrevs in this table should be used for this
978 : instance of `expand-abbrev'."
979 : (declare (doc-string 3))
980 : ;; We used to manually add the docstring, but we also want to record this
981 : ;; location as the definition of the variable (in load-history), so we may
982 : ;; as well just use `defvar'.
983 7 : (when (and docstring props (symbolp docstring))
984 : ;; There is really no docstring, instead the docstring arg
985 : ;; is a property name.
986 7 : (push docstring props) (setq docstring nil))
987 7 : (eval `(defvar ,tablename nil ,@(if docstring (list docstring))))
988 7 : (let ((table (if (boundp tablename) (symbol-value tablename))))
989 7 : (unless table
990 7 : (setq table (make-abbrev-table))
991 7 : (set tablename table)
992 7 : (unless (memq tablename abbrev-table-name-list)
993 14 : (push tablename abbrev-table-name-list)))
994 : ;; We used to just pass them to `make-abbrev-table', but that fails
995 : ;; if the table was pre-existing as is the case if it was created by
996 : ;; loading the user's abbrev file.
997 7 : (while (consp props)
998 0 : (unless (cdr props) (error "Missing value for property %S" (car props)))
999 7 : (abbrev-table-put table (pop props) (pop props)))
1000 7 : (dolist (elt definitions)
1001 7 : (apply 'define-abbrev table elt))))
1002 :
1003 : (defun abbrev-table-menu (table &optional prompt sortfun)
1004 : "Return a menu that shows all abbrevs in TABLE.
1005 : Selecting an entry runs `abbrev-insert'.
1006 : PROMPT is the prompt to use for the keymap.
1007 : SORTFUN is passed to `sort' to change the default ordering."
1008 0 : (unless sortfun (setq sortfun 'string-lessp))
1009 0 : (let ((entries ()))
1010 0 : (obarray-map (lambda (abbrev)
1011 0 : (when (symbol-value abbrev)
1012 0 : (let ((name (symbol-name abbrev)))
1013 0 : (push `(,(intern name) menu-item ,name
1014 : (lambda () (interactive)
1015 0 : (abbrev-insert ',abbrev)))
1016 0 : entries))))
1017 0 : table)
1018 0 : (nconc (make-sparse-keymap prompt)
1019 0 : (sort entries (lambda (x y)
1020 0 : (funcall sortfun (nth 2 x) (nth 2 y)))))))
1021 :
1022 : ;; Keep it after define-abbrev-table, since define-derived-mode uses
1023 : ;; define-abbrev-table.
1024 : (define-derived-mode edit-abbrevs-mode fundamental-mode "Edit-Abbrevs"
1025 : "Major mode for editing the list of abbrev definitions.")
1026 :
1027 : (provide 'abbrev)
1028 :
1029 : ;;; abbrev.el ends here
|