-;;; Abbrev-expansion of mail aliases.
-;;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
-;;; Created: 19 oct 90, Jamie Zawinski <jwz@lucid.com>
-;;; Last change 15-dec-91. jwz
+;;; mailabbrev.el --- abbrev-expansion of mail aliases.
+
+;;; Copyright (C) 1985, 1986, 1987, 1992, 1993 Free Software Foundation, Inc.
+
+;; Author: Jamie Zawinski <jwz@lucid.com>
+;; Maintainer: Jamie Zawinski <jwz@lucid.com>
+;; Created: 19 Oct 90
+;; Keywords: mail
;;; This file is part of GNU Emacs.
;;; GNU Emacs is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 1, or (at your option)
+;;; the Free Software Foundation; either version 2, or (at your option)
;;; any later version.
;;; GNU Emacs is distributed in the hope that it will be useful,
;;; along with GNU Emacs; see the file COPYING. If not, write to
;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;;; Commentary:
+
;;; This file ensures that, when the point is in a To:, CC:, BCC:, or From:
;;; field, word-abbrevs are defined for each of your mail aliases. These
;;; aliases will be defined from your .mailrc file (or the file specified by
-;;; the MAILRC environment variable) if it exists. Providing abbrev-mode is
-;;; on in your send-mail buffer, your mail aliases will expand any time you
-;;; type a word-delimiter at the end of an abbreviation.
+;;; the MAILRC environment variable) if it exists. Your mail aliases will
+;;; expand any time you type a word-delimiter at the end of an abbreviation.
;;;
;;; What you see is what you get: no abbreviations will be expanded after you
;;; have sent the mail, unlike the old system. This means you don't suffer
;;; (bound to C-c C-a), which prompts you for an alias (with completion)
;;; and inserts its expansion at point.
;;;
-;;; To use this code, do something like
-;;;
-;;; (setq mail-mode-hook '(lambda () (require 'mail-abbrevs)))
-;;;
;;; This file fixes a bug in the old system which prohibited your .mailrc
;;; file from having lines like
;;;
;;; but that's what the file format is, so we have to live with it.)
;;;
;;; If you like, you can call the function define-mail-alias to define your
-;;; mail-aliases instead of using a .mailrc file. When you call it in this
-;;; way, addresses are seperated by commas.
+;;; mail aliases instead of using a .mailrc file. When you call it in this
+;;; way, addresses are separated by commas.
;;;
;;; CAVEAT: This works on most Sun systems; I have been told that some versions
;;; of /bin/mail do not understand double-quotes in the .mailrc file. So you
;;; This code also understands the "source" .mailrc command, for reading
;;; aliases from some other file as well.
;;;
+;;; Aliases may contain hyphens, as in "alias foo-bar foo@bar"; word-abbrevs
+;;; normally cannot contain hyphens, but this code works around that for the
+;;; specific case of mail-alias word-abbrevs.
+;;;
;;; To read in the contents of another .mailrc-type file from emacs, use the
-;;; command Meta-X merge-mail-aliases. The rebuild-mail-aliases command is
+;;; command Meta-X merge-mail-abbrevs. The rebuild-mail-abbrevs command is
;;; similar, but will delete existing aliases first.
;;;
-;;; If you want multiple addresses seperated by a string other than ", " then
-;;; you can set the variable mail-alias-seperator-string to it. This has to
+;;; If you would like your aliases to be expanded when you type M-> or ^N to
+;;; move out of the mail-header into the message body (instead of having to
+;;; type SPC at the end of the abbrev before moving away) then you can do
+;;;
+;;; (define-key mail-mode-map "\C-n" 'mail-abbrev-next-line)
+;;; (define-key mail-mode-map "\M->" 'mail-abbrev-end-of-buffer)
+;;;
+;;; If you want multiple addresses separated by a string other than ", " then
+;;; you can set the variable mail-alias-separator-string to it. This has to
;;; be a comma bracketed by whitespace if you want any kind of reasonable
;;; behaviour.
;;;
;;; Thanks to Harald Hanche-Olsen, Michael Ernst, David Loeffler, and
;;; Noah Friedman for suggestions and bug reports.
+;;; To use this file, add mail-abbrevs-setup as a hook
+;;; to the hook list `mail-setup-hook'.
+
+;;; Code:
+
(require 'sendmail)
(defvar mail-abbrev-mailrc-file nil
(or (getenv "MAILRC") "~/.mailrc"))))
;; originally defined in sendmail.el - used to be an alist, now is a table.
-(defvar mail-aliases nil
- "Abbrev table of mail address aliases.
+(defvar mail-abbrevs nil
+ "Word-abbrev table of mail address aliases.
If this is nil, it means the aliases have not yet been initialized and
should be read from the .mailrc file. (This is distinct from there being
no aliases, which is represented by this being a table with no entries.)")
;;;###autoload
-(defun mail-aliases-setup ()
- (if (and (not (vectorp mail-aliases))
+(defun mail-abbrevs-setup ()
+ (if (and (not (vectorp mail-abbrevs))
(file-exists-p (mail-abbrev-mailrc-file)))
- (build-mail-aliases))
+ (build-mail-abbrevs))
(make-local-variable 'pre-abbrev-expand-hook)
(setq pre-abbrev-expand-hook
(cond ((and (listp pre-abbrev-expand-hook)
(list 'sendmail-pre-abbrev-expand-hook pre-abbrev-expand-hook))))
(abbrev-mode 1))
-;;; Originally defined in mailalias.el. Changed to call define-mail-alias
-;;; with an additional argument.
-(defun build-mail-aliases (&optional file recursivep)
- "Read mail aliases from .mailrc and set mail-aliases."
+;;;###autoload
+(defun build-mail-abbrevs (&optional file recursivep)
+ "Read mail aliases from `~/.mailrc' file and set `mail-abbrevs'."
(setq file (expand-file-name (or file (mail-abbrev-mailrc-file))))
- (if (vectorp mail-aliases)
+ (if (vectorp mail-abbrevs)
nil
- (setq mail-aliases nil)
- (define-abbrev-table 'mail-aliases '()))
- (message "Parsing %s ..." file)
+ (setq mail-abbrevs nil)
+ (define-abbrev-table 'mail-abbrevs '()))
+ (message "Parsing %s..." file)
(let ((buffer nil)
(obuf (current-buffer)))
(unwind-protect
(progn
(setq buffer (generate-new-buffer "mailrc"))
- (buffer-flush-undo buffer)
+ (buffer-disable-undo buffer)
(set-buffer buffer)
(cond ((get-file-buffer file)
(insert (save-excursion
(forward-char 1)))
(goto-char (point-min))
(while (re-search-forward
- "^\\(a\\(lias\\|\\)\\|g\\(roup\\)\\|source\\)[ \t]+" nil t)
+ "^\\(a\\(lias\\)?\\|g\\(roup\\)?\\|source\\)[ \t]+" nil t)
(beginning-of-line)
(if (looking-at "source[ \t]+\\([^ \t\n]+\\)")
(progn
(end-of-line)
- (build-mail-aliases
+ (build-mail-abbrevs
(buffer-substring (match-beginning 1) (match-end 1)) t))
(re-search-forward "[ \t]+\\([^ \t\n]+\\)")
(let* ((name (buffer-substring
;; This would happen automatically before the first abbrev was
;; expanded, but why not do it now.
(or recursivep (mail-resolve-all-aliases))
- mail-aliases)
+ mail-abbrevs)
(if buffer (kill-buffer buffer))
(set-buffer obuf)))
- (message "Parsing %s ... done" file))
+ (message "Parsing %s... done" file))
-(defvar mail-alias-seperator-string ", "
+(defvar mail-alias-separator-string ", "
"*A string inserted between addresses in multi-address mail aliases.
This has to contain a comma, so \", \" is a reasonable value. You might
also want something like \",\\n \" to get each address on its own line.")
;; to be called before expanding abbrevs if it's necessary.
(defvar mail-abbrev-aliases-need-to-be-resolved t)
-;; originally defined in mailalias.el ; build-mail-aliases calls this with
+;; originally defined in mailalias.el ; build-mail-abbrevs calls this with
;; stuff parsed from the .mailrc file.
;;
;;;###autoload
(defun define-mail-alias (name definition &optional from-mailrc-file)
"Define NAME as a mail-alias that translates to DEFINITION.
-If DEFINITION contains multiple addresses, seperate them with commas."
- ;; When this is called from build-mail-aliases, the third argument is
+If DEFINITION contains multiple addresses, separate them with commas."
+ ;; When this is called from build-mail-abbrevs, the third argument is
;; true, and we do some evil space->comma hacking like /bin/mail does.
(interactive "sDefine mail alias: \nsDefine %s as mail alias for: ")
;; Read the defaults first, if we have not done so.
- (if (vectorp mail-aliases)
+ (if (vectorp mail-abbrevs)
nil
- (setq mail-aliases nil)
- (define-abbrev-table 'mail-aliases '())
+ (setq mail-abbrevs nil)
+ (define-abbrev-table 'mail-abbrevs '())
(if (file-exists-p (mail-abbrev-mailrc-file))
- (build-mail-aliases)))
+ (build-mail-abbrevs)))
;; strip garbage from front and end
(if (string-match "\\`[ \t\n,]+" definition)
(setq definition (substring definition (match-end 0))))
(while start
;; If we're reading from the mailrc file, then addresses are delimited
;; by spaces, and addresses with embedded spaces must be surrounded by
- ;; double-quotes. Otherwise, addresses are seperated by commas.
+ ;; double-quotes. Otherwise, addresses are separated by commas.
(if from-mailrc-file
(if (eq ?\" (aref definition start))
(setq start (1+ start)
(match-end 0))))
(setq definition (mapconcat (function identity)
(nreverse result)
- mail-alias-seperator-string)))
+ mail-alias-separator-string)))
(setq mail-abbrev-aliases-need-to-be-resolved t)
(setq name (downcase name))
- ;; use an abbrev table instead of an alist for mail-aliases.
+ ;; use an abbrev table instead of an alist for mail-abbrevs.
(let ((abbrevs-changed abbrevs-changed)) ; protect this from being changed.
- (define-abbrev mail-aliases name definition 'mail-abbrev-expand-hook)))
+ (define-abbrev mail-abbrevs name definition 'mail-abbrev-expand-hook)))
(defun mail-resolve-all-aliases ()
(if mail-abbrev-aliases-need-to-be-resolved
(progn
;; (message "Resolving mail aliases...")
- (if (vectorp mail-aliases)
- (mapatoms (function mail-resolve-all-aliases-1) mail-aliases))
+ (if (vectorp mail-abbrevs)
+ (mapatoms (function mail-resolve-all-aliases-1) mail-abbrevs))
(setq mail-abbrev-aliases-need-to-be-resolved nil)
;; (message "Resolving mail aliases... done.")
)))
-(defun mail-resolve-all-aliases-1 (sym)
+(defun mail-resolve-all-aliases-1 (sym &optional so-far)
+ (if (memq sym so-far)
+ (error "mail alias loop detected: %s"
+ (mapconcat 'symbol-name (cons sym so-far) " <- ")))
(let ((definition (and (boundp sym) (symbol-value sym))))
(if definition
(let ((result '())
(setq definition
(mapconcat (function (lambda (x)
(or (mail-resolve-all-aliases-1
- (intern-soft x mail-aliases))
+ (intern-soft x mail-abbrevs)
+ (cons sym so-far))
x)))
(nreverse result)
- mail-alias-seperator-string))
+ mail-alias-separator-string))
(set sym definition))))
(symbol-value sym))
(defun mail-abbrev-expand-hook ()
- "For use as the fourth arg to `define-abbrev'.
-After expanding a mail alias, if Auto Fill mode is on and we're past the
-fill column, break the line at the previous comma, and indent the next line."
+ "For use as the fourth arg to define-abbrev.
+After expanding a mail-abbrev, if fill-mode is on and we're past the
+fill-column, break the line at the previous comma, and indent the next
+line."
(save-excursion
(let ((p (point))
- bol)
- (if (and (if (boundp 'auto-fill-function)
- auto-fill-function
- auto-fill-hook)
- (>= (current-column) fill-column))
- (progn
- (beginning-of-line)
- (setq bol (point))
- (goto-char p)
- (if (search-backward "," bol t)
- (progn
- (forward-char 1)
- (insert "\n ")))
- (if (> (current-column) fill-column)
- (let ((fill-prefix " "))
- (do-auto-fill)))
- )))))
-
-
-(defun mail-interactive-insert-alias (&optional alias)
- "Prompt for and insert a mail alias."
- (interactive (list (completing-read "Expand alias: " mail-aliases nil t)))
- (insert (or (and alias (symbol-value (intern-soft alias mail-aliases))) "")))
-
-(define-key mail-mode-map "\C-c\C-a" 'mail-interactive-insert-alias)
-
-
-(defvar mail-abbrev-mode-regexp "^\\(To\\|From\\|CC\\|BCC\\):"
- "*Regexp to select mail-headers in which mail-aliases should be expanded.
+ bol comma fp)
+ (beginning-of-line)
+ (setq bol (point))
+ (goto-char p)
+ (while (and auto-fill-function
+ (>= (current-column) fill-column)
+ (search-backward "," bol t))
+ (setq comma (point))
+ (forward-char 1) ; Now we are just past the comma.
+ (insert "\n")
+ (delete-horizontal-space)
+ (setq p (point))
+ (indent-relative)
+ (setq fp (buffer-substring p (point)))
+ ;; Go to the end of the new line.
+ (end-of-line)
+ (if (> (current-column) fill-column)
+ ;; It's still too long; do normal auto-fill.
+ (let ((fill-prefix (or fp "\t")))
+ (do-auto-fill)))
+ ;; Resume the search.
+ (goto-char comma)
+ ))))
+\f
+;;; Syntax tables and abbrev-expansion
+
+(defvar mail-abbrev-mode-regexp "^\\(Resent-\\)?\\(To\\|From\\|CC\\|BCC\\):"
+ "*Regexp to select mail-headers in which mail-abbrevs should be expanded.
This string it will be handed to `looking-at' with the point at the beginning
of the current line; if it matches, abbrev mode will be turned on, otherwise
it will be turned off. (You don't need to worry about continuation lines.)
turned on.")
(defvar mail-mode-syntax-table (copy-syntax-table text-mode-syntax-table)
- "The syntax table which is current in mail mode.")
+ "The syntax table which is used in send-mail mode message bodies.")
(defvar mail-mode-header-syntax-table
(let ((tab (copy-syntax-table text-mode-syntax-table)))
- ;; This makes the caracters "@%!._-" be considered symbol-consituents
+ ;; This makes the characters "@%!._-" be considered symbol-consituents
;; but not word-constituents, so forward-sexp will move you over an
;; entire address, but forward-word will only move you over a sequence
;; of alphanumerics. (Clearly the right thing.)
(modify-syntax-entry ?- "_" tab)
(modify-syntax-entry ?< "(>" tab)
(modify-syntax-entry ?> ")<" tab)
- ;; I hate this more than you can possibly imagine.
- ;; Do this if you want to have aliases with hyphens in them. This causes
- ;; hyphens to be considered word-syntax, so forward-word will not stop at
- ;; hyphens.
- ;;(modify-syntax-entry ?- "w" tab)
tab)
- "The syntax table used when the cursor is in a mail-address header.
-mail-mode-syntax-table is used when the cursor is not in an address header.")
+ "The syntax table used in send-mail mode when in a mail-address header.
+mail-mode-syntax-table is used when the cursor is in the message body or in
+non-address headers.")
+
+(defvar mail-abbrev-syntax-table
+ (let* ((tab (copy-syntax-table mail-mode-header-syntax-table))
+ (i (1- (length tab)))
+ (_ (aref (standard-syntax-table) ?_))
+ (w (aref (standard-syntax-table) ?w)))
+ (while (>= i 0)
+ (if (= (aref tab i) _) (aset tab i w))
+ (setq i (1- i)))
+ tab)
+ "The syntax-table used for abbrev-expansion purposes; this is not actually
+made the current syntax table of the buffer, but simply controls the set of
+characters which may be a part of the name of a mail-alias.")
+
+
+(defun mail-abbrev-in-expansion-header-p ()
+ "Whether point is in a mail-address header field."
+ (let ((case-fold-search t))
+ (and ;;
+ ;; we are on an appropriate header line...
+ (save-excursion
+ (beginning-of-line)
+ ;; skip backwards over continuation lines.
+ (while (and (looking-at "^[ \t]")
+ (not (= (point) (point-min))))
+ (forward-line -1))
+ ;; are we at the front of an appropriate header line?
+ (looking-at mail-abbrev-mode-regexp))
+ ;;
+ ;; ...and we are before the mail-header-separator
+ (< (point)
+ (save-excursion
+ (goto-char (point-min))
+ (search-forward (concat "\n" mail-header-separator "\n")
+ nil 0)
+ (point))))))
+
+(defvar mail-mode-abbrev-table) ; quiet the compiler
-;; This hook is run before trying to expand an abbrev in a mail buffer.
-;; It determines whether point is in the header, and chooses which
-;; abbrev table accordingly.
(defun sendmail-pre-abbrev-expand-hook ()
- (if mail-abbrev-aliases-need-to-be-resolved
- (mail-resolve-all-aliases))
- (if (and mail-aliases (not (eq mail-aliases t)))
- (let ((case-fold-search t))
- (if (and ;;
- ;; we are on an appropriate header line...
- (save-excursion
- (beginning-of-line)
- ;; skip backwards over continuation lines.
- (while (and (looking-at "^[ \t]")
- (not (= (point) (point-min))))
- (forward-line -1))
- ;; are we at the front of an appropriate header line?
- (looking-at mail-abbrev-mode-regexp))
- ;;
- ;; ...and we are before the mail-header-separator
- (< (point)
- (save-excursion
- (goto-char (point-min))
- (search-forward (concat "\n" mail-header-separator "\n")
- nil 0)
- (point))))
- ;; install the mail-aliases abbrev and syntax tables...
- (progn
- (setq local-abbrev-table mail-aliases)
- (set-syntax-table mail-mode-header-syntax-table))
- ;; or install the normal mail-mode abbrev table (likely empty).
- (progn
- (setq local-abbrev-table (and (boundp 'mail-mode-abbrev-table)
- mail-mode-abbrev-table))
- (set-syntax-table mail-mode-syntax-table))))))
-
-
-(defun merge-mail-aliases (file)
+ (and (and mail-abbrevs (not (eq mail-abbrevs t)))
+ (if (mail-abbrev-in-expansion-header-p)
+ (progn
+ ;;
+ ;; We are in a To: (or CC:, or whatever) header, and
+ ;; should use word-abbrevs to expand mail aliases.
+
+ ;; Before anything else, resolve aliases if they need it.
+ (and mail-abbrev-aliases-need-to-be-resolved
+ (mail-resolve-all-aliases))
+
+ ;; Now proceed with the abbrev section.
+ ;; - First, install the mail-abbrevs as the word-abbrev table.
+ ;; - Then install the mail-abbrev-syntax-table, which
+ ;; temporarily marks all of the
+ ;; non-alphanumeric-atom-characters (the "_"
+ ;; syntax ones) as being normal word-syntax. We do this
+ ;; because the C code for expand-abbrev only works on words,
+ ;; and we want these characters to be considered words for
+ ;; the purpose of abbrev expansion.
+ ;; - Then we call expand-abbrev again, recursively, to do
+ ;; the abbrev expansion with the above syntax table.
+ ;; - Then we do a trick which tells the expand-abbrev frame
+ ;; which invoked us to not continue (and thus not
+ ;; expand twice.) This means that any abbrev expansion
+ ;; will happen as a result of this function's call to
+ ;; expand-abbrev, and not as a result of the call to
+ ;; expand-abbrev which invoked *us*.
+ ;; - Then we set the syntax table to
+ ;; mail-mode-header-syntax-table, which doesn't have
+ ;; anything to do with abbrev expansion, but
+ ;; is just for the user's convenience (see its doc string.)
+ ;;
+
+ (setq local-abbrev-table mail-abbrevs)
+
+ ;; If the character just typed was non-alpha-symbol-syntax,
+ ;; then don't expand the abbrev now (that is, don't expand
+ ;; when the user types -.) Check the character's syntax in
+ ;; the mail-mode-header-syntax-table.
+
+ (set-syntax-table mail-mode-header-syntax-table)
+ (or (eq (char-syntax last-command-char) ?_)
+ (let ((pre-abbrev-expand-hook nil)) ; That's us; don't loop.
+ ;; Use this table so that abbrevs can have hyphens in them.
+ (set-syntax-table mail-abbrev-syntax-table)
+ (expand-abbrev)
+ ;; Now set it back to what it was before.
+ (set-syntax-table mail-mode-header-syntax-table)))
+ (setq abbrev-start-location (point) ; This is the trick.
+ abbrev-start-location-buffer (current-buffer)))
+
+ ;; We're not in a mail header where mail aliases should
+ ;; be expanded, then use the normal mail-mode abbrev table
+ ;; (if any) and the normal mail-mode syntax table.
+
+ (setq local-abbrev-table (and (boundp 'mail-mode-abbrev-table)
+ mail-mode-abbrev-table))
+ (set-syntax-table mail-mode-syntax-table))
+ ))
+\f
+;;; utilities
+
+(defun merge-mail-abbrevs (file)
"Merge mail aliases from the given file with existing ones."
(interactive (list
(let ((insert-default-directory t)
default-directory
(expand-file-name def default-directory)
t))))
- (build-mail-aliases file))
+ (build-mail-abbrevs file))
-(defun rebuild-mail-aliases (file)
+(defun rebuild-mail-abbrevs (file)
"Rebuild all the mail aliases from the given file."
(interactive (list
(let ((insert-default-directory t)
default-directory
(expand-file-name def default-directory)
t))))
- (setq mail-aliases nil)
- (build-mail-aliases file))
+ (setq mail-abbrevs nil)
+ (build-mail-abbrevs file))
+
+(defun mail-interactive-insert-alias (&optional alias)
+ "Prompt for and insert a mail alias."
+ (interactive (progn
+ (if (not (vectorp mail-abbrevs)) (mail-abbrevs-setup))
+ (list (completing-read "Expand alias: " mail-abbrevs nil t))))
+ (if (not (vectorp mail-abbrevs)) (mail-abbrevs-setup))
+ (insert (or (and alias (symbol-value (intern-soft alias mail-abbrevs))) "")))
+
+(defun mail-abbrev-next-line (&optional arg)
+ "Expand any mail abbrev, then move cursor vertically down ARG lines.
+If there is no character in the target line exactly under the current column,
+the cursor is positioned after the character in that line which spans this
+column, or at the end of the line if it is not long enough.
+If there is no line in the buffer after this one,
+a newline character is inserted to create a line
+and the cursor moves to that line.
+
+The command \\[set-goal-column] can be used to create
+a semipermanent goal column to which this command always moves.
+Then it does not try to move vertically. This goal column is stored
+in `goal-column', which is nil when there is none.
+
+If you are thinking of using this in a Lisp program, consider
+using `forward-line' instead. It is usually easier to use
+and more reliable (no dependence on goal column, etc.)."
+ (interactive "p")
+ (if (looking-at "[ \t]*\n") (expand-abbrev))
+ (setq this-command 'next-line)
+ (next-line arg))
+
+(defun mail-abbrev-end-of-buffer (&optional arg)
+ "Expand any mail abbrev, then move point to end of buffer.
+Leave mark at previous position.
+With arg N, put point N/10 of the way from the true end.
+
+Don't use this command in Lisp programs!
+\(goto-char (point-max)) is faster and avoids clobbering the mark."
+ (interactive "p")
+ (if (looking-at "[ \t]*\n") (expand-abbrev))
+ (setq this-command 'end-of-buffer)
+ (end-of-buffer arg))
+
+(define-key mail-mode-map "\C-c\C-a" 'mail-interactive-insert-alias)
-(provide 'mail-abbrevs)
+;;(define-key mail-mode-map "\C-n" 'mail-abbrev-next-line)
+;;(define-key mail-mode-map "\M->" 'mail-abbrev-end-of-buffer)
+(provide 'mailabbrev)
HCoop / bpt / emacs.git / blobdiff