(require 'emu)
+(require 'ew-var)
(require 'ew-unit)
(require 'ew-scan-s)
(require 'ew-scan-m)
(require 'ew-parse)
(provide 'ew-dec)
+(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.
FIELD-NAME is a name of the field such as \"To\", \"Subject\" etc. and
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))
ew-decode-sticked-encoded-word)
(ew-separate-eword (get frag-anchor 'next-frag)
frag-anchor
- '(ew:raw-us-texts-tok)))
+ '(ew:us-texts)))
(when (cdr tmp)
(ew-mark (cdr tmp) frag-anchor))
(setq frag1 (get frag-anchor 'next-frag))
(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) (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
(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)))
))
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
(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
'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)
(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))
;;;
(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
(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))))
projects / elisp / flim.git / blobdiff