Merge from emacs-24; up to 2012-12-06T01:39:03Z!monnier@iro.umontreal.ca
[bpt/emacs.git] / lisp / mail / mailabbrev.el
index c99b2a2..3308e64 100644 (file)
@@ -1,9 +1,9 @@
 ;;; mailabbrev.el --- abbrev-expansion of mail aliases
 
-;; Copyright (C) 1985, 1986, 1987, 1992, 1993, 1996, 1997, 2000, 2001,
-;;   2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1987, 1992-1993, 1996-1997, 2000-2013 Free
+;; Software Foundation, Inc.
 
-;; Author: Jamie Zawinski <jwz@lucid.com>, now <jwz@jwz.org>
+;; Author: Jamie Zawinski <jwz@lucid.com; now jwz@jwz.org>
 ;; Maintainer: FSF
 ;; Created: 19 Oct 90
 ;; Keywords: mail
 
 ;;;###autoload
 (define-minor-mode mail-abbrevs-mode
-  "Non-nil means expand mail aliases as abbrevs, in certain message headers."
+  "Toggle abbrev expansion of mail aliases (Mail Abbrevs mode).
+With a prefix argument ARG, enable Mail Abbrevs mode if ARG is
+positive, and disable it otherwise.  If called from Lisp, enable
+the mode if ARG is omitted or nil.
+
+Mail Abbrevs mode is a global minor mode.  When enabled,
+abbrev-like expansion is performed when editing certain mail
+headers (those specified by `mail-abbrev-mode-regexp'), based on
+the entries in your `mail-personal-alias-file'."
   :global t
   :group 'mail-abbrev
   :version "20.3"
@@ -246,10 +254,12 @@ By default this is the file specified by `mail-personal-alias-file'."
     mail-abbrevs)
   (message "Parsing %s... done" file))
 
-(defvar mail-alias-separator-string ", "
-  "*A string inserted between addresses in multi-address mail aliases.
+(defcustom mail-alias-separator-string ", "
+  "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.")
+also want something like \",\\n    \" to get each address on its own line."
+  :type 'string
+  :group 'mail-abbrev)
 
 ;; define-mail-abbrev sets this flag, which causes mail-resolve-all-aliases
 ;; to be called before expanding abbrevs if it's necessary.
@@ -261,7 +271,12 @@ also want something like \",\\n    \" to get each address on its own line.")
 ;;;###autoload
 (defun define-mail-abbrev (name definition &optional from-mailrc-file)
   "Define NAME as a mail alias abbrev that translates to DEFINITION.
-If DEFINITION contains multiple addresses, separate them with commas."
+If DEFINITION contains multiple addresses, separate them with commas.
+
+Optional argument FROM-MAILRC-FILE means that DEFINITION comes
+from a mailrc file.  In that case, addresses are separated with
+spaces and addresses with embedded spaces are surrounded by
+double-quotes."
   ;; 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: ")
@@ -272,33 +287,62 @@ If DEFINITION contains multiple addresses, separate them with commas."
       (setq definition (substring definition (match-end 0))))
   (if (string-match "[ \t\n,]+\\'" definition)
       (setq definition (substring definition 0 (match-beginning 0))))
-  (let* ((result '())
-        (L (length definition))
+  (let* ((L (length definition))
         (start (if (> L 0) 0))
-        end)
+        end this-entry result)
     (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 separated by commas.
-      (if from-mailrc-file
-         (if (eq ?\" (aref definition start))
-             (setq start (1+ start)
-                   end (string-match "\"[ \t,]*" definition start))
-           (setq end (string-match "[ \t,]+" definition start)))
-       (setq end (string-match "[ \t\n,]*,[ \t\n,]*" definition start)))
-      (let ((tem (substring definition start end)))
+      (cond
+       (from-mailrc-file
+       ;; If we're reading from the mailrc file, addresses are
+       ;; delimited by spaces, and addresses with embedded spaces are
+       ;; surrounded by non-escaped double-quotes.
+       (if (eq ?\" (aref definition start))
+           (setq start (1+ start)
+                 end (and (string-match
+                           "[^\\]\\(\\([\\][\\]\\)*\\)\"[ \t,]*"
+                           definition start)
+                          (match-end 1)))
+         (setq end (string-match "[ \t,]+" definition start)))
+       ;; Extract the address and advance the loop past it.
+       (setq this-entry (substring definition start end)
+             start (and end (/= (match-end 0) L) (match-end 0)))
+       ;; If the full name contains a problem character, quote it.
+       (and (string-match "\\(.+?\\)[ \t]*\\(<.*>\\)" this-entry)
+            (string-match "[^- !#$%&'*+/0-9=?A-Za-z^_`{|}~]"
+                          (match-string 1 this-entry))
+            (setq this-entry (replace-regexp-in-string
+                              "\\(.+?\\)[ \t]*\\(<.*>\\)"
+                              "\"\\1\" \\2"
+                              this-entry)))
+       (push this-entry result))
+       ;; When we are not reading from .mailrc, addresses are
+       ;; separated by commas.  Try to accept a rfc822-like syntax.
+       ;; (Todo: extend rfc822.el to do the work for us.)
+       ((equal (string-match
+               "[ \t,]*\\(\"\\(?:[^\"]\\|[^\\]\\(?:[\\][\\]\\)*\"\\)*\"[ \t]*\
+<[-.!#$%&'*+/0-9=?A-Za-z^_`{|}~@]+>\\)[ \t,]*"
+               definition start)
+              start)
+       ;; If an entry has a valid [ "foo bar" <foo@example.com> ]
+       ;; form, use it literally .  This also allows commas in the
+       ;; quoted string, e.g.  [ "foo bar, jr" <foo@example.com> ]
+       (push (match-string 1 definition) result)
+       (setq start (and (/= (match-end 0) L) (match-end 0))))
+       (t
+       ;; Otherwise, read the next address by looking for a comma.
+       (setq end (string-match "[ \t\n,]*,[ \t\n]*" definition start))
+       (setq this-entry (substring definition start end))
        ;; Advance the loop past this address.
-       (setq start (and end
-                        (/= (match-end 0) L)
-                        (match-end 0)))
+       (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)))
+       (and (string-match "\\(.+?\\)[ \t]*\\(<.*>\\)" this-entry)
+            (string-match "[^- !#$%&'*+/0-9=?A-Za-z^_`{|}~]"
+                          (match-string 1 this-entry))
+            (setq this-entry (replace-regexp-in-string
+                              "\\(.+?\\)[ \t]*\\(<.*>\\)" "\"\\1\" \\2"
+                              this-entry)))
+       (push this-entry result))))
+
     (setq definition (mapconcat (function identity)
                                (nreverse result)
                                mail-alias-separator-string)))
@@ -347,46 +391,37 @@ If DEFINITION contains multiple addresses, separate them with commas."
 (defun mail-abbrev-expand-hook ()
   "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."
-  ;; 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)
-         )))))
+fill-column, break the line at the previous comma, and indent the next line
+with a space."
+  (when auto-fill-function
+    (let (p)
+      (save-excursion
+       (while (>= (current-column) fill-column)
+         (while (and (search-backward "," (point-at-bol) 'move)
+                     (>= (current-column) (1- fill-column))
+                     (setq p (point))))
+         (when (or (not (bolp))
+                   (and p (goto-char p)))
+           (setq p nil)
+           (forward-char 1)
+           (insert "\n")
+           (when (looking-at "[\t ]+")
+             (delete-region (point) (match-end 0)))
+           (insert " ")
+           (end-of-line)))))))
 \f
 ;;; Syntax tables and abbrev-expansion
 
-(defvar mail-abbrev-mode-regexp
+(defcustom mail-abbrev-mode-regexp
   "^\\(Resent-\\)?\\(To\\|From\\|CC\\|BCC\\|Reply-to\\):"
-  "*Regexp to select mail-headers in which mail abbrevs should be expanded.
+  "Regexp matching mail headers in which mail abbrevs should be expanded.
 This string will be handed to `looking-at' with 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.)
 This should be set to match those mail fields in which you want abbreviations
-turned on.")
+turned on."
+  :type 'regexp
+  :group 'mail-abbrev)
 
 (defvar mail-abbrev-syntax-table nil
   "The syntax-table used for abbrev-expansion purposes.
@@ -437,10 +472,12 @@ of a mail alias.  The value is set up, buffer-local, when first needed.")
 
 (defun mail-abbrev-expand-wrapper (expand)
   (if (and mail-abbrevs (not (eq mail-abbrevs t)))
-      (if (mail-abbrev-in-expansion-header-p)
+      (if (or (mail-abbrev-in-expansion-header-p)
+             ;; Necessary for `message-read-from-minibuffer' to work.
+             (window-minibuffer-p))
 
-          ;; 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 or a minibuffer,
+          ;; and should use word-abbrevs to expand mail aliases.
           (let ((local-abbrev-table mail-abbrevs))
 
             ;; Before anything else, resolve aliases if they need it.
@@ -466,12 +503,12 @@ of a mail alias.  The value is set up, buffer-local, when first needed.")
             ;; when the user types -.)  Check the character's syntax in
             ;; the usual syntax table.
 
-            (or (and (integerp last-command-char)
+            (or (and (integerp last-command-event)
                      ;; Some commands such as M-> may want to expand first.
                      (equal this-command 'self-insert-command)
-                     (or (eq (char-syntax last-command-char) ?_)
+                     (or (eq (char-syntax last-command-event) ?_)
                          ;; Don't expand on @.
-                         (memq last-command-char '(?@ ?. ?% ?! ?_ ?-))))
+                         (memq last-command-event '(?@ ?. ?% ?! ?_ ?-))))
                 ;; Use this table so that abbrevs can have hyphens in them.
                 (with-syntax-table mail-abbrev-syntax-table
                   (funcall expand))))
@@ -531,65 +568,36 @@ of a mail alias.  The value is set up, buffer-local, when first needed.")
 
 (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))
-        (beg (with-syntax-table mail-abbrev-syntax-table
-                (save-excursion
-                  (backward-word 1)
-                  (point))))
-         (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))))))
+  (let ((end (point))
+        (beg (with-syntax-table mail-abbrev-syntax-table
+               (save-excursion
+                 (backward-word 1)
+                 (point)))))
+    (completion-in-region beg end 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.)."
+  "Expand a mail abbrev before point, then move vertically down ARG lines.
+This only expands an abbrev (if one is present) if called with
+point at the end of a line, or on whitespace before the end of a line.
+
+In terms of line motion, this behaves like `next-line', which see."
   (interactive "p")
   (if (looking-at "[ \t]*\n") (expand-abbrev))
   (setq this-command 'next-line)
   (with-no-warnings (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.
+  "Expand a mail abbrev before point, then move to the end of the buffer.
+This only expands an abbrev (if one is present) if called with
+point at the end of a line, or on whitespace before the end of a line.
 
-Don't use this command in Lisp programs!
-\(goto-char (point-max)) is faster and avoids clobbering the mark."
+In other respects, this behaves like `end-of-buffer', which see."
   (interactive "P")
   (if (looking-at "[ \t]*\n") (expand-abbrev))
   (setq this-command 'end-of-buffer)
-  (with-no-warnings
-   (end-of-buffer arg)))
+  (with-no-warnings (end-of-buffer arg)))
 
 (eval-after-load "sendmail"
   '(progn
@@ -602,5 +610,4 @@ Don't use this command in Lisp programs!
 
 (provide 'mailabbrev)
 
-;; arch-tag: 5aa2d901-73f8-4ad7-b73c-4802282ad2ff
 ;;; mailabbrev.el ends here