X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=ew-dec.el;h=eebda02c92ab8e9b207705afe8ce7f8b150da2d7;hb=955b92b07f71c449e9ff8f2b49b7e12408527cec;hp=e805aee71c507dde6e5f5a5b0e311ac9beef817b;hpb=f87bb7feacfe97e675fd65ef0b3da18a17c52930;p=elisp%2Fflim.git diff --git a/ew-dec.el b/ew-dec.el index e805aee..eebda02 100644 --- a/ew-dec.el +++ b/ew-dec.el @@ -1,4 +1,5 @@ (require 'emu) +(require 'ew-var) (require 'ew-unit) (require 'ew-scan-s) (require 'ew-scan-m) @@ -6,51 +7,8 @@ (require 'ew-parse) (provide 'ew-dec) -;;; user customizable variable. - -(defvar ew-decode-quoted-encoded-word nil) -(defvar ew-ignore-75bytes-limit nil) -(defvar ew-ignore-76bytes-limit nil) -(defvar ew-permit-sticked-comment nil) -(defvar ew-permit-sticked-special nil) - -;; anonymous function to decode ground string. -;; NOTE: STR is CRLF-form and it should return as CRLF-form. -(defvar ew-decode-us-ascii (lambda (str) (decode-coding-string str 'iso-latin-1-unix))) - -;;; -(defvar ew-decode-field-syntax-alist -'(("from" ew-scan-unibyte-std11 . ew:tag-mailbox+-tok) - ("sender" ew-scan-unibyte-std11 . ew:tag-mailbox-tok) - ("to" ew-scan-unibyte-std11 . ew:tag-address+-tok) - ("resent-to" ew-scan-unibyte-std11 . ew:tag-address+-tok) - ("cc" ew-scan-unibyte-std11 . ew:tag-address+-tok) - ("resent-cc" ew-scan-unibyte-std11 . ew:tag-address+-tok) - ("bcc" ew-scan-unibyte-std11 . ew:tag-address*-tok) - ("resent-bcc" ew-scan-unibyte-std11 . ew:tag-address*-tok) - ("message-id" ew-scan-unibyte-std11) - ("resent-message-id" ew-scan-unibyte-std11) - ("in-reply-to" ew-scan-unibyte-std11 . ew:tag-phrase-msg-id*-tok) - ("references" ew-scan-unibyte-std11 . ew:tag-phrase-msg-id*-tok) - ("keywords" ew-scan-unibyte-std11 . ew:tag-phrase*-tok) - ("subject" ew-scan-unibyte-unstructured) - ("comments" ew-scan-unibyte-unstructured) - ("encrypted" ew-scan-unibyte-std11) - ("date" ew-scan-unibyte-std11) - ("reply-to" ew-scan-unibyte-std11 . ew:tag-address+-tok) - ("received" ew-scan-unibyte-std11) - ("resent-reply-to" ew-scan-unibyte-std11 . ew:tag-address+-tok) - ("resent-from" ew-scan-unibyte-std11 . ew:tag-mailbox+-tok) - ("resent-sender" ew-scan-unibyte-std11 . ew:tag-mailbox-tok) - ("resent-date" ew-scan-unibyte-std11) - ("return-path" ew-scan-unibyte-std11) - ("mime-version" ew-scan-unibyte-std11) - ("content-type" ew-scan-unibyte-mime) - ("content-transfer-encoding" ew-scan-unibyte-mime) - ("content-id" ew-scan-unibyte-mime) - ("content-description" ew-scan-unibyte-unstructured) -)) -(defvar ew-decode-field-default-syntax '(ew-scan-unibyte-unstructured)) +(defvar ew-decode-field-cache-buf '()) +(defvar ew-decode-field-cache-num 300) (defun ew-decode-field (field-name field-body &optional eword-filter) "Decode MIME RFC2047 encoded-words in a field. @@ -67,13 +25,42 @@ If EWORD-FILTER is non-nil, it should be closure. it is called for each successful decoded encoded-word with decoded string as a argument. The return value of EWORD-FILTER is used as decoding result instead of its argument." - (let ((tmp (assoc (downcase field-name) ew-decode-field-syntax-alist)) + (let* ((key (ew-cons* field-name field-body eword-filter + (ew-dynamic-options))) + (tmp (assoc key ew-decode-field-cache-buf))) + (if tmp + (cdr tmp) + (progn + (setq tmp (nthcdr ew-decode-field-cache-num + ew-decode-field-cache-buf)) + (if (cdr tmp) + (progn + (setcdr (cdr tmp) ew-decode-field-cache-buf) + (setq ew-decode-field-cache-buf (cdr tmp)) + (setcdr tmp nil)) + (setq ew-decode-field-cache-buf + (cons (cons nil nil) + ew-decode-field-cache-buf))) + (setcar (car ew-decode-field-cache-buf) key) + (setcdr (car ew-decode-field-cache-buf) + (ew-decode-field-no-cache + field-name field-body eword-filter)) + (cdar ew-decode-field-cache-buf))))) + +(defun ew-decode-field-no-cache (field-name field-body &optional eword-filter) + "No caching version of ew-decode-field." + (let ((tmp (assq (intern (downcase field-name)) ew-decode-field-syntax-alist)) frag-anchor frag1 frag2 decode) (if tmp (setq tmp (cdr tmp)) (setq tmp ew-decode-field-default-syntax)) (setq frag-anchor (funcall (car tmp) (1+ (length field-name)) field-body)) ;;(setq zzz frag-anchor) + (when (and (eq (car tmp) 'ew-scan-unibyte-unstructured) + ew-decode-sticked-encoded-word) + (ew-separate-eword (get frag-anchor 'next-frag) + frag-anchor + '(ew:us-texts))) (when (cdr tmp) (ew-mark (cdr tmp) frag-anchor)) (setq frag1 (get frag-anchor 'next-frag)) @@ -85,20 +72,29 @@ instead of its argument." (setq frag2 (get frag2 'next-frag))) (funcall decode frag-anchor frag1 frag2 eword-filter) (setq frag1 frag2)) - (mapconcat (lambda (frag) (or (get frag 'result) (symbol-name frag))) - (ew-frag-list frag-anchor) ""))) + (setq frag1 (get frag-anchor 'prev-frag) + tmp ()) + (while (not (eq frag1 frag-anchor)) + (setq tmp (cons (or (get frag1 'decoded) (symbol-name frag1)) tmp) + frag1 (get frag1 'prev-frag))) + (apply 'concat tmp))) (defun ew-mark (tag anchor) (let ((tlist (cons (list (symbol-value tag)) (ew-pair-list anchor)))) ;;(insert (format "%s" tlist)) (ew-parse - (lambda () (if (null tlist) '(0) - (prog1 (car tlist) (setq tlist (cdr tlist))))) - (lambda (msg tok) (setq zzz-anchor anchor) (message "parse error: %s%s : %s" msg tok anchor))))) + (lambda () + (if (null tlist) + (cons 0 anchor) + (prog1 (car tlist) (setq tlist (cdr tlist))))) + (lambda (msg tok) + (message "%s%s : %s" msg tok anchor) + (when (< 0 ew-parse-error-sit-for-seconds) + (sit-for ew-parse-error-sit-for-seconds)))))) (defun ew-decode-none (anchor frag end eword-filter) (while (not (eq frag end)) - (put frag 'result (funcall ew-decode-us-ascii (symbol-name frag))) + (put frag 'decoded (funcall ew-decode-us-ascii (symbol-name frag))) (setq frag (get frag 'next-frag)))) (defun ew-decode-generic (anchor start end @@ -128,22 +124,22 @@ instead of its argument." (setq ewords (ew-rcons* ewords f) frag f)) (while (not (eq first frag)) - (put first 'result "") + (put first 'decoded "") (setq first (get first 'next-frag))) - (put frag 'result "") + (put frag 'decoded "") (setq result (ew-rappend result (funcall decode-ewords (nreverse ewords) eword-filter))))) ((memq type all) (setq buff (cons frag buff)) - (put frag 'result "")) + (put frag 'decoded "")) (t (error "unexpected token: %s (%s)" frag type))) (setq frag (get frag 'next-frag))) (when buff (setq result (ew-rappend result (funcall decode-others (nreverse buff))))) - (put start 'result + (put start 'decoded (apply 'ew-quote-concat (nreverse result))) )) @@ -220,16 +216,16 @@ instead of its argument." anchor start end 'ew-decode-unstructured-ewords 'ew-decode-unstructured-others - '(ew:raw-us-texts-tok) - '(ew:raw-us-wsp-tok - ew:raw-us-fold-tok) - '(ew:raw-us-texts-tok - ew:raw-us-wsp-tok - ew:raw-us-fold-tok) + '(ew:us-texts) + '(ew:us-wsp + ew:us-fold) + '(ew:us-texts + ew:us-wsp + ew:us-fold) eword-filter)) (defun ew-decode-phrase-ewords (ewords eword-filter) - (let ((qs (eq (get (car ewords) 'type) 'ew:raw-qs-texts-tok)) + (let ((qs (eq (get (car ewords) 'type) 'ew:qs-texts)) require-quoting result) (while ewords @@ -252,16 +248,16 @@ instead of its argument." (defun ew-decode-phrase-others (frags) (ew-decode-generic-others frags - '(ew:raw-qs-begin-tok - ew:raw-qs-end-tok) - '(ew:raw-qs-qfold-tok - ew:raw-qs-qpair-tok) - '(ew:raw-atom-tok - ew:raw-wsp-tok - ew:raw-fold-tok - ew:raw-qs-texts-tok - ew:raw-qs-wsp-tok - ew:raw-qs-fold-tok))) + '(ew:qs-begin + ew:qs-end) + '(ew:qs-qfold + ew:qs-qpair) + '(ew:atom + ew:wsp + ew:fold + ew:qs-texts + ew:qs-wsp + ew:qs-fold))) (defun ew-decode-phrase (anchor start end eword-filter) (ew-decode-generic @@ -269,20 +265,20 @@ instead of its argument." 'ew-decode-phrase-ewords 'ew-decode-phrase-others (if ew-decode-quoted-encoded-word - '(ew:raw-atom-tok ew:raw-qs-texts-tok) - '(ew:raw-atom-tok)) - '(ew:raw-wsp-tok - ew:raw-fold-tok) - '(ew:raw-atom-tok - ew:raw-wsp-tok - ew:raw-fold-tok - ew:raw-qs-begin-tok - ew:raw-qs-end-tok - ew:raw-qs-texts-tok - ew:raw-qs-wsp-tok - ew:raw-qs-fold-tok - ew:raw-qs-qfold-tok - ew:raw-qs-qpair-tok) + '(ew:atom ew:qs-texts) + '(ew:atom)) + '(ew:wsp + ew:fold) + '(ew:atom + ew:wsp + ew:fold + ew:qs-begin + ew:qs-end + ew:qs-texts + ew:qs-wsp + ew:qs-fold + ew:qs-qfold + ew:qs-qpair) eword-filter)) (defun ew-decode-comment-ewords (ewords eword-filter) @@ -308,25 +304,25 @@ instead of its argument." (ew-decode-generic-others frags '() - '(ew:raw-cm-qfold-tok - ew:raw-cm-qpair-tok) - '(ew:raw-cm-texts-tok - ew:raw-cm-wsp-tok - ew:raw-cm-fold-tok))) + '(ew:cm-qfold + ew:cm-qpair) + '(ew:cm-texts + ew:cm-wsp + ew:cm-fold))) (defun ew-decode-comment (anchor start end eword-filter) (ew-decode-generic anchor start end 'ew-decode-comment-ewords 'ew-decode-comment-others - '(ew:raw-cm-texts-tok) - '(ew:raw-cm-wsp-tok - ew:raw-cm-fold-tok) - '(ew:raw-cm-texts-tok - ew:raw-cm-wsp-tok - ew:raw-cm-fold-tok - ew:raw-cm-qfold-tok - ew:raw-cm-qpair-tok) + '(ew:cm-texts) + '(ew:cm-wsp + ew:cm-fold) + '(ew:cm-texts + ew:cm-wsp + ew:cm-fold + ew:cm-qfold + ew:cm-qpair) eword-filter)) ;;; @@ -365,11 +361,11 @@ instead of its argument." (or ew-ignore-76bytes-limit (<= (get frag 'line-length) 76)) (cond - ((eq (get frag 'type) 'ew:raw-cm-texts-tok) + ((eq (get frag 'type) 'ew:cm-texts) (ew-eword-p (symbol-name frag))) - ((eq (get frag 'type) 'ew:raw-qs-texts-tok) + ((eq (get frag 'type) 'ew:qs-texts) (ew-eword-p (symbol-name frag))) - ((eq (get frag 'type) 'ew:raw-atom-tok) + ((eq (get frag 'type) 'ew:atom) (and (or ew-permit-sticked-comment (and @@ -382,7 +378,7 @@ instead of its argument." (or (ew-comment-frag-p (get frag 'next-frag)) (not (ew-special-frag-p (get frag 'next-frag)))))) (ew-eword-p (symbol-name frag)))) - ((eq (get frag 'type) 'ew:raw-us-texts-tok) + ((eq (get frag 'type) 'ew:us-texts) (and (or ew-permit-sticked-special (not (ew-special-frag-p (get frag 'prev-frag))))