code.delx.au - gnu-emacs/blob - lisp/mail/mailabbrev.el

   1 ;;; Abbrev-expansion of mail aliases.
   2 ;;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
   3 ;;; Created: 19 oct 90, Jamie Zawinski <jwz@lucid.com>
   4 ;;; Last change 15-dec-91. jwz
   5
   6 ;;; This file is part of GNU Emacs.
   7
   8 ;;; GNU Emacs is free software; you can redistribute it and/or modify
   9 ;;; it under the terms of the GNU General Public License as published by
  10 ;;; the Free Software Foundation; either version 1, or (at your option)
  11 ;;; any later version.
  12
  13 ;;; GNU Emacs is distributed in the hope that it will be useful,
  14 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;;; GNU General Public License for more details.
  17
  18 ;;; You should have received a copy of the GNU General Public License
  19 ;;; along with GNU Emacs; see the file COPYING.  If not, write to
  20 ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  21
  22 ;;; This file ensures that, when the point is in a To:, CC:, BCC:, or From:
  23 ;;; field, word-abbrevs are defined for each of your mail aliases.  These
  24 ;;; aliases will be defined from your .mailrc file (or the file specified by
  25 ;;; the MAILRC environment variable) if it exists.  Providing abbrev-mode is
  26 ;;; on in your send-mail buffer, your mail aliases will expand any time you
  27 ;;; type a word-delimiter at the end of an abbreviation.
  28 ;;;
  29 ;;; What you see is what you get: no abbreviations will be expanded after you
  30 ;;; have sent the mail, unlike the old system.  This means you don't suffer
  31 ;;; the annoyance of having the system do things behind your back -- if an
  32 ;;; address you typed is going to be rewritten, you know it immediately,
  33 ;;; instead of after the mail has been sent and it's too late to do anything
  34 ;;; about it.  You will never again be screwed because you forgot to delete an
  35 ;;; old alias from your .mailrc when a new local user arrives and is given a
  36 ;;; userid which conflicts with one of your aliases, for example.
  37 ;;;
  38 ;;; Your mail alias abbrevs will be in effect only when the point is in an
  39 ;;; appropriate header field.  When in the body of the message, or other
  40 ;;; header fields, the mail aliases will not expand.  Rather, the normal
  41 ;;; mode-specific abbrev table (mail-mode-abbrev-table) will be used if
  42 ;;; defined.  So if you use mail-mode specific abbrevs, this code will not
  43 ;;; adversely affect you.  You can control which header fields the abbrevs
  44 ;;; are used in by changing the variable mail-abbrev-mode-regexp.
  45 ;;;
  46 ;;; If auto-fill mode is on, abbrevs will wrap at commas instead of at word
  47 ;;; boundaries; also, header continuation-lines will be properly indented.
  48 ;;;
  49 ;;; You can also insert a mail alias with mail-interactive-insert-alias
  50 ;;; (bound to C-c C-a), which prompts you for an alias (with completion)
  51 ;;; and inserts its expansion at point.
  52 ;;;
  53 ;;; To use this code, do something like
  54 ;;;
  55 ;;;    (setq mail-mode-hook '(lambda () (require 'mail-abbrevs)))
  56 ;;;
  57 ;;; This file fixes a bug in the old system which prohibited your .mailrc
  58 ;;; file from having lines like
  59 ;;;
  60 ;;;     alias someone "John Doe <doe@quux.com>"
  61 ;;;
  62 ;;; That is, if you want an address to have embedded spaces, simply surround it
  63 ;;; with double-quotes.  This is necessary because the format of the .mailrc
  64 ;;; file bogusly uses spaces as address delimiters.  The following line defines
  65 ;;; an alias which expands to three addresses:
  66 ;;;
  67 ;;;     alias foobar addr-1 addr-2 "address three <addr-3>"
  68 ;;;
  69 ;;; (This is bogus because mail-delivery programs want commas, not spaces,
  70 ;;; but that's what the file format is, so we have to live with it.)
  71 ;;;
  72 ;;; If you like, you can call the function define-mail-alias to define your
  73 ;;; mail-aliases instead of using a .mailrc file.  When you call it in this
  74 ;;; way, addresses are seperated by commas.
  75 ;;;
  76 ;;; CAVEAT: This works on most Sun systems; I have been told that some versions
  77 ;;; of /bin/mail do not understand double-quotes in the .mailrc file.  So you
  78 ;;; should make sure your version does before including verbose addresses like
  79 ;;; this.  One solution to this, if you are on a system whose /bin/mail doesn't
  80 ;;; work that way, (and you still want to be able to /bin/mail to send mail in
  81 ;;; addition to emacs) is to define minimal aliases (without full names) in
  82 ;;; your .mailrc file, and use define-mail-alias to redefine them when sending
  83 ;;; mail from emacs; this way, mail sent from /bin/mail will work, and mail
  84 ;;; sent from emacs will be pretty.
  85 ;;;
  86 ;;; Aliases in the mailrc file may be nested.  If you define aliases like
  87 ;;;     alias group1 fred ethel
  88 ;;;     alias group2 larry curly moe
  89 ;;;     alias everybody group1 group2
  90 ;;; Then when you type "everybody" on the To: line, it will be expanded to
  91 ;;;     fred, ethyl, larry, curly, moe
  92 ;;;
  93 ;;; Aliases may also contain forward references; the alias of "everybody" can
  94 ;;; preceed the aliases of "group1" and "group2".
  95 ;;;
  96 ;;; This code also understands the "source" .mailrc command, for reading
  97 ;;; aliases from some other file as well.
  98 ;;;
  99 ;;; To read in the contents of another .mailrc-type file from emacs, use the
 100 ;;; command Meta-X merge-mail-aliases.  The rebuild-mail-aliases command is
 101 ;;; similar, but will delete existing aliases first.
 102 ;;;
 103 ;;; If you want multiple addresses seperated by a string other than ", " then
 104 ;;; you can set the variable mail-alias-seperator-string to it.  This has to
 105 ;;; be a comma bracketed by whitespace if you want any kind of reasonable
 106 ;;; behaviour.
 107 ;;;
 108 ;;; Thanks to Harald Hanche-Olsen, Michael Ernst, David Loeffler, and
 109 ;;; Noah Friedman for suggestions and bug reports.
 110
 111 (require 'sendmail)
 112
 113 (defvar mail-abbrev-mailrc-file nil
 114   "Name of file with mail aliases.   If nil, ~/.mailrc is used.")
 115
 116 (defmacro mail-abbrev-mailrc-file ()
 117   '(or mail-abbrev-mailrc-file
 118        (setq mail-abbrev-mailrc-file
 119              (or (getenv "MAILRC") "~/.mailrc"))))
 120
 121 ;; originally defined in sendmail.el - used to be an alist, now is a table.
 122 (defvar mail-aliases nil
 123   "Word-abbrev table of mail address aliases.
 124 If this is nil, it means the aliases have not yet been initialized and
 125 should be read from the .mailrc file.  (This is distinct from there being
 126 no aliases, which is represented by this being a table with no entries.)")
 127
 128 (defun mail-aliases-setup ()
 129   (if (and (not (vectorp mail-aliases))
 130            (file-exists-p (mail-abbrev-mailrc-file)))
 131       (build-mail-aliases))
 132   (make-local-variable 'pre-abbrev-expand-hook)
 133   (setq pre-abbrev-expand-hook
 134     (cond ((and (listp pre-abbrev-expand-hook)
 135                 (not (eq 'lambda (car pre-abbrev-expand-hook))))
 136            (cons 'sendmail-pre-abbrev-expand-hook pre-abbrev-expand-hook))
 137           (t
 138            (list 'sendmail-pre-abbrev-expand-hook pre-abbrev-expand-hook))))
 139   (abbrev-mode 1))
 140
 141 ;;; Originally defined in mailalias.el.  Changed to call define-mail-alias
 142 ;;; with an additional argument.
 143 (defun build-mail-aliases (&optional file recursivep)
 144   "Read mail aliases from .mailrc and set mail-aliases."
 145   (setq file (expand-file-name (or file (mail-abbrev-mailrc-file))))
 146   (if (vectorp mail-aliases)
 147       nil
 148     (setq mail-aliases nil)
 149     (define-abbrev-table 'mail-aliases '()))
 150   (message "Parsing %s ..." file)
 151   (let ((buffer nil)
 152         (obuf (current-buffer)))
 153     (unwind-protect
 154         (progn
 155           (setq buffer (generate-new-buffer "mailrc"))
 156           (buffer-flush-undo buffer)
 157           (set-buffer buffer)
 158           (cond ((get-file-buffer file)
 159                  (insert (save-excursion
 160                            (set-buffer (get-file-buffer file))
 161                            (buffer-substring (point-min) (point-max)))))
 162                 ((not (file-exists-p file)))
 163                 (t (insert-file-contents file)))
 164           ;; Don't lose if no final newline.
 165           (goto-char (point-max))
 166           (or (eq (preceding-char) ?\n) (newline))
 167           (goto-char (point-min))
 168           ;; Delete comments from the file
 169           (while (search-forward "# " nil t)
 170             (let ((p (- (point) 2)))
 171               (end-of-line)
 172               (delete-region p (point))))
 173           (goto-char (point-min))
 174           ;; handle "\\\n" continuation lines
 175           (while (not (eobp))
 176             (end-of-line)
 177             (if (= (preceding-char) ?\\)
 178                 (progn (delete-char -1) (delete-char 1) (insert ?\ ))
 179                 (forward-char 1)))
 180           (goto-char (point-min))
 181           (while (re-search-forward
 182                   "^\\(a\\(lias\\|\\)\\|g\\(roup\\)\\|source\\)[ \t]+" nil t)
 183             (beginning-of-line)
 184             (if (looking-at "source[ \t]+\\([^ \t\n]+\\)")
 185                 (progn
 186                   (end-of-line)
 187                   (build-mail-aliases
 188                    (buffer-substring (match-beginning 1) (match-end 1)) t))
 189               (re-search-forward "[ \t]+\\([^ \t\n]+\\)")
 190               (let* ((name (buffer-substring
 191                             (match-beginning 1) (match-end 1)))
 192                      (start (progn (skip-chars-forward " \t") (point))))
 193                 (end-of-line)
 194 ;               (message "** %s \"%s\"" name (buffer-substring start (point)))(sit-for 1)
 195                 (define-mail-alias
 196                     name
 197                     (buffer-substring start (point))
 198                     t))))
 199           ;; Resolve forward references in .mailrc file.
 200           ;; This would happen automatically before the first abbrev was
 201           ;; expanded, but why not do it now.
 202           (or recursivep (mail-resolve-all-aliases))
 203           mail-aliases)
 204       (if buffer (kill-buffer buffer))
 205       (set-buffer obuf)))
 206     (message "Parsing %s ... done" file))
 207
 208 (defvar mail-alias-seperator-string ", "
 209   "*A string inserted between addresses in multi-address mail aliases.
 210 This has to contain a comma, so \", \" is a reasonable value.  You might
 211 also want something like \",\\n    \" to get each address on its own line.")
 212
 213 ;; define-mail-alias sets this flag, which causes mail-resolve-all-aliases
 214 ;; to be called before expanding abbrevs if it's necessary.
 215 (defvar mail-abbrev-aliases-need-to-be-resolved t)
 216
 217 ;; originally defined in mailalias.el ; build-mail-aliases calls this with
 218 ;; stuff parsed from the .mailrc file.
 219 ;;
 220 (defun define-mail-alias (name definition &optional from-mailrc-file)
 221   "Define NAME as a mail-alias that translates to DEFINITION.
 222 If DEFINITION contains multiple addresses, seperate them with commas."
 223   ;; When this is called from build-mail-aliases, the third argument is
 224   ;; true, and we do some evil space->comma hacking like /bin/mail does.
 225   (interactive "sDefine mail alias: \nsDefine %s as mail alias for: ")
 226   ;; Read the defaults first, if we have not done so.
 227   (if (vectorp mail-aliases)
 228       nil
 229     (setq mail-aliases nil)
 230     (define-abbrev-table 'mail-aliases '())
 231     (if (file-exists-p (mail-abbrev-mailrc-file))
 232         (build-mail-aliases)))
 233   ;; strip garbage from front and end
 234   (if (string-match "\\`[ \t\n,]+" definition)
 235       (setq definition (substring definition (match-end 0))))
 236   (if (string-match "[ \t\n,]+\\'" definition)
 237       (setq definition (substring definition 0 (match-beginning 0))))
 238   (let ((result '())
 239         (start 0)
 240         (L (length definition))
 241         end)
 242     (while start
 243       ;; If we're reading from the mailrc file, then addresses are delimited
 244       ;; by spaces, and addresses with embedded spaces must be surrounded by
 245       ;; double-quotes.  Otherwise, addresses are seperated by commas.
 246       (if from-mailrc-file
 247           (if (eq ?\" (aref definition start))
 248               (setq start (1+ start)
 249                     end (string-match "\"[ \t,]*" definition start))
 250               (setq end (string-match "[ \t,]+" definition start)))
 251           (setq end (string-match "[ \t\n,]*,[ \t\n,]*" definition start)))
 252       (setq result (cons (substring definition start end) result))
 253       (setq start (and end
 254                        (/= (match-end 0) L)
 255                        (match-end 0))))
 256     (setq definition (mapconcat (function identity)
 257                                 (nreverse result)
 258                                 mail-alias-seperator-string)))
 259   (setq mail-abbrev-aliases-need-to-be-resolved t)
 260   (setq name (downcase name))
 261   ;; use an abbrev table instead of an alist for mail-aliases.
 262   (let ((abbrevs-changed abbrevs-changed))  ; protect this from being changed.
 263     (define-abbrev mail-aliases name definition 'mail-abbrev-expand-hook)))
 264
 265
 266 (defun mail-resolve-all-aliases ()
 267   "Resolve all forward references in the mail aliases table."
 268   (if mail-abbrev-aliases-need-to-be-resolved
 269       (progn
 270 ;;      (message "Resolving mail aliases...")
 271         (if (vectorp mail-aliases)
 272             (mapatoms (function mail-resolve-all-aliases-1) mail-aliases))
 273         (setq mail-abbrev-aliases-need-to-be-resolved nil)
 274 ;;      (message "Resolving mail aliases... done.")
 275         )))
 276
 277 (defun mail-resolve-all-aliases-1 (sym)
 278   (let ((definition (and (boundp sym) (symbol-value sym))))
 279     (if definition
 280         (let ((result '())
 281               (start 0))
 282           (while start
 283             (let ((end (string-match "[ \t\n]*,[, \t\n]*" definition start)))
 284               (setq result (cons (substring definition start end) result)
 285                     start (and end (match-end 0)))))
 286           (setq definition
 287                 (mapconcat (function (lambda (x)
 288                              (or (mail-resolve-all-aliases-1
 289                                    (intern-soft x mail-aliases))
 290                                  x)))
 291                            (nreverse result)
 292                            mail-alias-seperator-string))
 293           (set sym definition))))
 294   (symbol-value sym))
 295
 296
 297 (defun mail-abbrev-expand-hook ()
 298   "For use as the fourth arg to define-abbrev.
 299   After expanding a mail-abbrev, if fill-mode is on and we're past the
 300 fill-column, break the line at the previous comma, and indent the next
 301 line."
 302   (save-excursion
 303     (let ((p (point))
 304           bol)
 305       (if (and (if (boundp 'auto-fill-function)
 306                    auto-fill-function
 307                  auto-fill-hook)
 308                (>= (current-column) fill-column))
 309           (progn
 310             (beginning-of-line)
 311             (setq bol (point))
 312             (goto-char p)
 313             (if (search-backward "," bol t)
 314                 (progn
 315                   (forward-char 1)
 316                   (insert "\n   ")))
 317             (if (> (current-column) fill-column)
 318                 (let ((fill-prefix "    "))
 319                   (do-auto-fill)))
 320             )))))
 321
 322
 323 (defun mail-interactive-insert-alias (&optional alias)
 324   "Prompt for and insert a mail alias."
 325   (interactive (list (completing-read "Expand alias: " mail-aliases nil t)))
 326   (insert (or (and alias (symbol-value (intern-soft alias mail-aliases))) "")))
 327
 328 (define-key mail-mode-map "\C-c\C-a" 'mail-interactive-insert-alias)
 329
 330
 331 (defvar mail-abbrev-mode-regexp "^\\(To\\|From\\|CC\\|BCC\\):"
 332   "*Regexp to select mail-headers in which mail-aliases should be expanded.
 333 This string it will be handed to `looking-at' with the point at the beginning
 334 of the current line; if it matches, abbrev mode will be turned on, otherwise
 335 it will be turned off.  (You don't need to worry about continuation lines.)
 336 This should be set to match those mail fields in which you want abbreviations
 337 turned on.")
 338
 339 (defvar mail-mode-syntax-table (copy-syntax-table text-mode-syntax-table)
 340   "The syntax table which is current in send-mail mode.")
 341
 342 (defvar mail-mode-header-syntax-table
 343   (let ((tab (copy-syntax-table text-mode-syntax-table)))
 344     ;; This makes the caracters "@%!._-" be considered symbol-consituents
 345     ;; but not word-constituents, so forward-sexp will move you over an
 346     ;; entire address, but forward-word will only move you over a sequence
 347     ;; of alphanumerics.  (Clearly the right thing.)
 348     (modify-syntax-entry ?@ "_" tab)
 349     (modify-syntax-entry ?% "_" tab)
 350     (modify-syntax-entry ?! "_" tab)
 351     (modify-syntax-entry ?. "_" tab)
 352     (modify-syntax-entry ?_ "_" tab)
 353     (modify-syntax-entry ?- "_" tab)
 354     (modify-syntax-entry ?< "(>" tab)
 355     (modify-syntax-entry ?> ")<" tab)
 356     ;; I hate this more than you can possibly imagine.
 357     ;; Do this if you want to have aliases with hyphens in them.  This causes
 358     ;; hyphens to be considered word-syntax, so forward-word will not stop at
 359     ;; hyphens.
 360     ;;(modify-syntax-entry ?- "w" tab)
 361     tab)
 362   "The syntax table used when the cursor is in a mail-address header.
 363 mail-mode-syntax-table is used when the cursor is not in an address header.")
 364
 365
 366 (defun sendmail-pre-abbrev-expand-hook ()
 367   (if mail-abbrev-aliases-need-to-be-resolved
 368       (mail-resolve-all-aliases))
 369   (if (and mail-aliases (not (eq mail-aliases t)))
 370       (let ((case-fold-search t))
 371         (if (and ;;
 372                  ;; we are on an appropriate header line...
 373                  (save-excursion
 374                    (beginning-of-line)
 375                    ;; skip backwards over continuation lines.
 376                    (while (and (looking-at "^[ \t]")
 377                                (not (= (point) (point-min))))
 378                      (forward-line -1))
 379                    ;; are we at the front of an appropriate header line?
 380                    (looking-at mail-abbrev-mode-regexp))
 381                  ;;
 382                  ;; ...and we are before the mail-header-separator
 383                  (< (point)
 384                     (save-excursion
 385                       (goto-char (point-min))
 386                       (search-forward (concat "\n" mail-header-separator "\n")
 387                                       nil 0)
 388                       (point))))
 389             ;; install the mail-aliases abbrev and syntax tables...
 390             (progn
 391               (setq local-abbrev-table mail-aliases)
 392               (set-syntax-table mail-mode-header-syntax-table))
 393           ;; or install the normal mail-mode abbrev table (likely empty).
 394           (progn
 395             (setq local-abbrev-table (and (boundp 'mail-mode-abbrev-table)
 396                                           mail-mode-abbrev-table))
 397             (set-syntax-table mail-mode-syntax-table))))))
 398
 399
 400 (defun merge-mail-aliases (file)
 401   "Merge mail aliases from the given file with existing ones."
 402   (interactive (list
 403                 (let ((insert-default-directory t)
 404                       (default-directory (expand-file-name "~/"))
 405                       (def (mail-abbrev-mailrc-file)))
 406                   (read-file-name
 407                     (format "Read additional aliases from file: (default %s) "
 408                             def)
 409                     default-directory
 410                     (expand-file-name def default-directory)
 411                     t))))
 412   (build-mail-aliases file))
 413
 414 (defun rebuild-mail-aliases (file)
 415   "Rebuild all the mail aliases from the given file."
 416   (interactive (list
 417                 (let ((insert-default-directory t)
 418                       (default-directory (expand-file-name "~/"))
 419                       (def (mail-abbrev-mailrc-file)))
 420                   (read-file-name
 421                    (format "Read mail aliases from file: (default %s) " def)
 422                    default-directory
 423                    (expand-file-name def default-directory)
 424                    t))))
 425   (setq mail-aliases nil)
 426   (build-mail-aliases file))
 427
 428 \f
 429 ;;; Patching it in:
 430 ;;; Remove the entire file mailalias.el
 431 ;;; Remove the definition of mail-aliases from sendmail.el
 432 ;;; Add a call to mail-aliases-setup to mail-setup in sendmail.el
 433 ;;; Remove the call to expand-mail-aliases from sendmail-send-it in sendmail.el
 434 ;;; Remove the autoload of expand-mail-aliases from sendmail.el
 435 ;;; Remove the autoload of build-mail-aliases from sendmail.el
 436 ;;; Add an autoload of define-mail-alias
 437
 438 (fmakunbound 'expand-mail-aliases)
 439
 440 (provide 'mail-abbrevs)
 441