X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=sidebyside;f=wl%2Fwl-refile.el;h=b128365251a56ea106f938ea5914ed0b96026ce1;hb=312d0ff8909b01d453beb51511df90d7a8a3a9bc;hp=b7cc69a491f562532188bf668447ea13ca1e9c36;hpb=e3e5f572d472484c24a40f53375103b9c9a0a7a9;p=elisp%2Fwanderlust.git

diff --git a/wl/wl-refile.el b/wl/wl-refile.el
index b7cc69a..b128365 100644
--- a/wl/wl-refile.el
+++ b/wl/wl-refile.el
@@ -1,6 +1,6 @@
-;;; wl-refile.el -- Refile modules for Wanderlust.
+;;; wl-refile.el --- Refile modules for Wanderlust.
 
-;; Copyright 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
+;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
 
 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
 ;; Keywords: mail, net news
@@ -24,50 +24,63 @@
 ;;
 
 ;;; Commentary:
-;; 
+;;
 
 ;;; Code:
-;; 
+;;
 
 (require 'wl-vars)
 (require 'wl-util)
-(provide 'wl-refile)
-
 
 (defvar wl-refile-alist nil)
 (defvar wl-refile-alist-file-name "refile-alist")
 ;; should be renamed to "refile-from-alist"
 (defvar wl-refile-msgid-alist nil)
 (defvar wl-refile-msgid-alist-file-name "refile-msgid-alist")
+(defvar wl-refile-subject-alist nil)
+(defvar wl-refile-subject-alist-file-name "refile-subject-alist")
+
+(defvar wl-refile-default-from-folder-path-separator "/")
 
 (defvar wl-refile-alist-max-length 1000)
 
 (defun wl-refile-alist-setup ()
-  (setq wl-refile-alist
-	(elmo-object-load
-	 (expand-file-name wl-refile-alist-file-name
-			   elmo-msgdb-dir)))
-  (setq wl-refile-msgid-alist
-	(elmo-object-load
-	 (expand-file-name wl-refile-msgid-alist-file-name
-			   elmo-msgdb-dir))))
+  (let ((flist wl-refile-guess-functions))
+    (while flist
+      (cond
+       ((eq (car flist) 'wl-refile-guess-by-history)
+	(setq wl-refile-alist
+	      (elmo-object-load
+	       (expand-file-name wl-refile-alist-file-name
+				 elmo-msgdb-directory) elmo-mime-charset)))
+       ((eq (car flist) 'wl-refile-guess-by-msgid)
+	(setq wl-refile-msgid-alist
+	      (elmo-object-load
+	       (expand-file-name wl-refile-msgid-alist-file-name
+				 elmo-msgdb-directory) elmo-mime-charset)))
+       ((eq (car flist) 'wl-refile-guess-by-subject)
+	(setq wl-refile-subject-alist
+	      (elmo-object-load
+	       (expand-file-name wl-refile-subject-alist-file-name
+				 elmo-msgdb-directory) elmo-mime-charset))))
+      (setq flist (cdr flist)))))
 
-(defun wl-refile-alist-save (file-name alist)
-  (save-excursion
-    (let ((filename (expand-file-name file-name
-				      elmo-msgdb-dir))
-	  (tmp-buffer (get-buffer-create " *wl-refile-alist-tmp*")))
-      (set-buffer tmp-buffer)
-      (erase-buffer)
-      (if (> (length alist) wl-refile-alist-max-length)
-	  (setcdr (nthcdr (1- wl-refile-alist-max-length) alist) nil))
-      (prin1 alist tmp-buffer)
-      (princ "\n" tmp-buffer)
-      (if (file-writable-p filename)
-	  (write-region (point-min) (point-max)
-			filename nil 'no-msg)
-	(message (format "%s is not writable." filename)))
-      (kill-buffer tmp-buffer))))
+(defun wl-refile-alist-save ()
+  (if wl-refile-alist
+      (wl-refile-alist-save-file
+       wl-refile-alist-file-name wl-refile-alist))
+  (if wl-refile-msgid-alist
+      (wl-refile-alist-save-file
+       wl-refile-msgid-alist-file-name wl-refile-msgid-alist))
+  (if wl-refile-subject-alist
+      (wl-refile-alist-save-file
+       wl-refile-subject-alist-file-name wl-refile-subject-alist)))
+
+(defun wl-refile-alist-save-file (file-name alist)
+  (if (> (length alist) wl-refile-alist-max-length)
+      (setcdr (nthcdr (1- wl-refile-alist-max-length) alist) nil))
+  (elmo-object-save (expand-file-name file-name elmo-msgdb-directory)
+		    alist elmo-mime-charset))
 
 (defun wl-refile-learn (entity dst)
   (let (tocc-list from key hit ml)
@@ -78,8 +91,8 @@
 		     (downcase (wl-address-header-extract-address entity))))
 		  (wl-parse-addresses
 		   (concat
-		    (elmo-msgdb-overview-entity-get-to entity) ","
-		    (elmo-msgdb-overview-entity-get-cc entity)))))
+		    (elmo-message-entity-field entity 'to) ","
+		    (elmo-message-entity-field entity 'cc)))))
     (while tocc-list
       (if (wl-string-member
 	   (car tocc-list)
@@ -93,19 +106,24 @@
 	   (setq from
 		 (downcase
 		  (wl-address-header-extract-address
-		   (elmo-msgdb-overview-entity-get-from
-		    entity)))))
-	  (setq key from)))
-    (if (not ml)
-	(wl-refile-msgid-learn entity dst))
-    (if key
-	(if (setq hit (assoc key wl-refile-alist))
-	    (setcdr hit dst)
-	  (setq wl-refile-alist
-		(nconc wl-refile-alist (list (cons key dst))))))))
+		   (elmo-message-entity-field entity 'from)))))
+	  (setq key from))
+      (if (or wl-refile-msgid-alist
+	      (memq 'wl-refile-guess-by-msgid
+		    wl-refile-guess-functions))
+	  (wl-refile-msgid-learn entity dst))
+      (if (or wl-refile-subject-alist
+	      (memq 'wl-refile-guess-by-subject
+		    wl-refile-guess-functions))
+	  (wl-refile-subject-learn entity dst)))
+    (when key
+      (if (setq hit (assoc key wl-refile-alist))
+	  (setq wl-refile-alist (delq hit wl-refile-alist)))
+      (setq wl-refile-alist (cons (cons key dst)
+				  wl-refile-alist)))))
 
 (defun wl-refile-msgid-learn (entity dst)
-  (let ((key (elmo-msgdb-overview-entity-get-id entity))
+  (let ((key (elmo-message-entity-field entity 'message-id))
 	hit)
     (setq dst (elmo-string dst))
     (if key
@@ -114,17 +132,35 @@
 	  (setq wl-refile-msgid-alist (cons (cons key dst)
 					    wl-refile-msgid-alist))))))
 
+(defun wl-refile-subject-learn (entity dst)
+  (let ((subject (funcall wl-summary-subject-filter-function
+			  (elmo-message-entity-field entity 'subject 'decode)))
+	hit)
+    (setq dst (elmo-string dst))
+    (if (and subject (not (string= subject "")))
+	(if (setq hit (assoc subject wl-refile-subject-alist))
+	    (setcdr hit dst)
+	  (setq wl-refile-subject-alist (cons (cons subject dst)
+					    wl-refile-subject-alist))))))
+
 ;;
 ;; refile guess
 ;;
-(defvar wl-refile-guess-func-list
+(defvar wl-refile-guess-functions
   '(wl-refile-guess-by-rule
     wl-refile-guess-by-msgid
-    wl-refile-guess-by-history)
+    wl-refile-guess-by-subject
+    wl-refile-guess-by-history
+    wl-refile-guess-by-from)
   "*Functions in this list are used for guessing refile destination folder.")
 
-(defun wl-refile-guess (entity)
-  (let ((flist wl-refile-guess-func-list) guess)
+;; 2000-11-05: *-func-list -> *-functions
+(elmo-define-obsolete-variable 'wl-refile-guess-func-list
+			       'wl-refile-guess-functions)
+
+(defun wl-refile-guess (entity &optional functions)
+  (let ((flist (or functions wl-refile-guess-functions))
+	guess)
     (while flist
       (if (setq guess (funcall (car flist) entity))
 	  (setq flist nil)
@@ -132,7 +168,7 @@
     guess))
 
 (defun wl-refile-evaluate-rule (rule entity)
-  "Returns folder string if RULE is matched to ENTITY.
+  "Return 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)
@@ -155,7 +191,7 @@ If RULE does not match ENTITY, returns nil."
 		 (string-match
 		  (car (car pairs))
 		  value)
-		 (setq guess (wl-refile-expand-newtext
+		 (setq guess (wl-expand-newtext
 			      (wl-refile-evaluate-rule (cdr (car pairs))
 						       entity)
 			      value)))
@@ -166,48 +202,7 @@ If RULE does not match ENTITY, returns nil."
 
 (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)))
+  (elmo-message-entity-field entity (intern (downcase field)) 'decode))
 
 (defun wl-refile-guess-by-rule (entity)
   (let ((rules wl-refile-rule-alist)
@@ -225,36 +220,45 @@ If RULE does not match ENTITY, returns nil."
 		    (downcase (wl-address-header-extract-address entity))))
 		 (wl-parse-addresses
 		  (concat
-		   (elmo-msgdb-overview-entity-get-to entity) ","
-		   (elmo-msgdb-overview-entity-get-cc entity)))))
+		   (elmo-message-entity-field entity 'to) ","
+		   (elmo-message-entity-field entity 'cc)))))
 	ret-val)
-    (setq tocc-list (elmo-list-delete
-		     (or wl-user-mail-address-list
-			 (list (wl-address-header-extract-address wl-from)))
-		     tocc-list))
+    (setq tocc-list (wl-address-delete-user-mail-addresses tocc-list))
     (while tocc-list
       (if (setq ret-val (cdr (assoc (car tocc-list) wl-refile-alist)))
 	  (setq tocc-list nil)
 	(setq tocc-list (cdr tocc-list))))
-    (or ret-val
-	(wl-refile-guess-by-from entity))))
+    ret-val))
 
 (defun wl-refile-get-account-part-from-address (address)
   (if (string-match "\\([^@]+\\)@[^@]+" address)
       (wl-match-string 1 address)
     address))
-		 
+
 (defun wl-refile-guess-by-from (entity)
-  (let ((from
-	 (downcase (wl-address-header-extract-address
-		    (elmo-msgdb-overview-entity-get-from entity)))))
+  (let ((from (downcase (wl-address-header-extract-address
+			 (elmo-message-entity-field entity 'from))))
+	(folder (elmo-make-folder wl-refile-default-from-folder))
+	(elmo-path-sep wl-refile-default-from-folder-path-separator))
     ;; search from alist
     (or (cdr (assoc from wl-refile-alist))
-	(format "%s/%s" wl-refile-default-from-folder
-		(wl-refile-get-account-part-from-address from)))))
-  
+	(concat
+	 (elmo-folder-prefix-internal folder)
+	 (elmo-concat-path
+	  (substring wl-refile-default-from-folder
+		     (length (elmo-folder-prefix-internal folder)))
+	  (wl-refile-get-account-part-from-address from))))))
+
 (defun wl-refile-guess-by-msgid (entity)
-  (cdr (assoc (elmo-msgdb-overview-entity-get-references entity)
+  (cdr (assoc (elmo-message-entity-field entity 'references)
 	      wl-refile-msgid-alist)))
 
+(defun wl-refile-guess-by-subject (entity)
+  (cdr (assoc (funcall wl-summary-subject-filter-function
+		       (elmo-message-entity-field entity 'subject 'decode))
+	      wl-refile-subject-alist)))
+
+(require 'product)
+(product-provide (provide 'wl-refile) (require 'wl-version))
+
 ;;; wl-refile.el ends here