Merge from trunk
[bpt/emacs.git] / lisp / mail / mailabbrev.el
CommitLineData
55535639 1;;; mailabbrev.el --- abbrev-expansion of mail aliases
275da787 2
acaf905b 3;; Copyright (C) 1985-1987, 1992-1993, 1996-1997, 2000-2012
a4d9b7bc 4;; Free Software Foundation, Inc.
275da787 5
4c120732 6;; Author: Jamie Zawinski <jwz@lucid.com; now jwz@jwz.org>
fcc31755 7;; Maintainer: FSF
275da787
RM
8;; Created: 19 Oct 90
9;; Keywords: mail
10
b578f267 11;; This file is part of GNU Emacs.
b01c3008 12
b1fc2b50 13;; GNU Emacs is free software: you can redistribute it and/or modify
b578f267 14;; it under the terms of the GNU General Public License as published by
b1fc2b50
GM
15;; the Free Software Foundation, either version 3 of the License, or
16;; (at your option) any later version.
b01c3008 17
b578f267
EN
18;; GNU Emacs is distributed in the hope that it will be useful,
19;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21;; GNU General Public License for more details.
b01c3008 22
b578f267 23;; You should have received a copy of the GNU General Public License
b1fc2b50 24;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
b01c3008 25
275da787
RM
26;;; Commentary:
27
0f965ba3 28;; This file ensures that, when the point is in a To:, CC:, BCC:, or From:
b578f267
EN
29;; field, word-abbrevs are defined for each of your mail aliases. These
30;; aliases will be defined from your .mailrc file (or the file specified by
f6babbac 31;; `mail-personal-alias-file') if it exists. Your mail aliases will
b578f267
EN
32;; expand any time you type a word-delimiter at the end of an abbreviation.
33;;
34;; What you see is what you get: if mailabbrev is in use when you type
35;; a name, and the name does not expand, you know it is not an abbreviation.
36;; However, if you yank abbreviations into the headers
37;; in a way that bypasses the check for abbreviations,
38;; they are expanded (but not visibly) when you send the message.
39;;
40;; Your mail alias abbrevs will be in effect only when the point is in an
41;; appropriate header field. When in the body of the message, or other
42;; header fields, the mail aliases will not expand. Rather, the normal
fba75b6b 43;; mode-specific abbrev table will be used if
b578f267
EN
44;; defined. So if you use mail-mode specific abbrevs, this code will not
45;; adversely affect you. You can control which header fields the abbrevs
46;; are used in by changing the variable mail-abbrev-mode-regexp.
47;;
48;; If auto-fill mode is on, abbrevs will wrap at commas instead of at word
49;; boundaries; also, header continuation-lines will be properly indented.
50;;
85d0e9ed 51;; You can also insert a mail alias with mail-abbrev-insert-alias
b578f267
EN
52;; (bound to C-c C-a), which prompts you for an alias (with completion)
53;; and inserts its expansion at point.
54;;
55;; This file fixes a bug in the old system which prohibited your .mailrc
56;; file from having lines like
57;;
58;; alias someone "John Doe <doe@quux.com>"
59;;
60;; That is, if you want an address to have embedded spaces, simply surround it
61;; with double-quotes. This is necessary because the format of the .mailrc
62;; file bogusly uses spaces as address delimiters. The following line defines
63;; an alias which expands to three addresses:
64;;
65;; alias foobar addr-1 addr-2 "address three <addr-3>"
66;;
67;; (This is bogus because mail-delivery programs want commas, not spaces,
68;; but that's what the file format is, so we have to live with it.)
69;;
70;; If you like, you can call the function define-mail-abbrev to define your
71;; mail aliases instead of using a .mailrc file. When you call it in this
72;; way, addresses are separated by commas.
73;;
74;; CAVEAT: This works on most Sun systems; I have been told that some versions
75;; of /bin/mail do not understand double-quotes in the .mailrc file. So you
76;; should make sure your version does before including verbose addresses like
77;; this. One solution to this, if you are on a system whose /bin/mail doesn't
78;; work that way, (and you still want to be able to /bin/mail to send mail in
79;; addition to emacs) is to define minimal aliases (without full names) in
80;; your .mailrc file, and use define-mail-abbrev to redefine them when sending
81;; mail from emacs; this way, mail sent from /bin/mail will work, and mail
82;; sent from emacs will be pretty.
83;;
84;; Aliases in the mailrc file may be nested. If you define aliases like
85;; alias group1 fred ethel
86;; alias group2 larry curly moe
87;; alias everybody group1 group2
88;; Then when you type "everybody" on the To: line, it will be expanded to
89;; fred, ethyl, larry, curly, moe
90;;
91;; Aliases may also contain forward references; the alias of "everybody" can
92;; precede the aliases of "group1" and "group2".
93;;
94;; This code also understands the "source" .mailrc command, for reading
95;; aliases from some other file as well.
96;;
97;; Aliases may contain hyphens, as in "alias foo-bar foo@bar"; word-abbrevs
98;; normally cannot contain hyphens, but this code works around that for the
99;; specific case of mail-alias word-abbrevs.
100;;
101;; To read in the contents of another .mailrc-type file from emacs, use the
102;; command Meta-X merge-mail-abbrevs. The rebuild-mail-abbrevs command is
103;; similar, but will delete existing aliases first.
104;;
105;; If you would like your aliases to be expanded when you type M-> or ^N to
106;; move out of the mail-header into the message body (instead of having to
107;; type SPC at the end of the abbrev before moving away) then you can do
108;;
109;; (add-hook
bde4c7ce 110;; 'mail-mode-hook
c0df1972 111;; (lambda ()
6b823692
AS
112;; (define-key mail-mode-map [remap next-line] 'mail-abbrev-next-line)
113;; (define-key mail-mode-map [remap end-of-buffer] 'mail-abbrev-end-of-buffer)))
b578f267
EN
114;;
115;; If you want multiple addresses separated by a string other than ", " then
116;; you can set the variable mail-alias-separator-string to it. This has to
117;; be a comma bracketed by whitespace if you want any kind of reasonable
fffa137c 118;; behavior.
b578f267
EN
119;;
120;; Thanks to Harald Hanche-Olsen, Michael Ernst, David Loeffler, and
121;; Noah Friedman for suggestions and bug reports.
122
bde4c7ce 123;; To use this package, do (add-hook 'mail-mode-hook 'mail-abbrevs-setup).
b01c3008 124
275da787
RM
125;;; Code:
126
d075ed70
RS
127(eval-when-compile
128 (require 'sendmail))
b01c3008 129
7d4c958f
KH
130(defgroup mail-abbrev nil
131 "Expand mail aliases as abbrevs, in certain mail headers."
132 :group 'abbrev-mode)
133
dcbb251e
SM
134;;;###autoload
135(define-minor-mode mail-abbrevs-mode
ac6c8639
CY
136 "Toggle abbrev expansion of mail aliases (Mail Abbrevs mode).
137With a prefix argument ARG, enable Mail Abbrevs mode if ARG is
138positive, and disable it otherwise. If called from Lisp, enable
139the mode if ARG is omitted or nil.
140
141Mail Abbrevs mode is a global minor mode. When enabled,
142abbrev-like expansion is performed when editing certain mail
143headers (those specified by `mail-abbrev-mode-regexp'), based on
144the entries in your `mail-personal-alias-file'."
dcbb251e 145 :global t
7d4c958f 146 :group 'mail-abbrev
dcbb251e
SM
147 :version "20.3"
148 (if mail-abbrevs-mode (mail-abbrevs-enable) (mail-abbrevs-disable)))
7d4c958f
KH
149
150(defcustom mail-abbrevs-only nil
dcbb251e 151 "Non-nil means only mail abbrevs should expand automatically.
7d4c958f
KH
152Other abbrevs expand only when you explicitly use `expand-abbrev'."
153 :type 'boolean
154 :group 'mail-abbrev)
155
b01c3008 156;; originally defined in sendmail.el - used to be an alist, now is a table.
753d16a6 157(defvar mail-abbrevs nil
22f4ef2e 158 "Word-abbrev table of mail address aliases.
b01c3008
RS
159If this is nil, it means the aliases have not yet been initialized and
160should be read from the .mailrc file. (This is distinct from there being
161no aliases, which is represented by this being a table with no entries.)")
162
00bafa45
RS
163(defvar mail-abbrev-modtime nil
164 "The modification time of your mail alias file when it was last examined.")
165
166(defun mail-abbrevs-sync-aliases ()
f7e85dcf
RS
167 (when mail-personal-alias-file
168 (if (file-exists-p mail-personal-alias-file)
169 (let ((modtime (nth 5 (file-attributes mail-personal-alias-file))))
170 (if (not (equal mail-abbrev-modtime modtime))
171 (progn
172 (setq mail-abbrev-modtime modtime)
173 (build-mail-abbrevs)))))))
00bafa45 174
aa228418 175;;;###autoload
753d16a6 176(defun mail-abbrevs-setup ()
17804728 177 "Initialize use of the `mailabbrev' package."
753d16a6 178 (if (and (not (vectorp mail-abbrevs))
a3039e32 179 (file-exists-p mail-personal-alias-file))
00bafa45 180 (progn
0f965ba3 181 (setq mail-abbrev-modtime
00bafa45
RS
182 (nth 5 (file-attributes mail-personal-alias-file)))
183 (build-mail-abbrevs)))
184 (mail-abbrevs-sync-aliases)
dcbb251e 185 (add-hook 'abbrev-expand-functions 'mail-abbrev-expand-wrapper nil t)
b01c3008
RS
186 (abbrev-mode 1))
187
7d4c958f 188(defun mail-abbrevs-enable ()
bde4c7ce 189 (add-hook 'mail-mode-hook 'mail-abbrevs-setup))
7d4c958f
KH
190
191(defun mail-abbrevs-disable ()
192 "Turn off use of the `mailabbrev' package."
bde4c7ce 193 (remove-hook 'mail-mode-hook 'mail-abbrevs-setup)
7d4c958f
KH
194 (abbrev-mode (if (default-value 'abbrev-mode) 1 -1)))
195
22f4ef2e 196;;;###autoload
753d16a6 197(defun build-mail-abbrevs (&optional file recursivep)
a3039e32
NF
198 "Read mail aliases from personal mail alias file and set `mail-abbrevs'.
199By default this is the file specified by `mail-personal-alias-file'."
200 (setq file (expand-file-name (or file mail-personal-alias-file)))
753d16a6 201 (if (vectorp mail-abbrevs)
b01c3008 202 nil
753d16a6
RS
203 (setq mail-abbrevs nil)
204 (define-abbrev-table 'mail-abbrevs '()))
5aefeeba 205 (message "Parsing %s..." file)
dcbb251e
SM
206 (with-temp-buffer
207 (buffer-disable-undo)
208 (cond ((get-file-buffer file)
209 (insert (with-current-buffer (get-file-buffer file)
210 (buffer-substring (point-min) (point-max)))))
211 ((not (file-exists-p file)))
212 (t (insert-file-contents file)))
213 ;; Don't lose if no final newline.
214 (goto-char (point-max))
215 (or (eq (preceding-char) ?\n) (newline))
216 (goto-char (point-min))
217 ;; Delete comments from the file
218 (while (search-forward "# " nil t)
219 (let ((p (- (point) 2)))
220 (end-of-line)
221 (delete-region p (point))))
222 (goto-char (point-min))
223 ;; handle "\\\n" continuation lines
224 (while (not (eobp))
225 (end-of-line)
226 (if (= (preceding-char) ?\\)
227 (progn (delete-char -1) (delete-char 1) (insert ?\ ))
228 (forward-char 1)))
229 (goto-char (point-min))
230 (while (re-search-forward
231 "^\\(a\\(lias\\)?\\|g\\(roup\\)?\\|source\\)[ \t]+" nil t)
232 (beginning-of-line)
233 (if (looking-at "source[ \t]+\\([^ \t\n]+\\)")
234 (progn
235 (end-of-line)
236 (build-mail-abbrevs
237 (substitute-in-file-name
238 (buffer-substring (match-beginning 1) (match-end 1)))
239 t))
240 (re-search-forward "[ \t]+\\([^ \t\n]+\\)")
241 (let* ((name (buffer-substring
242 (match-beginning 1) (match-end 1)))
243 (start (progn (skip-chars-forward " \t") (point))))
244 (end-of-line)
245 ;; (message "** %s \"%s\"" name (buffer-substring start (point)))(sit-for 1)
246 (define-mail-abbrev
247 name
248 (buffer-substring start (point))
249 t))))
250 ;; Resolve forward references in .mailrc file.
251 ;; This would happen automatically before the first abbrev was
252 ;; expanded, but why not do it now.
253 (or recursivep (mail-resolve-all-aliases))
254 mail-abbrevs)
255 (message "Parsing %s... done" file))
b01c3008 256
f22cd786 257(defvar mail-alias-separator-string ", "
b01c3008 258 "*A string inserted between addresses in multi-address mail aliases.
0f965ba3 259This has to contain a comma, so \", \" is a reasonable value. You might
b01c3008
RS
260also want something like \",\\n \" to get each address on its own line.")
261
51e4ece8 262;; define-mail-abbrev sets this flag, which causes mail-resolve-all-aliases
b01c3008
RS
263;; to be called before expanding abbrevs if it's necessary.
264(defvar mail-abbrev-aliases-need-to-be-resolved t)
265
753d16a6 266;; originally defined in mailalias.el ; build-mail-abbrevs calls this with
b01c3008
RS
267;; stuff parsed from the .mailrc file.
268;;
aa228418 269;;;###autoload
51e4ece8 270(defun define-mail-abbrev (name definition &optional from-mailrc-file)
92182a70 271 "Define NAME as a mail alias abbrev that translates to DEFINITION.
4bb79f82
CY
272If DEFINITION contains multiple addresses, separate them with commas.
273
274Optional argument FROM-MAILRC-FILE means that DEFINITION comes
275from a mailrc file. In that case, addresses are separated with
276spaces and addresses with embedded spaces are surrounded by
277double-quotes."
753d16a6 278 ;; When this is called from build-mail-abbrevs, the third argument is
b01c3008
RS
279 ;; true, and we do some evil space->comma hacking like /bin/mail does.
280 (interactive "sDefine mail alias: \nsDefine %s as mail alias for: ")
281 ;; Read the defaults first, if we have not done so.
dcbb251e 282 (unless (vectorp mail-abbrevs) (build-mail-abbrevs))
b01c3008
RS
283 ;; strip garbage from front and end
284 (if (string-match "\\`[ \t\n,]+" definition)
285 (setq definition (substring definition (match-end 0))))
286 (if (string-match "[ \t\n,]+\\'" definition)
287 (setq definition (substring definition 0 (match-beginning 0))))
4bb79f82 288 (let* ((L (length definition))
8eb6c7da 289 (start (if (> L 0) 0))
4bb79f82 290 end this-entry result)
b01c3008 291 (while start
4bb79f82
CY
292 (cond
293 (from-mailrc-file
294 ;; If we're reading from the mailrc file, addresses are
295 ;; delimited by spaces, and addresses with embedded spaces are
296 ;; surrounded by non-escaped double-quotes.
297 (if (eq ?\" (aref definition start))
298 (setq start (1+ start)
299 end (and (string-match
300 "[^\\]\\(\\([\\][\\]\\)*\\)\"[ \t,]*"
301 definition start)
302 (match-end 1)))
303 (setq end (string-match "[ \t,]+" definition start)))
304 ;; Extract the address and advance the loop past it.
305 (setq this-entry (substring definition start end)
306 start (and end (/= (match-end 0) L) (match-end 0)))
307 ;; If the full name contains a problem character, quote it.
308 (and (string-match "\\(.+?\\)[ \t]*\\(<.*>\\)" this-entry)
309 (string-match "[^- !#$%&'*+/0-9=?A-Za-z^_`{|}~]"
310 (match-string 1 this-entry))
311 (setq this-entry (replace-regexp-in-string
312 "\\(.+?\\)[ \t]*\\(<.*>\\)"
313 "\"\\1\" \\2"
314 this-entry)))
315 (push this-entry result))
316 ;; When we are not reading from .mailrc, addresses are
317 ;; separated by commas. Try to accept a rfc822-like syntax.
318 ;; (Todo: extend rfc822.el to do the work for us.)
319 ((equal (string-match
320 "[ \t,]*\\(\"\\(?:[^\"]\\|[^\\]\\(?:[\\][\\]\\)*\"\\)*\"[ \t]*\
321<[-.!#$%&'*+/0-9=?A-Za-z^_`{|}~@]+>\\)[ \t,]*"
322 definition start)
323 start)
324 ;; If an entry has a valid [ "foo bar" <foo@example.com> ]
325 ;; form, use it literally . This also allows commas in the
326 ;; quoted string, e.g. [ "foo bar, jr" <foo@example.com> ]
327 (push (match-string 1 definition) result)
328 (setq start (and (/= (match-end 0) L) (match-end 0))))
329 (t
330 ;; Otherwise, read the next address by looking for a comma.
331 (setq end (string-match "[ \t\n,]*,[ \t\n]*" definition start))
332 (setq this-entry (substring definition start end))
69ba53f7 333 ;; Advance the loop past this address.
4bb79f82 334 (setq start (and end (/= (match-end 0) L) (match-end 0)))
69ba53f7 335 ;; If the full name contains a problem character, quote it.
4bb79f82
CY
336 (and (string-match "\\(.+?\\)[ \t]*\\(<.*>\\)" this-entry)
337 (string-match "[^- !#$%&'*+/0-9=?A-Za-z^_`{|}~]"
338 (match-string 1 this-entry))
339 (setq this-entry (replace-regexp-in-string
340 "\\(.+?\\)[ \t]*\\(<.*>\\)" "\"\\1\" \\2"
341 this-entry)))
342 (push this-entry result))))
343
b01c3008
RS
344 (setq definition (mapconcat (function identity)
345 (nreverse result)
f22cd786 346 mail-alias-separator-string)))
b01c3008
RS
347 (setq mail-abbrev-aliases-need-to-be-resolved t)
348 (setq name (downcase name))
753d16a6 349 ;; use an abbrev table instead of an alist for mail-abbrevs.
b01c3008 350 (let ((abbrevs-changed abbrevs-changed)) ; protect this from being changed.
8fad672b 351 (define-abbrev mail-abbrevs name definition 'mail-abbrev-expand-hook 0 t)))
b01c3008
RS
352
353
354(defun mail-resolve-all-aliases ()
355 "Resolve all forward references in the mail aliases table."
356 (if mail-abbrev-aliases-need-to-be-resolved
357 (progn
358;; (message "Resolving mail aliases...")
753d16a6
RS
359 (if (vectorp mail-abbrevs)
360 (mapatoms (function mail-resolve-all-aliases-1) mail-abbrevs))
b01c3008
RS
361 (setq mail-abbrev-aliases-need-to-be-resolved nil)
362;; (message "Resolving mail aliases... done.")
363 )))
364
d7c1ec4b
RM
365(defun mail-resolve-all-aliases-1 (sym &optional so-far)
366 (if (memq sym so-far)
367 (error "mail alias loop detected: %s"
368 (mapconcat 'symbol-name (cons sym so-far) " <- ")))
b01c3008
RS
369 (let ((definition (and (boundp sym) (symbol-value sym))))
370 (if definition
371 (let ((result '())
372 (start 0))
373 (while start
374 (let ((end (string-match "[ \t\n]*,[, \t\n]*" definition start)))
375 (setq result (cons (substring definition start end) result)
376 start (and end (match-end 0)))))
377 (setq definition
378 (mapconcat (function (lambda (x)
379 (or (mail-resolve-all-aliases-1
e1d24183 380 (intern-soft (downcase x) mail-abbrevs)
d7c1ec4b 381 (cons sym so-far))
b01c3008
RS
382 x)))
383 (nreverse result)
f22cd786 384 mail-alias-separator-string))
b01c3008
RS
385 (set sym definition))))
386 (symbol-value sym))
387
388
f22cd786 389(defun mail-abbrev-expand-hook ()
92182a70
RS
390 "For use as the fourth arg to `define-abbrev'.
391After expanding a mail-abbrev, if Auto Fill mode is on and we're past the
392fill-column, break the line at the previous comma, and indent the next line."
0f965ba3
RM
393 ;; Disable abbrev mode to avoid recursion in indent-relative expanding
394 ;; part of the abbrev expansion as an abbrev itself.
395 (let ((abbrev-mode nil))
396 (save-excursion
397 (let ((p (point))
398 bol comma fp)
399 (beginning-of-line)
400 (setq bol (point))
401 (goto-char p)
402 (while (and auto-fill-function
403 (>= (current-column) fill-column)
404 (search-backward "," bol t))
405 (setq comma (point))
406 (forward-char 1) ; Now we are just past the comma.
407 (insert "\n")
408 (delete-horizontal-space)
409 (setq p (point))
410 (indent-relative)
411 (setq fp (buffer-substring p (point)))
412 ;; Go to the end of the new line.
413 (end-of-line)
414 (if (> (current-column) fill-column)
415 ;; It's still too long; do normal auto-fill.
416 (let ((fill-prefix (or fp "\t")))
417 (do-auto-fill)))
418 ;; Resume the search.
419 (goto-char comma)
420 )))))
22f4ef2e
RM
421\f
422;;; Syntax tables and abbrev-expansion
b01c3008 423
0f965ba3 424(defvar mail-abbrev-mode-regexp
450b15a0 425 "^\\(Resent-\\)?\\(To\\|From\\|CC\\|BCC\\|Reply-to\\):"
92182a70 426 "*Regexp to select mail-headers in which mail abbrevs should be expanded.
fb11ccf6 427This string will be handed to `looking-at' with point at the beginning
b01c3008
RS
428of the current line; if it matches, abbrev mode will be turned on, otherwise
429it will be turned off. (You don't need to worry about continuation lines.)
430This should be set to match those mail fields in which you want abbreviations
431turned on.")
432
d075ed70 433(defvar mail-abbrev-syntax-table nil
4d2795c3
RS
434 "The syntax-table used for abbrev-expansion purposes.
435This is not actually made the current syntax table of the buffer, but
436simply controls the set of characters which may be a part of the name
d075ed70 437of a mail alias. The value is set up, buffer-local, when first needed.")
22f4ef2e 438
cf8b484f
RS
439(defun mail-abbrev-make-syntax-table ()
440 (make-local-variable 'mail-abbrev-syntax-table)
441 (unless mail-abbrev-syntax-table
f436b1cb 442 (let ((tab (copy-syntax-table (syntax-table)))
cf8b484f
RS
443 (_ (aref (standard-syntax-table) ?_))
444 (w (aref (standard-syntax-table) ?w)))
445 (map-char-table
446 (function (lambda (key value)
6946ae5b
AS
447 (if (null value)
448 ;; Fetch the inherited value
449 (setq value (aref tab key)))
cf8b484f
RS
450 (if (equal value _)
451 (set-char-table-range tab key w))))
452 tab)
453 (modify-syntax-entry ?@ "w" tab)
f8aba1ce
MR
454 (modify-syntax-entry ?% "w" tab)
455 (modify-syntax-entry ?! "w" tab)
456 (modify-syntax-entry ?. "w" tab)
457 (modify-syntax-entry ?_ "w" tab)
458 (modify-syntax-entry ?- "w" tab)
cf8b484f 459 (setq mail-abbrev-syntax-table tab))))
22f4ef2e
RM
460
461(defun mail-abbrev-in-expansion-header-p ()
462 "Whether point is in a mail-address header field."
463 (let ((case-fold-search t))
464 (and ;;
465 ;; we are on an appropriate header line...
466 (save-excursion
349deff4
GM
467 (unless (eobp) (forward-char 1))
468 (re-search-backward "^[^ \t]" nil 'move)
22f4ef2e
RM
469 ;; are we at the front of an appropriate header line?
470 (looking-at mail-abbrev-mode-regexp))
471 ;;
13aa1cde 472 ;; ...and are we in the headers?
8fad672b
RS
473 (< (point)
474 (save-restriction
475 (widen)
476 (save-excursion
477 (rfc822-goto-eoh)
478 (point)))))))
22f4ef2e 479
dcbb251e
SM
480(defun mail-abbrev-expand-wrapper (expand)
481 (if (and mail-abbrevs (not (eq mail-abbrevs t)))
482 (if (mail-abbrev-in-expansion-header-p)
483
484 ;; We are in a To: (or CC:, or whatever) header, and
485 ;; should use word-abbrevs to expand mail aliases.
486 (let ((local-abbrev-table mail-abbrevs))
487
488 ;; Before anything else, resolve aliases if they need it.
489 (and mail-abbrev-aliases-need-to-be-resolved
490 (mail-resolve-all-aliases))
491
492 ;; Now proceed with the abbrev section.
493 ;; - We already installed mail-abbrevs as the abbrev table.
494 ;; - Then install the mail-abbrev-syntax-table, which
495 ;; temporarily marks all of the
496 ;; non-alphanumeric-atom-characters (the "_"
497 ;; syntax ones) as being normal word-syntax. We do this
498 ;; because the C code for expand-abbrev only works on words,
499 ;; and we want these characters to be considered words for
500 ;; the purpose of abbrev expansion.
501 ;; - Then we call the expand function, to do
502 ;; the abbrev expansion with the above syntax table.
503
504 (mail-abbrev-make-syntax-table)
505
506 ;; If the character just typed was non-alpha-symbol-syntax,
507 ;; then don't expand the abbrev now (that is, don't expand
508 ;; when the user types -.) Check the character's syntax in
509 ;; the usual syntax table.
510
a4d9b7bc 511 (or (and (integerp last-command-event)
dcbb251e
SM
512 ;; Some commands such as M-> may want to expand first.
513 (equal this-command 'self-insert-command)
a4d9b7bc 514 (or (eq (char-syntax last-command-event) ?_)
dcbb251e 515 ;; Don't expand on @.
a4d9b7bc 516 (memq last-command-event '(?@ ?. ?% ?! ?_ ?-))))
dcbb251e
SM
517 ;; Use this table so that abbrevs can have hyphens in them.
518 (with-syntax-table mail-abbrev-syntax-table
519 (funcall expand))))
520
521 (if (or (not mail-abbrevs-only)
522 (eq this-command 'expand-abbrev))
523 ;; We're not in a mail header where mail aliases should
524 ;; be expanded, then use the normal mail-mode abbrev table
525 ;; (if any) and the normal mail-mode syntax table.
526 (funcall expand)
527 ;; This is not a mail abbrev, and we should not expand it.
528 ;; Don't expand anything.
529 nil))
530 ;; No mail-abbrevs at all, do the normal thing.
531 (funcall expand)))
22f4ef2e
RM
532\f
533;;; utilities
b01c3008 534
753d16a6 535(defun merge-mail-abbrevs (file)
b01c3008
RS
536 "Merge mail aliases from the given file with existing ones."
537 (interactive (list
538 (let ((insert-default-directory t)
539 (default-directory (expand-file-name "~/"))
a3039e32 540 (def mail-personal-alias-file))
b01c3008 541 (read-file-name
5b76833f 542 (format "Read additional aliases from file (default %s): "
b01c3008
RS
543 def)
544 default-directory
545 (expand-file-name def default-directory)
546 t))))
753d16a6 547 (build-mail-abbrevs file))
b01c3008 548
cf376527 549(defun rebuild-mail-abbrevs (&optional file)
b01c3008
RS
550 "Rebuild all the mail aliases from the given file."
551 (interactive (list
552 (let ((insert-default-directory t)
553 (default-directory (expand-file-name "~/"))
a3039e32 554 (def mail-personal-alias-file))
b01c3008 555 (read-file-name
5b76833f 556 (format "Read mail aliases from file (default %s): " def)
b01c3008
RS
557 default-directory
558 (expand-file-name def default-directory)
559 t))))
cf376527
RS
560 (if (null file)
561 (setq file buffer-file-name))
753d16a6
RS
562 (setq mail-abbrevs nil)
563 (build-mail-abbrevs file))
49116ac0 564
85d0e9ed 565(defun mail-abbrev-insert-alias (&optional alias)
22f4ef2e 566 "Prompt for and insert a mail alias."
c540863c 567 (interactive (progn
753d16a6
RS
568 (if (not (vectorp mail-abbrevs)) (mail-abbrevs-setup))
569 (list (completing-read "Expand alias: " mail-abbrevs nil t))))
570 (if (not (vectorp mail-abbrevs)) (mail-abbrevs-setup))
0eef787b
RS
571 (insert (or (and alias (symbol-value (intern-soft alias mail-abbrevs))) ""))
572 (mail-abbrev-expand-hook))
753d16a6 573
85d0e9ed
GM
574(defun mail-abbrev-complete-alias ()
575 "Perform completion on alias preceding point."
85d0e9ed 576 (interactive)
da00bb18 577 (mail-abbrev-make-syntax-table)
e2d4ea5a
SM
578 (let ((end (point))
579 (beg (with-syntax-table mail-abbrev-syntax-table
580 (save-excursion
581 (backward-word 1)
582 (point)))))
583 (completion-in-region beg end mail-abbrevs)))
85d0e9ed 584
753d16a6 585(defun mail-abbrev-next-line (&optional arg)
1fa1ea7d
GM
586 "Expand a mail abbrev before point, then move vertically down ARG lines.
587This only expands an abbrev (if one is present) if called with
588point at the end of a line, or on whitespace before the end of a line.
589
590In terms of line motion, this behaves like `next-line', which see."
22f4ef2e 591 (interactive "p")
d7c1ec4b
RM
592 (if (looking-at "[ \t]*\n") (expand-abbrev))
593 (setq this-command 'next-line)
91dd4dc4 594 (with-no-warnings (next-line arg)))
22f4ef2e 595
753d16a6 596(defun mail-abbrev-end-of-buffer (&optional arg)
1fa1ea7d
GM
597 "Expand a mail abbrev before point, then move to the end of the buffer.
598This only expands an abbrev (if one is present) if called with
599point at the end of a line, or on whitespace before the end of a line.
753d16a6 600
1fa1ea7d 601In other respects, this behaves like `end-of-buffer', which see."
650d6486 602 (interactive "P")
d7c1ec4b
RM
603 (if (looking-at "[ \t]*\n") (expand-abbrev))
604 (setq this-command 'end-of-buffer)
1fa1ea7d 605 (with-no-warnings (end-of-buffer arg)))
22f4ef2e 606
f526e65a
RS
607(eval-after-load "sendmail"
608 '(progn
609 (define-key mail-mode-map "\C-c\C-a" 'mail-abbrev-insert-alias)
610 (define-key mail-mode-map "\e\t" ; like lisp-complete-symbol
611 'mail-abbrev-complete-alias)))
22f4ef2e 612
753d16a6
RS
613;;(define-key mail-mode-map "\C-n" 'mail-abbrev-next-line)
614;;(define-key mail-mode-map "\M->" 'mail-abbrev-end-of-buffer)
b01c3008 615
3e1b7a46 616(provide 'mailabbrev)
b578f267 617
55535639 618;;; mailabbrev.el ends here