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