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

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

diff --git a/tm-ew-e.el b/tm-ew-e.el
index 7c554ce..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.12 $
+;;; 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.12 1996/01/11 18:31:43 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 "?=")

       )))
 
 
       )))
 
 

@@ -92,20 +92,18 @@
     ))
 
 (defun tm-eword::parse-lc-word (str)
     ))
 
 (defun tm-eword::parse-lc-word (str)

-  (let* ((rest (string-to-char-list str))
-        (chr (car rest))
+  (let* ((chr (sref str 0))

         (lc (tm-eword::char-type chr))
         (lc (tm-eword::char-type chr))

-        (p (char-bytes chr))
+        (i (char-length chr))
+        (len (length str))

         )
         )

-    (catch 'tag
-      (while (setq rest (cdr rest))
-       (setq chr (car rest))
-       (if (not (eq lc (tm-eword::char-type chr)))
-           (throw 'tag nil)
-         )
-       (setq p (+ p (char-bytes chr)))
-       ))
-    (cons (cons lc (substring str 0 p)) (substring str p))
+    (while (and (< i len)
+               (setq chr (sref str i))
+               (eq lc (tm-eword::char-type chr))
+               )
+      (setq i (+ i (char-length chr)))
+      )
+    (cons (cons lc (substring str 0 i)) (substring str i))

     ))
 
 (defun tm-eword::split-to-lc-words (str)
     ))
 
 (defun tm-eword::split-to-lc-words (str)

@@ -160,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)

@@ -182,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))

@@ -210,60 +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/convert-string-from-emacs 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/convert-string-from-emacs 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)

@@ -282,56 +272,66 @@
                  )
             (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))
             )
            (t
             (setq string (car rword))
                    ))
             (setq len (+ (length string) column))
             (setq rwl (cdr rwl))
             )
            (t
             (setq string (car rword))

-            (let* ((ls (reverse (string-to-char-list string)))
-                   (sl (length string))
-                   (p sl) str)
-              (while (and ls
+            (let* ((sl (length string))
+                   (p 0) np
+                   (str "") nstr)
+              (while (and (< p len)

                           (progn
                           (progn

-                            (setq p (- p (char-bytes (car ls))))
-                            (setq str (substring string 0 p))
+                            (setq np (+ p (char-length (sref string p))))
+                            (setq nstr (substring string 0 np))

                             (setq ret (tm-eword::encoded-word-length
                             (setq ret (tm-eword::encoded-word-length

-                                       (cons str (cdr rword))
+                                       (cons nstr (cdr rword))

                                        ))
                                        ))

-                            (setq str (cdr ret))
+                            (setq nstr (cdr ret))

                             (setq len (+ (car ret) column))
                             (setq len (+ (car ret) column))

-                            (> len 76)
+                            (<= len 76)

                             ))
                             ))

-                (setq ls (cdr ls))
-                )
-              (if (and ls (not (string= str "")))
-                  (progn
-                    (setq rwl (cons (cons (substring string p) (cdr rword))
-                                    (cdr rwl)))
-                    (setq string
-                          (tm-eword::encode-encoded-text
-                           (nth 1 rword) (nth 2 rword) str))
-                    (setq len (+ (length string) column))
-                    )
-                (setq string "\n ")
-                (setq len 1)
+                (setq str nstr
+                      p np))
+              (if (string-equal str "")
+                  (setq string "\n "
+                        len 1)
+                (setq rwl (cons (cons (substring string p) (cdr rword))
+                                (cdr rwl)))
+                (setq string
+                      (tm-eword::encode-encoded-text
+                       (tm-eword::rword-charset rword)
+                       (tm-eword::rword-encoding rword)
+                       str
+                       (tm-eword::rword-type rword)))
+                (setq len (+ (length string) column))

                 )
               )))
       )
     (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)

@@ -366,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))

   )
 
 
   )
 
 

@@ -383,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)

@@ -393,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))
                           ))
             )

@@ -402,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))
       )

@@ -443,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))

@@ -474,39 +478,43 @@
 (defun mime/encode-field (str)
   (setq str (rfc822/unfolding-string str))
   (let ((ret (string-match rfc822/field-top-regexp str)))
 (defun mime/encode-field (str)
   (setq str (rfc822/unfolding-string str))
   (let ((ret (string-match rfc822/field-top-regexp str)))

-    (if ret
-       (let ((field-name (substring str 0 (match-end 1)))
-             (field-body (eliminate-top-spaces
-                          (substring str (match-end 0))))
-             fname)
-         (concat field-name ": "
-                 (cond ((string= field-body "") "")
-                       ((member (setq fname (downcase field-name))
-                                '("reply-to" "from" "sender"
-                                  "resent-reply-to" "resent-from"
-                                  "resent-sender" "to" "resent-to"
-                                  "cc" "resent-cc"
-                                  "bcc" "resent-bcc" "dcc")
-                                )
-                        (car (tm-eword::encode-address-list
-                              (+ (length field-name) 1) field-body))
-                        )
-                       (t
-                        (catch 'tag
-                          (let ((r mime/no-encoding-header-fields) fn)
-                            (while r
-                              (setq fn (car r))
-                              (if (string= (downcase fn) fname)
-                                  (throw 'tag field-body)
-                                )
-                              (setq r (cdr r))
-                              ))
-                          (car (tm-eword::encode-string
-                                (+ (length field-name) 1) field-body))
-                          ))
-                       ))
-         )
-      str)))
+    (or (if ret
+           (let ((field-name (substring str 0 (match-end 1)))
+                 (field-body (eliminate-top-spaces
+                              (substring str (match-end 0))))
+                 fname)
+             (if (setq ret
+                       (cond ((string= field-body "") "")
+                             ((member (setq fname (downcase field-name))
+                                      '("reply-to" "from" "sender"
+                                        "resent-reply-to" "resent-from"
+                                        "resent-sender" "to" "resent-to"
+                                        "cc" "resent-cc"
+                                        "bcc" "resent-bcc" "dcc")
+                                      )
+                              (car (tm-eword::encode-address-list
+                                    (+ (length field-name) 2) field-body))
+                              )
+                             (t
+                              (catch 'tag
+                                (let ((r mime/no-encoding-header-fields)
+                                      fn)
+                                  (while r
+                                    (setq fn (car r))
+                                    (if (string= (downcase fn) fname)
+                                        (throw 'tag field-body)
+                                      )
+                                    (setq r (cdr r))
+                                    ))
+                                (car (tm-eword::encode-string
+                                      (+ (length field-name) 1)
+                                      field-body 'text))
+                                ))
+                             ))
+                 (concat field-name ": " ret)
+               )))
+       (car (tm-eword::encode-string 0 str))
+       )))

 
 (defun mime/exist-encoded-word-in-subject ()
   (let ((str (rfc822/get-field-body "Subject")))
 
 (defun mime/exist-encoded-word-in-subject ()
   (let ((str (rfc822/get-field-body "Subject")))

@@ -518,13 +526,12 @@
   (save-excursion
     (save-restriction
       (narrow-to-region (goto-char (point-min))
   (save-excursion
     (save-restriction
       (narrow-to-region (goto-char (point-min))

-                       (progn
-                         (re-search-forward
-                          (concat
-                           "^" (regexp-quote mail-header-separator) "$")
-                          nil t)
-                         (match-beginning 0)
-                         ))
+                       (if (re-search-forward
+                            (concat
+                             "^" (regexp-quote mail-header-separator) "$")
+                            nil t)
+                           (match-beginning 0)
+                         (point-max)))

       (goto-char (point-min))
       (let (beg end field)
        (while (re-search-forward rfc822/field-top-regexp nil t)
       (goto-char (point-min))
       (let (beg end field)
        (while (re-search-forward rfc822/field-top-regexp nil t)

@@ -552,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)))

   )
 
 
   )