X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=eword-decode.el;h=49e2761a9a5645ff7171196cd6446db8a7e3c5be;hb=e3747e8f4ecbf39d106d117fb494506089cc5c2a;hp=affdce6b3afe3b108b81d4aec1eff1bb58f7485f;hpb=f87bb7feacfe97e675fd65ef0b3da18a17c52930;p=elisp%2Fflim.git diff --git a/eword-decode.el b/eword-decode.el index affdce6..49e2761 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)))) @@ -366,6 +367,8 @@ mime-charset, it decodes non-ASCII bit patterns as the mime-charset. Otherwise it decodes non-ASCII bit patterns as the default-mime-charset." (interactive "*r") + (rotate-memo args-eword-decode-region + (list start end (buffer-substring start end) unfolding must-unfold code-conversion)) (save-excursion (save-restriction (narrow-to-region start end) @@ -408,28 +411,36 @@ 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 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 (buffer-substring p end) + decoded (ew-decode-field + field-name + (ew-lf-crlf-to-crlf 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-decode-field field-name (ew-lf-crlf-to-crlf field-body))) - )) + (insert (ew-crlf-to-lf decoded)))) (eword-decode-region (point-min) (point-max) t nil nil) )))) @@ -706,34 +717,17 @@ If MAX-COLUMN is omitted, `fill-column' is used. 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-and-fold-structured-field + (list string start-column max-column must-unfold)) (or max-column (setq max-column fill-column)) - (let ((c start-column) - (tokens (eword-lexical-analyze string must-unfold)) - (result "") - token) - (while (and (setq token (car tokens)) - (setq tokens (cdr tokens))) - (let* ((type (car token))) - (if (eq type 'spaces) - (let* ((next-token (car tokens)) - (next-str (eword-decode-token next-token)) - (next-len (string-width next-str)) - (next-c (+ c next-len 1))) - (if (< next-c max-column) - (setq result (concat result " " next-str) - c next-c) - (setq result (concat result "\n " next-str) - c (1+ next-len))) - (setq tokens (cdr tokens)) - ) - (let* ((str (eword-decode-token token))) - (setq result (concat result str) - c (+ c (string-width str))) - )))) - (if token - (concat result (eword-decode-token token)) - result))) + (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. @@ -743,20 +737,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)) - (let ((tokens (eword-lexical-analyze string 'must-unfold)) - (result "")) - (while tokens - (let* ((token (car tokens)) - (type (car token))) - (setq tokens (cdr tokens)) - (setq result - (if (eq type 'spaces) - (concat result " ") - (concat result (eword-decode-token token)) - )))) - result)) + (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-crlf-to-lf (ew-crlf-unfold decoded)))) (defun eword-decode-structured-field-body (string &optional must-unfold start-column max-column) @@ -776,18 +760,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) 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) 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. @@ -805,12 +784,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) - 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,6 +794,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)) (let* ((structure (car (std11-parse-address (eword-lexical-analyze (std11-unfold-string string) 'must-unfold))))