diff options
author | Miles Bader <miles@gnu.org> | 2004-09-04 13:13:48 +0000 |
---|---|---|
committer | Miles Bader <miles@gnu.org> | 2004-09-04 13:13:48 +0000 |
commit | 33af8947de497b0d14ba9a5db26c4f5dae2f0e48 (patch) | |
tree | 1eb5e59df51f2addaceb6e030eeb0490ea56015b /lisp/gnus/ietf-drums.el | |
parent | d9cea513c0cda4d896cf3f3c0fa2b86c5f18b8c7 (diff) | |
download | emacs-33af8947de497b0d14ba9a5db26c4f5dae2f0e48.tar.gz |
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523after-merge-gnus-5_10
Merge from emacs--gnus--5.10, gnus--rel--5.10
Patches applied:
* miles@gnu.org--gnu-2004/emacs--gnus--5.10--base-0
tag of miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-464
* miles@gnu.org--gnu-2004/emacs--gnus--5.10--patch-1
Import from CVS branch gnus-5_10-branch
* miles@gnu.org--gnu-2004/emacs--gnus--5.10--patch-2
Merge from lorentey@elte.hu--2004/emacs--multi-tty--0, emacs--cvs-trunk--0
* miles@gnu.org--gnu-2004/emacs--gnus--5.10--patch-3
Merge from gnus--rel--5.10
* miles@gnu.org--gnu-2004/emacs--gnus--5.10--patch-4
Merge from gnus--rel--5.10
* miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-18
Update from CVS
* miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-19
Remove autoconf-generated files from archive
* miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-20
Update from CVS
Diffstat (limited to 'lisp/gnus/ietf-drums.el')
-rw-r--r-- | lisp/gnus/ietf-drums.el | 77 |
1 files changed, 52 insertions, 25 deletions
diff --git a/lisp/gnus/ietf-drums.el b/lisp/gnus/ietf-drums.el index a6e118ab5cf..f8837076b56 100644 --- a/lisp/gnus/ietf-drums.el +++ b/lisp/gnus/ietf-drums.el @@ -1,5 +1,5 @@ -;;; ietf-drums.el --- functions for parsing RFC822bis headers -;; Copyright (C) 1998, 1999, 2000, 2002 +;;; ietf-drums.el --- Functions for parsing RFC822bis headers +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -27,6 +27,16 @@ ;; Messages". This library is based on ;; draft-ietf-drums-msg-fmt-05.txt, released on 1998-08-05. +;; Pending a real regression self test suite, Simon Josefsson added +;; various self test expressions snipped from bug reports, and their +;; expected value, below. I you believe it could be useful, please +;; add your own test cases, or write a real self test suite, or just +;; remove this. + +;; <m3oekvfd50.fsf@whitebox.m5r.de> +;; (ietf-drums-parse-address "'foo' <foo@example.com>") +;; => ("foo@example.com" . "'foo'") + ;;; Code: (eval-when-compile (require 'cl)) @@ -64,10 +74,14 @@ backslash and doublequote.") (modify-syntax-entry ?> ")" table) (modify-syntax-entry ?@ "w" table) (modify-syntax-entry ?/ "w" table) - (modify-syntax-entry ?= " " table) - (modify-syntax-entry ?* " " table) - (modify-syntax-entry ?\; " " table) - (modify-syntax-entry ?\' " " table) + (modify-syntax-entry ?* "_" table) + (modify-syntax-entry ?\; "_" table) + (modify-syntax-entry ?\' "_" table) + (if (featurep 'xemacs) + (let ((i 128)) + (while (< i 256) + (modify-syntax-entry i "w" table) + (setq i (1+ i))))) table)) (defun ietf-drums-token-to-list (token) @@ -200,25 +214,38 @@ backslash and doublequote.") (defun ietf-drums-parse-addresses (string) "Parse STRING and return a list of MAILBOX / DISPLAY-NAME pairs." - (with-temp-buffer - (ietf-drums-init string) - (let ((beg (point)) - pairs c) - (while (not (eobp)) - (setq c (char-after)) - (cond - ((memq c '(?\" ?< ?\()) - (forward-sexp 1)) - ((eq c ?,) - (push (ietf-drums-parse-address (buffer-substring beg (point))) - pairs) - (forward-char 1) - (setq beg (point))) - (t - (forward-char 1)))) - (push (ietf-drums-parse-address (buffer-substring beg (point))) - pairs) - (nreverse pairs)))) + (if (null string) + nil + (with-temp-buffer + (ietf-drums-init string) + (let ((beg (point)) + pairs c address) + (while (not (eobp)) + (setq c (char-after)) + (cond + ((memq c '(?\" ?< ?\()) + (condition-case nil + (forward-sexp 1) + (error + (skip-chars-forward "^,")))) + ((eq c ?,) + (setq address + (condition-case nil + (ietf-drums-parse-address + (buffer-substring beg (point))) + (error nil))) + (if address (push address pairs)) + (forward-char 1) + (setq beg (point))) + (t + (forward-char 1)))) + (setq address + (condition-case nil + (ietf-drums-parse-address + (buffer-substring beg (point))) + (error nil))) + (if address (push address pairs)) + (nreverse pairs))))) (defun ietf-drums-unfold-fws () "Unfold folding white space in the current buffer." |