Initial Commit
[packages] / xemacs-packages / mail-lib / mail-abbrevs.el
1 ;;; mail-abbrev.el --- Abbrev-expansion of mail aliases.
2
3 ;;; Copyright (C) 1985-1994 Free Software Foundation, Inc.
4
5 ;; Created: 19 oct 90, Jamie Zawinski <jwz@jwz.org>
6 ;; Modified: 5 apr 92, Roland McGrath <roland@gnu.ai.mit.edu>
7 ;; Maintainer: XEmacs Development Team
8
9 ;; This file is part of XEmacs.
10
11 ;; XEmacs is free software; you can redistribute it and/or modify it
12 ;; under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
14 ;; any later version.
15
16 ;; XEmacs is distributed in the hope that it will be useful, but
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
19 ;; General Public License for more details.
20
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with XEmacs; see the file COPYING.  If not, write to the 
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
25
26 ;;; Synched up with:  Not synched.
27
28 ;;; Commentary:
29
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
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.
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
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 quotes.  This is necessary because the format of the .mailrc file
67 ;; bogusly uses spaces as address delimiters.  The following line defines an
68 ;; 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
77 ;; way, addresses are separated by commas.
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 ;; precede 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
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
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
110 ;; If you want multiple addresses separated by a string other than ", " then
111 ;; you can set the variable mail-alias-separator-string to it.  This has to
112 ;; be a comma bracketed by whitespace if you want any kind of reasonable
113 ;; behaviour.
114
115 ;; Some versions of /bin/mail append the contents of multiple definitions of
116 ;; the same alias together, so that
117 ;;     alias group one two three
118 ;;     alias group four five
119 ;; would define "group" as "one two three four five" instead of "four five".
120 ;; This code does *not* support that syntax, because it's a horrible syntax
121 ;; and isn't worth the effort or added code complexity.  (So there.)
122 ;;
123 ;; Thanks to Harald Hanche-Olsen, Michael Ernst, David Loeffler, Noah
124 ;; Friedman, and Michelangelo Grigni for suggestions and bug reports.
125
126
127 ;;; Code:
128
129 (require 'sendmail)
130
131 (defgroup mail-abbrevs nil
132   "Mail abbreviation (addressbook)"
133   :group 'mail)
134
135 ;;;###autoload
136 (defcustom mail-abbrev-mailrc-file nil
137   "Name of file with mail aliases.   If nil, ~/.mailrc is used."
138   :type '(choice (const :tag "Default" nil)
139                  file)
140   :group 'mail-abbrevs)
141
142 ;;;###autoload
143 (defun mail-abbrev-mailrc-file ()
144   (or mail-abbrev-mailrc-file
145       (setq mail-abbrev-mailrc-file
146             (or (getenv "MAILRC") "~/.mailrc"))))
147
148 ;; originally defined in sendmail.el - used to be an alist, now is a table.
149 ;;;###autoload
150 (defvar mail-aliases nil
151   "Word-abbrev table of mail address aliases.
152 If this is nil, it means the aliases have not yet been initialized and
153 should be read from the .mailrc file.  (This is distinct from there being
154 no aliases, which is represented by this being a table with no entries.)")
155
156 ;;;###autoload
157 (defun mail-aliases-setup ()
158   (if (and (not (vectorp mail-aliases))
159            (file-exists-p (mail-abbrev-mailrc-file)))
160       (build-mail-aliases))
161   (make-local-variable 'pre-abbrev-expand-hook)
162   (setq pre-abbrev-expand-hook
163     (cond ((and (listp pre-abbrev-expand-hook)
164                 (not (eq 'lambda (car pre-abbrev-expand-hook))))
165            (cons 'sendmail-pre-abbrev-expand-hook pre-abbrev-expand-hook))
166           (t
167            (list 'sendmail-pre-abbrev-expand-hook pre-abbrev-expand-hook))))
168   (abbrev-mode 1))
169
170 ;;;###autoload
171 (defun build-mail-aliases (&optional file recursivep)
172   "Read mail aliases from .mailrc and set mail-aliases."
173   (setq file (expand-file-name (or file (mail-abbrev-mailrc-file))))
174   (or (vectorp mail-aliases)
175       (setq mail-aliases (make-abbrev-table)))
176   (message "Parsing %s..." file)
177   (let ((buffer nil)
178         (obuf (current-buffer)))
179     (unwind-protect
180         (progn
181           (setq buffer (generate-new-buffer "mailrc"))
182           (buffer-disable-undo buffer)
183           (set-buffer buffer)
184           (cond ((get-file-buffer file)
185                  (insert (save-excursion
186                            (set-buffer (get-file-buffer file))
187                            (buffer-substring (point-min) (point-max)))))
188                 ((not (file-exists-p file)))
189                 (t (insert-file-contents file)))
190           ;; Don't lose if no final newline.
191           (goto-char (point-max))
192           (or (eq (preceding-char) ?\n) (newline))
193           (goto-char (point-min))
194           ;; Delete comments from the file
195           (while (search-forward "# " nil t)
196             (let ((p (- (point) 2)))
197               (end-of-line)
198               (delete-region p (point))))
199           (goto-char (point-min))
200           ;; handle "\\\n" continuation lines
201           (while (not (eobp))
202             (end-of-line)
203             (if (= (preceding-char) ?\\)
204                 (progn (delete-char -1) (delete-char 1) (insert ?\ ))
205                 (forward-char 1)))
206           (goto-char (point-min))
207           (while (re-search-forward
208                   "^\\(a\\(lias\\)?\\|g\\(roup\\)?\\|source\\)[ \t]+" nil t)
209             (beginning-of-line)
210             (if (looking-at "source[ \t]+\\([^ \t\n]+\\)")
211                 (progn
212                   (end-of-line)
213                   (build-mail-aliases
214                    (substitute-in-file-name
215                     (buffer-substring (match-beginning 1) (match-end 1)))
216                    t))
217               (re-search-forward "[ \t]+\\([^ \t\n]+\\)")
218               (let* ((name (buffer-substring
219                             (match-beginning 1) (match-end 1)))
220                      (start (progn (skip-chars-forward " \t") (point))))
221                 (end-of-line)
222 ;               (message "** %s \"%s\"" name (buffer-substring start (point)))(sit-for 1)
223                 (define-mail-alias
224                     name
225                     (buffer-substring start (point))
226                     t))))
227           ;; Resolve forward references in .mailrc file.
228           ;; This would happen automatically before the first abbrev was
229           ;; expanded, but why not do it now.
230           (or recursivep (mail-resolve-all-aliases))
231           )
232       (if buffer (kill-buffer buffer))
233       (set-buffer obuf)))
234     (message "Parsing %s... done" file)
235     ;; Bob Weiner, Altrasoft, 12/10/96: Return nil so can be
236     ;; used as a local-write-file-hook in ~/.mailrc.
237     nil)
238
239 (defcustom mail-alias-separator-string ", "
240   "*A string inserted between addresses in multi-address mail aliases.
241 This has to contain a comma, so \", \" is a reasonable value.  You might 
242 also want something like \",\\n    \" to get each address on its own line."
243   :type 'string
244   :group 'mail-abbrevs)
245
246 ;; define-mail-alias sets this flag, which causes mail-resolve-all-aliases
247 ;; to be called before expanding abbrevs if it's necessary.
248 (defvar mail-abbrev-aliases-need-to-be-resolved t)
249
250 ;; originally defined in mailalias.el ; build-mail-aliases calls this with
251 ;; stuff parsed from the .mailrc file.
252 ;;
253 ;;;###autoload
254 (defun define-mail-alias (name definition &optional from-mailrc-file)
255   "Define NAME as a mail-alias that translates to DEFINITION.
256 If DEFINITION contains multiple addresses, separate them with commas."
257   ;; When this is called from build-mail-aliases, the third argument is
258   ;; true, and we do some evil space->comma hacking like /bin/mail does.
259   (interactive "sDefine mail alias: \nsDefine %s as mail alias for: ")
260   ;; Read the defaults first, if we have not done so.
261   (if (vectorp mail-aliases)
262       nil
263     (setq mail-aliases (make-abbrev-table))
264     (if (file-exists-p (mail-abbrev-mailrc-file))
265         (build-mail-aliases)))
266   ;; strip garbage from front and end
267   (if (string-match "\\`[ \t\n,]+" definition)
268       (setq definition (substring definition (match-end 0))))
269   (if (string-match "[ \t\n,]+\\'" definition)
270       (setq definition (substring definition 0 (match-beginning 0))))
271   (let ((result '())
272         (start 0)
273         (L (length definition))
274         end)
275     (while start
276       ;; If we're reading from the mailrc file, then addresses are delimited
277       ;; by spaces, and addresses with embedded spaces must be surrounded by
278       ;; single or double-quotes.  Otherwise, addresses are separated by
279       ;; commas.
280       (if from-mailrc-file
281           (cond ((eq ?\" (aref definition start))
282                  (setq start (1+ start)
283                        end (string-match "\"[ \t,]*" definition start)))
284                 ((eq ?\' (aref definition start))
285                  (setq start (1+ start)
286                        end (string-match "\'[ \t,]*" definition start)))
287                 (t
288                  (setq end (string-match "[ \t,]+" definition start))))
289         (setq end (string-match "[ \t\n,]*,[ \t\n,]*" definition start)))
290       (setq result (cons (substring definition start end) result))
291       (setq start (and end
292                        (/= (match-end 0) L)
293                        (match-end 0))))
294     (setq definition (mapconcat (function identity)
295                                 (nreverse result)
296                                 mail-alias-separator-string)))
297   (setq mail-abbrev-aliases-need-to-be-resolved t)
298   (setq name (downcase name))
299   ;; use an abbrev table instead of an alist for mail-aliases.
300   (let ((abbrevs-changed abbrevs-changed))  ; protect this from being changed.
301     (define-abbrev mail-aliases name definition 'mail-abbrev-expand-hook)))
302
303
304 (defun mail-resolve-all-aliases ()
305   "Resolve all forward references in the mail aliases table."
306   (if mail-abbrev-aliases-need-to-be-resolved
307       (progn
308 ;;      (message "Resolving mail aliases...")
309         (if (vectorp mail-aliases)
310             (mapatoms (function mail-resolve-all-aliases-1) mail-aliases))
311         (setq mail-abbrev-aliases-need-to-be-resolved nil)
312 ;;      (message "Resolving mail aliases... done.")
313         )))
314
315 (defun mail-resolve-all-aliases-1 (sym &optional so-far)
316   (if (memq sym so-far)
317       (error "mail alias loop detected: %s"
318              (mapconcat 'symbol-name (cons sym so-far) " <- ")))
319   (let ((definition (and (boundp sym) (symbol-value sym))))
320     (if definition
321         (let ((result '())
322               (start 0))
323           (while start
324             (let ((end (string-match "[ \t\n]*,[, \t\n]*" definition start)))
325               (setq result (cons (substring definition start end) result)
326                     start (and end (match-end 0)))))
327           (setq definition
328                 (mapconcat (function (lambda (x)
329                              (or (mail-resolve-all-aliases-1
330                                    (intern-soft (downcase x) mail-aliases)
331                                    (cons sym so-far))
332                                  x)))
333                            (nreverse result)
334                            mail-alias-separator-string))
335           (set sym definition))))
336   (symbol-value sym))
337
338
339 (defun mail-abbrev-expand-hook ()
340   "For use as the fourth arg to define-abbrev.
341 After expanding a mail-abbrev, if fill-mode is on and we're past the
342 fill-column, break the line at the previous comma, and indent the next
343 line."
344   (save-excursion
345     (let ((p (point))
346           bol comma fp)
347       (beginning-of-line)
348       (setq bol (point))
349       (goto-char p)
350       (while (and auto-fill-function
351                   (>= (current-column) fill-column)
352                   (search-backward "," bol t))
353         (setq comma (point))
354         (forward-char 1)                ; Now we are just past the comma.
355         (insert "\n")
356         (delete-horizontal-space)
357         (setq p (point))
358         ;; Prevent abbrev expansion from happening again, since
359         ;; sendmail-pre-abbrev-expand-hook will already have done it.
360         (let ((abbrev-mode nil))
361           (indent-relative))
362         (setq fp (buffer-substring p (point)))
363         ;; Go to the end of the new line.
364         (end-of-line)
365         (if (> (current-column) fill-column)
366             ;; It's still too long; do normal auto-fill.
367             (let ((fill-prefix (or fp "\t")))
368               (do-auto-fill)))
369         ;; Resume the search.
370         (goto-char comma)
371         ))))
372 \f
373 ;;; Syntax tables and abbrev-expansion
374
375 (defcustom mail-abbrev-mode-regexp
376   "^\\(Resent-\\)?\\(To\\|From\\|CC\\|BCC\\|Reply-to\\):"
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   :type 'regexp
384   :group 'mail-abbrevs)
385
386 (defcustom mail-rename-buffer-regexp
387   "^\\(?:Resent-\\)?\\To:[ \t]*\\(.+\\)"
388   "*Regexp to select mail-headers which should be used to automatically set
389 the name of the mail composition buffer.  Set this to an empty string to disable
390 auto-renaming."
391   :type 'regexp
392   :group 'mail-abbrevs)
393
394 (defvar mail-mode-syntax-table (copy-syntax-table text-mode-syntax-table)
395   "The syntax table which is used in send-mail mode message bodies.")
396
397 (defvar mail-mode-header-syntax-table
398   (let ((tab (copy-syntax-table text-mode-syntax-table)))
399     ;; This makes the characters "@%!._-" be considered symbol-consituents
400     ;; but not word-constituents, so forward-sexp will move you over an
401     ;; entire address, but forward-word will only move you over a sequence
402     ;; of alphanumerics.  (Clearly the right thing.)
403     (modify-syntax-entry ?@ "_" tab)
404     (modify-syntax-entry ?% "_" tab)
405     (modify-syntax-entry ?! "_" tab)
406     (modify-syntax-entry ?. "_" tab)
407     (modify-syntax-entry ?_ "_" tab)
408     (modify-syntax-entry ?- "_" tab)
409     (modify-syntax-entry ?< "(>" tab)
410     (modify-syntax-entry ?> ")<" tab)
411     tab)
412   "The syntax table used in send-mail mode when in a mail-address header.
413 mail-mode-syntax-table is used when the cursor is in the message body or in
414 non-address headers.")
415
416 (defvar mail-abbrev-syntax-table
417   (let ((tab (copy-syntax-table mail-mode-header-syntax-table)))
418     (if (vectorp tab)
419         (let ((i (1- (length tab)))
420               (_ (aref (standard-syntax-table) ?_))
421               (w (aref (standard-syntax-table) ?w)))
422           (while (>= i 0)
423             (if (= (aref tab i) _) (aset tab i w))
424             (setq i (1- i))))
425       (map-syntax-table
426        #'(lambda (key val)
427            (if (eq (char-syntax-from-code val) ?_)
428                (put-char-table key (set-char-syntax-in-code val ?w) tab)
429                ))
430        tab))
431     tab)
432   "The syntax-table used for abbrev-expansion purposes; this is not actually
433 made the current syntax table of the buffer, but simply controls the set of
434 characters which may be a part of the name of a mail-alias.")
435
436
437 (defun mail-abbrev-in-expansion-header-p ()
438   "Whether point is in a mail-address header field."
439   (let ((case-fold-search t))
440     (and ;;
441          ;; we are on an appropriate header line...
442      (save-excursion
443        (beginning-of-line)
444        ;; skip backwards over continuation lines.
445        (while (and (looking-at "^[ \t]")
446                    (not (= (point) (point-min))))
447          (forward-line -1))
448        ;; are we at the front of an appropriate header line?
449        (looking-at mail-abbrev-mode-regexp))
450      ;;
451      ;; ...and we are before the mail-header-separator
452      (< (point)
453         (save-excursion
454           (goto-char (point-min))
455           (search-forward (concat "\n" mail-header-separator "\n")
456                           nil 0)
457           (point))))))
458
459 (defvar mail-mode-abbrev-table) ; quiet the compiler
460 (defvar message-mode-map) ; quiet the compiler
461
462 (defun mail-maybe-rename-buffer ()
463   (let ((case-fold-search t))
464     (and ;; user has not disabled this feature...
465      (not (string-equal mail-rename-buffer-regexp ""))
466          ;; ... and we are before the mail-header-separator...
467      (< (point)
468         (save-excursion
469           (goto-char (point-min))
470           (search-forward (concat "\n" mail-header-separator "\n")
471                           nil 0)
472           (point)))
473      ;; ... and we are on an appropriate header line
474      (save-excursion
475        (beginning-of-line)
476        ;; skip backwards over continuation lines.
477        (while (and (looking-at "^[ \t]")
478                    (not (= (point) (point-min))))
479          (forward-line -1))
480        (looking-at mail-rename-buffer-regexp))
481      (rename-buffer (concat "mail to " (match-string 1)) t))))
482
483 (defun sendmail-pre-abbrev-expand-hook ()
484   (if mail-abbrev-aliases-need-to-be-resolved
485       (mail-resolve-all-aliases))
486   (if (and mail-aliases (not (eq mail-aliases t)))
487       (if (not (mail-abbrev-in-expansion-header-p))
488           ;;
489           ;; If we're not in a mail header in which mail aliases should
490           ;; be expanded, then use the normal mail-mode abbrev table (if any)
491           ;; and the normal mail-mode syntax table.
492           ;;
493           (progn
494             (setq local-abbrev-table (and (boundp 'mail-mode-abbrev-table)
495                                           mail-mode-abbrev-table))
496             (set-syntax-table mail-mode-syntax-table))
497         ;;
498         ;; Otherwise, we are in a To: (or CC:, or whatever) header, and
499         ;; should use word-abbrevs to expand mail aliases.
500         ;;   -  First, install the mail-aliases as the word-abbrev table.
501         ;;   -  Then install the mail-abbrev-syntax-table, which temporarily
502         ;;      marks all of the non-alphanumeric-atom-characters (the "_"
503         ;;      syntax ones) as being normal word-syntax.  We do this because
504         ;;      the C code for expand-abbrev only works on words, and we want
505         ;;      these characters to be considered words for the purpose of
506         ;;      abbrev expansion.
507         ;;   -  Then we call expand-abbrev again, recursively, to do the abbrev
508         ;;      expansion with the above syntax table.
509         ;;   -  Then we do a trick which tells the expand-abbrev frame which
510         ;;      invoked us to not continue (and thus not expand twice.)
511         ;;      This means that any abbrev expansion will happen as a result
512         ;;      of this function's call to expand-abbrev, and not as a result
513         ;;      of the call to expand-abbrev which invoked *us*.
514         ;;   -  Then we set the syntax table to mail-mode-header-syntax-table,
515         ;;      which doesn't have anything to do with abbrev expansion, but
516         ;;      is just for the user's convenience (see its doc string.)
517         ;;
518         (mail-maybe-rename-buffer)
519         (setq local-abbrev-table mail-aliases)
520         ;; If the character just typed was non-alpha-symbol-syntax, then don't
521         ;; expand the abbrev now (that is, don't expand when the user types -.)
522         ;; Check the character's syntax in the mail-mode-header-syntax-table.
523         (set-syntax-table mail-mode-header-syntax-table)
524         (or (and last-command-char
525                  (eq (char-syntax last-command-char) ?_))
526             (let ((pre-abbrev-expand-hook nil)) ; That's us; don't loop.
527               ;; Use this table so that abbrevs can have hyphens in them.
528               (set-syntax-table mail-abbrev-syntax-table)
529               (expand-abbrev)
530               ;; Now set it back to what it was before.
531               (set-syntax-table mail-mode-header-syntax-table)))
532         (setq abbrev-start-location (point)  ; This is the trick.
533               abbrev-start-location-buffer (current-buffer))
534         )))
535 \f
536 ;;; Reading addresses from the minibuffer; by David Hughes <djh@Harston.CV.COM>
537
538 (defun mail-abbrev-minibuffer-setup-hook ()
539   ;; Use as the value of minibuffer-setup-hook when reading addresses
540   ;; from the minibuffer, as in:
541   ;;  (let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook))
542   ;;    (read-string "Who: "))
543   (if (and (not (vectorp mail-aliases))
544            (file-exists-p (mail-abbrev-mailrc-file)))
545       (build-mail-aliases))
546   (make-local-variable 'pre-abbrev-expand-hook)
547   (setq pre-abbrev-expand-hook
548         (function
549          (lambda ()
550            (setq local-abbrev-table mail-aliases)
551            (set-syntax-table mail-mode-header-syntax-table)
552            (or (and last-command-char
553                     (eq (char-syntax last-command-char) ?_))
554                (let ((pre-abbrev-expand-hook nil)) ; That's us; don't loop.
555                  ;; Use this table so that abbrevs can have hyphens in them.
556                  (set-syntax-table mail-abbrev-syntax-table)
557                  (expand-abbrev)
558                  ;; Now set it back to what it was before.
559                  (set-syntax-table mail-mode-header-syntax-table)))
560            (setq abbrev-start-location (point)  ; This is the trick.
561                  abbrev-start-location-buffer (current-buffer)))))
562   (abbrev-mode 1))
563
564 \f
565 ;;; utilities
566
567 (defun merge-mail-aliases (file)
568   "Merge mail aliases from the given file with existing ones."
569   (interactive (list
570                 (let ((insert-default-directory t)
571                       (default-directory (expand-file-name "~/"))
572                       (def (mail-abbrev-mailrc-file)))
573                   (read-file-name
574                     (format "Read additional aliases from file: (default %s) "
575                             def)
576                     default-directory
577                     (expand-file-name def default-directory)
578                     t))))
579   (build-mail-aliases file))
580
581 (defun rebuild-mail-aliases (file)
582   "Rebuild all the mail aliases from the given file."
583   (interactive (list
584                 (let ((insert-default-directory t)
585                       (default-directory (expand-file-name "~/"))
586                       (def (mail-abbrev-mailrc-file)))
587                   (read-file-name
588                    (format "Read mail aliases from file: (default %s) " def)
589                    default-directory
590                    (expand-file-name def default-directory)
591                    t))))
592   (setq mail-aliases nil)
593   (build-mail-aliases file))
594
595 (defun mail-interactive-insert-alias (&optional alias)
596   "Prompt for and insert a mail alias."
597   (interactive (progn
598                 (if (not (vectorp mail-aliases)) (mail-aliases-setup))
599                 (list (completing-read "Expand alias: " mail-aliases nil t))))
600   (if (not (vectorp mail-aliases)) (mail-aliases-setup))
601   (insert (or (and alias (symbol-value (intern-soft alias mail-aliases))) "")))
602
603 (defun abbrev-hacking-next-line (&optional arg)
604   "Just like `next-line' (\\<global-map>\\[next-line]) but expands abbrevs \
605 when at end of line."
606   (interactive "_p")
607   (if (and (looking-at "[ \t]*\n")
608            (= (char-syntax (preceding-char)) ?w))
609       (expand-abbrev))
610   (next-line (or arg 1)))
611
612 (defun abbrev-hacking-end-of-buffer (&optional arg)
613   "Just like `end-of-buffer' (\\<global-map>\\[end-of-buffer]) but expands \
614 abbrevs when at end of buffer."
615   (interactive "_P")
616   (if (and (looking-at "[ \t]*\n")
617            (= (char-syntax (preceding-char)) ?w))
618       (expand-abbrev))
619   (end-of-buffer arg))
620
621 (defun mail-abbrev-init-keys (keymap)
622   "Initialize Mail Abbrevs for the given keymap."
623
624   (define-key keymap "\C-c\C-a" 'mail-interactive-insert-alias)
625
626   ;;(define-key mail-mode-map "\C-n" 'abbrev-hacking-next-line)
627   ;;(define-key mail-mode-map "\M->" 'abbrev-hacking-end-of-buffer)
628   (let ((subst '((next-line . abbrev-hacking-next-line)
629                  (fkey-next-line . abbrev-hacking-next-line)
630                  (end-of-buffer . abbrev-hacking-end-of-buffer)
631                  (fkey-end-of-buffer . abbrev-hacking-end-of-buffer)
632                  )))
633     (while subst
634       (let ((keys
635              (delq nil
636                    (nconc (where-is-internal (car (car subst)) keymap)
637                           (where-is-internal (car (car subst)))))))
638         (while keys
639           (define-key keymap (car keys) (cdr (car subst)))
640           (pop keys)))
641       (pop subst))))
642
643 (mail-abbrev-init-keys mail-mode-map)
644 (when (boundp 'message-mode-map)
645   (mail-abbrev-init-keys message-mode-map))
646
647 (provide 'mail-abbrevs)
648 \f
649 ;;; mail-abbrevs.el ends here