+;;; @ quoted-string
+;;;
+
+(defun std11-wrap-as-quoted-pairs (string specials)
+ (let (dest
+ (i 0)
+ (b 0)
+ (len (length string))
+ )
+ (while (< i len)
+ (let ((chr (aref string i)))
+ (if (memq chr specials)
+ (setq dest (concat dest (substring string b i) "\\")
+ b i)
+ ))
+ (setq i (1+ i))
+ )
+ (concat dest (substring string b))
+ ))
+
+(defconst std11-non-qtext-char-list '(?\" ?\\ ?\r ?\n))
+
+(defun std11-wrap-as-quoted-string (string)
+ "Wrap STRING as RFC 822 quoted-string. [std11.el]"
+ (concat "\""
+ (std11-wrap-as-quoted-pairs string std11-non-qtext-char-list)
+ "\""))
+
+(defun std11-strip-quoted-pair (string)
+ "Strip quoted-pairs in STRING. [std11.el]"
+ (let (dest
+ (b 0)
+ (i 0)
+ (len (length string))
+ )
+ (while (< i len)
+ (let ((chr (aref string i)))
+ (if (eq chr ?\\)
+ (setq dest (concat dest (substring string b i))
+ b (1+ i)
+ i (+ i 2))
+ (setq i (1+ i))
+ )))
+ (concat dest (substring string b))
+ ))
+
+(defun std11-strip-quoted-string (string)
+ "Strip quoted-string STRING. [std11.el]"
+ (let ((len (length string)))
+ (or (and (>= len 2)
+ (let ((max (1- len)))
+ (and (eq (aref string 0) ?\")
+ (eq (aref string max) ?\")
+ (std11-strip-quoted-pair (substring string 1 max))
+ )))
+ string)))
+
+
+;;; @ composer
+;;;
+
+(defun std11-addr-to-string (seq)
+ "Return string from lexical analyzed list SEQ
+represents addr-spec of RFC 822. [std11.el]"
+ (mapconcat (function
+ (lambda (token)
+ (let ((name (car token)))
+ (cond
+ ((eq name 'spaces) "")
+ ((eq name 'comment) "")
+ ((eq name 'quoted-string)
+ (concat "\"" (cdr token) "\""))
+ (t (cdr token)))
+ )))
+ seq "")
+ )
+
+(defun std11-address-string (address)
+ "Return string of address part from parsed ADDRESS of RFC 822.
+\[std11.el]"
+ (cond ((eq (car address) 'group)
+ (mapconcat (function std11-address-string)
+ (car (cdr address))
+ ", ")
+ )
+ ((eq (car address) 'mailbox)
+ (let ((addr (nth 1 address)))
+ (std11-addr-to-string
+ (if (eq (car addr) 'phrase-route-addr)
+ (nth 2 addr)
+ (cdr addr)
+ )
+ )))))
+
+(defun std11-full-name-string (address)
+ "Return string of full-name part from parsed ADDRESS of RFC 822.
+\[std11.el]"
+ (cond ((eq (car address) 'group)
+ (mapconcat (function
+ (lambda (token)
+ (cdr token)
+ ))
+ (nth 1 address) "")
+ )
+ ((eq (car address) 'mailbox)
+ (let ((addr (nth 1 address))
+ (comment (nth 2 address))
+ phrase)
+ (if (eq (car addr) 'phrase-route-addr)
+ (setq phrase
+ (mapconcat
+ (function
+ (lambda (token)
+ (let ((type (car token)))
+ (cond ((eq type 'quoted-string)
+ (std11-strip-quoted-pair (cdr token))
+ )
+ ((eq type 'comment)
+ (concat
+ "("
+ (std11-strip-quoted-pair (cdr token))
+ ")")
+ )
+ (t
+ (cdr token)
+ )))))
+ (nth 1 addr) ""))
+ )
+ (cond ((> (length phrase) 0) phrase)
+ (comment (std11-strip-quoted-pair comment))
+ )
+ ))))
+
+(defun std11-msg-id-string (msg-id)
+ "Return string from parsed MSG-ID of RFC 822."
+ (concat "<" (std11-addr-to-string (cdr msg-id)) ">")
+ )
+
+(defun std11-fill-msg-id-list-string (string &optional column)
+ "Fill list of msg-id in STRING, and return the result."
+ (or column
+ (setq column 12))
+ (let ((lal (std11-lexical-analyze string))
+ dest)
+ (let ((ret (std11-parse-msg-id lal)))
+ (if ret
+ (let* ((str (std11-msg-id-string (car ret)))
+ (len (length str)))
+ (setq lal (cdr ret))
+ (if (> (+ len column) 76)
+ (setq dest (concat dest "\n " str)
+ column (1+ len))
+ (setq dest str
+ column (+ column len))
+ ))
+ (setq dest (concat dest (cdr (car lal)))
+ lal (cdr lal))
+ ))
+ (while lal
+ (let ((ret (std11-parse-msg-id lal)))
+ (if ret
+ (let* ((str (std11-msg-id-string (car ret)))
+ (len (1+ (length str))))
+ (setq lal (cdr ret))
+ (if (> (+ len column) 76)
+ (setq dest (concat dest "\n " str)
+ column len)
+ (setq dest (concat dest " " str)
+ column (+ column len))
+ ))
+ (setq dest (concat dest (cdr (car lal)))
+ lal (cdr lal))
+ )))
+ dest))
+
+
+;;; @ parser