2 ;;; $Id: tl-header.el,v 5.2 1994/12/07 07:29:33 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::match-ctexts (str)
70 (if (string-match "^[^()\\\\]+" str)
71 (let ((e (match-end 0)))
72 (list (substring str 0 e)(substring str e))
75 (defun message::match-comment (str)
77 (if (and (>= (length str) 2)
81 (setq str (substring str 1))
82 (while (cond ((string= str "")
85 ((not (= (elt str 0) ?\)))
86 (setq ret (or (message::match-ctexts str)
87 (message::match-comment str)
90 (setq dest (concat dest (car ret)))
91 (setq str (nth 1 ret))
93 (if (= (elt str 0) ?\))
94 (list (concat "(" dest ")") (substring str 1))
98 (defun message/parse-comment (str)
99 (if (string-match "^\\s +" str)
100 (setq str (substring str (match-end 0)))
102 (let ((ret (message::match-comment str)))
104 (list (list "(" (substring (car ret) 1 (- (length (car ret)) 1))
110 (defun message/parse-address (str)
112 (message/parse-phrase-route-addr str)
113 (message/parse-addr-spec str)
118 (setq rest (cdr ret))
119 (setq cret (message/parse-comment (car rest)))
121 (list (append (car ret) (car cret))
123 (list (car ret) rest)
128 (defun message/parse-addresses (str)
130 (ret (message/parse-address str))
134 (setq dest (list (car ret)))
135 (setq rs (car (nth 1 ret)))
136 (while (and (string-match "^\\s *,\\s *" rs)
137 (setq ret (message/parse-address
138 (substring rs (match-end 0))))
140 (setq dest (append dest (list (car ret))))
141 (setq rs (car (nth 1 ret)))
143 (if (string-match "^\\s *$" rs)
148 (defun message/unfolding-string (str)
150 (while (string-match "\n\\s +" str)
151 (setq dest (concat dest (substring str 0 (match-beginning 0)) " "))
152 (setq str (substring str (match-end 0)))
157 (defun message/strip-quoted-string (str)
158 (let ((max (- (length str) 1))
160 (if (and (eq (elt str 0) ?\")
161 (eq (elt str max) ?\")
163 (substring str 1 max)