This commit was generated by cvs2svn to compensate for changes in r434,

[elisp/tm.git] / tm-ew-e.el

diff --git a/tm-ew-e.el b/tm-ew-e.el
index f500554..1461b65 100644 (file)
--- a/tm-ew-e.el
+++ b/tm-ew-e.el
@@ -6,7 +6,7 @@
 ;;; Copyright (C) 1993 .. 1996 MORIOKA Tomohiko
 ;;;
 ;;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
 ;;; Copyright (C) 1993 .. 1996 MORIOKA Tomohiko
 ;;;
 ;;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>

-;;; Version: $Revision: 7.18 $
+;;; Version: $Revision: 7.37 $

 ;;; Keywords: mail, news, MIME, RFC 1522, multilingual, encoded-word
 ;;;
 ;;; This file is part of tm (Tools for MIME).
 ;;; Keywords: mail, news, MIME, RFC 1522, multilingual, encoded-word
 ;;;
 ;;; This file is part of tm (Tools for MIME).

@@ -36,7 +36,7 @@
 ;;;
 
 (defconst tm-ew-e/RCS-ID
 ;;;
 
 (defconst tm-ew-e/RCS-ID

-  "$Id: tm-ew-e.el,v 7.18 1996/05/09 18:08:47 morioka Exp $")
+  "$Id: tm-ew-e.el,v 7.37 1996/07/10 12:52:46 morioka Exp $")

 (defconst mime-eword/encoder-version (get-version-string tm-ew-e/RCS-ID))
 
 
 (defconst mime-eword/encoder-version (get-version-string tm-ew-e/RCS-ID))
 
 

@@ -48,24 +48,23 @@
 (defvar mime/use-X-Nsubject nil)
 
 (defvar mime-eword/charset-encoding-alist
 (defvar mime/use-X-Nsubject nil)
 
 (defvar mime-eword/charset-encoding-alist

-  '(("US-ASCII"       . nil)
-    ("ISO-8859-1"     . "Q")
-    ("ISO-8859-2"     . "Q")
-    ("ISO-8859-3"     . "Q")
-    ("ISO-8859-4"     . "Q")
-;;; ("ISO-8859-5"     . "Q")
-    ("KOI8-R"         . "Q")
-    ("ISO-8859-7"     . "Q")
-    ("ISO-8859-8"     . "Q")
-    ("ISO-8859-9"     . "Q")
-    ("ISO-2022-JP"    . "B")
-    ("ISO-2022-KR"    . "B")
-    ("EUC-KR"         . "B")
-    ("ISO-2022-JP-2"  . "B")
-    ("ISO-2022-INT-1" . "B")
+  '((us-ascii          . nil)
+    (iso-8859-1                . "Q")
+    (iso-8859-2                . "Q")
+    (iso-8859-3                . "Q")
+    (iso-8859-4                . "Q")
+    (iso-8859-5                . "Q")
+    (koi8-r            . "Q")
+    (iso-8859-7                . "Q")
+    (iso-8859-8                . "Q")
+    (iso-8859-9                . "Q")
+    (iso-2022-jp       . "B")
+    (iso-2022-kr       . "B")
+    (euc-kr            . "B")
+    (iso-2022-jp-2     . "B")
+    (iso-2022-int-1    . "B")

     ))
 
     ))
 

-

 ;;; @ encoded-text encoder
 ;;;
 
 ;;; @ encoded-text encoder
 ;;;
 

@@ -78,7 +77,8 @@
               )
         ))
     (if text
               )
         ))
     (if text

-       (concat "=?" charset "?" encoding "?" text "?=")
+       (concat "=?" (upcase (symbol-name charset)) "?"
+               encoding "?" text "?=")

       )))
 
 
       )))
 
 

@@ -94,14 +94,14 @@
 (defun tm-eword::parse-lc-word (str)
   (let* ((chr (sref str 0))
         (lc (tm-eword::char-type chr))
 (defun tm-eword::parse-lc-word (str)
   (let* ((chr (sref str 0))
         (lc (tm-eword::char-type chr))

-        (i (char-bytes chr))
+        (i (char-length chr))

         (len (length str))
         )
     (while (and (< i len)
                (setq chr (sref str i))
                (eq lc (tm-eword::char-type chr))
                )
         (len (length str))
         )
     (while (and (< i len)
                (setq chr (sref str i))
                (eq lc (tm-eword::char-type chr))
                )

-      (setq i (+ i (char-bytes chr)))
+      (setq i (+ i (char-length chr)))

       )
     (cons (cons lc (substring str 0 i)) (substring str i))
     ))
       )
     (cons (cons lc (substring str 0 i)) (substring str i))
     ))

@@ -158,20 +158,31 @@
 ;;; @ rule
 ;;;
 
 ;;; @ rule
 ;;;
 

-(defun tm-eword::find-charset-rule (lcl)
-  (if lcl
-      (let* ((charset (mime/find-charset lcl))
-            (encoding
-             (cdr (assoc charset mime-eword/charset-encoding-alist))
-             ))
+(defmacro tm-eword::make-rword (text charset encoding type)
+  (` (list (, text)(, charset)(, encoding)(, type))))
+(defmacro tm-eword::rword-text (rword)
+  (` (car (, rword))))
+(defmacro tm-eword::rword-charset (rword)
+  (` (car (cdr (, rword)))))
+(defmacro tm-eword::rword-encoding (rword)
+  (` (car (cdr (cdr (, rword))))))
+(defmacro tm-eword::rword-type (rword)
+  (` (car (cdr (cdr (cdr (, rword)))))))
+
+(defun tm-eword::find-charset-rule (charsets)
+  (if charsets
+      (let* ((charset (charsets-to-mime-charset charsets))
+            (encoding (cdr (assq charset mime-eword/charset-encoding-alist)))
+            )

        (list charset encoding)
        )))
 
        (list charset encoding)
        )))
 

-(defun tm-eword::words-to-ruled-words (wl)
+(defun tm-eword::words-to-ruled-words (wl &optional mode)

   (mapcar (function
           (lambda (word)
   (mapcar (function
           (lambda (word)

-            (cons (cdr word) (tm-eword::find-charset-rule (car word)))
-            ))
+            (let ((ret (tm-eword::find-charset-rule (car word))))
+              (tm-eword::make-rword (cdr word) (car ret)(nth 1 ret) mode)
+              )))

          wl))
 
 (defun tm-eword::space-process (seq)
          wl))
 
 (defun tm-eword::space-process (seq)

@@ -180,13 +191,14 @@
       (setq b (car seq))
       (setq seq (cdr seq))
       (setq c (car seq))
       (setq b (car seq))
       (setq seq (cdr seq))
       (setq c (car seq))

-      (setq cc (nth 1 c))
-      (if (null (nth 1 b))
+      (setq cc (tm-eword::rword-charset c))
+      (if (null (tm-eword::rword-charset b))

          (progn
            (setq a (car prev))
          (progn
            (setq a (car prev))

-           (setq ac (nth 1 a))
-           (if (and (nth 2 a)(nth 2 c))
-               (cond ((equal ac cc)
+           (setq ac (tm-eword::rword-charset a))
+           (if (and (tm-eword::rword-encoding a)
+                    (tm-eword::rword-encoding c))
+               (cond ((eq ac cc)

                       (setq prev (cons
                                   (cons (concat (car a)(car b)(car c))
                                         (cdr a))
                       (setq prev (cons
                                   (cons (concat (car a)(car b)(car c))
                                         (cdr a))

@@ -208,58 +220,40 @@
     (reverse prev)
     ))
 
     (reverse prev)
     ))
 

-(defun tm-eword::split-string (str)
+(defun tm-eword::split-string (str &optional mode)

   (tm-eword::space-process
   (tm-eword::space-process

-   (tm-eword::words-to-ruled-words
-    (tm-eword::lc-words-to-words
-     (tm-eword::split-to-lc-words str)
-     ))))
+   (tm-eword::words-to-ruled-words (tm-eword::lc-words-to-words
+                                   (tm-eword::split-to-lc-words str))
+                                  mode)))

 
 
 ;;; @ length
 ;;;
 
 
 
 ;;; @ length
 ;;;
 

-(defun base64-length (string)
-  (let ((l (length string)))
-    (* (+ (/ l 3)
-         (if (= (mod l 3) 0) 0 1)
-         ) 4)
-    ))
-
-(defun q-encoding-length (string)
-  (let ((l 0)(i 0)(len (length string)) chr)
-    (while (< i len)
-      (setq chr (elt string i))
-      (if (string-match "[A-Za-z0-9!*+/=_---]" (char-to-string chr))
-         (setq l (+ l 1))
-       (setq l (+ l 3))
-       )
-      (setq i (+ i 1)) )
-    l))
-

 (defun tm-eword::encoded-word-length (rword)
 (defun tm-eword::encoded-word-length (rword)

-  (let ((charset  (nth 1 rword))
-       (encoding (nth 2 rword))
-       (string   (car rword))
+  (let ((string   (tm-eword::rword-text     rword))
+       (charset  (tm-eword::rword-charset  rword))
+       (encoding (tm-eword::rword-encoding rword))

        ret)
     (setq ret
        ret)
     (setq ret

-         (cond ((equal encoding "B")
-                (setq string (mime-charset-encode-string string charset))
-                (base64-length string)
+         (cond ((string-equal encoding "B")
+                (setq string (encode-mime-charset-string string charset))
+                (base64-encoded-length string)

                 )
                 )

-               ((equal encoding "Q")
-                (setq string (mime-charset-encode-string string charset))
-                (q-encoding-length string)
+               ((string-equal encoding "Q")
+                (setq string (encode-mime-charset-string string charset))
+                (q-encoding-encoded-length string
+                                           (tm-eword::rword-type rword))

                 )))
     (if ret
                 )))
     (if ret

-       (cons (+ 7 (length charset) ret) string)
+       (cons (+ 7 (length (symbol-name charset)) ret) string)

       )))
 
 
 ;;; @ encode-string
 ;;;
 
       )))
 
 
 ;;; @ encode-string
 ;;;
 

-(defun tm-eword::encode-string-1 (column rwl &optional mode)
+(defun tm-eword::encode-string-1 (column rwl)

   (let* ((rword (car rwl))
         (ret (tm-eword::encoded-word-length rword))
         string len)
   (let* ((rword (car rwl))
         (ret (tm-eword::encoded-word-length rword))
         string len)

@@ -278,7 +272,10 @@
                  )
             (setq string
                   (tm-eword::encode-encoded-text
                  )
             (setq string
                   (tm-eword::encode-encoded-text

-                   (nth 1 rword) (nth 2 rword) (cdr ret)
+                   (tm-eword::rword-charset rword)
+                   (tm-eword::rword-encoding rword)
+                   (cdr ret)
+                   (tm-eword::rword-type rword)

                    ))
             (setq len (+ (length string) column))
             (setq rwl (cdr rwl))
                    ))
             (setq len (+ (length string) column))
             (setq rwl (cdr rwl))

@@ -290,7 +287,7 @@
                    (str "") nstr)
               (while (and (< p len)
                           (progn
                    (str "") nstr)
               (while (and (< p len)
                           (progn

-                            (setq np (+ p (char-bytes (sref string p))))
+                            (setq np (+ p (char-length (sref string p))))

                             (setq nstr (substring string 0 np))
                             (setq ret (tm-eword::encoded-word-length
                                        (cons nstr (cdr rword))
                             (setq nstr (substring string 0 np))
                             (setq ret (tm-eword::encoded-word-length
                                        (cons nstr (cdr rword))

@@ -308,7 +305,10 @@
                                 (cdr rwl)))
                 (setq string
                       (tm-eword::encode-encoded-text
                                 (cdr rwl)))
                 (setq string
                       (tm-eword::encode-encoded-text

-                       (nth 1 rword) (nth 2 rword) str))
+                       (tm-eword::rword-charset rword)
+                       (tm-eword::rword-encoding rword)
+                       str
+                       (tm-eword::rword-type rword)))

                 (setq len (+ (length string) column))
                 )
               )))
                 (setq len (+ (length string) column))
                 )
               )))

@@ -316,16 +316,22 @@
     (list string len rwl)
     ))
 
     (list string len rwl)
     ))
 

-(defun tm-eword::encode-rwl (column rwl &optional mode)
-  (let (ret dest ps special str)
+(defun tm-eword::encode-rwl (column rwl)
+  (let (ret dest ps special str ew-f pew-f)

     (while rwl
     (while rwl

-      (setq ret (tm-eword::encode-string-1 column rwl mode))
+      (setq ew-f (nth 2 (car rwl)))
+      (if (and pew-f ew-f)
+         (setq rwl (cons '(" ") rwl)
+               pew-f nil)
+       (setq pew-f ew-f)
+       )
+      (setq ret (tm-eword::encode-string-1 column rwl))

       (setq str (car ret))
       (if (eq (elt str 0) ?\n)
          (if (eq special ?\()
              (progn
                (setq dest (concat dest "\n ("))
       (setq str (car ret))
       (if (eq (elt str 0) ?\n)
          (if (eq special ?\()
              (progn
                (setq dest (concat dest "\n ("))

-               (setq ret (tm-eword::encode-string-1 2 rwl mode))
+               (setq ret (tm-eword::encode-string-1 2 rwl))

                (setq str (car ret))
                ))
        (cond ((eq special 32)
                (setq str (car ret))
                ))
        (cond ((eq special 32)

@@ -360,7 +366,7 @@
     ))
 
 (defun tm-eword::encode-string (column str &optional mode)
     ))
 
 (defun tm-eword::encode-string (column str &optional mode)

-  (tm-eword::encode-rwl column (tm-eword::split-string str) mode)
+  (tm-eword::encode-rwl column (tm-eword::split-string str mode))

   )
 
 
   )
 
 

@@ -377,8 +383,11 @@
             (setq dest
                   (append dest
                           (list
             (setq dest
                   (append dest
                           (list

-                           (cons str (tm-eword::find-charset-rule
-                                      (find-charset-string str)))
+                           (let ((ret (tm-eword::find-charset-rule
+                                       (find-charset-string str))))
+                             (tm-eword::make-rword
+                              str (car ret)(nth 1 ret) 'phrase)
+                             )

                            )))
             )
            ((eq type 'comment)
                            )))
             )
            ((eq type 'comment)

@@ -387,7 +396,8 @@
                           '(("(" nil nil))
                           (tm-eword::words-to-ruled-words
                            (tm-eword::lc-words-to-words
                           '(("(" nil nil))
                           (tm-eword::words-to-ruled-words
                            (tm-eword::lc-words-to-words

-                            (tm-eword::split-to-lc-words (cdr token))))
+                            (tm-eword::split-to-lc-words (cdr token)))
+                           'comment)

                           '((")" nil nil))
                           ))
             )
                           '((")" nil nil))
                           ))
             )

@@ -396,7 +406,7 @@
                                (tm-eword::words-to-ruled-words
                                 (tm-eword::lc-words-to-words
                                  (tm-eword::split-to-lc-words (cdr token))
                                (tm-eword::words-to-ruled-words
                                 (tm-eword::lc-words-to-words
                                  (tm-eword::split-to-lc-words (cdr token))

-                                 ))))
+                                 ) 'phrase)))

             ))
       (setq phrase (cdr phrase))
       )
             ))
       (setq phrase (cdr phrase))
       )

@@ -437,7 +447,7 @@
              (append dest
                      '((" " nil nil)
                        ("(" nil nil))
              (append dest
                      '((" " nil nil)
                        ("(" nil nil))

-                     (tm-eword::split-string comment)
+                     (tm-eword::split-string comment 'comment)

                      '((")" nil nil))
                      )))
     dest))
                      '((")" nil nil))
                      )))
     dest))

@@ -483,7 +493,7 @@
                                         "bcc" "resent-bcc" "dcc")
                                       )
                               (car (tm-eword::encode-address-list
                                         "bcc" "resent-bcc" "dcc")
                                       )
                               (car (tm-eword::encode-address-list

-                                    (+ (length field-name) 1) field-body))
+                                    (+ (length field-name) 2) field-body))

                               )
                              (t
                               (catch 'tag
                               )
                              (t
                               (catch 'tag

@@ -497,12 +507,13 @@
                                     (setq r (cdr r))
                                     ))
                                 (car (tm-eword::encode-string
                                     (setq r (cdr r))
                                     ))
                                 (car (tm-eword::encode-string

-                                      (+ (length field-name) 1) field-body))
+                                      (+ (length field-name) 1)
+                                      field-body 'text))

                                 ))
                              ))
                  (concat field-name ": " ret)
                )))
                                 ))
                              ))
                  (concat field-name ": " ret)
                )))

-       (tm-eword::encode-string 0 str)
+       (car (tm-eword::encode-string 0 str))

        )))
 
 (defun mime/exist-encoded-word-in-subject ()
        )))
 
 (defun mime/exist-encoded-word-in-subject ()

@@ -548,8 +559,7 @@
       )))
 
 (defun mime-eword/encode-string (str &optional column mode)
       )))
 
 (defun mime-eword/encode-string (str &optional column mode)

-  (car (tm-eword::encode-rwl (or column 0)
-                            (tm-eword::split-string str) mode))
+  (car (tm-eword::encode-rwl (or column 0) (tm-eword::split-string str mode)))

   )
 
 
   )