-;;; mailabbrev.el --- abbrev-expansion of mail aliases.
+;;; mailabbrev.el --- abbrev-expansion of mail aliases
-;; Copyright (C) 1985, 1986, 87, 92, 93, 1996 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1986, 1987, 1992, 1993, 1996, 1997, 2000, 2002,
+;; 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
-;; Author: Jamie Zawinski <jwz@lucid.com>
-;; Maintainer: Jamie Zawinski <jwz@lucid.com>
+;; Author: Jamie Zawinski <jwz@lucid.com>, now <jwz@jwz.org>
+;; Maintainer: FSF
;; Created: 19 Oct 90
;; Keywords: mail
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
-;; This file ensures that, when the point is in a To:, CC:, BCC:, or From:
+;; 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. Your mail aliases will
+;; `mail-personal-alias-file') 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: if mailabbrev is in use when you type
;; Your mail alias abbrevs will be in effect only when the point is in an
;; appropriate header field. When in the body of the message, or other
;; header fields, the mail aliases will not expand. Rather, the normal
-;; mode-specific abbrev table (mail-mode-abbrev-table) will be used if
+;; mode-specific abbrev table will be used if
;; defined. So if you use mail-mode specific abbrevs, this code will not
;; adversely affect you. You can control which header fields the abbrevs
;; are used in by changing the variable mail-abbrev-mode-regexp.
;; If auto-fill mode is on, abbrevs will wrap at commas instead of at word
;; boundaries; also, header continuation-lines will be properly indented.
;;
-;; You can also insert a mail alias with mail-interactive-insert-alias
+;; You can also insert a mail alias with mail-abbrev-insert-alias
;; (bound to C-c C-a), which prompts you for an alias (with completion)
;; and inserts its expansion at point.
;;
;; type SPC at the end of the abbrev before moving away) then you can do
;;
;; (add-hook
-;; 'mail-setup-hook
-;; '(lambda ()
-;; (substitute-key-definition 'next-line 'mail-abbrev-next-line
-;; mail-mode-map global-map)
-;; (substitute-key-definition 'end-of-buffer 'mail-abbrev-end-of-buffer
-;; mail-mode-map global-map)))
+;; 'mail-mode-hook
+;; (lambda ()
+;; (define-key mail-mode-map [remap next-line] 'mail-abbrev-next-line)
+;; (define-key mail-mode-map [remap end-of-buffer] '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
;; Thanks to Harald Hanche-Olsen, Michael Ernst, David Loeffler, and
;; Noah Friedman for suggestions and bug reports.
-;; To use this package, do (add-hook 'mail-setup-hook 'mail-abbrevs-setup).
+;; To use this package, do (add-hook 'mail-mode-hook 'mail-abbrevs-setup).
;;; Code:
-(require 'sendmail)
+(eval-when-compile
+ (require 'sendmail))
+
+(defgroup mail-abbrev nil
+ "Expand mail aliases as abbrevs, in certain mail headers."
+ :group 'abbrev-mode)
+
+(defcustom mail-abbrevs-mode nil
+ "*Non-nil means expand mail aliases as abbrevs, in certain message headers."
+ :type 'boolean
+ :group 'mail-abbrev
+ :require 'mailabbrev
+ :set (lambda (symbol value)
+ (setq mail-abbrevs-mode value)
+ (if value (mail-abbrevs-enable) (mail-abbrevs-disable)))
+ :initialize 'custom-initialize-default
+ :version "20.3")
+
+(defcustom mail-abbrevs-only nil
+ "*Non-nil means only mail abbrevs should expand automatically.
+Other abbrevs expand only when you explicitly use `expand-abbrev'."
+ :type 'boolean
+ :group 'mail-abbrev)
;; originally defined in sendmail.el - used to be an alist, now is a table.
(defvar mail-abbrevs nil
"The modification time of your mail alias file when it was last examined.")
(defun mail-abbrevs-sync-aliases ()
- (if (file-exists-p mail-personal-alias-file)
- (let ((modtime (nth 5 (file-attributes mail-personal-alias-file))))
- (if (not (equal mail-abbrev-modtime modtime))
- (progn
- (setq mail-abbrev-modtime modtime)
- (build-mail-abbrevs))))))
+ (when mail-personal-alias-file
+ (if (file-exists-p mail-personal-alias-file)
+ (let ((modtime (nth 5 (file-attributes mail-personal-alias-file))))
+ (if (not (equal mail-abbrev-modtime modtime))
+ (progn
+ (setq mail-abbrev-modtime modtime)
+ (build-mail-abbrevs)))))))
;;;###autoload
(defun mail-abbrevs-setup ()
(if (and (not (vectorp mail-abbrevs))
(file-exists-p mail-personal-alias-file))
(progn
- (setq mail-abbrev-modtime
+ (setq mail-abbrev-modtime
(nth 5 (file-attributes mail-personal-alias-file)))
(build-mail-abbrevs)))
(mail-abbrevs-sync-aliases)
- (make-local-hook 'pre-abbrev-expand-hook)
(add-hook 'pre-abbrev-expand-hook 'sendmail-pre-abbrev-expand-hook
nil t)
(abbrev-mode 1))
+(defun mail-abbrevs-enable ()
+ (add-hook 'mail-mode-hook 'mail-abbrevs-setup))
+
+(defun mail-abbrevs-disable ()
+ "Turn off use of the `mailabbrev' package."
+ (remove-hook 'mail-mode-hook 'mail-abbrevs-setup)
+ (abbrev-mode (if (default-value 'abbrev-mode) 1 -1)))
+
;;;###autoload
(defun build-mail-abbrevs (&optional file recursivep)
"Read mail aliases from personal mail alias file and set `mail-abbrevs'.
(obuf (current-buffer)))
(unwind-protect
(progn
- (setq buffer (generate-new-buffer "mailrc"))
+ (setq buffer (generate-new-buffer " mailrc"))
(buffer-disable-undo buffer)
(set-buffer buffer)
(cond ((get-file-buffer file)
(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
+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.")
;; define-mail-abbrev sets this flag, which causes mail-resolve-all-aliases
end (string-match "\"[ \t,]*" definition start))
(setq end (string-match "[ \t,]+" definition start)))
(setq end (string-match "[ \t\n,]*,[ \t\n,]*" definition start)))
- (setq result (cons (substring definition start end) result))
- (setq start (and end
- (/= (match-end 0) L)
- (match-end 0))))
+ (let ((tem (substring definition start end)))
+ ;; Advance the loop past this address.
+ (setq start (and end
+ (/= (match-end 0) L)
+ (match-end 0)))
+ ;; If the full name contains a problem character, quote it.
+ (when (string-match "\\(.+?\\)[ \t]*\\(<.*>\\)" tem)
+ (if (string-match "[^- !#$%&'*+/0-9=?A-Za-z^_`{|}~]"
+ (match-string 1 tem))
+ (setq tem (replace-regexp-in-string
+ "\\(.+?\\)[ \t]*\\(<.*>\\)" "\"\\1\" \\2"
+ tem))))
+ (push tem result)))
(setq definition (mapconcat (function identity)
(nreverse result)
mail-alias-separator-string)))
(setq name (downcase name))
;; use an abbrev table instead of an alist for mail-abbrevs.
(let ((abbrevs-changed abbrevs-changed)) ; protect this from being changed.
- (define-abbrev mail-abbrevs name definition 'mail-abbrev-expand-hook)))
+ (define-abbrev mail-abbrevs name definition 'mail-abbrev-expand-hook 0 t)))
(defun mail-resolve-all-aliases ()
"For use as the fourth arg to `define-abbrev'.
After expanding a mail-abbrev, 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."
- (save-excursion
- (let ((p (point))
- 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)
- ))))
+ ;; Disable abbrev mode to avoid recursion in indent-relative expanding
+ ;; part of the abbrev expansion as an abbrev itself.
+ (let ((abbrev-mode nil))
+ (save-excursion
+ (let ((p (point))
+ 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
+(defvar mail-abbrev-mode-regexp
"^\\(Resent-\\)?\\(To\\|From\\|CC\\|BCC\\|Reply-to\\):"
"*Regexp to select mail-headers in which mail abbrevs should be expanded.
This string will be handed to `looking-at' with point at the beginning
This should be set to match those mail fields in which you want abbreviations
turned on.")
-(defvar mail-mode-header-syntax-table
- (let ((tab (copy-syntax-table text-mode-syntax-table)))
- ;; This makes the characters "@%!._-" be considered symbol-constituents
- ;; 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)
- (modify-syntax-entry ?. "_" tab)
- (modify-syntax-entry ?_ "_" tab)
- (modify-syntax-entry ?- "_" tab)
- (modify-syntax-entry ?< "(>" tab)
- (modify-syntax-entry ?> ")<" tab)
- tab)
- "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))
- (_ (aref (standard-syntax-table) ?_))
- (w (aref (standard-syntax-table) ?w)))
- (map-char-table
- (function (lambda (key value)
- (if (equal value _)
- (set-char-table-range tab key w))))
- tab)
- tab)
+(defvar mail-abbrev-syntax-table nil
"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.")
-
+of a mail alias. The value is set up, buffer-local, when first needed.")
+
+(defun mail-abbrev-make-syntax-table ()
+ (make-local-variable 'mail-abbrev-syntax-table)
+ (unless mail-abbrev-syntax-table
+ (let ((tab (copy-syntax-table (syntax-table)))
+ (_ (aref (standard-syntax-table) ?_))
+ (w (aref (standard-syntax-table) ?w)))
+ (map-char-table
+ (function (lambda (key value)
+ (if (null value)
+ ;; Fetch the inherited value
+ (setq value (aref tab key)))
+ (if (equal value _)
+ (set-char-table-range tab key w))))
+ tab)
+ (modify-syntax-entry ?@ "w" tab)
+ (modify-syntax-entry ?% "w" tab)
+ (modify-syntax-entry ?! "w" tab)
+ (modify-syntax-entry ?. "w" tab)
+ (modify-syntax-entry ?_ "w" tab)
+ (modify-syntax-entry ?- "w" tab)
+ (setq mail-abbrev-syntax-table tab))))
(defun mail-abbrev-in-expansion-header-p ()
"Whether point is in a mail-address header field."
(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))
+ (unless (eobp) (forward-char 1))
+ (re-search-backward "^[^ \t]" nil 'move)
;; are we at the front of an appropriate header line?
(looking-at mail-abbrev-mode-regexp))
;;
- ;; ...and we are before the mail-header-separator
+ ;; ...and are we in the headers?
(< (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
+ (save-restriction
+ (widen)
+ (save-excursion
+ (rfc822-goto-eoh)
+ (point)))))))
(defun sendmail-pre-abbrev-expand-hook ()
(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.
+
+ ;; We are in a To: (or CC:, or whatever) header, and
+ ;; should use word-abbrevs to expand mail aliases.
+ (let ((local-abbrev-table mail-abbrevs)
+ (old-syntax-table (syntax-table)))
;; 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.
+ ;; - We already installed mail-abbrevs as the abbrev table.
;; - Then install the mail-abbrev-syntax-table, which
;; temporarily marks all of the
;; non-alphanumeric-atom-characters (the "_"
;; the purpose of abbrev expansion.
;; - Then we call expand-abbrev again, recursively, to do
;; the abbrev expansion with the above syntax table.
+ ;; - Restore the previous 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)
+ (mail-abbrev-make-syntax-table)
;; 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.
+ ;; the usual syntax table.
- (set-syntax-table mail-mode-header-syntax-table)
(or (and (integerp last-command-char)
- (eq (char-syntax last-command-char) ?_))
+ (or (eq (char-syntax last-command-char) ?_)
+ ;; Don't expand on @.
+ (memq 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)))
+ (unwind-protect
+ (expand-abbrev)
+ ;; Now set it back to what it was before.
+ (set-syntax-table old-syntax-table))))
(setq abbrev-start-location (point-max) ; 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))
+ (if (or (not mail-abbrevs-only)
+ (eq this-command 'expand-abbrev))
+ ;; 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.
+ nil
+ ;; This is not a mail abbrev, and we should not expand it.
+ ;; This kludge stops expand-abbrev from doing anything.
+ (setq abbrev-start-location (point-max)
+ abbrev-start-location-buffer (current-buffer))))
))
\f
;;; utilities
(default-directory (expand-file-name "~/"))
(def mail-personal-alias-file))
(read-file-name
- (format "Read additional aliases from file: (default %s) "
+ (format "Read additional aliases from file (default %s): "
def)
default-directory
(expand-file-name def default-directory)
(default-directory (expand-file-name "~/"))
(def mail-personal-alias-file))
(read-file-name
- (format "Read mail aliases from file: (default %s) " def)
+ (format "Read mail aliases from file (default %s): " def)
default-directory
(expand-file-name def default-directory)
t))))
(setq mail-abbrevs nil)
(build-mail-abbrevs file))
-(defun mail-interactive-insert-alias (&optional alias)
+(defun mail-abbrev-insert-alias (&optional alias)
"Prompt for and insert a mail alias."
(interactive (progn
(if (not (vectorp mail-abbrevs)) (mail-abbrevs-setup))
(insert (or (and alias (symbol-value (intern-soft alias mail-abbrevs))) ""))
(mail-abbrev-expand-hook))
+(defun mail-abbrev-complete-alias ()
+ "Perform completion on alias preceding point."
+ ;; Based on lisp.el:lisp-complete-symbol
+ (interactive)
+ (mail-abbrev-make-syntax-table)
+ (let* ((end (point))
+ (syntax-table (syntax-table))
+ (beg (unwind-protect
+ (save-excursion
+ (set-syntax-table mail-abbrev-syntax-table)
+ (backward-word 1)
+ (point))
+ (set-syntax-table syntax-table)))
+ (alias (buffer-substring beg end))
+ (completion (try-completion alias mail-abbrevs)))
+ (cond ((eq completion t)
+ (message "%s" alias)) ; confirm
+ ((null completion)
+ (error "[Can't complete \"%s\"]" alias)) ; (message ...) (ding)
+ ((not (string= completion alias))
+ (delete-region beg end)
+ (insert completion))
+ (t (with-output-to-temp-buffer "*Completions*"
+ (display-completion-list
+ (prog2
+ (message "Making completion list...")
+ (all-completions alias mail-abbrevs)
+ (message "Making completion list...done"))
+ alias))))))
+
(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,
(interactive "P")
(if (looking-at "[ \t]*\n") (expand-abbrev))
(setq this-command 'end-of-buffer)
- (end-of-buffer arg))
+ (with-no-warnings
+ (end-of-buffer arg)))
-(define-key mail-mode-map "\C-c\C-a" 'mail-interactive-insert-alias)
+(eval-after-load "sendmail"
+ '(progn
+ (define-key mail-mode-map "\C-c\C-a" 'mail-abbrev-insert-alias)
+ (define-key mail-mode-map "\e\t" ; like lisp-complete-symbol
+ 'mail-abbrev-complete-alias)))
;;(define-key mail-mode-map "\C-n" 'mail-abbrev-next-line)
;;(define-key mail-mode-map "\M->" 'mail-abbrev-end-of-buffer)
(provide 'mailabbrev)
-;;; mailabbrev.el ends here.
+(if mail-abbrevs-mode
+ (mail-abbrevs-enable))
+
+;;; arch-tag: 5aa2d901-73f8-4ad7-b73c-4802282ad2ff
+;;; mailabbrev.el ends here