1 |
;;; ietf-drums.el --- functions for parsing RFC822bis headers |
;;; ietf-drums.el --- Functions for parsing RFC822bis headers |
2 |
;; Copyright (C) 1998, 1999, 2000, 2002 |
;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004 |
3 |
;; Free Software Foundation, Inc. |
;; Free Software Foundation, Inc. |
4 |
|
|
5 |
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
27 |
;; Messages". This library is based on |
;; Messages". This library is based on |
28 |
;; draft-ietf-drums-msg-fmt-05.txt, released on 1998-08-05. |
;; 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'") |
39 |
|
|
40 |
;;; Code: |
;;; Code: |
41 |
|
|
42 |
(eval-when-compile (require 'cl)) |
(eval-when-compile (require 'cl)) |
74 |
(modify-syntax-entry ?> ")" table) |
(modify-syntax-entry ?> ")" table) |
75 |
(modify-syntax-entry ?@ "w" table) |
(modify-syntax-entry ?@ "w" table) |
76 |
(modify-syntax-entry ?/ "w" table) |
(modify-syntax-entry ?/ "w" table) |
77 |
(modify-syntax-entry ?= " " table) |
(modify-syntax-entry ?* "_" table) |
78 |
(modify-syntax-entry ?* " " table) |
(modify-syntax-entry ?\; "_" table) |
79 |
(modify-syntax-entry ?\; " " table) |
(modify-syntax-entry ?\' "_" table) |
80 |
(modify-syntax-entry ?\' " " table) |
(if (featurep 'xemacs) |
81 |
|
(let ((i 128)) |
82 |
|
(while (< i 256) |
83 |
|
(modify-syntax-entry i "w" table) |
84 |
|
(setq i (1+ i))))) |
85 |
table)) |
table)) |
86 |
|
|
87 |
(defun ietf-drums-token-to-list (token) |
(defun ietf-drums-token-to-list (token) |
214 |
|
|
215 |
(defun ietf-drums-parse-addresses (string) |
(defun ietf-drums-parse-addresses (string) |
216 |
"Parse STRING and return a list of MAILBOX / DISPLAY-NAME pairs." |
"Parse STRING and return a list of MAILBOX / DISPLAY-NAME pairs." |
217 |
(with-temp-buffer |
(if (null string) |
218 |
(ietf-drums-init string) |
nil |
219 |
(let ((beg (point)) |
(with-temp-buffer |
220 |
pairs c) |
(ietf-drums-init string) |
221 |
(while (not (eobp)) |
(let ((beg (point)) |
222 |
(setq c (char-after)) |
pairs c address) |
223 |
(cond |
(while (not (eobp)) |
224 |
((memq c '(?\" ?< ?\()) |
(setq c (char-after)) |
225 |
(forward-sexp 1)) |
(cond |
226 |
((eq c ?,) |
((memq c '(?\" ?< ?\()) |
227 |
(push (ietf-drums-parse-address (buffer-substring beg (point))) |
(condition-case nil |
228 |
pairs) |
(forward-sexp 1) |
229 |
(forward-char 1) |
(error |
230 |
(setq beg (point))) |
(skip-chars-forward "^,")))) |
231 |
(t |
((eq c ?,) |
232 |
(forward-char 1)))) |
(setq address |
233 |
(push (ietf-drums-parse-address (buffer-substring beg (point))) |
(condition-case nil |
234 |
pairs) |
(ietf-drums-parse-address |
235 |
(nreverse pairs)))) |
(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))))) |
249 |
|
|
250 |
(defun ietf-drums-unfold-fws () |
(defun ietf-drums-unfold-fws () |
251 |
"Unfold folding white space in the current buffer." |
"Unfold folding white space in the current buffer." |