Mercurial > emacs
comparison lisp/gnus/ietf-drums.el @ 82951:0fde48feb604
Import Gnus 5.10 from the v5_10 branch of the Gnus repository.
author | Andreas Schwab <schwab@suse.de> |
---|---|
date | Thu, 22 Jul 2004 16:45:51 +0000 |
parents | 695cf19ef79e |
children | 5ef78f4dd84f |
comparison
equal
deleted
inserted
replaced
56503:8bbd2323fbf2 | 82951:0fde48feb604 |
---|---|
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 |
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 |
62 (modify-syntax-entry ?\\ "/" table) | 62 (modify-syntax-entry ?\\ "/" table) |
63 (modify-syntax-entry ?< "(" table) | 63 (modify-syntax-entry ?< "(" table) |
64 (modify-syntax-entry ?> ")" table) | 64 (modify-syntax-entry ?> ")" table) |
65 (modify-syntax-entry ?@ "w" table) | 65 (modify-syntax-entry ?@ "w" table) |
66 (modify-syntax-entry ?/ "w" table) | 66 (modify-syntax-entry ?/ "w" table) |
67 (modify-syntax-entry ?= " " table) | |
68 (modify-syntax-entry ?* " " table) | 67 (modify-syntax-entry ?* " " table) |
69 (modify-syntax-entry ?\; " " table) | 68 (modify-syntax-entry ?\; " " table) |
70 (modify-syntax-entry ?\' " " table) | 69 (modify-syntax-entry ?\' " " table) |
70 (if (featurep 'xemacs) | |
71 (let ((i 128)) | |
72 (while (< i 256) | |
73 (modify-syntax-entry i "w" table) | |
74 (setq i (1+ i))))) | |
71 table)) | 75 table)) |
72 | 76 |
73 (defun ietf-drums-token-to-list (token) | 77 (defun ietf-drums-token-to-list (token) |
74 "Translate TOKEN into a list of characters." | 78 "Translate TOKEN into a list of characters." |
75 (let ((i 0) | 79 (let ((i 0) |
127 (cond | 131 (cond |
128 ((eq c ?\") | 132 ((eq c ?\") |
129 (forward-sexp 1)) | 133 (forward-sexp 1)) |
130 ((eq c ?\() | 134 ((eq c ?\() |
131 (forward-sexp 1)) | 135 (forward-sexp 1)) |
132 ((memq c '(?\ ?\t ?\n)) | 136 ((memq c '(? ?\t ?\n)) |
133 (delete-char 1)) | 137 (delete-char 1)) |
134 (t | 138 (t |
135 (forward-char 1)))) | 139 (forward-char 1)))) |
136 (buffer-string)))) | 140 (buffer-string)))) |
137 | 141 |
198 (ietf-drums-get-comment string))) | 202 (ietf-drums-get-comment string))) |
199 (cons mailbox display-string))))) | 203 (cons mailbox display-string))))) |
200 | 204 |
201 (defun ietf-drums-parse-addresses (string) | 205 (defun ietf-drums-parse-addresses (string) |
202 "Parse STRING and return a list of MAILBOX / DISPLAY-NAME pairs." | 206 "Parse STRING and return a list of MAILBOX / DISPLAY-NAME pairs." |
203 (with-temp-buffer | 207 (if (null string) |
204 (ietf-drums-init string) | 208 nil |
205 (let ((beg (point)) | 209 (with-temp-buffer |
206 pairs c) | 210 (ietf-drums-init string) |
207 (while (not (eobp)) | 211 (let ((beg (point)) |
208 (setq c (char-after)) | 212 pairs c address) |
209 (cond | 213 (while (not (eobp)) |
210 ((memq c '(?\" ?< ?\()) | 214 (setq c (char-after)) |
211 (forward-sexp 1)) | 215 (cond |
212 ((eq c ?,) | 216 ((memq c '(?\" ?< ?\()) |
213 (push (ietf-drums-parse-address (buffer-substring beg (point))) | 217 (condition-case nil |
214 pairs) | 218 (forward-sexp 1) |
215 (forward-char 1) | 219 (error |
216 (setq beg (point))) | 220 (skip-chars-forward "^,")))) |
217 (t | 221 ((eq c ?,) |
218 (forward-char 1)))) | 222 (setq address |
219 (push (ietf-drums-parse-address (buffer-substring beg (point))) | 223 (condition-case nil |
220 pairs) | 224 (ietf-drums-parse-address |
221 (nreverse pairs)))) | 225 (buffer-substring beg (point))) |
226 (error nil))) | |
227 (if address (push address pairs)) | |
228 (forward-char 1) | |
229 (setq beg (point))) | |
230 (t | |
231 (forward-char 1)))) | |
232 (setq address | |
233 (condition-case nil | |
234 (ietf-drums-parse-address | |
235 (buffer-substring beg (point))) | |
236 (error nil))) | |
237 (if address (push address pairs)) | |
238 (nreverse pairs))))) | |
222 | 239 |
223 (defun ietf-drums-unfold-fws () | 240 (defun ietf-drums-unfold-fws () |
224 "Unfold folding white space in the current buffer." | 241 "Unfold folding white space in the current buffer." |
225 (goto-char (point-min)) | 242 (goto-char (point-min)) |
226 (while (re-search-forward ietf-drums-fws-regexp nil t) | 243 (while (re-search-forward ietf-drums-fws-regexp nil t) |