X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=eword-decode.el;h=affdce6b3afe3b108b81d4aec1eff1bb58f7485f;hb=5aad1166a5731dc848a68cbb380bbcba6a23d063;hp=e6ca2b08b2453621714b077fde7f29fb0f525fe9;hpb=0386e3dcfac511d44079405c3011e83f6b811333;p=elisp%2Fflim.git diff --git a/eword-decode.el b/eword-decode.el index e6ca2b0..affdce6 100644 --- a/eword-decode.el +++ b/eword-decode.el @@ -32,78 +32,87 @@ ;;; Code: -(require 'std11-parse) +(require 'std11) (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 +;;; + +(defcustom eword-decode-sticked-encoded-word nil + "*If non-nil, decode encoded-words sticked on atoms, +other encoded-words, etc. +however this behaviour violates RFC2047." + :group 'eword-decode + :type 'boolean) + +(defcustom eword-decode-quoted-encoded-word nil + "*If non-nil, decode encoded-words in quoted-string +however this behaviour violates RFC2047." + :group 'eword-decode + :type 'boolean) + ;;; @ MIME encoded-word definition ;;; -(defconst eword-encoded-text-regexp "[!->@-~]+") -(defconst eword-encoded-word-regexp +(defconst eword-encoded-word-prefix-regexp (concat (regexp-quote "=?") - "\\(" - mime-charset-regexp - "\\)" + "\\(" mime-charset-regexp "\\)" (regexp-quote "?") "\\(B\\|Q\\)" - (regexp-quote "?") - "\\(" - eword-encoded-text-regexp - "\\)" - (regexp-quote "?="))) -(defconst eword-after-encoded-word-regexp "\\([ \t]\\|$\\)") + (regexp-quote "?"))) +(defconst eword-encoded-word-suffix-regexp + (regexp-quote "?=")) + +(defconst eword-encoded-text-in-unstructured-regexp "[!->@-~]+") +(defconst eword-encoded-word-in-unstructured-regexp + (concat eword-encoded-word-prefix-regexp + "\\(" eword-encoded-text-in-unstructured-regexp "\\)" + eword-encoded-word-suffix-regexp)) +(defconst eword-after-encoded-word-in-unstructured-regexp "\\([ \t]\\|$\\)") (defconst eword-encoded-text-in-phrase-regexp "[-A-Za-z0-9!*+/=_]+") (defconst eword-encoded-word-in-phrase-regexp - (concat (regexp-quote "=?") - "\\(" - mime-charset-regexp - "\\)" - (regexp-quote "?") - "\\(B\\|Q\\)" - (regexp-quote "?") - "\\(" - eword-encoded-text-in-phrase-regexp - "\\)" - (regexp-quote "?="))) -(defconst eword-after-encoded-word-in-phrase-regexp "\\([ \t(]\\|$\\)") + (concat eword-encoded-word-prefix-regexp + "\\(" eword-encoded-text-in-phrase-regexp "\\)" + eword-encoded-word-suffix-regexp)) +(defconst eword-after-encoded-word-in-phrase-regexp "\\([ \t]\\|$\\)") (defconst eword-encoded-text-in-comment-regexp "[]!-'*->@-[^-~]+") (defconst eword-encoded-word-in-comment-regexp - (concat (regexp-quote "=?") - "\\(" - mime-charset-regexp - "\\)" - (regexp-quote "?") - "\\(B\\|Q\\)" - (regexp-quote "?") - "\\(" - eword-encoded-text-in-comment-regexp - "\\)" - (regexp-quote "?="))) + (concat eword-encoded-word-prefix-regexp + "\\(" eword-encoded-text-in-comment-regexp "\\)" + eword-encoded-word-suffix-regexp)) (defconst eword-after-encoded-word-in-comment-regexp "\\([ \t()\\\\]\\|$\\)") (defconst eword-encoded-text-in-quoted-string-regexp "[]!#->@-[^-~]+") (defconst eword-encoded-word-in-quoted-string-regexp - (concat (regexp-quote "=?") - "\\(" - mime-charset-regexp - "\\)" - (regexp-quote "?") - "\\(B\\|Q\\)" - (regexp-quote "?") - "\\(" - eword-encoded-text-in-quoted-string-regexp - "\\)" - (regexp-quote "?="))) + (concat eword-encoded-word-prefix-regexp + "\\(" eword-encoded-text-in-quoted-string-regexp "\\)" + eword-encoded-word-suffix-regexp)) (defconst eword-after-encoded-word-in-quoted-string-regexp "\\([ \t\"\\\\]\\|$\\)") +; obsolete +(defconst eword-encoded-text-regexp eword-encoded-text-in-unstructured-regexp) +(defconst eword-encoded-word-regexp eword-encoded-word-in-unstructured-regexp) + ;;; @@ Base64 ;;; @@ -131,31 +140,15 @@ ;;; @@ Quoted-Printable ;;; -(defconst quoted-printable-hex-chars "0123456789ABCDEF") -(defconst quoted-printable-octet-regexp - (concat "=[" quoted-printable-hex-chars - "][" quoted-printable-hex-chars "]")) - (defconst eword-Q-encoded-text-regexp (concat "\\([^=?]\\|" quoted-printable-octet-regexp "\\)+")) ;; (defconst eword-Q-encoding-and-encoded-text-regexp ;; (concat "\\(Q\\)\\?" eword-Q-encoded-text-regexp)) -;;; @ for string +;;; @ internal utilities ;;; -(defcustom eword-decode-sticked-encoded-word nil - "*If non-nil, decode encoded-words sticked on atoms, -other encoded-words, etc. -however this behaviour violates RFC2047." - :group 'eword-decode - :type 'boolean) - -(defvar eword-decode-quoted-encoded-word nil - "*If non-nil, decode encoded-words in quoted-string -however this behaviour violates RFC2047.") - (defun eword-decode-first-encoded-words (string eword-regexp after-regexp @@ -163,18 +156,20 @@ however this behaviour violates RFC2047.") "Decode MIME encoded-words in beginning of STRING. EWORD-REGEXP is the regexp that matches a encoded-word. -Usual value is eword-encoded-word-regexp, +Usual value is +eword-encoded-word-in-unstructured-regexp, eword-encoded-text-in-phrase-regexp, eword-encoded-word-in-comment-regexp or eword-encoded-word-in-quoted-string-regexp. AFTER-REGEXP is the regexp that matches a after encoded-word. -Usual value is eword-after-encoded-word-regexp, +Usual value is +eword-after-encoded-word-in-unstructured-regexp, eword-after-encoded-text-in-phrase-regexp, eword-after-encoded-word-in-comment-regexp or eword-after-encoded-word-in-quoted-string-regexp. -If beginning of STRING matches EWORD-REGEXP and AFTER-REGEXP, +If beginning of STRING matches EWORD-REGEXP with AFTER-REGEXP, returns a cons cell of decoded string(sequence of characters) and the rest(sequence of octets). @@ -189,14 +184,19 @@ 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)." (if eword-decode-sticked-encoded-word (setq after-regexp "")) - (let ((between-ewords-regexp - (if eword-decode-sticked-encoded-word - "\\(\n?[ \t]\\)*" - "\\(\n?[ \t]\\)+")) - (src string) ; sequence of octets. - (dst "")) ; sequence of characters. - (if (string-match - (concat "\\`\\(" eword-regexp "\\)" after-regexp) src) + (let* ((between-ewords-regexp + (if eword-decode-sticked-encoded-word + "\\(\n?[ \t]\\)*" + "\\(\n?[ \t]\\)+")) + (between-ewords-eword-after-regexp + (concat "\\`\\(" between-ewords-regexp "\\)" + "\\(" eword-regexp "\\)" + after-regexp)) + (eword-after-regexp + (concat "\\`\\(" eword-regexp "\\)" after-regexp)) + (src string) ; sequence of octets. + (dst "")) ; sequence of characters. + (if (string-match eword-after-regexp src) (let* (p (q (match-end 1)) (ew (substring src 0 q)) @@ -207,11 +207,7 @@ such as a version of Net$cape)." (progn (while (and - (string-match - (concat "\\`\\(" between-ewords-regexp "\\)" - "\\(" eword-regexp "\\)" - after-regexp) - src) + (string-match between-ewords-eword-after-regexp src) (progn (setq p (match-end 1) q (match-end 3) @@ -228,150 +224,109 @@ such as a version of Net$cape)." (cons dst src)) nil))) -(defun eword-decode-comment-string (string &optional must-unfold) - (let ((src string) - (buf "") +(defun eword-decode-entire-string (string + eword-regexp + after-regexp + safe-regexp + escape ; ?\\ or nil. + delimiters ; list of chars. + chars-must-be-quote + must-unfold + code-conversion) + (if (and code-conversion + (not (mime-charset-to-coding-system code-conversion))) + (setq code-conversion default-mime-charset)) + (let ((equal-safe-regexp (concat "\\`=?" safe-regexp)) (dst "") - (flag-ew t)) + (buf "") + (src string) + (ew-enable t)) (while (< 0 (length src)) (let ((ch (aref src 0)) (decoded (and - flag-ew + ew-enable (eword-decode-first-encoded-words src - eword-encoded-word-in-comment-regexp - eword-after-encoded-word-in-comment-regexp - must-unfold)))) + eword-regexp after-regexp must-unfold)))) (if (and (not (string= buf "")) - (or decoded (eq ch ?\() (eq ch ?\)))) + (or decoded (memq ch delimiters))) (setq dst (concat dst (std11-wrap-as-quoted-pairs - (decode-mime-charset-string buf - default-mime-charset) - '(?\( ?\)))) + (decode-mime-charset-string buf code-conversion) + chars-must-be-quote)) buf "")) (cond (decoded (setq dst (concat dst (std11-wrap-as-quoted-pairs (car decoded) - '(?( ?)))) + chars-must-be-quote)) src (cdr decoded))) - ((or (eq ch ?\() (eq ch ?\))) + ((memq ch delimiters) (setq dst (concat dst (list ch)) src (substring src 1) - flag-ew t)) - ((eq ch ?\\) + ew-enable t)) + ((eq ch escape) (setq buf (concat buf (list (aref src 1))) src (substring src 2) - flag-ew t)) - ((or (eq ch ?\ ) (eq ch ?\t) (eq ch ?\n)) - (setq buf (concat buf (list ch)) - src (substring src 1) - flag-ew t)) - ((string-match "\\`=?[^ \t\n()\\\\=]*" src) + ew-enable t)) + ((string-match "\\`[ \t\n]+" src) (setq buf (concat buf (substring src 0 (match-end 0))) src (substring src (match-end 0)) - flag-ew eword-decode-sticked-encoded-word)) - (t (error "something wrong"))))) - (if (not (string= buf "")) - (setq dst (concat dst - (std11-wrap-as-quoted-pairs - (decode-mime-charset-string buf - default-mime-charset) - '(?\( ?\)))))) - dst)) - -(defun eword-decode-quoted-string (string &optional must-unfold) - (let ((src string) - (buf "") - (dst "") - (flag-ew t)) - (while (< 0 (length src)) - (let ((ch (aref src 0)) - (decoded (and - eword-decode-quoted-encoded-word - flag-ew - (eword-decode-first-encoded-words src - eword-encoded-word-in-quoted-string-regexp - eword-after-encoded-word-in-quoted-string-regexp - must-unfold)))) - (if (and (not (string= buf "")) - (or decoded (eq ch ?\"))) - (setq dst (concat dst - (std11-wrap-as-quoted-pairs - (decode-mime-charset-string buf - default-mime-charset) - '(?\"))) - buf "")) - (cond - (decoded - (setq dst (concat dst - (std11-wrap-as-quoted-pairs - (car decoded) - '(?\"))) - src (cdr decoded))) - ((or (eq ch ?\")) - (setq dst (concat dst (list ch)) - src (substring src 1) - flag-ew t)) - ((eq ch ?\\) - (setq buf (concat buf (list (aref src 1))) - src (substring src 2) - flag-ew t)) - ((or (eq ch ?\ ) (eq ch ?\t) (eq ch ?\n)) - (setq buf (concat buf (list ch)) - src (substring src 1) - flag-ew t)) - ((string-match "\\`=?[^ \t\n\"\\\\=]*" src) + ew-enable t)) + ((and (string-match equal-safe-regexp src) + (< 0 (match-end 0))) (setq buf (concat buf (substring src 0 (match-end 0))) src (substring src (match-end 0)) - flag-ew eword-decode-sticked-encoded-word)) + ew-enable eword-decode-sticked-encoded-word)) (t (error "something wrong"))))) (if (not (string= buf "")) (setq dst (concat dst (std11-wrap-as-quoted-pairs - (decode-mime-charset-string buf - default-mime-charset) - '(?\"))))) + (decode-mime-charset-string buf code-conversion) + chars-must-be-quote)))) dst)) -(defun eword-decode-unstructured-string (string &optional must-unfold) - (let ((src string) - (buf "") - (dst "") - (flag-ew t)) - (while (< 0 (length src)) - (let ((ch (aref src 0)) - (decoded (and flag-ew (eword-decode-first-encoded-words src - eword-encoded-word-regexp - eword-after-encoded-word-regexp - must-unfold)))) - (if (and (not (string= buf "")) - decoded) - (setq dst (concat dst - (decode-mime-charset-string buf - default-mime-charset)) - buf "")) - (cond - (decoded - (setq dst (concat dst (car decoded)) - src (cdr decoded))) - ((or (eq ch ?\ ) (eq ch ?\t) (eq ch ?\n)) - (setq buf (concat buf (list ch)) - src (substring src 1) - flag-ew t)) - ((string-match "\\`=?[^ \t\n=]*" src) - (setq buf (concat buf (substring src 0 (match-end 0))) - src (substring src (match-end 0)) - flag-ew eword-decode-sticked-encoded-word)) - (t (error "something wrong"))))) - (if (not (string= buf "")) - (setq dst (concat dst - (decode-mime-charset-string buf - default-mime-charset)))) - dst)) -(defun eword-decode-string (string &optional must-unfold) +;;; @ for string +;;; + +(defun eword-decode-unstructured (string code-conversion &optional must-unfold) + (eword-decode-entire-string + string + eword-encoded-word-in-unstructured-regexp + eword-after-encoded-word-in-unstructured-regexp + "[^ \t\n=]*" + nil + nil + nil + must-unfold + code-conversion)) + +(defun eword-decode-comment (string code-conversion &optional must-unfold) + (eword-decode-entire-string + string + eword-encoded-word-in-comment-regexp + eword-after-encoded-word-in-comment-regexp + "[^ \t\n()\\\\=]*" + ?\\ + '(?\( ?\)) + '(?\( ?\) ?\\ ?\r ?\n) + must-unfold + code-conversion)) + +(defun eword-decode-quoted-string (string code-conversion &optional must-unfold) + (eword-decode-entire-string + string + eword-encoded-word-in-quoted-string-regexp + eword-after-encoded-word-in-quoted-string-regexp + "[^ \t\n\"\\\\=]*" + ?\\ + '(?\") + '(?\" ?\\ ?\r ?\n) + must-unfold + code-conversion)) + +(defun eword-decode-string (string &optional must-unfold code-conversion) "Decode MIME encoded-words in STRING. STRING is unfolded before decoding. @@ -381,23 +336,35 @@ 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-unstructured-string +such as a version of Net$cape). + +If CODE-CONVERSION is nil, it decodes only encoded-words. If it is +mime-charset, it decodes non-ASCII bit patterns as the mime-charset. +Otherwise it decodes non-ASCII bit patterns as the +default-mime-charset." + (eword-decode-unstructured (std11-unfold-string string) + code-conversion must-unfold)) ;;; @ for region ;;; -(defun eword-decode-region (start end &optional unfolding must-unfold) +(defun eword-decode-region (start end &optional unfolding must-unfold + code-conversion) "Decode MIME encoded-words in region between START and END. If UNFOLDING is not nil, it unfolds before decoding. 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)." +such as a version of Net$cape). + +If CODE-CONVERSION is nil, it decodes only encoded-words. If it is +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") (save-excursion (save-restriction @@ -405,8 +372,9 @@ such as a version of Net$cape)." (if unfolding (eword-decode-unfold) ) - (let ((str (eword-decode-unstructured-string - (buffer-substring (point-min) (point-max)) + (let ((str (eword-decode-unstructured + (buffer-substring (point-min) (point-max)) + code-conversion must-unfold))) (delete-region (point-min) (point-max)) (insert str))))) @@ -416,17 +384,17 @@ such as a version of Net$cape)." ;;; (defcustom eword-decode-ignored-field-list - '(newsgroups path lines nntp-posting-host message-id date) + '(Newsgroups Path Lines Nntp-Posting-Host Received Message-Id Date) "*List of field-names to be ignored when decoding. Each field name must be symbol." :group 'eword-decode :type '(repeat symbol)) (defcustom eword-decode-structured-field-list - '(reply-to resent-reply-to from resent-from sender resent-sender - to resent-to cc resent-cc bcc resent-bcc dcc - mime-version content-type content-transfer-encoding - content-disposition) + '(Reply-To Resent-Reply-To From Resent-From Sender Resent-Sender + To Resent-To Cc Resent-Cc Bcc Resent-Bcc Dcc + Mime-Version Content-Type Content-Transfer-Encoding + Content-Disposition) "*List of field-names to decode as structured field. Each field name must be symbol." :group 'eword-decode @@ -440,46 +408,30 @@ 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)) (save-excursion (save-restriction (std11-narrow-to-header separator) - (let ((default-charset - (if code-conversion - (if (mime-charset-to-coding-system code-conversion) - code-conversion - default-mime-charset)))) - (if default-charset - (let (beg p end field-name 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 (downcase 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)) - (default-mime-charset default-charset)) - (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) - (let ((default-mime-charset default-charset)) - (eword-decode-region beg (point-max) 'unfold)) - (goto-char (point-max)) - ))))) - (eword-decode-region (point-min) (point-max) t) - ))))) + (if code-conversion + (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)) + 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) + )))) (defun eword-decode-unfold () (goto-char (point-min)) @@ -502,7 +454,18 @@ If SEPARATOR is not nil, it is used as header separator." ;;; @ encoded-word decoder ;;; -(defvar eword-warning-face nil "Face used for invalid encoded-word.") +(defvar eword-decode-encoded-word-error-handler + 'eword-decode-encoded-word-default-error-handler) + +(defvar eword-warning-face nil + "Face used for invalid encoded-word.") + +(defun eword-decode-encoded-word-default-error-handler (word signal) + (and (add-text-properties 0 (length word) + (and eword-warning-face + (list 'face eword-warning-face)) + word) + word)) (defun eword-decode-encoded-word (word &optional must-unfold) "Decode WORD if it is an encoded-word. @@ -527,12 +490,8 @@ as a version of Net$cape)." (condition-case err (eword-decode-encoded-text charset encoding text must-unfold) (error - (and - (add-text-properties 0 (length word) - (and eword-warning-face - (list 'face eword-warning-face)) - word) - word))) + (funcall eword-decode-encoded-word-error-handler word err) + )) )) word)) @@ -570,21 +529,18 @@ as a version of Net$cape)." (error "Invalid encoding %s" encoding) ))) ) - (if dest - (progn - (setq dest (decode-coding-string dest cs)) - (if must-unfold - (mapconcat (function - (lambda (chr) - (cond - ((eq chr ?\n) "") - ((eq chr ?\t) " ") - (t (char-to-string chr))) - )) - (std11-unfold-string dest) - "") - dest) - )))))) + (when dest + (setq dest (decode-mime-charset-string dest charset)) + (if must-unfold + (mapconcat (function + (lambda (chr) + (cond ((eq chr ?\n) "") + ((eq chr ?\t) " ") + (t (char-to-string chr))) + )) + (std11-unfold-string dest) + "") + dest)))))) ;;; @ lexical analyze @@ -621,10 +577,17 @@ be the result." (defun eword-analyze-quoted-string (string &optional must-unfold) (let ((p (std11-check-enclosure string ?\" ?\"))) (if p - (cons (cons 'quoted-string - (eword-decode-quoted-string (substring string 0 p))) - (substring string p)) - ))) + (cons (cons 'quoted-string + (if eword-decode-quoted-encoded-word + (eword-decode-quoted-string + (substring string 0 p) + default-mime-charset) + (std11-wrap-as-quoted-string + (decode-mime-charset-string + (std11-strip-quoted-pair (substring string 1 (1- p))) + default-mime-charset)))) + (substring string p))) + )) (defun eword-analyze-domain-literal (string &optional must-unfold) (std11-analyze-domain-literal string)) @@ -637,7 +600,9 @@ be the result." (setq p (std11-check-enclosure string ?\( ?\) t p))) (setq p (or p len)) (cons (cons 'comment - (eword-decode-comment-string (substring string 0 p))) + (eword-decode-comment + (std11-unfold-string (substring string 0 p)) + default-mime-charset)) (substring string p))) nil))) @@ -649,12 +614,20 @@ be the result." (defun eword-analyze-encoded-word (string &optional must-unfold) (let ((decoded (eword-decode-first-encoded-words - string - eword-encoded-word-in-phrase-regexp - eword-after-encoded-word-in-phrase-regexp - must-unfold))) + string + eword-encoded-word-in-phrase-regexp + eword-after-encoded-word-in-phrase-regexp + must-unfold))) (if decoded - (cons (cons 'atom (car decoded)) (cdr decoded))))) + (let ((s (car decoded))) + (while (or (string-match std11-atom-regexp s) + (string-match std11-spaces-regexp s)) + (setq s (substring s (match-end 0)))) + (if (= (length s) 0) + (cons (cons 'atom (car decoded)) (cdr decoded)) + (cons (cons 'quoted-string + (std11-wrap-as-quoted-string (car decoded))) + (cdr decoded))))))) (defun eword-analyze-atom (string &optional must-unfold) (if (let ((enable-multibyte-characters nil)) @@ -672,17 +645,24 @@ be the result." )))) (defun eword-lexical-analyze-internal (string must-unfold) - (let (dest ret) + (let ((last 'eword-analyze-spaces) + dest ret) (while (not (string-equal string "")) (setq ret - (let ((rest eword-lexical-analyzers) - func r) - (while (and (setq func (car rest)) - (null (setq r (funcall func string must-unfold))) - ) - (setq rest (cdr rest))) - (or r `((error . ,string) . "")) - )) + (let ((rest eword-lexical-analyzers) + func r) + (while (and (setq func (car rest)) + (or + (and + (not eword-decode-sticked-encoded-word) + (not (eq last 'eword-analyze-spaces)) + (eq func 'eword-analyze-encoded-word)) + (null (setq r (funcall func string must-unfold)))) + ) + (setq rest (cdr rest))) + (setq last func) + (or r `((error . ,string) . "")) + )) (setq dest (cons (car ret) dest)) (setq string (cdr ret)) ) @@ -763,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 @@ -791,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. @@ -815,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)) + (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.