;;;
;;; $Id: tl-header.el,v 5.2 1994/12/07 07:29:33 morioka Exp $
;;;

(provide 'tl-header)

(defconst message/quoted-string-regexp "\"[^\"]*\"")
(defconst message/field-name-regexp "^[!-9;-~]+:")
(defconst message/field-body-regexp ".*\\(\n[ \t].*\\)*")
(defconst message/field-regexp
  (concat message/field-name-regexp
	  message/field-body-regexp))
(defconst message/word-regexp "[!#-'*+0-9=?A-Z^-~---]+")
(defconst message/local-part-regexp
  (concat message/word-regexp "\\(\\." message/word-regexp "\\)*"))
(defconst message/domain-regexp (concat "@" message/local-part-regexp))
(defconst message/addr-spec-regexp
  (concat message/local-part-regexp "\\(" message/domain-regexp "\\)?"))

(defun message/get-field-body (name)
  (save-excursion
    (save-restriction
      (goto-char (point-min))
      (if (re-search-forward (concat "^" name ":[ \t]*") nil t)
	  (buffer-substring
	   (match-end 0)
	   (and (re-search-forward message/field-body-regexp nil t)
		(match-end 0))
	   )))))

(defun message/divide-field (str)
  (let (field-name field-body)
    (if (string-match message/field-name-regexp str)
	(progn
	  (setq field-name (substring str 0 (match-end 0)))
	  (setq field-body (substring str (match-end 0)))
	  (if (string-match "^[ \t]+" field-body)
	      (setq field-body (substring field-body (match-end 0)))
	    )
	  (list field-name field-body)
	  ))))

(defun message/parse-addr-spec (str)
  (if (string-match "^\\s +" str)
      (setq str (substring str (match-end 0)))
    )
  (if (eq (string-match message/addr-spec-regexp str) 0)
      (list (list (substring str 0 (match-end 0)))
	    (substring str (match-end 0))
	    )
    ))

(defun message/parse-phrase-route-addr (str)
  (let ((p (and (string-match "^\\(\".*\"\\|[^,]\\)*<" str)
		(match-end 0)))
	phrase ad)
    (if (and p
	     (setq ad (message/parse-addr-spec (substring str p)))
	     (eq (elt (nth 1 ad) 0) ?>))
	(list (list (substring str 0 (- p 1))
		    "<"
		    (car (car ad))
		    ">")
	      (substring (nth 1 ad) 1)
	      )
      nil)
    ))

(defun message::match-ctexts (str)
  (if (string-match "^[^()\\\\]+" str)
      (let ((e (match-end 0)))
	(list (substring str 0 e)(substring str e))
	)))

(defun message::match-comment (str)
  (catch 'tag
    (if (and (>= (length str) 2)
	     (= (elt str 0) ?\()
	     )
	(let ((dest "") ret)
	  (setq str (substring str 1))
	  (while (cond ((string= str "")
			(throw 'tag nil)
			)
		       ((not (= (elt str 0) ?\)))
			(setq ret (or (message::match-ctexts str)
				      (message::match-comment str)
				      ))
			))
	    (setq dest (concat dest (car ret)))
	    (setq str (nth 1 ret))
	    )
	  (if (= (elt str 0) ?\))
	      (list (concat "(" dest ")") (substring str 1))
	    )
	  ))))

(defun message/parse-comment (str)
  (if (string-match "^\\s +" str)
      (setq str (substring str (match-end 0)))
    )
  (let ((ret (message::match-comment str)))
    (if ret
	(list (list "(" (substring (car ret) 1 (- (length (car ret)) 1))
		    ")")
	      (nth 1 ret)
	      )
      )))

(defun message/parse-address (str)
  (let ((ret (or
	      (message/parse-phrase-route-addr str)
	      (message/parse-addr-spec str)
	      ))
	n rest type cret)
    (if ret
	(progn
	  (setq rest (cdr ret))
	  (setq cret (message/parse-comment (car rest)))
	  (if cret
	      (list (append (car ret) (car cret))
		    (cdr cret))
	    (list (car ret) rest)
	    )
	  ))
    ))

(defun message/parse-addresses (str)
  (let (dest
	(ret (message/parse-address str))
	rs)
    (if ret
	(progn
	  (setq dest (list (car ret)))
	  (setq rs (car (nth 1 ret)))
	  (while (and (string-match "^\\s *,\\s *" rs)
		      (setq ret (message/parse-address
				 (substring rs (match-end 0))))
		      )
	    (setq dest (append dest (list (car ret))))
	    (setq rs (car (nth 1 ret)))
	    )
	  (if (string-match "^\\s *$" rs)
	      dest)
	  ))
    ))

(defun message/unfolding-string (str)
  (let ((dest ""))
    (while (string-match "\n\\s +" str)
      (setq dest (concat dest (substring str 0 (match-beginning 0)) " "))
      (setq str (substring str (match-end 0)))
      )
    (concat dest str)
    ))

(defun message/strip-quoted-string (str)
  (let ((max (- (length str) 1))
	)
    (if (and (eq (elt str 0) ?\")
	     (eq (elt str max) ?\")
	     )
	(substring str 1 max)
      str)))