+(defun wl-refile-evaluate-rule (rule entity)
+ "Returns folder string if RULE is matched to ENTITY.
+If RULE does not match ENTITY, returns nil."
+ (let ((case-fold-search t)
+ fields guess pairs value)
+ (cond
+ ((stringp rule) rule)
+ ((listp (car rule))
+ (setq fields (car rule))
+ (while fields
+ (if (setq guess (wl-refile-evaluate-rule (append (list (car fields))
+ (cdr rule))
+ entity))
+ (setq fields nil)
+ (setq fields (cdr fields))))
+ guess)
+ ((stringp (car rule))
+ (setq pairs (cdr rule))
+ (setq value (wl-refile-get-field-value entity (car rule)))
+ (while pairs
+ (if (and (stringp value)
+ (string-match
+ (car (car pairs))
+ value)
+ (setq guess (wl-refile-expand-newtext
+ (wl-refile-evaluate-rule (cdr (car pairs))
+ entity)
+ value)))
+ (setq pairs nil)
+ (setq pairs (cdr pairs))))
+ guess)
+ (t (error "Invalid structure for wl-refile-rule-alist")))))
+
+(defun wl-refile-get-field-value (entity field)
+ "Get FIELD value from ENTITY."
+ (let ((field (downcase field))
+ (fixed-fields '("from" "subject" "to" "cc")))
+ (if (member field fixed-fields)
+ (funcall (symbol-function
+ (intern (concat
+ "elmo-msgdb-overview-entity-get-"
+ field)))
+ entity)
+ (elmo-msgdb-overview-entity-get-extra-field entity field))))
+
+(defun wl-refile-expand-newtext (newtext original)
+ (let ((len (length newtext))
+ (pos 0)
+ c expanded beg N did-expand)
+ (while (< pos len)
+ (setq beg pos)
+ (while (and (< pos len)
+ (not (= (aref newtext pos) ?\\)))
+ (setq pos (1+ pos)))
+ (unless (= beg pos)
+ (push (substring newtext beg pos) expanded))
+ (when (< pos len)
+ ;; We hit a \; expand it.
+ (setq did-expand t
+ pos (1+ pos)
+ c (aref newtext pos))
+ (if (not (or (= c ?\&)
+ (and (>= c ?1)
+ (<= c ?9))))
+ ;; \ followed by some character we don't expand.
+ (push (char-to-string c) expanded)
+ ;; \& or \N
+ (if (= c ?\&)
+ (setq N 0)
+ (setq N (- c ?0)))
+ (when (match-beginning N)
+ (push (substring original (match-beginning N) (match-end N))
+ expanded))))
+ (setq pos (1+ pos)))
+ (if did-expand
+ (apply (function concat) (nreverse expanded))
+ newtext)))
+