* FLIM-ELS (flim-modules): Add `closure', `natset', `digraph',

[elisp/flim.git] / eword-decode.el

diff --git a/eword-decode.el b/eword-decode.el
index bee20c3..affdce6 100644 (file)
--- a/eword-decode.el
+++ b/eword-decode.el
@@ -36,10 +36,21 @@
 (require 'mel)
 (require 'mime-def)
 
+(require 'ew-dec)
+
 (defgroup eword-decode nil
   "Encoded-word decoding"
   :group 'mime)
 
+;;; TEST
+
+(defmacro rotate-memo (var val)
+  `(progn
+     (unless (boundp ',var) (setq ,var ()))
+     (setq ,var (cons ,val ,var))
+     (let ((tmp (last ,var (- (length ,var) 100))))
+       (when tmp (setcdr tmp nil)))
+     ,var))
 
 ;;; @ variables
 ;;;
@@ -397,6 +408,10 @@ Otherwise it decodes non-ASCII bit patterns as the
 default-mime-charset.
 If SEPARATOR is not nil, it is used as header separator."
   (interactive "*")
+  (rotate-memo args-eword-decode-header
+              (list code-conversion))
+  (unless code-conversion
+    (message "eword-decode-header is called with no code-conversion"))
   (if (and code-conversion
           (not (mime-charset-to-coding-system code-conversion)))
       (setq code-conversion default-mime-charset))
@@ -404,34 +419,17 @@ If SEPARATOR is not nil, it is used as header separator."
     (save-restriction
       (std11-narrow-to-header separator)
       (if code-conversion
-         (let (beg p end field-name len)
+         (let (beg p end field-name field-body len)
            (goto-char (point-min))
            (while (re-search-forward std11-field-head-regexp nil t)
              (setq beg (match-beginning 0)
                    p (match-end 0)
                    field-name (buffer-substring beg (1- p))
-                   len (string-width field-name)
-                   field-name (intern (capitalize field-name))
-                   end (std11-field-end))
-             (cond ((memq field-name eword-decode-ignored-field-list)
-                    ;; Don't decode
-                    )
-                   ((memq field-name eword-decode-structured-field-list)
-                    ;; Decode as structured field
-                    (let ((body (buffer-substring p end)))
-                      (delete-region p end)
-                      (insert (eword-decode-and-fold-structured-field
-                               body (1+ len)))
-                      ))
-                   (t
-                    ;; Decode as unstructured field
-                    (save-restriction
-                      (narrow-to-region beg (1+ end))
-                      (goto-char p)
-                      (eword-decode-region beg (point-max) 'unfold nil
-                        code-conversion)
-                      (goto-char (point-max))
-                      )))))
+                   end (std11-field-end)
+                   field-body (buffer-substring p end))
+             (delete-region p end)
+             (insert (ew-decode-field field-name (ew-lf-crlf-to-crlf field-body)))
+             ))
        (eword-decode-region (point-min) (point-max) t nil nil)
        ))))
 
@@ -745,6 +743,8 @@ characters are regarded as variable `default-mime-charset'.
 
 If an encoded-word is broken or your emacs implementation can not
 decode the charset included in it, it is not decoded."
+  (rotate-memo args-eword-decode-and-unfold-structured-field
+              (list string))
   (let ((tokens (eword-lexical-analyze string 'must-unfold))
        (result ""))
     (while tokens
@@ -773,15 +773,21 @@ decode the charset included in it, it is not decoded.
 If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even
 if there are in decoded encoded-words (generated by bad manner MUA
 such as a version of Net$cape)."
+  (rotate-memo args-eword-decode-structured-field-body
+              (list string must-unfold start-column max-column))
   (if start-column
-      ;; fold with max-column
-      (eword-decode-and-fold-structured-field
-       string start-column max-column must-unfold)
+      ;; fold with max-column (folding is not implemented.)
+      (let* ((ew-decode-field-default-syntax '(ew-scan-unibyte-std11))
+            (decoded (ew-decode-field (make-string (1- start-column) ?X)
+                                      (ew-lf-crlf-to-crlf string)
+                                      (if must-unfold 'ew-cut-cr-lf))))
+       (if must-unfold (ew-cut-cr-lf decoded) decoded))
     ;; Don't fold
-    (mapconcat (function eword-decode-token)
-              (eword-lexical-analyze string must-unfold)
-              "")
-    ))
+    (let* ((ew-decode-field-default-syntax '(ew-scan-unibyte-std11))
+          (decoded (ew-decode-field ""
+                                    (ew-lf-crlf-to-crlf string)
+                                    (if must-unfold 'ew-cut-cr-lf))))
+      (if must-unfold (ew-cut-cr-lf decoded) decoded))))
 
 (defun eword-decode-unstructured-field-body (string &optional must-unfold)
   "Decode non us-ascii characters in STRING as unstructured field body.
@@ -797,7 +803,14 @@ decode the charset included in it, it is not decoded.
 If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even
 if there are in decoded encoded-words (generated by bad manner MUA
 such as a version of Net$cape)."
-  (eword-decode-string string must-unfold default-mime-charset))
+  (rotate-memo args-eword-decode-unstructured-field-body
+              (list string must-unfold))
+  (let ((decoded (ew-decode-field ""
+                                 (ew-lf-crlf-to-crlf string)
+                                 (if must-unfold 'ew-cut-cr-lf))))
+    (if must-unfold
+       (ew-cut-cr-lf decoded)
+      decoded)))
 
 (defun eword-extract-address-components (string)
   "Extract full name and canonical address from STRING.