Mercurial > emacs

comparison lisp/gnus/ietf-drums.el @ 56927:55fd4f77387a after-merge-gnus-5_10

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 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
author Miles Bader <miles@gnu.org>
date Sat, 04 Sep 2004 13:13:48 +0000
parents 695cf19ef79e
children 18a818a2ee7c cce1c0ee76ee
comparison
equal deleted inserted replaced
56926:f8e248e9a717 56927:55fd4f77387a
1 ;;; ietf-drums.el --- functions for parsing RFC822bis headers 1 ;;; ietf-drums.el --- Functions for parsing RFC822bis headers
2 ;; Copyright (C) 1998, 1999, 2000, 2002 2 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004
3 ;; Free Software Foundation, Inc. 3 ;; Free Software Foundation, Inc.
4 4
5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> 5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
6 ;; This file is part of GNU Emacs. 6 ;; This file is part of GNU Emacs.
7 7
24 24
25 ;; DRUMS is an IETF Working Group that works (or worked) on the 25 ;; DRUMS is an IETF Working Group that works (or worked) on the
26 ;; successor to RFC822, "Standard For The Format Of Arpa Internet Text 26 ;; successor to RFC822, "Standard For The Format Of Arpa Internet Text
27 ;; Messages". This library is based on 27 ;; Messages". This library is based on
28 ;; draft-ietf-drums-msg-fmt-05.txt, released on 1998-08-05. 28 ;; draft-ietf-drums-msg-fmt-05.txt, released on 1998-08-05.
29
30 ;; Pending a real regression self test suite, Simon Josefsson added
31 ;; various self test expressions snipped from bug reports, and their
32 ;; expected value, below. I you believe it could be useful, please
33 ;; add your own test cases, or write a real self test suite, or just
34 ;; remove this.
35
36 ;; <m3oekvfd50.fsf@whitebox.m5r.de>
37 ;; (ietf-drums-parse-address "'foo' <foo@example.com>")
38 ;; => ("foo@example.com" . "'foo'")
29 39
30 ;;; Code: 40 ;;; Code:
31 41
32 (eval-when-compile (require 'cl)) 42 (eval-when-compile (require 'cl))
33 (require 'time-date) 43 (require 'time-date)
62 (modify-syntax-entry ?\\ "/" table) 72 (modify-syntax-entry ?\\ "/" table)
63 (modify-syntax-entry ?< "(" table) 73 (modify-syntax-entry ?< "(" table)
64 (modify-syntax-entry ?> ")" table) 74 (modify-syntax-entry ?> ")" table)
65 (modify-syntax-entry ?@ "w" table) 75 (modify-syntax-entry ?@ "w" table)
66 (modify-syntax-entry ?/ "w" table) 76 (modify-syntax-entry ?/ "w" table)
67 (modify-syntax-entry ?= " " table) 77 (modify-syntax-entry ?* "_" table)
68 (modify-syntax-entry ?* " " table) 78 (modify-syntax-entry ?\; "_" table)
69 (modify-syntax-entry ?\; " " table) 79 (modify-syntax-entry ?\' "_" table)
70 (modify-syntax-entry ?\' " " table) 80 (if (featurep 'xemacs)
81 (let ((i 128))
82 (while (< i 256)
83 (modify-syntax-entry i "w" table)
84 (setq i (1+ i)))))
71 table)) 85 table))
72 86
73 (defun ietf-drums-token-to-list (token) 87 (defun ietf-drums-token-to-list (token)
74 "Translate TOKEN into a list of characters." 88 "Translate TOKEN into a list of characters."
75 (let ((i 0) 89 (let ((i 0)
198 (ietf-drums-get-comment string))) 212 (ietf-drums-get-comment string)))
199 (cons mailbox display-string))))) 213 (cons mailbox display-string)))))
200 214
201 (defun ietf-drums-parse-addresses (string) 215 (defun ietf-drums-parse-addresses (string)
202 "Parse STRING and return a list of MAILBOX / DISPLAY-NAME pairs." 216 "Parse STRING and return a list of MAILBOX / DISPLAY-NAME pairs."
203 (with-temp-buffer 217 (if (null string)
204 (ietf-drums-init string) 218 nil
205 (let ((beg (point)) 219 (with-temp-buffer
206 pairs c) 220 (ietf-drums-init string)
207 (while (not (eobp)) 221 (let ((beg (point))
208 (setq c (char-after)) 222 pairs c address)
209 (cond 223 (while (not (eobp))
210 ((memq c '(?\" ?< ?\()) 224 (setq c (char-after))
211 (forward-sexp 1)) 225 (cond
212 ((eq c ?,) 226 ((memq c '(?\" ?< ?\())
213 (push (ietf-drums-parse-address (buffer-substring beg (point))) 227 (condition-case nil
214 pairs) 228 (forward-sexp 1)
215 (forward-char 1) 229 (error
216 (setq beg (point))) 230 (skip-chars-forward "^,"))))
217 (t 231 ((eq c ?,)
218 (forward-char 1)))) 232 (setq address
219 (push (ietf-drums-parse-address (buffer-substring beg (point))) 233 (condition-case nil
220 pairs) 234 (ietf-drums-parse-address
221 (nreverse pairs)))) 235 (buffer-substring beg (point)))
236 (error nil)))
237 (if address (push address pairs))
238 (forward-char 1)
239 (setq beg (point)))
240 (t
241 (forward-char 1))))
242 (setq address
243 (condition-case nil
244 (ietf-drums-parse-address
245 (buffer-substring beg (point)))
246 (error nil)))
247 (if address (push address pairs))
248 (nreverse pairs)))))
222 249
223 (defun ietf-drums-unfold-fws () 250 (defun ietf-drums-unfold-fws ()
224 "Unfold folding white space in the current buffer." 251 "Unfold folding white space in the current buffer."
225 (goto-char (point-min)) 252 (goto-char (point-min))
226 (while (re-search-forward ietf-drums-fws-regexp nil t) 253 (while (re-search-forward ietf-drums-fws-regexp nil t)