* wl-summary.el (wl-summary-print-destination):

Duplicate folder string to avoid putting text-property on
original string.

* wl-refile.el (wl-refile-get-field-value): New function.
(wl-refile-evaluate-rule): New function;
Evaluate refile rule recursively.
(wl-refile-guess-by-rule): Use wl-refile-evaluate-rule.
* wl-summary.el (wl-summary-auto-refile-check-refile-rule-alist-subr):
New function; Check existence of a target folder recursively.
(wl-summary-auto-refile-check-refile-rule-alist):
Use wl-summary-auto-refile-check-refile-rule-alist-subr.

diff --git a/wl/ChangeLog b/wl/ChangeLog
index 7485720..2a998e5 100644 (file)
--- a/wl/ChangeLog
+++ b/wl/ChangeLog
@@ -1,3 +1,18 @@
+2000-04-04  Yuuichi Teranishi  <teranisi@gohome.org>
+
+       * wl-summary.el (wl-summary-print-destination):
+       Duplicate folder string to avoid putting text-property on
+       original string.
+
+       * wl-refile.el (wl-refile-get-field-value): New function.
+       (wl-refile-evaluate-rule): New function;
+       Evaluate refile rule recursively.
+       (wl-refile-guess-by-rule): Use wl-refile-evaluate-rule.
+       * wl-summary.el (wl-summary-auto-refile-check-refile-rule-alist-subr):
+       New function; Check existence of a target folder recursively.
+       (wl-summary-auto-refile-check-refile-rule-alist):
+       Use wl-summary-auto-refile-check-refile-rule-alist-subr.
+
 2000-03-30  Yuuichi Teranishi  <teranisi@gohome.org>
 
        * wl-demo.el (wl-title-logo): Refer wl-icon-dir.

diff --git a/wl/wl-refile.el b/wl/wl-refile.el
index 836fe54..b144b14 100644 (file)
--- a/wl/wl-refile.el
+++ b/wl/wl-refile.el
@@ -4,7 +4,7 @@
 
 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
 ;; Keywords: mail, net news
-;; Time-stamp: <00/03/23 19:07:28 teranisi>
+;; Time-stamp: <2000-04-04 11:38:57 teranisi>
 
 ;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen).
 
@@ -132,35 +132,56 @@
        (setq flist (cdr flist))))
     guess))
 
+(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 (string-match
+                 (car (car pairs))
+                 value)
+                (setq guess (wl-refile-evaluate-rule (cdr (car pairs))
+                                                     entity)))
+           (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-guess-by-rule (entity)
   (let ((rules wl-refile-rule-alist)
-       (rule-set) (field) (field-cont))
-    (catch 'found
-      (while rules
-       (setq rule-set (cdr (car rules))
-             field (car (car rules)))
-       (cond ((string-match field "From")
-              (setq field-cont
-                    (elmo-msgdb-overview-entity-get-from entity)))
-             ((string-match field "Subject")
-              (setq field-cont
-                    (elmo-msgdb-overview-entity-get-subject entity)))
-             ((string-match field "To")
-              (setq field-cont
-                    (elmo-msgdb-overview-entity-get-to entity)))
-             ((string-match field "Cc")
-              (setq field-cont
-                    (elmo-msgdb-overview-entity-get-cc entity)))
-             (t
-              (setq field-cont
-                    (elmo-msgdb-overview-entity-get-extra-field
-                     entity (downcase field)))))
-       (if field-cont
-           (while rule-set
-             (if (string-match (car (car rule-set)) field-cont)
-                 (throw 'found (cdr (car rule-set)))
-               (setq rule-set (cdr rule-set)))))
-       (setq rules (cdr rules))))))
+       guess)
+    (while rules
+      (if (setq guess (wl-refile-evaluate-rule (car rules) entity))
+         (setq rules nil)
+       (setq rules (cdr rules))))
+    guess))
 
 (defun wl-refile-guess-by-history (entity)
   (let ((tocc-list 

diff --git a/wl/wl-summary.el b/wl/wl-summary.el
index b62d9c5..5aaf9ad 100644 (file)
--- a/wl/wl-summary.el
+++ b/wl/wl-summary.el
@@ -4,7 +4,7 @@
 
 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
 ;; Keywords: mail, net news
-;; Time-stamp: <00/03/22 01:00:41 teranisi>
+;; Time-stamp: <2000-04-04 13:36:01 teranisi>
 
 ;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen).
 
@@ -3247,6 +3247,7 @@ If optional argument NUMBER is specified, mark message specified by NUMBER."
   "Print refile destination on line."
   (wl-summary-remove-destination)
   (let ((inhibit-read-only t)
+       (folder (copy-sequence folder))
        (buffer-read-only nil)
        len rs re c)
     (setq len (string-width folder))
@@ -3403,18 +3404,34 @@ If optional argument NUMBER is specified, mark message specified by NUMBER."
 (defsubst wl-summary-no-auto-refile-message-p (msg mark-alist) 
   (member (cadr (assq msg mark-alist)) wl-summary-auto-refile-skip-marks))
 
+(defun wl-summary-auto-refile-check-refile-rule-alist-subr (rule dsts)
+  "Collect destination folders from rule."
+  (if (stringp rule)
+      (if (member rule dsts)
+         dsts
+       (setq dsts (cons rule dsts)))
+    ;; A rule.
+    (let (pairs sub-dsts)
+      (setq pairs (cdr rule))
+      (while pairs
+       (setq dsts
+             (wl-summary-auto-refile-check-refile-rule-alist-subr
+              (cdr (car pairs)) dsts))
+       (setq pairs (cdr pairs))))
+    dsts))
+
 (defun wl-summary-auto-refile-check-refile-rule-alist ()
   (when wl-refile-rule-alist
     (message "Checking destination folders...")
-    (let ((ralist wl-refile-rule-alist)
-         pairs dsts)
-      (while ralist
-       (setq pairs (cdr (car ralist)))
-       (while pairs
-         (if (not (member (cdr (car pairs)) dsts))
-             (setq dsts (cons (cdr (car pairs)) dsts)))
-         (setq pairs (cdr pairs)))
-       (setq ralist (cdr ralist)))
+    (let ((rules wl-refile-rule-alist)
+         dsts)
+      (while rules
+       (setq dsts
+             (append
+              (wl-summary-auto-refile-check-refile-rule-alist-subr
+               (car rules) nil)
+              dsts))
+       (setq rules (cdr rules)))
       (mapcar 
        'wl-folder-confirm-existence
        dsts))