Commit | Line | Data |
---|---|---|
84176303 ER |
1 | ;;; mailabbrev.el --- abbrev-expansion of mail aliases. |
2 | ||
3 | ;; Author: Jamie Zawinski <jwz@lucid.com> | |
4 | ;; Roland McGrath <roland@gnu.ai.mit.edu> | |
5 | ;; Created: 19 Oct 90 | |
6 | ;; Last-Modified: 13 Jun 92 | |
fd7fa35a | 7 | ;; Keywords: mail |
84176303 | 8 | |
9c50f912 | 9 | ;;; ??? We must get papers for this or delete it. |
22f4ef2e | 10 | ;;; Copyright (C) 1985, 1986, 1987, 1992 Free Software Foundation, Inc. |
b01c3008 RS |
11 | |
12 | ;;; This file is part of GNU Emacs. | |
13 | ||
14 | ;;; GNU Emacs is free software; you can redistribute it and/or modify | |
15 | ;;; it under the terms of the GNU General Public License as published by | |
d7c1ec4b | 16 | ;;; the Free Software Foundation; either version 2, or (at your option) |
b01c3008 RS |
17 | ;;; any later version. |
18 | ||
19 | ;;; GNU Emacs is distributed in the hope that it will be useful, | |
20 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
21 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
22 | ;;; GNU General Public License for more details. | |
23 | ||
24 | ;;; You should have received a copy of the GNU General Public License | |
25 | ;;; along with GNU Emacs; see the file COPYING. If not, write to | |
26 | ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
27 | ||
84176303 ER |
28 | ;;; Commentary: |
29 | ||
b01c3008 RS |
30 | ;;; This file ensures that, when the point is in a To:, CC:, BCC:, or From: |
31 | ;;; field, word-abbrevs are defined for each of your mail aliases. These | |
32 | ;;; aliases will be defined from your .mailrc file (or the file specified by | |
22f4ef2e RM |
33 | ;;; the MAILRC environment variable) if it exists. Your mail aliases will |
34 | ;;; expand any time you type a word-delimiter at the end of an abbreviation. | |
b01c3008 RS |
35 | ;;; |
36 | ;;; What you see is what you get: no abbreviations will be expanded after you | |
37 | ;;; have sent the mail, unlike the old system. This means you don't suffer | |
38 | ;;; the annoyance of having the system do things behind your back -- if an | |
39 | ;;; address you typed is going to be rewritten, you know it immediately, | |
40 | ;;; instead of after the mail has been sent and it's too late to do anything | |
41 | ;;; about it. You will never again be screwed because you forgot to delete an | |
42 | ;;; old alias from your .mailrc when a new local user arrives and is given a | |
43 | ;;; userid which conflicts with one of your aliases, for example. | |
44 | ;;; | |
45 | ;;; Your mail alias abbrevs will be in effect only when the point is in an | |
46 | ;;; appropriate header field. When in the body of the message, or other | |
47 | ;;; header fields, the mail aliases will not expand. Rather, the normal | |
48 | ;;; mode-specific abbrev table (mail-mode-abbrev-table) will be used if | |
49 | ;;; defined. So if you use mail-mode specific abbrevs, this code will not | |
50 | ;;; adversely affect you. You can control which header fields the abbrevs | |
51 | ;;; are used in by changing the variable mail-abbrev-mode-regexp. | |
52 | ;;; | |
53 | ;;; If auto-fill mode is on, abbrevs will wrap at commas instead of at word | |
54 | ;;; boundaries; also, header continuation-lines will be properly indented. | |
55 | ;;; | |
56 | ;;; You can also insert a mail alias with mail-interactive-insert-alias | |
57 | ;;; (bound to C-c C-a), which prompts you for an alias (with completion) | |
58 | ;;; and inserts its expansion at point. | |
59 | ;;; | |
b01c3008 RS |
60 | ;;; This file fixes a bug in the old system which prohibited your .mailrc |
61 | ;;; file from having lines like | |
62 | ;;; | |
63 | ;;; alias someone "John Doe <doe@quux.com>" | |
64 | ;;; | |
65 | ;;; That is, if you want an address to have embedded spaces, simply surround it | |
66 | ;;; with double-quotes. This is necessary because the format of the .mailrc | |
67 | ;;; file bogusly uses spaces as address delimiters. The following line defines | |
68 | ;;; an alias which expands to three addresses: | |
69 | ;;; | |
70 | ;;; alias foobar addr-1 addr-2 "address three <addr-3>" | |
71 | ;;; | |
72 | ;;; (This is bogus because mail-delivery programs want commas, not spaces, | |
73 | ;;; but that's what the file format is, so we have to live with it.) | |
74 | ;;; | |
75 | ;;; If you like, you can call the function define-mail-alias to define your | |
76 | ;;; mail-aliases instead of using a .mailrc file. When you call it in this | |
f22cd786 | 77 | ;;; way, addresses are separated by commas. |
b01c3008 RS |
78 | ;;; |
79 | ;;; CAVEAT: This works on most Sun systems; I have been told that some versions | |
80 | ;;; of /bin/mail do not understand double-quotes in the .mailrc file. So you | |
81 | ;;; should make sure your version does before including verbose addresses like | |
82 | ;;; this. One solution to this, if you are on a system whose /bin/mail doesn't | |
83 | ;;; work that way, (and you still want to be able to /bin/mail to send mail in | |
84 | ;;; addition to emacs) is to define minimal aliases (without full names) in | |
85 | ;;; your .mailrc file, and use define-mail-alias to redefine them when sending | |
86 | ;;; mail from emacs; this way, mail sent from /bin/mail will work, and mail | |
87 | ;;; sent from emacs will be pretty. | |
88 | ;;; | |
89 | ;;; Aliases in the mailrc file may be nested. If you define aliases like | |
90 | ;;; alias group1 fred ethel | |
91 | ;;; alias group2 larry curly moe | |
92 | ;;; alias everybody group1 group2 | |
93 | ;;; Then when you type "everybody" on the To: line, it will be expanded to | |
94 | ;;; fred, ethyl, larry, curly, moe | |
95 | ;;; | |
96 | ;;; Aliases may also contain forward references; the alias of "everybody" can | |
97 | ;;; preceed the aliases of "group1" and "group2". | |
98 | ;;; | |
99 | ;;; This code also understands the "source" .mailrc command, for reading | |
100 | ;;; aliases from some other file as well. | |
101 | ;;; | |
22f4ef2e RM |
102 | ;;; Aliases may contain hyphens, as in "alias foo-bar foo@bar"; word-abbrevs |
103 | ;;; normally cannot contain hyphens, but this code works around that for the | |
104 | ;;; specific case of mail-alias word-abbrevs. | |
105 | ;;; | |
b01c3008 RS |
106 | ;;; To read in the contents of another .mailrc-type file from emacs, use the |
107 | ;;; command Meta-X merge-mail-aliases. The rebuild-mail-aliases command is | |
108 | ;;; similar, but will delete existing aliases first. | |
109 | ;;; | |
22f4ef2e RM |
110 | ;;; If you would like your aliases to be expanded when you type M-> or ^N to |
111 | ;;; move out of the mail-header into the message body (instead of having to | |
112 | ;;; type SPC at the end of the abbrev before moving away) then you can do | |
113 | ;;; | |
114 | ;;; (define-key mail-mode-map "\C-n" 'abbrev-hacking-next-line) | |
115 | ;;; (define-key mail-mode-map "\M->" 'abbrev-hacking-end-of-buffer) | |
116 | ;;; | |
f22cd786 RM |
117 | ;;; If you want multiple addresses separated by a string other than ", " then |
118 | ;;; you can set the variable mail-alias-separator-string to it. This has to | |
b01c3008 RS |
119 | ;;; be a comma bracketed by whitespace if you want any kind of reasonable |
120 | ;;; behaviour. | |
121 | ;;; | |
122 | ;;; Thanks to Harald Hanche-Olsen, Michael Ernst, David Loeffler, and | |
123 | ;;; Noah Friedman for suggestions and bug reports. | |
f22cd786 RM |
124 | ;;; |
125 | ;;; INSTALLATION | |
126 | ;;; | |
127 | ;;; If you are using Emacs 18, you shouldn't have to do anything at all to | |
128 | ;;; install this code other than load this file. You might want to do this | |
129 | ;;; to have this code loaded only when needed: | |
130 | ;;; | |
131 | ;;; (setq mail-setup-hook '(lambda () (require 'mail-abbrevs))) | |
132 | ;;; | |
133 | ;;; Simply loading this file will redefine and overload the required | |
134 | ;;; functions. | |
135 | ;;; | |
136 | ;;; If you want to install this code more permanently (instead of loading | |
137 | ;;; it as a patch) you need to do the following: | |
138 | ;;; | |
139 | ;;; - Remove the entire file mailalias.el; | |
140 | ;;; - Remove the definition of mail-aliases from sendmail.el; | |
141 | ;;; - Add a call to mail-aliases-setup to the front of the function | |
142 | ;;; mail-setup in the file sendmail.el; | |
143 | ;;; - Remove the call to expand-mail-aliases from the function | |
144 | ;;; sendmail-send-it in the file sendmail.el; | |
145 | ;;; - Remove the autoload of expand-mail-aliases from the file sendmail.el; | |
146 | ;;; - Remove the autoload of build-mail-aliases from the file sendmail.el; | |
147 | ;;; - Add an autoload of define-mail-alias to loaddefs.el. | |
b01c3008 | 148 | |
84176303 ER |
149 | ;;; Code: |
150 | ||
b01c3008 RS |
151 | (require 'sendmail) |
152 | ||
153 | (defvar mail-abbrev-mailrc-file nil | |
154 | "Name of file with mail aliases. If nil, ~/.mailrc is used.") | |
155 | ||
156 | (defmacro mail-abbrev-mailrc-file () | |
157 | '(or mail-abbrev-mailrc-file | |
158 | (setq mail-abbrev-mailrc-file | |
159 | (or (getenv "MAILRC") "~/.mailrc")))) | |
160 | ||
161 | ;; originally defined in sendmail.el - used to be an alist, now is a table. | |
162 | (defvar mail-aliases nil | |
22f4ef2e | 163 | "Word-abbrev table of mail address aliases. |
b01c3008 RS |
164 | If this is nil, it means the aliases have not yet been initialized and |
165 | should be read from the .mailrc file. (This is distinct from there being | |
166 | no aliases, which is represented by this being a table with no entries.)") | |
167 | ||
aa228418 | 168 | ;;;###autoload |
b01c3008 RS |
169 | (defun mail-aliases-setup () |
170 | (if (and (not (vectorp mail-aliases)) | |
171 | (file-exists-p (mail-abbrev-mailrc-file))) | |
172 | (build-mail-aliases)) | |
5aefeeba RM |
173 | (make-local-variable 'pre-abbrev-expand-hook) |
174 | (setq pre-abbrev-expand-hook | |
175 | (cond ((and (listp pre-abbrev-expand-hook) | |
176 | (not (eq 'lambda (car pre-abbrev-expand-hook)))) | |
177 | (cons 'sendmail-pre-abbrev-expand-hook pre-abbrev-expand-hook)) | |
178 | (t | |
179 | (list 'sendmail-pre-abbrev-expand-hook pre-abbrev-expand-hook)))) | |
b01c3008 RS |
180 | (abbrev-mode 1)) |
181 | ||
182 | ;;; Originally defined in mailalias.el. Changed to call define-mail-alias | |
183 | ;;; with an additional argument. | |
22f4ef2e | 184 | ;;;###autoload |
b01c3008 RS |
185 | (defun build-mail-aliases (&optional file recursivep) |
186 | "Read mail aliases from .mailrc and set mail-aliases." | |
187 | (setq file (expand-file-name (or file (mail-abbrev-mailrc-file)))) | |
188 | (if (vectorp mail-aliases) | |
189 | nil | |
190 | (setq mail-aliases nil) | |
191 | (define-abbrev-table 'mail-aliases '())) | |
5aefeeba | 192 | (message "Parsing %s..." file) |
b01c3008 RS |
193 | (let ((buffer nil) |
194 | (obuf (current-buffer))) | |
195 | (unwind-protect | |
196 | (progn | |
197 | (setq buffer (generate-new-buffer "mailrc")) | |
22f4ef2e | 198 | (buffer-disable-undo buffer) |
b01c3008 RS |
199 | (set-buffer buffer) |
200 | (cond ((get-file-buffer file) | |
201 | (insert (save-excursion | |
202 | (set-buffer (get-file-buffer file)) | |
203 | (buffer-substring (point-min) (point-max))))) | |
204 | ((not (file-exists-p file))) | |
205 | (t (insert-file-contents file))) | |
206 | ;; Don't lose if no final newline. | |
207 | (goto-char (point-max)) | |
208 | (or (eq (preceding-char) ?\n) (newline)) | |
209 | (goto-char (point-min)) | |
210 | ;; Delete comments from the file | |
211 | (while (search-forward "# " nil t) | |
212 | (let ((p (- (point) 2))) | |
213 | (end-of-line) | |
214 | (delete-region p (point)))) | |
215 | (goto-char (point-min)) | |
216 | ;; handle "\\\n" continuation lines | |
217 | (while (not (eobp)) | |
218 | (end-of-line) | |
219 | (if (= (preceding-char) ?\\) | |
220 | (progn (delete-char -1) (delete-char 1) (insert ?\ )) | |
221 | (forward-char 1))) | |
222 | (goto-char (point-min)) | |
223 | (while (re-search-forward | |
224 | "^\\(a\\(lias\\|\\)\\|g\\(roup\\)\\|source\\)[ \t]+" nil t) | |
225 | (beginning-of-line) | |
226 | (if (looking-at "source[ \t]+\\([^ \t\n]+\\)") | |
227 | (progn | |
228 | (end-of-line) | |
229 | (build-mail-aliases | |
230 | (buffer-substring (match-beginning 1) (match-end 1)) t)) | |
231 | (re-search-forward "[ \t]+\\([^ \t\n]+\\)") | |
232 | (let* ((name (buffer-substring | |
233 | (match-beginning 1) (match-end 1))) | |
234 | (start (progn (skip-chars-forward " \t") (point)))) | |
235 | (end-of-line) | |
236 | ; (message "** %s \"%s\"" name (buffer-substring start (point)))(sit-for 1) | |
237 | (define-mail-alias | |
238 | name | |
239 | (buffer-substring start (point)) | |
240 | t)))) | |
241 | ;; Resolve forward references in .mailrc file. | |
242 | ;; This would happen automatically before the first abbrev was | |
243 | ;; expanded, but why not do it now. | |
244 | (or recursivep (mail-resolve-all-aliases)) | |
245 | mail-aliases) | |
246 | (if buffer (kill-buffer buffer)) | |
247 | (set-buffer obuf))) | |
5aefeeba | 248 | (message "Parsing %s... done" file)) |
b01c3008 | 249 | |
f22cd786 | 250 | (defvar mail-alias-separator-string ", " |
b01c3008 RS |
251 | "*A string inserted between addresses in multi-address mail aliases. |
252 | This has to contain a comma, so \", \" is a reasonable value. You might | |
253 | also want something like \",\\n \" to get each address on its own line.") | |
254 | ||
255 | ;; define-mail-alias sets this flag, which causes mail-resolve-all-aliases | |
256 | ;; to be called before expanding abbrevs if it's necessary. | |
257 | (defvar mail-abbrev-aliases-need-to-be-resolved t) | |
258 | ||
259 | ;; originally defined in mailalias.el ; build-mail-aliases calls this with | |
260 | ;; stuff parsed from the .mailrc file. | |
261 | ;; | |
aa228418 | 262 | ;;;###autoload |
b01c3008 RS |
263 | (defun define-mail-alias (name definition &optional from-mailrc-file) |
264 | "Define NAME as a mail-alias that translates to DEFINITION. | |
f22cd786 | 265 | If DEFINITION contains multiple addresses, separate them with commas." |
b01c3008 RS |
266 | ;; When this is called from build-mail-aliases, the third argument is |
267 | ;; true, and we do some evil space->comma hacking like /bin/mail does. | |
268 | (interactive "sDefine mail alias: \nsDefine %s as mail alias for: ") | |
269 | ;; Read the defaults first, if we have not done so. | |
270 | (if (vectorp mail-aliases) | |
271 | nil | |
272 | (setq mail-aliases nil) | |
273 | (define-abbrev-table 'mail-aliases '()) | |
274 | (if (file-exists-p (mail-abbrev-mailrc-file)) | |
275 | (build-mail-aliases))) | |
276 | ;; strip garbage from front and end | |
277 | (if (string-match "\\`[ \t\n,]+" definition) | |
278 | (setq definition (substring definition (match-end 0)))) | |
279 | (if (string-match "[ \t\n,]+\\'" definition) | |
280 | (setq definition (substring definition 0 (match-beginning 0)))) | |
281 | (let ((result '()) | |
282 | (start 0) | |
283 | (L (length definition)) | |
284 | end) | |
285 | (while start | |
286 | ;; If we're reading from the mailrc file, then addresses are delimited | |
287 | ;; by spaces, and addresses with embedded spaces must be surrounded by | |
f22cd786 | 288 | ;; double-quotes. Otherwise, addresses are separated by commas. |
b01c3008 RS |
289 | (if from-mailrc-file |
290 | (if (eq ?\" (aref definition start)) | |
291 | (setq start (1+ start) | |
292 | end (string-match "\"[ \t,]*" definition start)) | |
293 | (setq end (string-match "[ \t,]+" definition start))) | |
294 | (setq end (string-match "[ \t\n,]*,[ \t\n,]*" definition start))) | |
295 | (setq result (cons (substring definition start end) result)) | |
296 | (setq start (and end | |
297 | (/= (match-end 0) L) | |
298 | (match-end 0)))) | |
299 | (setq definition (mapconcat (function identity) | |
300 | (nreverse result) | |
f22cd786 | 301 | mail-alias-separator-string))) |
b01c3008 RS |
302 | (setq mail-abbrev-aliases-need-to-be-resolved t) |
303 | (setq name (downcase name)) | |
304 | ;; use an abbrev table instead of an alist for mail-aliases. | |
305 | (let ((abbrevs-changed abbrevs-changed)) ; protect this from being changed. | |
306 | (define-abbrev mail-aliases name definition 'mail-abbrev-expand-hook))) | |
307 | ||
308 | ||
309 | (defun mail-resolve-all-aliases () | |
310 | "Resolve all forward references in the mail aliases table." | |
311 | (if mail-abbrev-aliases-need-to-be-resolved | |
312 | (progn | |
313 | ;; (message "Resolving mail aliases...") | |
314 | (if (vectorp mail-aliases) | |
315 | (mapatoms (function mail-resolve-all-aliases-1) mail-aliases)) | |
316 | (setq mail-abbrev-aliases-need-to-be-resolved nil) | |
317 | ;; (message "Resolving mail aliases... done.") | |
318 | ))) | |
319 | ||
d7c1ec4b RM |
320 | (defun mail-resolve-all-aliases-1 (sym &optional so-far) |
321 | (if (memq sym so-far) | |
322 | (error "mail alias loop detected: %s" | |
323 | (mapconcat 'symbol-name (cons sym so-far) " <- "))) | |
b01c3008 RS |
324 | (let ((definition (and (boundp sym) (symbol-value sym)))) |
325 | (if definition | |
326 | (let ((result '()) | |
327 | (start 0)) | |
328 | (while start | |
329 | (let ((end (string-match "[ \t\n]*,[, \t\n]*" definition start))) | |
330 | (setq result (cons (substring definition start end) result) | |
331 | start (and end (match-end 0))))) | |
332 | (setq definition | |
333 | (mapconcat (function (lambda (x) | |
334 | (or (mail-resolve-all-aliases-1 | |
d7c1ec4b RM |
335 | (intern-soft x mail-aliases) |
336 | (cons sym so-far)) | |
b01c3008 RS |
337 | x))) |
338 | (nreverse result) | |
f22cd786 | 339 | mail-alias-separator-string)) |
b01c3008 RS |
340 | (set sym definition)))) |
341 | (symbol-value sym)) | |
342 | ||
343 | ||
f22cd786 | 344 | (defun mail-abbrev-expand-hook () |
22f4ef2e | 345 | "For use as the fourth arg to define-abbrev. |
f22cd786 | 346 | After expanding a mail-abbrev, if fill-mode is on and we're past the |
22f4ef2e RM |
347 | fill-column, break the line at the previous comma, and indent the next |
348 | line." | |
cbec775b RM |
349 | (save-excursion |
350 | (let ((p (point)) | |
351 | bol comma fp) | |
352 | (beginning-of-line) | |
353 | (setq bol (point)) | |
354 | (goto-char p) | |
5aefeeba | 355 | (while (and auto-fill-function |
cbec775b RM |
356 | (>= (current-column) fill-column) |
357 | (search-backward "," bol t)) | |
358 | (setq comma (point)) | |
359 | (forward-char 1) ; Now we are just past the comma. | |
360 | (insert "\n") | |
361 | (delete-horizontal-space) | |
f22cd786 | 362 | (setq p (point)) |
cbec775b RM |
363 | (indent-relative) |
364 | (setq fp (buffer-substring p (point))) | |
365 | ;; Go to the end of the new line. | |
366 | (end-of-line) | |
367 | (if (> (current-column) fill-column) | |
368 | ;; It's still too long; do normal auto-fill. | |
369 | (let ((fill-prefix (or fp "\t"))) | |
370 | (do-auto-fill))) | |
371 | ;; Resume the search. | |
372 | (goto-char comma) | |
373 | )))) | |
22f4ef2e RM |
374 | \f |
375 | ;;; Syntax tables and abbrev-expansion | |
b01c3008 | 376 | |
22f4ef2e | 377 | (defvar mail-abbrev-mode-regexp "^\\(Resent-\\)?\\(To\\|From\\|CC\\|BCC\\):" |
b01c3008 RS |
378 | "*Regexp to select mail-headers in which mail-aliases should be expanded. |
379 | This string it will be handed to `looking-at' with the point at the beginning | |
380 | of the current line; if it matches, abbrev mode will be turned on, otherwise | |
381 | it will be turned off. (You don't need to worry about continuation lines.) | |
382 | This should be set to match those mail fields in which you want abbreviations | |
383 | turned on.") | |
384 | ||
385 | (defvar mail-mode-syntax-table (copy-syntax-table text-mode-syntax-table) | |
22f4ef2e | 386 | "The syntax table which is used in send-mail mode message bodies.") |
b01c3008 RS |
387 | |
388 | (defvar mail-mode-header-syntax-table | |
389 | (let ((tab (copy-syntax-table text-mode-syntax-table))) | |
f22cd786 | 390 | ;; This makes the characters "@%!._-" be considered symbol-consituents |
b01c3008 RS |
391 | ;; but not word-constituents, so forward-sexp will move you over an |
392 | ;; entire address, but forward-word will only move you over a sequence | |
393 | ;; of alphanumerics. (Clearly the right thing.) | |
394 | (modify-syntax-entry ?@ "_" tab) | |
395 | (modify-syntax-entry ?% "_" tab) | |
396 | (modify-syntax-entry ?! "_" tab) | |
397 | (modify-syntax-entry ?. "_" tab) | |
398 | (modify-syntax-entry ?_ "_" tab) | |
399 | (modify-syntax-entry ?- "_" tab) | |
400 | (modify-syntax-entry ?< "(>" tab) | |
401 | (modify-syntax-entry ?> ")<" tab) | |
b01c3008 | 402 | tab) |
22f4ef2e RM |
403 | "The syntax table used in send-mail mode when in a mail-address header. |
404 | mail-mode-syntax-table is used when the cursor is in the message body or in | |
405 | non-address headers.") | |
406 | ||
407 | (defvar mail-abbrev-syntax-table | |
408 | (let* ((tab (copy-syntax-table mail-mode-header-syntax-table)) | |
409 | (i (1- (length tab))) | |
410 | (_ (aref (standard-syntax-table) ?_)) | |
411 | (w (aref (standard-syntax-table) ?w))) | |
412 | (while (>= i 0) | |
413 | (if (= (aref tab i) _) (aset tab i w)) | |
414 | (setq i (1- i))) | |
415 | tab) | |
416 | "The syntax-table used for abbrev-expansion purposes; this is not actually | |
417 | made the current syntax table of the buffer, but simply controls the set of | |
418 | characters which may be a part of the name of a mail-alias.") | |
419 | ||
420 | ||
421 | (defun mail-abbrev-in-expansion-header-p () | |
422 | "Whether point is in a mail-address header field." | |
423 | (let ((case-fold-search t)) | |
424 | (and ;; | |
425 | ;; we are on an appropriate header line... | |
426 | (save-excursion | |
427 | (beginning-of-line) | |
428 | ;; skip backwards over continuation lines. | |
429 | (while (and (looking-at "^[ \t]") | |
430 | (not (= (point) (point-min)))) | |
431 | (forward-line -1)) | |
432 | ;; are we at the front of an appropriate header line? | |
433 | (looking-at mail-abbrev-mode-regexp)) | |
434 | ;; | |
435 | ;; ...and we are before the mail-header-separator | |
436 | (< (point) | |
437 | (save-excursion | |
438 | (goto-char (point-min)) | |
439 | (search-forward (concat "\n" mail-header-separator "\n") | |
440 | nil 0) | |
441 | (point)))))) | |
442 | ||
443 | (defvar mail-mode-abbrev-table) ; quiet the compiler | |
b01c3008 | 444 | |
f22cd786 | 445 | (defun sendmail-pre-abbrev-expand-hook () |
b01c3008 RS |
446 | (if mail-abbrev-aliases-need-to-be-resolved |
447 | (mail-resolve-all-aliases)) | |
f22cd786 RM |
448 | (if (and mail-aliases (not (eq mail-aliases t))) |
449 | (if (not (mail-abbrev-in-expansion-header-p)) | |
450 | ;; | |
451 | ;; If we're not in a mail header in which mail aliases should | |
452 | ;; be expanded, then use the normal mail-mode abbrev table (if any) | |
453 | ;; and the normal mail-mode syntax table. | |
454 | ;; | |
b01c3008 | 455 | (progn |
f22cd786 RM |
456 | (setq local-abbrev-table (and (boundp 'mail-mode-abbrev-table) |
457 | mail-mode-abbrev-table)) | |
458 | (set-syntax-table mail-mode-syntax-table)) | |
22f4ef2e | 459 | ;; |
f22cd786 RM |
460 | ;; Otherwise, we are in a To: (or CC:, or whatever) header, and |
461 | ;; should use word-abbrevs to expand mail aliases. | |
462 | ;; - First, install the mail-aliases as the word-abbrev table. | |
463 | ;; - Then install the mail-abbrev-syntax-table, which temporarily | |
464 | ;; marks all of the non-alphanumeric-atom-characters (the "_" | |
465 | ;; syntax ones) as being normal word-syntax. We do this because | |
466 | ;; the C code for expand-abbrev only works on words, and we want | |
467 | ;; these characters to be considered words for the purpose of | |
468 | ;; abbrev expansion. | |
469 | ;; - Then we call expand-abbrev again, recursively, to do the abbrev | |
470 | ;; expansion with the above syntax table. | |
471 | ;; - Then we do a trick which tells the expand-abbrev frame which | |
472 | ;; invoked us to not continue (and thus not expand twice.) | |
d7c1ec4b RM |
473 | ;; This means that any abbrev expansion will happen as a result |
474 | ;; of this function's call to expand-abbrev, and not as a result | |
475 | ;; of the call to expand-abbrev which invoked *us*. | |
f22cd786 RM |
476 | ;; - Then we set the syntax table to mail-mode-header-syntax-table, |
477 | ;; which doesn't have anything to do with abbrev expansion, but | |
478 | ;; is just for the user's convenience (see its doc string.) | |
22f4ef2e | 479 | ;; |
f22cd786 RM |
480 | (setq local-abbrev-table mail-aliases) |
481 | ;; If the character just typed was non-alpha-symbol-syntax, then don't | |
482 | ;; expand the abbrev now (that is, don't expand when the user types -.) | |
d7c1ec4b RM |
483 | ;; Check the character's syntax in the mail-mode-header-syntax-table. |
484 | (set-syntax-table mail-mode-header-syntax-table) | |
485 | (or (eq (char-syntax last-command-char) ?_) | |
486 | (let ((pre-abbrev-expand-hook nil)) ; That's us; don't loop. | |
487 | ;; Use this table so that abbrevs can have hyphens in them. | |
f22cd786 | 488 | (set-syntax-table mail-abbrev-syntax-table) |
d7c1ec4b RM |
489 | (expand-abbrev) |
490 | ;; Now set it back to what it was before. | |
491 | (set-syntax-table mail-mode-header-syntax-table))) | |
492 | (setq abbrev-start-location (point) ; This is the trick. | |
f22cd786 | 493 | abbrev-start-location-buffer (current-buffer)) |
f22cd786 | 494 | ))) |
22f4ef2e RM |
495 | \f |
496 | ;;; utilities | |
b01c3008 RS |
497 | |
498 | (defun merge-mail-aliases (file) | |
499 | "Merge mail aliases from the given file with existing ones." | |
500 | (interactive (list | |
501 | (let ((insert-default-directory t) | |
502 | (default-directory (expand-file-name "~/")) | |
503 | (def (mail-abbrev-mailrc-file))) | |
504 | (read-file-name | |
505 | (format "Read additional aliases from file: (default %s) " | |
506 | def) | |
507 | default-directory | |
508 | (expand-file-name def default-directory) | |
509 | t)))) | |
510 | (build-mail-aliases file)) | |
511 | ||
512 | (defun rebuild-mail-aliases (file) | |
513 | "Rebuild all the mail aliases from the given file." | |
514 | (interactive (list | |
515 | (let ((insert-default-directory t) | |
516 | (default-directory (expand-file-name "~/")) | |
517 | (def (mail-abbrev-mailrc-file))) | |
518 | (read-file-name | |
519 | (format "Read mail aliases from file: (default %s) " def) | |
520 | default-directory | |
521 | (expand-file-name def default-directory) | |
522 | t)))) | |
523 | (setq mail-aliases nil) | |
524 | (build-mail-aliases file)) | |
49116ac0 | 525 | |
22f4ef2e RM |
526 | (defun mail-interactive-insert-alias (&optional alias) |
527 | "Prompt for and insert a mail alias." | |
528 | (interactive (list (completing-read "Expand alias: " mail-aliases nil t))) | |
433a300a | 529 | (insert (or (and alias (symbol-value (intern-soft alias mail-aliases))) ""))) |
22f4ef2e RM |
530 | |
531 | (defun abbrev-hacking-next-line (&optional arg) | |
532 | "Just like `next-line' (\\[next-line]) but expands abbrevs when at \ | |
533 | end of line." | |
534 | (interactive "p") | |
d7c1ec4b RM |
535 | (if (looking-at "[ \t]*\n") (expand-abbrev)) |
536 | (setq this-command 'next-line) | |
22f4ef2e RM |
537 | (next-line arg)) |
538 | ||
539 | (defun abbrev-hacking-end-of-buffer (&optional arg) | |
540 | "Just like `end-of-buffer' (\\[end-of-buffer]) but expands abbrevs when at \ | |
541 | end of line." | |
542 | (interactive "P") | |
d7c1ec4b RM |
543 | (if (looking-at "[ \t]*\n") (expand-abbrev)) |
544 | (setq this-command 'end-of-buffer) | |
22f4ef2e RM |
545 | (end-of-buffer arg)) |
546 | ||
547 | (define-key mail-mode-map "\C-c\C-a" 'mail-interactive-insert-alias) | |
548 | ||
5aefeeba RM |
549 | ;;(define-key mail-mode-map "\C-n" 'abbrev-hacking-next-line) |
550 | ;;(define-key mail-mode-map "\M->" 'abbrev-hacking-end-of-buffer) | |
b01c3008 | 551 | |
22f4ef2e | 552 | (provide 'mail-abbrevs) |
5aefeeba RM |
553 | |
554 | \f | |
555 | ;;; V18 compatibility | |
f22cd786 RM |
556 | ;;; |
557 | ;;; All of the Emacs18 stuff is isolated down here so that it will be | |
558 | ;;; easy to delete once v18 finally bites the dust. | |
559 | ;;; | |
560 | ;;; These defuns and defvars aren't inside the cond in deference to | |
561 | ;;; the intense brokenness of the v18 byte-compiler. | |
d7c1ec4b RM |
562 | ;;; |
563 | ;;; All the code on this page is gross and hidious and awful and might | |
564 | ;;; not even work all that well. Comfort yourself with knowing that the | |
565 | ;;; v19 code above works wonderfully. | |
5aefeeba RM |
566 | |
567 | (defun sendmail-v18-self-insert-command (arg) | |
568 | "Just like self-insert-command, but runs sendmail-pre-abbrev-expand-hook." | |
569 | (interactive "p") | |
d7c1ec4b | 570 | (if (not (eq (char-syntax last-command-char) ?w)) |
f22cd786 RM |
571 | (progn |
572 | (sendmail-pre-abbrev-expand-hook) | |
573 | ;; Unhack expand-abbrev, so it will work right next time around. | |
574 | (setq abbrev-start-location nil))) | |
d7c1ec4b RM |
575 | ;; this is gross and wasteful. |
576 | (let ((abbrev-mode (if (mail-abbrev-in-expansion-header-p) | |
577 | nil | |
578 | abbrev-mode))) | |
f22cd786 | 579 | (self-insert-command arg))) |
5aefeeba | 580 | |
d7c1ec4b RM |
581 | (defun abbrev-hacking-next-line-v18 (arg) |
582 | (if (looking-at "[ \t]*\n") (sendmail-pre-abbrev-expand-hook)) | |
583 | (setq this-command 'next-line) | |
584 | (next-line arg)) | |
585 | ||
586 | (defun abbrev-hacking-end-of-buffer-v18 (arg) | |
587 | (if (looking-at "[ \t]*\n") (sendmail-pre-abbrev-expand-hook)) | |
588 | (setq this-command 'end-of-buffer) | |
589 | (end-of-buffer arg)) | |
590 | ||
5aefeeba RM |
591 | (defvar mail-abbrevs-v18-map-munged nil) |
592 | ||
593 | (defun mail-abbrevs-v18-munge-map () | |
f22cd786 RM |
594 | ;; For every key that is bound to self-insert-command in global-map, |
595 | ;; bind that key to sendmail-self-insert-command in mail-mode-map. | |
596 | ;; We used to do this by making the mail-mode-map be a non-sparse map, | |
597 | ;; but that made the esc-map be shared in such a way that making a | |
598 | ;; local meta binding in the mail-mode-map made a *global* binding | |
599 | ;; instead. Yucko. | |
600 | (let ((global-map (current-global-map)) | |
d7c1ec4b | 601 | new-bindings |
f22cd786 RM |
602 | (i 0)) |
603 | (while (< i 128) | |
604 | (if (eq 'self-insert-command (or (cdr (assq i mail-mode-map)) | |
605 | (aref global-map i))) | |
d7c1ec4b RM |
606 | (setq new-bindings |
607 | (cons (cons i 'sendmail-v18-self-insert-command) | |
608 | new-bindings))) | |
609 | (setq i (1+ i))) | |
610 | (setq mail-mode-map | |
611 | (nconc (copy-keymap mail-mode-map) (nreverse new-bindings)))) | |
5aefeeba RM |
612 | (setq mail-abbrevs-v18-map-munged t)) |
613 | ||
f22cd786 | 614 | (defun mail-aliases-setup-v18 () |
5aefeeba | 615 | "Put this on `mail-setup-hook' to use mail-abbrevs." |
d7c1ec4b RM |
616 | (if (not (eq major-mode 'mail-mode)) |
617 | nil | |
618 | (or (and mail-mode-map (eq (current-local-map) mail-mode-map)) | |
619 | (error "shut 'er down clancy, she's suckin' mud")) | |
620 | (if (and (not (vectorp mail-aliases)) | |
621 | (file-exists-p (mail-abbrev-mailrc-file))) | |
622 | (build-mail-aliases)) | |
623 | (or mail-abbrevs-v18-map-munged (mail-abbrevs-v18-munge-map)) | |
624 | (use-local-map mail-mode-map) | |
625 | (abbrev-mode 1))) | |
5aefeeba RM |
626 | |
627 | ||
5aefeeba RM |
628 | (cond ((or (string-match "^18\\." emacs-version) |
629 | (and (boundp 'epoch::version) epoch::version)) | |
f22cd786 RM |
630 | ;; |
631 | ;; v19 (and this code) uses a new name for this function. | |
5aefeeba RM |
632 | (or (fboundp 'buffer-disable-undo) |
633 | (fset 'buffer-disable-undo 'buffer-flush-undo)) | |
f22cd786 RM |
634 | ;; |
635 | ;; v19 (and this code) uses a new name for auto-fill-hook (-function). | |
636 | ;; Encapsulate the function that uses it to bind the new name. | |
5aefeeba RM |
637 | (or (fboundp 'mail-abbrev-expand-hook-v19) |
638 | (fset 'mail-abbrev-expand-hook-v19 | |
639 | (symbol-function 'mail-abbrev-expand-hook))) | |
f22cd786 RM |
640 | (fset 'mail-abbrev-expand-hook |
641 | (function (lambda () | |
642 | (let ((auto-fill-function auto-fill-hook)) | |
643 | (mail-abbrev-expand-hook-v19))))) | |
644 | ;; | |
645 | ;; Turn off the broken v18 code (that is still called from sendmail.el) | |
5aefeeba | 646 | (fset 'expand-mail-aliases |
f22cd786 RM |
647 | (function (lambda (&rest args) |
648 | "Obsoleted by mail-abbrevs. Does nothing." | |
649 | nil))) | |
650 | ;; | |
d7c1ec4b RM |
651 | ;; Redefine the abbrev-hacking functions. Yuck. |
652 | (fset 'abbrev-hacking-next-line | |
653 | (function (lambda (p) (interactive "p") | |
654 | (abbrev-hacking-next-line-v18 p)))) | |
655 | (fset 'abbrev-hacking-end-of-buffer | |
656 | (function (lambda (p) (interactive "P") | |
657 | (abbrev-hacking-end-of-buffer-v18 p)))) | |
658 | ;; | |
f22cd786 RM |
659 | ;; Encapsulate mail-setup to do the necessary buffer initializations. |
660 | (or (fboundp 'mail-setup-v18) | |
661 | (fset 'mail-setup-v18 (symbol-function 'mail-setup))) | |
662 | (fset 'mail-setup | |
663 | (function (lambda (&rest args) | |
664 | (mail-aliases-setup-v18) | |
665 | (apply 'mail-setup-v18 args)))) | |
d7c1ec4b RM |
666 | |
667 | ;; | |
668 | ;; Encapsulate VM's version of mail-setup as well, if vm-mail is | |
669 | ;; defined as a function or as an autoload. | |
670 | (cond ((and (fboundp 'vm-mail) | |
671 | (if (eq 'autoload (car-safe (symbol-function 'vm-mail))) | |
672 | (load (nth 1 (symbol-function 'vm-mail)) t) | |
673 | t)) | |
674 | (or (fboundp 'vm-mail-internal-v18) | |
675 | (fset 'vm-mail-internal-v18 | |
676 | (symbol-function 'vm-mail-internal))) | |
677 | (fset 'vm-mail-internal | |
678 | (function (lambda (&rest args) | |
679 | (mail-aliases-setup-v18) | |
680 | (apply 'vm-mail-internal-v18 args)))))) | |
681 | ||
682 | ;; If we're being loaded from mail-setup-hook or mail-mode-hook | |
683 | ;; as run from inside mail-setup or vm-mail-internal, then install | |
684 | ;; right now. | |
685 | (if (eq major-mode 'mail-mode) | |
686 | (mail-aliases-setup-v18)) | |
5aefeeba | 687 | ) |
f22cd786 | 688 | |
5aefeeba RM |
689 | (t ; v19 |
690 | (fmakunbound 'expand-mail-aliases))) |