2 ;;; $Id: tl-header.el,v 4.6 1994/11/08 10:30:11 morioka Exp $
7 (defconst message/quoted-string-regexp "\"[^\"]*\"")
8 (defconst message/field-name-regexp "^[!-9;-~]+:")
9 (defconst message/field-body-regexp ".*\\(\n[ \t].*\\)*")
10 (defconst message/field-regexp
11 (concat message/field-name-regexp
12 message/field-body-regexp))
13 (defconst message/word-regexp "[!#-'*+0-9=?A-Z^-~---]+")
14 (defconst message/local-part-regexp
15 (concat message/word-regexp "\\(\\." message/word-regexp "\\)*"))
16 (defconst message/domain-regexp (concat "@" message/local-part-regexp))
17 (defconst message/addr-spec-regexp
18 (concat message/local-part-regexp "\\(" message/domain-regexp "\\)?"))
20 (defun message/get-field-body (name)
23 (goto-char (point-min))
24 (if (re-search-forward (concat "^" name ":[ \t]*") nil t)
27 (and (re-search-forward message/field-body-regexp nil t)
31 (defun message/divide-field (str)
32 (let (field-name field-body)
33 (if (string-match message/field-name-regexp str)
35 (setq field-name (substring str 0 (match-end 0)))
36 (setq field-body (substring str (match-end 0)))
37 (if (string-match "^[ \t]+" field-body)
38 (setq field-body (substring field-body (match-end 0)))
40 (list field-name field-body)
43 (defun message/parse-addr-spec (str)
44 (if (string-match "^\\s +" str)
45 (setq str (substring str (match-end 0)))
47 (if (eq (string-match message/addr-spec-regexp str) 0)
48 (list (list (substring str 0 (match-end 0)))
49 (substring str (match-end 0))
53 (defun message/parse-phrase-route-addr (str)
54 (let ((p (and (string-match "^\\(\".*\"\\|[^,]\\)*<" str)
58 (setq ad (message/parse-addr-spec (substring str p)))
59 (eq (elt (nth 1 ad) 0) ?>))
60 (list (list (substring str 0 (- p 1))
64 (substring (nth 1 ad) 1)
69 (defun message/parse-comment (str)
70 (if (string-match "^\\s +" str)
71 (setq str (substring str (match-end 0)))
73 (if (string-match "^([^,]*)" str)
74 (list (list "(" (substring str 1 (- (match-end 0) 1)) ")")
75 (substring str (match-end 0))
79 (defun message/parse-address (str)
81 (message/parse-phrase-route-addr str)
82 (message/parse-addr-spec str)
88 (setq cret (message/parse-comment (car rest)))
90 (list (append (car ret) (car cret))
97 (defun message/parse-addresses (str)
99 (ret (message/parse-address str))
103 (setq dest (list (car ret)))
104 (setq rs (car (nth 1 ret)))
105 (while (and (string-match "^\\s *,\\s *" rs)
106 (setq ret (message/parse-address
107 (substring rs (match-end 0))))
109 (setq dest (append dest (list (car ret))))
110 (setq rs (car (nth 1 ret)))
112 (if (string-match "^\\s *$" rs)
117 (defun message/unfolding-string (str)
119 (while (string-match "\n\\s +" str)
120 (setq dest (concat dest (substring str 0 (match-beginning 0)) " "))
121 (setq str (substring str (match-end 0)))
126 (defun message/strip-quoted-string (str)
127 (let ((max (- (length str) 1))
129 (if (and (eq (elt str 0) ?\")
130 (eq (elt str max) ?\")
132 (substring str 1 max)