X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=eword-decode.el;h=077ae7890aa6fe18fd2886a566cde77b57efdbc5;hb=4d9c85cce61c5f3a0e1746a885b57b667f3843d8;hp=fda1696b0c5372dce747f7f28200f5bc572aac80;hpb=d172c5b4e65095273156cefd01ca8f7f0b31bb0f;p=elisp%2Fflim.git diff --git a/eword-decode.el b/eword-decode.el index fda1696..077ae78 100644 --- a/eword-decode.el +++ b/eword-decode.el @@ -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))))