Commit | Line | Data |
---|---|---|
275da787 RM |
1 | ;;; mailabbrev.el --- abbrev-expansion of mail aliases. |
2 | ||
7b143708 | 3 | ;;; Copyright (C) 1985, 1986, 1987, 1992, 1993 Free Software Foundation, Inc. |
275da787 RM |
4 | |
5 | ;; Author: Jamie Zawinski <jwz@lucid.com> | |
6 | ;; Maintainer: Jamie Zawinski <jwz@lucid.com> | |
7 | ;; Created: 19 Oct 90 | |
8 | ;; Keywords: mail | |
9 | ||
b01c3008 RS |
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 | |
d7c1ec4b | 14 | ;;; the Free Software Foundation; either version 2, or (at your option) |
b01c3008 RS |
15 | ;;; 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; see the file COPYING. If not, write to | |
24 | ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
25 | ||
275da787 RM |
26 | ;;; Commentary: |
27 | ||
b01c3008 RS |
28 | ;;; This file ensures that, when the point is in a To:, CC:, BCC:, or From: |
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 | |
22f4ef2e RM |
31 | ;;; the MAILRC environment variable) if it exists. Your mail aliases will |
32 | ;;; expand any time you type a word-delimiter at the end of an abbreviation. | |
b01c3008 RS |
33 | ;;; |
34 | ;;; What you see is what you get: no abbreviations will be expanded after you | |
35 | ;;; have sent the mail, unlike the old system. This means you don't suffer | |
36 | ;;; the annoyance of having the system do things behind your back -- if an | |
37 | ;;; address you typed is going to be rewritten, you know it immediately, | |
38 | ;;; instead of after the mail has been sent and it's too late to do anything | |
39 | ;;; about it. You will never again be screwed because you forgot to delete an | |
40 | ;;; old alias from your .mailrc when a new local user arrives and is given a | |
41 | ;;; userid which conflicts with one of your aliases, for example. | |
42 | ;;; | |
43 | ;;; Your mail alias abbrevs will be in effect only when the point is in an | |
44 | ;;; appropriate header field. When in the body of the message, or other | |
45 | ;;; header fields, the mail aliases will not expand. Rather, the normal | |
46 | ;;; mode-specific abbrev table (mail-mode-abbrev-table) will be used if | |
47 | ;;; defined. So if you use mail-mode specific abbrevs, this code will not | |
48 | ;;; adversely affect you. You can control which header fields the abbrevs | |
49 | ;;; are used in by changing the variable mail-abbrev-mode-regexp. | |
50 | ;;; | |
51 | ;;; If auto-fill mode is on, abbrevs will wrap at commas instead of at word | |
52 | ;;; boundaries; also, header continuation-lines will be properly indented. | |
53 | ;;; | |
54 | ;;; You can also insert a mail alias with mail-interactive-insert-alias | |
55 | ;;; (bound to C-c C-a), which prompts you for an alias (with completion) | |
56 | ;;; and inserts its expansion at point. | |
57 | ;;; | |
b01c3008 RS |
58 | ;;; This file fixes a bug in the old system which prohibited your .mailrc |
59 | ;;; file from having lines like | |
60 | ;;; | |
61 | ;;; alias someone "John Doe <doe@quux.com>" | |
62 | ;;; | |
63 | ;;; That is, if you want an address to have embedded spaces, simply surround it | |
64 | ;;; with double-quotes. This is necessary because the format of the .mailrc | |
65 | ;;; file bogusly uses spaces as address delimiters. The following line defines | |
66 | ;;; an alias which expands to three addresses: | |
67 | ;;; | |
68 | ;;; alias foobar addr-1 addr-2 "address three <addr-3>" | |
69 | ;;; | |
70 | ;;; (This is bogus because mail-delivery programs want commas, not spaces, | |
71 | ;;; but that's what the file format is, so we have to live with it.) | |
72 | ;;; | |
73 | ;;; If you like, you can call the function define-mail-alias to define your | |
753d16a6 | 74 | ;;; mail aliases instead of using a .mailrc file. When you call it in this |
f22cd786 | 75 | ;;; way, addresses are separated by commas. |
b01c3008 RS |
76 | ;;; |
77 | ;;; CAVEAT: This works on most Sun systems; I have been told that some versions | |
78 | ;;; of /bin/mail do not understand double-quotes in the .mailrc file. So you | |
79 | ;;; should make sure your version does before including verbose addresses like | |
80 | ;;; this. One solution to this, if you are on a system whose /bin/mail doesn't | |
81 | ;;; work that way, (and you still want to be able to /bin/mail to send mail in | |
82 | ;;; addition to emacs) is to define minimal aliases (without full names) in | |
83 | ;;; your .mailrc file, and use define-mail-alias to redefine them when sending | |
84 | ;;; mail from emacs; this way, mail sent from /bin/mail will work, and mail | |
85 | ;;; sent from emacs will be pretty. | |
86 | ;;; | |
87 | ;;; Aliases in the mailrc file may be nested. If you define aliases like | |
88 | ;;; alias group1 fred ethel | |
89 | ;;; alias group2 larry curly moe | |
90 | ;;; alias everybody group1 group2 | |
91 | ;;; Then when you type "everybody" on the To: line, it will be expanded to | |
92 | ;;; fred, ethyl, larry, curly, moe | |
93 | ;;; | |
94 | ;;; Aliases may also contain forward references; the alias of "everybody" can | |
95 | ;;; preceed the aliases of "group1" and "group2". | |
96 | ;;; | |
97 | ;;; This code also understands the "source" .mailrc command, for reading | |
98 | ;;; aliases from some other file as well. | |
99 | ;;; | |
22f4ef2e RM |
100 | ;;; Aliases may contain hyphens, as in "alias foo-bar foo@bar"; word-abbrevs |
101 | ;;; normally cannot contain hyphens, but this code works around that for the | |
102 | ;;; specific case of mail-alias word-abbrevs. | |
103 | ;;; | |
b01c3008 | 104 | ;;; To read in the contents of another .mailrc-type file from emacs, use the |
753d16a6 | 105 | ;;; command Meta-X merge-mail-abbrevs. The rebuild-mail-abbrevs command is |
b01c3008 RS |
106 | ;;; similar, but will delete existing aliases first. |
107 | ;;; | |
22f4ef2e RM |
108 | ;;; If you would like your aliases to be expanded when you type M-> or ^N to |
109 | ;;; move out of the mail-header into the message body (instead of having to | |
110 | ;;; type SPC at the end of the abbrev before moving away) then you can do | |
111 | ;;; | |
c884cb87 RS |
112 | ;;; (define-key mail-mode-map "\C-n" 'mail-abbrev-next-line) |
113 | ;;; (define-key mail-mode-map "\M->" 'mail-abbrev-end-of-buffer) | |
22f4ef2e | 114 | ;;; |
f22cd786 RM |
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 | |
b01c3008 RS |
117 | ;;; be a comma bracketed by whitespace if you want any kind of reasonable |
118 | ;;; behaviour. | |
119 | ;;; | |
120 | ;;; Thanks to Harald Hanche-Olsen, Michael Ernst, David Loeffler, and | |
121 | ;;; Noah Friedman for suggestions and bug reports. | |
753d16a6 RS |
122 | |
123 | ;;; To use this file, add mail-abbrevs-setup as a hook | |
124 | ;;; to the hook list `mail-setup-hook'. | |
b01c3008 | 125 | |
275da787 RM |
126 | ;;; Code: |
127 | ||
b01c3008 RS |
128 | (require 'sendmail) |
129 | ||
130 | (defvar mail-abbrev-mailrc-file nil | |
131 | "Name of file with mail aliases. If nil, ~/.mailrc is used.") | |
132 | ||
133 | (defmacro mail-abbrev-mailrc-file () | |
134 | '(or mail-abbrev-mailrc-file | |
135 | (setq mail-abbrev-mailrc-file | |
136 | (or (getenv "MAILRC") "~/.mailrc")))) | |
137 | ||
138 | ;; originally defined in sendmail.el - used to be an alist, now is a table. | |
753d16a6 | 139 | (defvar mail-abbrevs nil |
22f4ef2e | 140 | "Word-abbrev table of mail address aliases. |
b01c3008 RS |
141 | If this is nil, it means the aliases have not yet been initialized and |
142 | should be read from the .mailrc file. (This is distinct from there being | |
143 | no aliases, which is represented by this being a table with no entries.)") | |
144 | ||
aa228418 | 145 | ;;;###autoload |
753d16a6 RS |
146 | (defun mail-abbrevs-setup () |
147 | (if (and (not (vectorp mail-abbrevs)) | |
b01c3008 | 148 | (file-exists-p (mail-abbrev-mailrc-file))) |
753d16a6 | 149 | (build-mail-abbrevs)) |
5aefeeba RM |
150 | (make-local-variable 'pre-abbrev-expand-hook) |
151 | (setq pre-abbrev-expand-hook | |
152 | (cond ((and (listp pre-abbrev-expand-hook) | |
153 | (not (eq 'lambda (car pre-abbrev-expand-hook)))) | |
154 | (cons 'sendmail-pre-abbrev-expand-hook pre-abbrev-expand-hook)) | |
155 | (t | |
156 | (list 'sendmail-pre-abbrev-expand-hook pre-abbrev-expand-hook)))) | |
b01c3008 RS |
157 | (abbrev-mode 1)) |
158 | ||
22f4ef2e | 159 | ;;;###autoload |
753d16a6 RS |
160 | (defun build-mail-abbrevs (&optional file recursivep) |
161 | "Read mail aliases from `~/.mailrc' file and set `mail-abbrevs'." | |
b01c3008 | 162 | (setq file (expand-file-name (or file (mail-abbrev-mailrc-file)))) |
753d16a6 | 163 | (if (vectorp mail-abbrevs) |
b01c3008 | 164 | nil |
753d16a6 RS |
165 | (setq mail-abbrevs nil) |
166 | (define-abbrev-table 'mail-abbrevs '())) | |
5aefeeba | 167 | (message "Parsing %s..." file) |
b01c3008 RS |
168 | (let ((buffer nil) |
169 | (obuf (current-buffer))) | |
170 | (unwind-protect | |
171 | (progn | |
172 | (setq buffer (generate-new-buffer "mailrc")) | |
22f4ef2e | 173 | (buffer-disable-undo buffer) |
b01c3008 RS |
174 | (set-buffer buffer) |
175 | (cond ((get-file-buffer file) | |
176 | (insert (save-excursion | |
177 | (set-buffer (get-file-buffer file)) | |
178 | (buffer-substring (point-min) (point-max))))) | |
179 | ((not (file-exists-p file))) | |
180 | (t (insert-file-contents file))) | |
181 | ;; Don't lose if no final newline. | |
182 | (goto-char (point-max)) | |
183 | (or (eq (preceding-char) ?\n) (newline)) | |
184 | (goto-char (point-min)) | |
185 | ;; Delete comments from the file | |
186 | (while (search-forward "# " nil t) | |
187 | (let ((p (- (point) 2))) | |
188 | (end-of-line) | |
189 | (delete-region p (point)))) | |
190 | (goto-char (point-min)) | |
191 | ;; handle "\\\n" continuation lines | |
192 | (while (not (eobp)) | |
193 | (end-of-line) | |
194 | (if (= (preceding-char) ?\\) | |
195 | (progn (delete-char -1) (delete-char 1) (insert ?\ )) | |
196 | (forward-char 1))) | |
197 | (goto-char (point-min)) | |
198 | (while (re-search-forward | |
c540863c | 199 | "^\\(a\\(lias\\)?\\|g\\(roup\\)?\\|source\\)[ \t]+" nil t) |
b01c3008 RS |
200 | (beginning-of-line) |
201 | (if (looking-at "source[ \t]+\\([^ \t\n]+\\)") | |
202 | (progn | |
203 | (end-of-line) | |
753d16a6 | 204 | (build-mail-abbrevs |
b01c3008 RS |
205 | (buffer-substring (match-beginning 1) (match-end 1)) t)) |
206 | (re-search-forward "[ \t]+\\([^ \t\n]+\\)") | |
207 | (let* ((name (buffer-substring | |
208 | (match-beginning 1) (match-end 1))) | |
209 | (start (progn (skip-chars-forward " \t") (point)))) | |
210 | (end-of-line) | |
211 | ; (message "** %s \"%s\"" name (buffer-substring start (point)))(sit-for 1) | |
212 | (define-mail-alias | |
213 | name | |
214 | (buffer-substring start (point)) | |
215 | t)))) | |
216 | ;; Resolve forward references in .mailrc file. | |
217 | ;; This would happen automatically before the first abbrev was | |
218 | ;; expanded, but why not do it now. | |
219 | (or recursivep (mail-resolve-all-aliases)) | |
753d16a6 | 220 | mail-abbrevs) |
b01c3008 RS |
221 | (if buffer (kill-buffer buffer)) |
222 | (set-buffer obuf))) | |
5aefeeba | 223 | (message "Parsing %s... done" file)) |
b01c3008 | 224 | |
f22cd786 | 225 | (defvar mail-alias-separator-string ", " |
b01c3008 RS |
226 | "*A string inserted between addresses in multi-address mail aliases. |
227 | This has to contain a comma, so \", \" is a reasonable value. You might | |
228 | also want something like \",\\n \" to get each address on its own line.") | |
229 | ||
230 | ;; define-mail-alias sets this flag, which causes mail-resolve-all-aliases | |
231 | ;; to be called before expanding abbrevs if it's necessary. | |
232 | (defvar mail-abbrev-aliases-need-to-be-resolved t) | |
233 | ||
753d16a6 | 234 | ;; originally defined in mailalias.el ; build-mail-abbrevs calls this with |
b01c3008 RS |
235 | ;; stuff parsed from the .mailrc file. |
236 | ;; | |
aa228418 | 237 | ;;;###autoload |
b01c3008 RS |
238 | (defun define-mail-alias (name definition &optional from-mailrc-file) |
239 | "Define NAME as a mail-alias that translates to DEFINITION. | |
f22cd786 | 240 | If DEFINITION contains multiple addresses, separate them with commas." |
753d16a6 | 241 | ;; When this is called from build-mail-abbrevs, the third argument is |
b01c3008 RS |
242 | ;; true, and we do some evil space->comma hacking like /bin/mail does. |
243 | (interactive "sDefine mail alias: \nsDefine %s as mail alias for: ") | |
244 | ;; Read the defaults first, if we have not done so. | |
753d16a6 | 245 | (if (vectorp mail-abbrevs) |
b01c3008 | 246 | nil |
753d16a6 RS |
247 | (setq mail-abbrevs nil) |
248 | (define-abbrev-table 'mail-abbrevs '()) | |
b01c3008 | 249 | (if (file-exists-p (mail-abbrev-mailrc-file)) |
753d16a6 | 250 | (build-mail-abbrevs))) |
b01c3008 RS |
251 | ;; strip garbage from front and end |
252 | (if (string-match "\\`[ \t\n,]+" definition) | |
253 | (setq definition (substring definition (match-end 0)))) | |
254 | (if (string-match "[ \t\n,]+\\'" definition) | |
255 | (setq definition (substring definition 0 (match-beginning 0)))) | |
256 | (let ((result '()) | |
257 | (start 0) | |
258 | (L (length definition)) | |
259 | end) | |
260 | (while start | |
261 | ;; If we're reading from the mailrc file, then addresses are delimited | |
262 | ;; by spaces, and addresses with embedded spaces must be surrounded by | |
f22cd786 | 263 | ;; double-quotes. Otherwise, addresses are separated by commas. |
b01c3008 RS |
264 | (if from-mailrc-file |
265 | (if (eq ?\" (aref definition start)) | |
266 | (setq start (1+ start) | |
267 | end (string-match "\"[ \t,]*" definition start)) | |
268 | (setq end (string-match "[ \t,]+" definition start))) | |
269 | (setq end (string-match "[ \t\n,]*,[ \t\n,]*" definition start))) | |
270 | (setq result (cons (substring definition start end) result)) | |
271 | (setq start (and end | |
272 | (/= (match-end 0) L) | |
273 | (match-end 0)))) | |
274 | (setq definition (mapconcat (function identity) | |
275 | (nreverse result) | |
f22cd786 | 276 | mail-alias-separator-string))) |
b01c3008 RS |
277 | (setq mail-abbrev-aliases-need-to-be-resolved t) |
278 | (setq name (downcase name)) | |
753d16a6 | 279 | ;; use an abbrev table instead of an alist for mail-abbrevs. |
b01c3008 | 280 | (let ((abbrevs-changed abbrevs-changed)) ; protect this from being changed. |
753d16a6 | 281 | (define-abbrev mail-abbrevs name definition 'mail-abbrev-expand-hook))) |
b01c3008 RS |
282 | |
283 | ||
284 | (defun mail-resolve-all-aliases () | |
285 | "Resolve all forward references in the mail aliases table." | |
286 | (if mail-abbrev-aliases-need-to-be-resolved | |
287 | (progn | |
288 | ;; (message "Resolving mail aliases...") | |
753d16a6 RS |
289 | (if (vectorp mail-abbrevs) |
290 | (mapatoms (function mail-resolve-all-aliases-1) mail-abbrevs)) | |
b01c3008 RS |
291 | (setq mail-abbrev-aliases-need-to-be-resolved nil) |
292 | ;; (message "Resolving mail aliases... done.") | |
293 | ))) | |
294 | ||
d7c1ec4b RM |
295 | (defun mail-resolve-all-aliases-1 (sym &optional so-far) |
296 | (if (memq sym so-far) | |
297 | (error "mail alias loop detected: %s" | |
298 | (mapconcat 'symbol-name (cons sym so-far) " <- "))) | |
b01c3008 RS |
299 | (let ((definition (and (boundp sym) (symbol-value sym)))) |
300 | (if definition | |
301 | (let ((result '()) | |
302 | (start 0)) | |
303 | (while start | |
304 | (let ((end (string-match "[ \t\n]*,[, \t\n]*" definition start))) | |
305 | (setq result (cons (substring definition start end) result) | |
306 | start (and end (match-end 0))))) | |
307 | (setq definition | |
308 | (mapconcat (function (lambda (x) | |
309 | (or (mail-resolve-all-aliases-1 | |
753d16a6 | 310 | (intern-soft x mail-abbrevs) |
d7c1ec4b | 311 | (cons sym so-far)) |
b01c3008 RS |
312 | x))) |
313 | (nreverse result) | |
f22cd786 | 314 | mail-alias-separator-string)) |
b01c3008 RS |
315 | (set sym definition)))) |
316 | (symbol-value sym)) | |
317 | ||
318 | ||
f22cd786 | 319 | (defun mail-abbrev-expand-hook () |
22f4ef2e | 320 | "For use as the fourth arg to define-abbrev. |
f22cd786 | 321 | After expanding a mail-abbrev, if fill-mode is on and we're past the |
22f4ef2e RM |
322 | fill-column, break the line at the previous comma, and indent the next |
323 | line." | |
cbec775b RM |
324 | (save-excursion |
325 | (let ((p (point)) | |
326 | bol comma fp) | |
327 | (beginning-of-line) | |
328 | (setq bol (point)) | |
329 | (goto-char p) | |
5aefeeba | 330 | (while (and auto-fill-function |
cbec775b RM |
331 | (>= (current-column) fill-column) |
332 | (search-backward "," bol t)) | |
333 | (setq comma (point)) | |
334 | (forward-char 1) ; Now we are just past the comma. | |
335 | (insert "\n") | |
336 | (delete-horizontal-space) | |
f22cd786 | 337 | (setq p (point)) |
cbec775b RM |
338 | (indent-relative) |
339 | (setq fp (buffer-substring p (point))) | |
340 | ;; Go to the end of the new line. | |
341 | (end-of-line) | |
342 | (if (> (current-column) fill-column) | |
343 | ;; It's still too long; do normal auto-fill. | |
344 | (let ((fill-prefix (or fp "\t"))) | |
345 | (do-auto-fill))) | |
346 | ;; Resume the search. | |
347 | (goto-char comma) | |
348 | )))) | |
22f4ef2e RM |
349 | \f |
350 | ;;; Syntax tables and abbrev-expansion | |
b01c3008 | 351 | |
22f4ef2e | 352 | (defvar mail-abbrev-mode-regexp "^\\(Resent-\\)?\\(To\\|From\\|CC\\|BCC\\):" |
753d16a6 | 353 | "*Regexp to select mail-headers in which mail-abbrevs should be expanded. |
b01c3008 RS |
354 | This string it will be handed to `looking-at' with the point at the beginning |
355 | of the current line; if it matches, abbrev mode will be turned on, otherwise | |
356 | it will be turned off. (You don't need to worry about continuation lines.) | |
357 | This should be set to match those mail fields in which you want abbreviations | |
358 | turned on.") | |
359 | ||
360 | (defvar mail-mode-syntax-table (copy-syntax-table text-mode-syntax-table) | |
22f4ef2e | 361 | "The syntax table which is used in send-mail mode message bodies.") |
b01c3008 RS |
362 | |
363 | (defvar mail-mode-header-syntax-table | |
364 | (let ((tab (copy-syntax-table text-mode-syntax-table))) | |
f22cd786 | 365 | ;; This makes the characters "@%!._-" be considered symbol-consituents |
b01c3008 RS |
366 | ;; but not word-constituents, so forward-sexp will move you over an |
367 | ;; entire address, but forward-word will only move you over a sequence | |
368 | ;; of alphanumerics. (Clearly the right thing.) | |
369 | (modify-syntax-entry ?@ "_" tab) | |
370 | (modify-syntax-entry ?% "_" tab) | |
371 | (modify-syntax-entry ?! "_" tab) | |
372 | (modify-syntax-entry ?. "_" tab) | |
373 | (modify-syntax-entry ?_ "_" tab) | |
374 | (modify-syntax-entry ?- "_" tab) | |
375 | (modify-syntax-entry ?< "(>" tab) | |
376 | (modify-syntax-entry ?> ")<" tab) | |
b01c3008 | 377 | tab) |
22f4ef2e RM |
378 | "The syntax table used in send-mail mode when in a mail-address header. |
379 | mail-mode-syntax-table is used when the cursor is in the message body or in | |
380 | non-address headers.") | |
381 | ||
382 | (defvar mail-abbrev-syntax-table | |
383 | (let* ((tab (copy-syntax-table mail-mode-header-syntax-table)) | |
384 | (i (1- (length tab))) | |
385 | (_ (aref (standard-syntax-table) ?_)) | |
386 | (w (aref (standard-syntax-table) ?w))) | |
387 | (while (>= i 0) | |
388 | (if (= (aref tab i) _) (aset tab i w)) | |
389 | (setq i (1- i))) | |
390 | tab) | |
391 | "The syntax-table used for abbrev-expansion purposes; this is not actually | |
392 | made the current syntax table of the buffer, but simply controls the set of | |
393 | characters which may be a part of the name of a mail-alias.") | |
394 | ||
395 | ||
396 | (defun mail-abbrev-in-expansion-header-p () | |
397 | "Whether point is in a mail-address header field." | |
398 | (let ((case-fold-search t)) | |
399 | (and ;; | |
400 | ;; we are on an appropriate header line... | |
401 | (save-excursion | |
402 | (beginning-of-line) | |
403 | ;; skip backwards over continuation lines. | |
404 | (while (and (looking-at "^[ \t]") | |
405 | (not (= (point) (point-min)))) | |
406 | (forward-line -1)) | |
407 | ;; are we at the front of an appropriate header line? | |
408 | (looking-at mail-abbrev-mode-regexp)) | |
409 | ;; | |
410 | ;; ...and we are before the mail-header-separator | |
411 | (< (point) | |
412 | (save-excursion | |
413 | (goto-char (point-min)) | |
414 | (search-forward (concat "\n" mail-header-separator "\n") | |
415 | nil 0) | |
416 | (point)))))) | |
417 | ||
418 | (defvar mail-mode-abbrev-table) ; quiet the compiler | |
b01c3008 | 419 | |
f22cd786 | 420 | (defun sendmail-pre-abbrev-expand-hook () |
753d16a6 | 421 | (and (and mail-abbrevs (not (eq mail-abbrevs t))) |
275da787 RM |
422 | (if (mail-abbrev-in-expansion-header-p) |
423 | (progn | |
424 | ;; | |
425 | ;; We are in a To: (or CC:, or whatever) header, and | |
426 | ;; should use word-abbrevs to expand mail aliases. | |
427 | ||
428 | ;; Before anything else, resolve aliases if they need it. | |
429 | (and mail-abbrev-aliases-need-to-be-resolved | |
430 | (mail-resolve-all-aliases)) | |
431 | ||
432 | ;; Now proceed with the abbrev section. | |
753d16a6 | 433 | ;; - First, install the mail-abbrevs as the word-abbrev table. |
275da787 RM |
434 | ;; - Then install the mail-abbrev-syntax-table, which |
435 | ;; temporarily marks all of the | |
436 | ;; non-alphanumeric-atom-characters (the "_" | |
437 | ;; syntax ones) as being normal word-syntax. We do this | |
438 | ;; because the C code for expand-abbrev only works on words, | |
439 | ;; and we want these characters to be considered words for | |
440 | ;; the purpose of abbrev expansion. | |
441 | ;; - Then we call expand-abbrev again, recursively, to do | |
442 | ;; the abbrev expansion with the above syntax table. | |
443 | ;; - Then we do a trick which tells the expand-abbrev frame | |
444 | ;; which invoked us to not continue (and thus not | |
445 | ;; expand twice.) This means that any abbrev expansion | |
446 | ;; will happen as a result of this function's call to | |
447 | ;; expand-abbrev, and not as a result of the call to | |
448 | ;; expand-abbrev which invoked *us*. | |
449 | ;; - Then we set the syntax table to | |
450 | ;; mail-mode-header-syntax-table, which doesn't have | |
451 | ;; anything to do with abbrev expansion, but | |
452 | ;; is just for the user's convenience (see its doc string.) | |
453 | ;; | |
454 | ||
753d16a6 | 455 | (setq local-abbrev-table mail-abbrevs) |
275da787 RM |
456 | |
457 | ;; If the character just typed was non-alpha-symbol-syntax, | |
458 | ;; then don't expand the abbrev now (that is, don't expand | |
459 | ;; when the user types -.) Check the character's syntax in | |
460 | ;; the mail-mode-header-syntax-table. | |
461 | ||
462 | (set-syntax-table mail-mode-header-syntax-table) | |
463 | (or (eq (char-syntax last-command-char) ?_) | |
464 | (let ((pre-abbrev-expand-hook nil)) ; That's us; don't loop. | |
465 | ;; Use this table so that abbrevs can have hyphens in them. | |
466 | (set-syntax-table mail-abbrev-syntax-table) | |
467 | (expand-abbrev) | |
468 | ;; Now set it back to what it was before. | |
469 | (set-syntax-table mail-mode-header-syntax-table))) | |
470 | (setq abbrev-start-location (point) ; This is the trick. | |
471 | abbrev-start-location-buffer (current-buffer))) | |
472 | ||
473 | ;; We're not in a mail header where mail aliases should | |
474 | ;; be expanded, then use the normal mail-mode abbrev table | |
475 | ;; (if any) and the normal mail-mode syntax table. | |
476 | ||
477 | (setq local-abbrev-table (and (boundp 'mail-mode-abbrev-table) | |
478 | mail-mode-abbrev-table)) | |
479 | (set-syntax-table mail-mode-syntax-table)) | |
480 | )) | |
22f4ef2e RM |
481 | \f |
482 | ;;; utilities | |
b01c3008 | 483 | |
753d16a6 | 484 | (defun merge-mail-abbrevs (file) |
b01c3008 RS |
485 | "Merge mail aliases from the given file with existing ones." |
486 | (interactive (list | |
487 | (let ((insert-default-directory t) | |
488 | (default-directory (expand-file-name "~/")) | |
489 | (def (mail-abbrev-mailrc-file))) | |
490 | (read-file-name | |
491 | (format "Read additional aliases from file: (default %s) " | |
492 | def) | |
493 | default-directory | |
494 | (expand-file-name def default-directory) | |
495 | t)))) | |
753d16a6 | 496 | (build-mail-abbrevs file)) |
b01c3008 | 497 | |
753d16a6 | 498 | (defun rebuild-mail-abbrevs (file) |
b01c3008 RS |
499 | "Rebuild all the mail aliases from the given file." |
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 mail aliases from file: (default %s) " def) | |
506 | default-directory | |
507 | (expand-file-name def default-directory) | |
508 | t)))) | |
753d16a6 RS |
509 | (setq mail-abbrevs nil) |
510 | (build-mail-abbrevs file)) | |
49116ac0 | 511 | |
22f4ef2e RM |
512 | (defun mail-interactive-insert-alias (&optional alias) |
513 | "Prompt for and insert a mail alias." | |
c540863c | 514 | (interactive (progn |
753d16a6 RS |
515 | (if (not (vectorp mail-abbrevs)) (mail-abbrevs-setup)) |
516 | (list (completing-read "Expand alias: " mail-abbrevs nil t)))) | |
517 | (if (not (vectorp mail-abbrevs)) (mail-abbrevs-setup)) | |
518 | (insert (or (and alias (symbol-value (intern-soft alias mail-abbrevs))) ""))) | |
519 | ||
520 | (defun mail-abbrev-next-line (&optional arg) | |
521 | "Expand any mail abbrev, then move cursor vertically down ARG lines. | |
522 | If there is no character in the target line exactly under the current column, | |
523 | the cursor is positioned after the character in that line which spans this | |
524 | column, or at the end of the line if it is not long enough. | |
525 | If there is no line in the buffer after this one, | |
526 | a newline character is inserted to create a line | |
527 | and the cursor moves to that line. | |
528 | ||
529 | The command \\[set-goal-column] can be used to create | |
530 | a semipermanent goal column to which this command always moves. | |
531 | Then it does not try to move vertically. This goal column is stored | |
532 | in `goal-column', which is nil when there is none. | |
533 | ||
534 | If you are thinking of using this in a Lisp program, consider | |
535 | using `forward-line' instead. It is usually easier to use | |
536 | and more reliable (no dependence on goal column, etc.)." | |
22f4ef2e | 537 | (interactive "p") |
d7c1ec4b RM |
538 | (if (looking-at "[ \t]*\n") (expand-abbrev)) |
539 | (setq this-command 'next-line) | |
22f4ef2e RM |
540 | (next-line arg)) |
541 | ||
753d16a6 RS |
542 | (defun mail-abbrev-end-of-buffer (&optional arg) |
543 | "Expand any mail abbrev, then move point to end of buffer. | |
544 | Leave mark at previous position. | |
545 | With arg N, put point N/10 of the way from the true end. | |
546 | ||
547 | Don't use this command in Lisp programs! | |
548 | \(goto-char (point-max)) is faster and avoids clobbering the mark." | |
7b143708 | 549 | (interactive "p") |
d7c1ec4b RM |
550 | (if (looking-at "[ \t]*\n") (expand-abbrev)) |
551 | (setq this-command 'end-of-buffer) | |
22f4ef2e RM |
552 | (end-of-buffer arg)) |
553 | ||
554 | (define-key mail-mode-map "\C-c\C-a" 'mail-interactive-insert-alias) | |
555 | ||
753d16a6 RS |
556 | ;;(define-key mail-mode-map "\C-n" 'mail-abbrev-next-line) |
557 | ;;(define-key mail-mode-map "\M->" 'mail-abbrev-end-of-buffer) | |
b01c3008 | 558 | |
3e1b7a46 | 559 | (provide 'mailabbrev) |