aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/mail/mailabbrev.el82
1 files changed, 58 insertions, 24 deletions
diff --git a/lisp/mail/mailabbrev.el b/lisp/mail/mailabbrev.el
index c99b2a22d3d..30f33829b35 100644
--- a/lisp/mail/mailabbrev.el
+++ b/lisp/mail/mailabbrev.el
@@ -261,7 +261,12 @@ also want something like \",\\n \" to get each address on its own line.")
261;;;###autoload 261;;;###autoload
262(defun define-mail-abbrev (name definition &optional from-mailrc-file) 262(defun define-mail-abbrev (name definition &optional from-mailrc-file)
263 "Define NAME as a mail alias abbrev that translates to DEFINITION. 263 "Define NAME as a mail alias abbrev that translates to DEFINITION.
264If DEFINITION contains multiple addresses, separate them with commas." 264If DEFINITION contains multiple addresses, separate them with commas.
265
266Optional argument FROM-MAILRC-FILE means that DEFINITION comes
267from a mailrc file. In that case, addresses are separated with
268spaces and addresses with embedded spaces are surrounded by
269double-quotes."
265 ;; When this is called from build-mail-abbrevs, the third argument is 270 ;; When this is called from build-mail-abbrevs, the third argument is
266 ;; true, and we do some evil space->comma hacking like /bin/mail does. 271 ;; true, and we do some evil space->comma hacking like /bin/mail does.
267 (interactive "sDefine mail alias: \nsDefine %s as mail alias for: ") 272 (interactive "sDefine mail alias: \nsDefine %s as mail alias for: ")
@@ -272,33 +277,62 @@ If DEFINITION contains multiple addresses, separate them with commas."
272 (setq definition (substring definition (match-end 0)))) 277 (setq definition (substring definition (match-end 0))))
273 (if (string-match "[ \t\n,]+\\'" definition) 278 (if (string-match "[ \t\n,]+\\'" definition)
274 (setq definition (substring definition 0 (match-beginning 0)))) 279 (setq definition (substring definition 0 (match-beginning 0))))
275 (let* ((result '()) 280 (let* ((L (length definition))
276 (L (length definition))
277 (start (if (> L 0) 0)) 281 (start (if (> L 0) 0))
278 end) 282 end this-entry result)
279 (while start 283 (while start
280 ;; If we're reading from the mailrc file, then addresses are delimited 284 (cond
281 ;; by spaces, and addresses with embedded spaces must be surrounded by 285 (from-mailrc-file
282 ;; double-quotes. Otherwise, addresses are separated by commas. 286 ;; If we're reading from the mailrc file, addresses are
283 (if from-mailrc-file 287 ;; delimited by spaces, and addresses with embedded spaces are
284 (if (eq ?\" (aref definition start)) 288 ;; surrounded by non-escaped double-quotes.
285 (setq start (1+ start) 289 (if (eq ?\" (aref definition start))
286 end (string-match "\"[ \t,]*" definition start)) 290 (setq start (1+ start)
287 (setq end (string-match "[ \t,]+" definition start))) 291 end (and (string-match
288 (setq end (string-match "[ \t\n,]*,[ \t\n,]*" definition start))) 292 "[^\\]\\(\\([\\][\\]\\)*\\)\"[ \t,]*"
289 (let ((tem (substring definition start end))) 293 definition start)
294 (match-end 1)))
295 (setq end (string-match "[ \t,]+" definition start)))
296 ;; Extract the address and advance the loop past it.
297 (setq this-entry (substring definition start end)
298 start (and end (/= (match-end 0) L) (match-end 0)))
299 ;; If the full name contains a problem character, quote it.
300 (and (string-match "\\(.+?\\)[ \t]*\\(<.*>\\)" this-entry)
301 (string-match "[^- !#$%&'*+/0-9=?A-Za-z^_`{|}~]"
302 (match-string 1 this-entry))
303 (setq this-entry (replace-regexp-in-string
304 "\\(.+?\\)[ \t]*\\(<.*>\\)"
305 "\"\\1\" \\2"
306 this-entry)))
307 (push this-entry result))
308 ;; When we are not reading from .mailrc, addresses are
309 ;; separated by commas. Try to accept a rfc822-like syntax.
310 ;; (Todo: extend rfc822.el to do the work for us.)
311 ((equal (string-match
312 "[ \t,]*\\(\"\\(?:[^\"]\\|[^\\]\\(?:[\\][\\]\\)*\"\\)*\"[ \t]*\
313<[-.!#$%&'*+/0-9=?A-Za-z^_`{|}~@]+>\\)[ \t,]*"
314 definition start)
315 start)
316 ;; If an entry has a valid [ "foo bar" <foo@example.com> ]
317 ;; form, use it literally . This also allows commas in the
318 ;; quoted string, e.g. [ "foo bar, jr" <foo@example.com> ]
319 (push (match-string 1 definition) result)
320 (setq start (and (/= (match-end 0) L) (match-end 0))))
321 (t
322 ;; Otherwise, read the next address by looking for a comma.
323 (setq end (string-match "[ \t\n,]*,[ \t\n]*" definition start))
324 (setq this-entry (substring definition start end))
290 ;; Advance the loop past this address. 325 ;; Advance the loop past this address.
291 (setq start (and end 326 (setq start (and end (/= (match-end 0) L) (match-end 0)))
292 (/= (match-end 0) L)
293 (match-end 0)))
294 ;; If the full name contains a problem character, quote it. 327 ;; If the full name contains a problem character, quote it.
295 (when (string-match "\\(.+?\\)[ \t]*\\(<.*>\\)" tem) 328 (and (string-match "\\(.+?\\)[ \t]*\\(<.*>\\)" this-entry)
296 (if (string-match "[^- !#$%&'*+/0-9=?A-Za-z^_`{|}~]" 329 (string-match "[^- !#$%&'*+/0-9=?A-Za-z^_`{|}~]"
297 (match-string 1 tem)) 330 (match-string 1 this-entry))
298 (setq tem (replace-regexp-in-string 331 (setq this-entry (replace-regexp-in-string
299 "\\(.+?\\)[ \t]*\\(<.*>\\)" "\"\\1\" \\2" 332 "\\(.+?\\)[ \t]*\\(<.*>\\)" "\"\\1\" \\2"
300 tem)))) 333 this-entry)))
301 (push tem result))) 334 (push this-entry result))))
335
302 (setq definition (mapconcat (function identity) 336 (setq definition (mapconcat (function identity)
303 (nreverse result) 337 (nreverse result)
304 mail-alias-separator-string))) 338 mail-alias-separator-string)))