update.
[elisp/flim.git] / eword-encode.el
index 2a38ee3..3574c16 100644 (file)
@@ -5,7 +5,7 @@
 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
 ;; Keywords: encoded-word, MIME, multilingual, header, mail, news
 
-;; This file is part of SEMI (Spadework for Emacs MIME Interfaces).
+;; This file is part of FLIM (Faithful Library about Internet Message).
 
 ;; This program is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU General Public License as
 (require 'eword-decode)
 
 
-;;; @ version
-;;;
-
-(defconst eword-encode-version "1.2")
-
-
 ;;; @ variables
 ;;;
 
@@ -171,15 +165,15 @@ MODE is allows `text', `comment', `phrase' or nil.  Default value is
 ;;; @ rule
 ;;;
 
-(defmacro tm-eword::make-rword (text charset encoding type)
+(defmacro make-ew-rword (text charset encoding type)
   (` (list (, text)(, charset)(, encoding)(, type))))
-(defmacro tm-eword::rword-text (rword)
+(defmacro ew-rword-text (rword)
   (` (car (, rword))))
-(defmacro tm-eword::rword-charset (rword)
+(defmacro ew-rword-charset (rword)
   (` (car (cdr (, rword)))))
-(defmacro tm-eword::rword-encoding (rword)
+(defmacro ew-rword-encoding (rword)
   (` (car (cdr (cdr (, rword))))))
-(defmacro tm-eword::rword-type (rword)
+(defmacro ew-rword-type (rword)
   (` (car (cdr (cdr (cdr (, rword)))))))
 
 (defun tm-eword::find-charset-rule (charsets)
@@ -194,7 +188,7 @@ MODE is allows `text', `comment', `phrase' or nil.  Default value is
   (mapcar (function
           (lambda (word)
             (let ((ret (tm-eword::find-charset-rule (car word))))
-              (tm-eword::make-rword (cdr word) (car ret)(nth 1 ret) mode)
+              (make-ew-rword (cdr word) (car ret)(nth 1 ret) mode)
               )))
          wl))
 
@@ -204,13 +198,13 @@ MODE is allows `text', `comment', `phrase' or nil.  Default value is
       (setq b (car seq))
       (setq seq (cdr seq))
       (setq c (car seq))
-      (setq cc (tm-eword::rword-charset c))
-      (if (null (tm-eword::rword-charset b))
+      (setq cc (ew-rword-charset c))
+      (if (null (ew-rword-charset b))
          (progn
            (setq a (car prev))
-           (setq ac (tm-eword::rword-charset a))
-           (if (and (tm-eword::rword-encoding a)
-                    (tm-eword::rword-encoding c))
+           (setq ac (ew-rword-charset a))
+           (if (and (ew-rword-encoding a)
+                    (ew-rword-encoding c))
                (cond ((eq ac cc)
                       (setq prev (cons
                                   (cons (concat (car a)(car b)(car c))
@@ -233,7 +227,7 @@ MODE is allows `text', `comment', `phrase' or nil.  Default value is
     (reverse prev)
     ))
 
-(defun tm-eword::split-string (str &optional mode)
+(defun eword-encode-split-string (str &optional mode)
   (tm-eword::space-process
    (tm-eword::words-to-ruled-words
     (eword-encode-charset-words-to-words
@@ -245,9 +239,9 @@ MODE is allows `text', `comment', `phrase' or nil.  Default value is
 ;;;
 
 (defun tm-eword::encoded-word-length (rword)
-  (let ((string   (tm-eword::rword-text     rword))
-       (charset  (tm-eword::rword-charset  rword))
-       (encoding (tm-eword::rword-encoding rword))
+  (let ((string   (ew-rword-text     rword))
+       (charset  (ew-rword-charset  rword))
+       (encoding (ew-rword-encoding rword))
        ret)
     (setq ret
          (cond ((string-equal encoding "B")
@@ -257,7 +251,7 @@ MODE is allows `text', `comment', `phrase' or nil.  Default value is
                ((string-equal encoding "Q")
                 (setq string (encode-mime-charset-string string charset))
                 (q-encoding-encoded-length string
-                                           (tm-eword::rword-type rword))
+                                           (ew-rword-type rword))
                 )))
     (if ret
        (cons (+ 7 (length (symbol-name charset)) ret) string)
@@ -287,10 +281,10 @@ MODE is allows `text', `comment', `phrase' or nil.  Default value is
                  )
             (setq string
                   (eword-encode-text
-                   (tm-eword::rword-charset rword)
-                   (tm-eword::rword-encoding rword)
+                   (ew-rword-charset rword)
+                   (ew-rword-encoding rword)
                    (cdr ret)
-                   (tm-eword::rword-type rword)
+                   (ew-rword-type rword)
                    ))
             (setq len (+ (length string) column))
             (setq rwl (cdr rwl))
@@ -319,10 +313,10 @@ MODE is allows `text', `comment', `phrase' or nil.  Default value is
                                 (cdr rwl)))
                 (setq string
                       (eword-encode-text
-                       (tm-eword::rword-charset rword)
-                       (tm-eword::rword-encoding rword)
+                       (ew-rword-charset rword)
+                       (ew-rword-encoding rword)
                        str
-                       (tm-eword::rword-type rword)))
+                       (ew-rword-type rword)))
                 (setq len (+ (length string) column))
                 )
               )))
@@ -330,7 +324,7 @@ MODE is allows `text', `comment', `phrase' or nil.  Default value is
     (list string len rwl)
     ))
 
-(defun tm-eword::encode-rwl (column rwl)
+(defun eword-encode-rword-list (column rwl)
   (let (ret dest ps special str ew-f pew-f)
     (while rwl
       (setq ew-f (nth 2 (car rwl)))
@@ -379,10 +373,6 @@ MODE is allows `text', `comment', `phrase' or nil.  Default value is
     (list dest column)
     ))
 
-(defun tm-eword::encode-string (column str &optional mode)
-  (tm-eword::encode-rwl column (tm-eword::split-string str mode))
-  )
-
 
 ;;; @ converter
 ;;;
@@ -399,7 +389,7 @@ MODE is allows `text', `comment', `phrase' or nil.  Default value is
                           (list
                            (let ((ret (tm-eword::find-charset-rule
                                        (find-non-ascii-charset-string str))))
-                             (tm-eword::make-rword
+                             (make-ew-rword
                               str (car ret)(nth 1 ret) 'phrase)
                              )
                            )))
@@ -430,7 +420,7 @@ MODE is allows `text', `comment', `phrase' or nil.  Default value is
     (tm-eword::space-process dest)
     ))
 
-(defun eword-addr-seq-to-rwl (seq)
+(defun eword-encode-addr-seq-to-rword-list (seq)
   (let (dest pname)
     (while seq
       (let* ((token (car seq))
@@ -444,7 +434,7 @@ MODE is allows `text', `comment', `phrase' or nil.  Default value is
                     (nconc
                      dest
                      (list (list "(" nil nil))
-                     (tm-eword::split-string (cdr token) 'comment)
+                     (eword-encode-split-string (cdr token) 'comment)
                      (list (list ")" nil nil))
                      ))
               )
@@ -472,7 +462,7 @@ MODE is allows `text', `comment', `phrase' or nil.  Default value is
       )
     dest))
 
-(defun eword-phrase-route-addr-to-rwl (phrase-route-addr)
+(defun eword-encode-phrase-route-addr-to-rword-list (phrase-route-addr)
   (if (eq (car phrase-route-addr) 'phrase-route-addr)
       (let ((phrase (nth 1 phrase-route-addr))
            (route (nth 2 phrase-route-addr))
@@ -486,35 +476,35 @@ MODE is allows `text', `comment', `phrase' or nil.  Default value is
          )
        (append
         dest
-        (eword-addr-seq-to-rwl
+        (eword-encode-addr-seq-to-rword-list
          (append '((specials . "<"))
                  route
                  '((specials . ">"))))
         ))))
 
-(defun eword-addr-spec-to-rwl (addr-spec)
+(defun eword-encode-addr-spec-to-rword-list (addr-spec)
   (if (eq (car addr-spec) 'addr-spec)
-      (eword-addr-seq-to-rwl (cdr addr-spec))
+      (eword-encode-addr-seq-to-rword-list (cdr addr-spec))
     ))
 
 (defun tm-eword::mailbox-to-rwl (mbox)
   (let ((addr (nth 1 mbox))
        (comment (nth 2 mbox))
        dest)
-    (setq dest (or (eword-phrase-route-addr-to-rwl addr)
-                  (eword-addr-spec-to-rwl addr)
+    (setq dest (or (eword-encode-phrase-route-addr-to-rword-list addr)
+                  (eword-encode-addr-spec-to-rword-list addr)
                   ))
     (if comment
        (setq dest
              (append dest
                      '((" " nil nil)
                        ("(" nil nil))
-                     (tm-eword::split-string comment 'comment)
+                     (eword-encode-split-string comment 'comment)
                      '((")" nil nil))
                      )))
     dest))
 
-(defun tm-eword::addresses-to-rwl (addresses)
+(defsubst eword-encode-addresses-to-rwl (addresses)
   (let ((dest (tm-eword::mailbox-to-rwl (car addresses))))
     (if dest
        (while (setq addresses (cdr addresses))
@@ -526,16 +516,40 @@ MODE is allows `text', `comment', `phrase' or nil.  Default value is
          ))
     dest))
 
-(defun tm-eword::encode-address-list (column str)
-  (tm-eword::encode-rwl
-   column
-   (tm-eword::addresses-to-rwl (std11-parse-addresses-string str))
-   ))
-
 
 ;;; @ application interfaces
 ;;;
 
+(defun eword-encode-string (string &optional column mode)
+  "Encode STRING as encoded-words, and return the result.
+Optional argument COLUMN is start-position of the field.
+Optional argument MODE allows `text', `comment', `phrase' or nil.
+Default value is `phrase'."
+  (car (eword-encode-rword-list (or column 0)
+                               (eword-encode-split-string string mode))))
+
+(defun eword-encode-address-list (string &optional column)
+  "Encode header field STRING as list of address, and return the result.
+Optional argument COLUMN is start-position of the field."
+  (car (eword-encode-rword-list
+       (or column 0)
+       (eword-encode-addresses-to-rwl (std11-parse-addresses-string string))
+       )))
+
+(defun eword-encode-structured-field-body (string &optional column)
+  "Encode header field STRING as structured field, and return the result.
+Optional argument COLUMN is start-position of the field."
+  (car (eword-encode-rword-list
+       (or column 0)
+       (eword-encode-addr-seq-to-rword-list (std11-lexical-analyze string))
+       )))
+
+(defun eword-encode-unstructured-field-body (string &optional column)
+  "Encode header field STRING as unstructured field, and return the result.
+Optional argument COLUMN is start-position of the field."
+  (car (eword-encode-rword-list (or column 0)
+                               (eword-encode-split-string string 'text))))
+
 (defun eword-encode-field (string)
   "Encode header field STRING, and return the result.
 A lexical token includes non-ASCII character is encoded as MIME
@@ -546,30 +560,34 @@ encoded-word.  ASCII token is not encoded."
            (let ((field-name (substring string 0 (1- (match-end 0))))
                  (field-body (eliminate-top-spaces
                               (substring string (match-end 0))))
-                 )
+                 field-name-symbol)
              (if (setq ret
-                       (cond ((string-equal field-body "") "")
-                             ((memq (intern (downcase field-name))
-                                    '(reply-to
-                                      from sender
-                                      resent-reply-to resent-from
-                                      resent-sender to resent-to
-                                      cc resent-cc
-                                      bcc resent-bcc dcc
-                                      mime-version)
-                                    )
-                              (car (tm-eword::encode-address-list
-                                    (+ (length field-name) 2) field-body))
+                       (cond ((string= field-body "") "")
+                             ((memq (setq field-name-symbol
+                                          (intern (capitalize field-name)))
+                                    '(Reply-To
+                                      From Sender
+                                      Resent-Reply-To Resent-From
+                                      Resent-Sender To Resent-To
+                                      Cc Resent-Cc Bcc Resent-Bcc
+                                      Dcc))
+                               (eword-encode-address-list
+                               field-body (+ (length field-name) 2))
+                              )
+                             ((memq field-name-symbol
+                                    '(In-Reply-To
+                                      Mime-Version User-Agent))
+                               (eword-encode-structured-field-body
+                               field-body (+ (length field-name) 2))
                               )
                              (t
-                              (car (tm-eword::encode-string
-                                    (1+ (length field-name))
-                                    field-body 'text))
+                               (eword-encode-unstructured-field-body
+                               field-body (1+ (length field-name)))
                               ))
                        )
                  (concat field-name ": " ret)
                )))
-       (car (tm-eword::encode-string 0 string))
+       (eword-encode-string string 0)
        )))
 
 (defun eword-in-subject-p ()
@@ -628,10 +646,6 @@ It refer variable `eword-field-encoding-method-alist'."
          ))
       )))
 
-(defun eword-encode-string (str &optional column mode)
-  (car (tm-eword::encode-rwl (or column 0) (tm-eword::split-string str mode)))
-  )
-
 
 ;;; @ end
 ;;;