Merge flim-1_10_5.
[elisp/flim.git] / eword-encode.el
index bed3ae6..c1603cd 100644 (file)
 ;;; @ variables
 ;;;
 
-(defvar eword-field-encoding-method-alist
+(defgroup eword-encode nil
+  "Encoded-word encoding"
+  :group 'mime)
+
+(defcustom eword-field-encoding-method-alist
   '(("X-Nsubject" . iso-2022-jp-2)
     ("Newsgroups" . nil)
     ("Message-ID" . nil)
@@ -52,7 +56,15 @@ If method is `default-mime-charset', this field will be encoded as
 variable `default-mime-charset' when it must be convert into
 network-code.
 
-If method is nil, this field will not be encoded.")
+If method is nil, this field will not be encoded."
+  :group 'eword-encode
+  :type '(repeat (cons (choice :tag "Field"
+                              (string :tag "Name")
+                              (const :tag "Default" t))
+                      (choice :tag "Method"
+                              (const :tag "MIME conversion" mime)
+                              (symbol :tag "non-MIME conversion")
+                              (const :tag "no-conversion" nil)))))
 
 (defvar eword-charset-encoding-alist
   '((us-ascii          . nil)
@@ -73,6 +85,7 @@ If method is nil, this field will not be encoded.")
     (euc-kr            . "B")
     (iso-2022-jp-2     . "B")
     (iso-2022-int-1    . "B")
+    (utf-8             . "B")
     ))
 
 
@@ -85,13 +98,7 @@ CHARSET is a symbol to indicate MIME charset of the encoded-word.
 ENCODING allows \"B\" or \"Q\".
 MODE is allows `text', `comment', `phrase' or nil.  Default value is
 `phrase'."
-  (let ((text
-        (cond ((string= encoding "B")
-               (base64-encode-string string))
-              ((string= encoding "Q")
-               (q-encoding-encode-string string mode))
-              )
-        ))
+  (let ((text (encoded-text-encode-string string encoding)))
     (if text
        (concat "=?" (upcase (symbol-name charset)) "?"
                encoding "?" text "?=")
@@ -250,8 +257,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
-                                           (ew-rword-type rword))
+                (Q-encoded-text-length string (ew-rword-type rword))
                 )))
     (if ret
        (cons (+ 7 (length (symbol-name charset)) ret) string)
@@ -377,7 +383,7 @@ MODE is allows `text', `comment', `phrase' or nil.  Default value is
 ;;; @ converter
 ;;;
 
-(defun tm-eword::phrase-to-rwl (phrase)
+(defun eword-encode-phrase-to-rword-list (phrase)
   (let (token type dest str)
     (while phrase
       (setq token (car phrase))
@@ -420,7 +426,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))
@@ -462,7 +468,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))
@@ -470,29 +476,29 @@ MODE is allows `text', `comment', `phrase' or nil.  Default value is
        (if (eq (car (car phrase)) 'spaces)
            (setq phrase (cdr phrase))
          )
-       (setq dest (tm-eword::phrase-to-rwl phrase))
+       (setq dest (eword-encode-phrase-to-rword-list phrase))
        (if dest
            (setq dest (append dest '((" " nil nil))))
          )
        (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)
+(defun eword-encode-mailbox-to-rword-list (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
@@ -504,51 +510,87 @@ MODE is allows `text', `comment', `phrase' or nil.  Default value is
                      )))
     dest))
 
-(defsubst eword-encode-addresses-to-rwl (addresses)
-  (let ((dest (tm-eword::mailbox-to-rwl (car addresses))))
+(defsubst eword-encode-addresses-to-rword-list (addresses)
+  (let ((dest (eword-encode-mailbox-to-rword-list (car addresses))))
     (if dest
        (while (setq addresses (cdr addresses))
-         (setq dest (append dest
-                            '(("," nil nil))
-                            '((" " nil nil))
-                            (tm-eword::mailbox-to-rwl (car addresses))
-                            ))
+         (setq dest
+               (append dest
+                       '(("," nil nil))
+                       '((" " nil nil))
+                       (eword-encode-mailbox-to-rword-list (car addresses))
+                       ))
          ))
     dest))
 
+(defsubst eword-encode-msg-id-to-rword-list (msg-id)
+  (cons '("<" nil nil)
+       (append (eword-encode-addr-seq-to-rword-list (cdr msg-id))
+               '((">" nil nil)))))
+
+(defsubst eword-encode-in-reply-to-to-rword-list (in-reply-to)
+  (let (dest)
+    (while in-reply-to
+      (setq dest
+           (append dest
+                   (let ((elt (car in-reply-to)))
+                     (if (eq (car elt) 'phrase)
+                         (eword-encode-phrase-to-rword-list (cdr elt))
+                       (eword-encode-msg-id-to-rword-list elt)
+                       ))))
+      (setq in-reply-to (cdr in-reply-to)))
+    dest))
+
 
 ;;; @ application interfaces
 ;;;
 
+(defcustom eword-encode-default-start-column 10
+  "Default start column if it is omitted."
+  :group 'eword-encode
+  :type 'integer)
+
 (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))))
+  (car (eword-encode-rword-list
+       (or column eword-encode-default-start-column)
+       (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))
+       (or column eword-encode-default-start-column)
+       (eword-encode-addresses-to-rword-list
+        (std11-parse-addresses-string string))
        )))
 
+(defun eword-encode-in-reply-to (string &optional column)
+  "Encode header field STRING as In-Reply-To field, and return the result.
+Optional argument COLUMN is start-position of the field."
+  (car (eword-encode-rword-list
+       (or column 13)
+       (eword-encode-in-reply-to-to-rword-list
+        (std11-parse-in-reply-to
+         (std11-lexical-analyze 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-addr-seq-to-rwl (std11-lexical-analyze string))
+       (or column eword-encode-default-start-column)
+       (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))))
+  (car (eword-encode-rword-list
+       (or column eword-encode-default-start-column)
+       (eword-encode-split-string string 'text))))
 
 (defun eword-encode-field (string)
   "Encode header field STRING, and return the result.
@@ -574,9 +616,12 @@ encoded-word.  ASCII token is not encoded."
                                (eword-encode-address-list
                                field-body (+ (length field-name) 2))
                               )
+                             ((eq field-name-symbol 'In-Reply-To)
+                               (eword-encode-in-reply-to
+                               field-body (+ (length field-name) 2))
+                              )
                              ((memq field-name-symbol
-                                    '(In-Reply-To
-                                      Mime-Version User-Agent))
+                                    '(Mime-Version User-Agent))
                                (eword-encode-structured-field-body
                                field-body (+ (length field-name) 2))
                               )