lisp/mail/mailabbrev.el

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