* mel-ccl.el (mel-ccl-encode-q-generic): New compile-time
[elisp/flim.git] / eword-decode.el
index fda1696..077ae78 100644 (file)
@@ -44,8 +44,9 @@
 
 ;;; TEST
 
+(defvar rotate-memo nil)
 (defmacro rotate-memo (var val)
-  `(progn
+  `(when rotate-memo
      (unless (boundp ',var) (setq ,var ()))
      (setq ,var (cons ,val ,var))
      (let ((tmp (last ,var (- (length ,var) 100))))
@@ -410,30 +411,39 @@ 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))
+  (rotate-memo args-eword-decode-header (list code-conversion))
   (unless code-conversion
-    (message "eword-decode-header is called with no code-conversion"))
+    (message "eword-decode-header is called with no code-conversion")
+    (sit-for 2))
   (if (and code-conversion
           (not (mime-charset-to-coding-system code-conversion)))
       (setq code-conversion default-mime-charset))
   (save-excursion
     (save-restriction
       (std11-narrow-to-header separator)
-      (rotate-memo header-eword-decode-header (buffer-substring (point-min) (point-max)))
+      (rotate-memo args-h-eword-decode-header (buffer-substring (point-min) (point-max)))
       (if code-conversion
-         (let (beg p end field-name field-body len)
+         (let (beg p end field-name field-body decoded)
            (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))
                    end (std11-field-end)
-                   field-body (buffer-substring p end))
+                   field-body (ew-lf-crlf-to-crlf
+                               (buffer-substring p end))
+                   decoded (ew-decode-field
+                            field-name field-body))
+             (unless (equal field-body decoded)
+               (setq decoded (ew-crlf-refold
+                              decoded
+                              (1+ (string-width field-name))
+                              fill-column)))
              (delete-region p end)
-             (insert (ew-crlf-to-lf
-                      (ew-decode-field field-name
-                                       (ew-lf-crlf-to-crlf field-body))))
+             (insert (ew-crlf-to-lf decoded))
+             (add-text-properties beg (min (1+ (point)) (point-max))
+                                  (list 'original-field-name field-name
+                                        'original-field-body field-body))
              ))
        (eword-decode-region (point-min) (point-max) t nil nil)
        ))))
@@ -715,34 +725,13 @@ such as a version of Net$cape)."
               (list string start-column max-column must-unfold))
   (or max-column
       (setq max-column fill-column))
-  (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)))
-        column)
-    (setq decoded (ew-crlf-to-lf decoded))
-    (setq column 0)
-    (ew-lf-line-convert decoded
-      (lambda (line)
-       (if (<= (length line) max-column)
-           line
-         (let ((start 0) index)
-           (catch 'loop
-             (while (< (+ column start) max-column)
-               (if (string-match " " decoded start)
-                   (progn
-                     (setq start (match-end 0))
-                     (when (< (match-beginning 0) max-column)
-                       (setq index (match-beginning 0))))
-                 (throw 'loop nil)))
-             (setq index (string-match " " decoded start)))
-           (if index
-               (concat (substring decoded 0 index)
-                       "\n"
-                       (substring decoded index))
-             decoded))))
-      (lambda (str) (setq column 1) str)
-      (lambda (str) (setq column 0) str))))
+  (let* ((field-name (make-string (1- start-column) ?X))
+        (field-body (ew-lf-crlf-to-crlf string))
+        (ew-decode-field-default-syntax '(ew-scan-unibyte-std11))
+        (decoded (ew-decode-field field-name field-body)))
+    (unless (equal field-body decoded)
+      (setq decoded (ew-crlf-refold decoded start-column max-column)))
+    (ew-crlf-to-lf decoded)))
 
 (defun eword-decode-and-unfold-structured-field (string)
   "Decode and unfold STRING as structured field body.
@@ -752,13 +741,10 @@ 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))
+  (rotate-memo args-eword-decode-and-unfold-structured-field (list string))
   (let* ((ew-decode-field-default-syntax '(ew-scan-unibyte-std11))
-        (decoded (ew-decode-field ""
-                                  (ew-lf-crlf-to-crlf string)
-                                  'ew-cut-cr-lf)))
-    (ew-cut-cr-lf decoded)))
+        (decoded (ew-decode-field "" (ew-lf-crlf-to-crlf string))))
+    (ew-crlf-to-lf (ew-crlf-unfold decoded))))
 
 (defun eword-decode-structured-field-body (string &optional must-unfold
                                                  start-column max-column)
@@ -778,18 +764,13 @@ 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 (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) (ew-crlf-to-lf decoded)))
+      ;; fold with max-column
+      (eword-decode-and-fold-structured-field
+       string start-column max-column must-unfold)
     ;; Don't fold
     (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) (ew-crlf-to-lf decoded)))))
+          (decoded (ew-decode-field "" (ew-lf-crlf-to-crlf string))))
+      (ew-crlf-to-lf decoded))))
 
 (defun eword-decode-unstructured-field-body (string &optional must-unfold)
   "Decode non us-ascii characters in STRING as unstructured field body.
@@ -807,10 +788,8 @@ if there are in decoded encoded-words (generated by bad manner MUA
 such as a version of Net$cape)."
   (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) (ew-crlf-to-lf decoded))))
+  (let ((decoded (ew-decode-field "" (ew-lf-crlf-to-crlf string))))
+    (ew-crlf-to-lf (ew-crlf-unfold decoded))))
 
 (defun eword-extract-address-components (string)
   "Extract full name and canonical address from STRING.
@@ -819,8 +798,7 @@ If no name can be extracted, FULL-NAME will be nil.
 It decodes non us-ascii characters in FULL-NAME encoded as
 encoded-words or invalid \"raw\" string.  \"Raw\" non us-ascii
 characters are regarded as variable `default-mime-charset'."
-  (rotate-memo args-eword-extract-address-components
-              (list string))
+  (rotate-memo args-eword-extract-address-components (list string))
   (let* ((structure (car (std11-parse-address
                          (eword-lexical-analyze
                           (std11-unfold-string string) 'must-unfold))))