changeset 99927:342e1636063f

(define-mail-abbrev): When reading from mailrc, recognize string quoting. When reading from Lisp, accept rfc822-like addresses.
author Chong Yidong <cyd@stupidchicken.com>
date Tue, 25 Nov 2008 22:58:01 +0000
parents 5b589da725ea
children ba6d5a708321
files lisp/mail/mailabbrev.el
diffstat 1 files changed, 58 insertions(+), 24 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/mail/mailabbrev.el	Tue Nov 25 22:57:50 2008 +0000
+++ b/lisp/mail/mailabbrev.el	Tue Nov 25 22:58:01 2008 +0000
@@ -261,7 +261,12 @@
 ;;;###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 +277,62 @@
       (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)))