Mercurial > emacs

comparison lisp/gnus/ietf-drums.el @ 82951:0fde48feb604

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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)