X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-refile.el;h=467289f28e5b1a7d45688112bb07ef3d57afd4a0;hb=1d7c8a8eeaa2e5e2b71b893ea47effd6b7c3ff89;hp=2026137d3c1bedae1f746b3d4ad2c2606f2be525;hpb=904f224e492403eb92709aa60d90858c2d1b714d;p=elisp%2Fwanderlust.git diff --git a/wl/wl-refile.el b/wl/wl-refile.el index 2026137..467289f 100644 --- a/wl/wl-refile.el +++ b/wl/wl-refile.el @@ -1,6 +1,6 @@ ;;; wl-refile.el -- Refile modules for Wanderlust. -;; Copyright 1998,1999,2000 Yuuichi Teranishi +;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi ;; Author: Yuuichi Teranishi ;; Keywords: mail, net news @@ -31,58 +31,69 @@ (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-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-dir) 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-dir) 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-dir) elmo-mime-charset)))) + (setq flist (cdr flist))))) + +(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-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-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-dir) + alist elmo-mime-charset)) (defun wl-refile-learn (entity dst) (let (tocc-list from key hit ml) (setq dst (elmo-string dst)) - (setq tocc-list + (setq tocc-list (mapcar (function - (lambda (entity) + (lambda (entity) (downcase (wl-address-header-extract-address entity)))) - (wl-parse-addresses + (wl-parse-addresses (concat (elmo-msgdb-overview-entity-get-to entity) "," (elmo-msgdb-overview-entity-get-cc entity))))) (while tocc-list - (if (wl-string-member - (car tocc-list) + (if (wl-string-member + (car tocc-list) (mapcar (function downcase) wl-subscribed-mailing-list)) (setq ml (car tocc-list) tocc-list nil) @@ -90,19 +101,25 @@ (if ml (setq key ml) ; subscribed entity!! (or (wl-address-user-mail-address-p - (setq from - (downcase + (setq from + (downcase (wl-address-header-extract-address - (elmo-msgdb-overview-entity-get-from + (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)))))))) + (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)) @@ -114,17 +131,32 @@ (setq wl-refile-msgid-alist (cons (cons key dst) wl-refile-msgid-alist)))))) +(defun wl-refile-subject-learn (entity dst) + (let ((subject (wl-summary-subject-filter-func-internal + (elmo-msgdb-overview-entity-get-subject entity))) + 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-subject wl-refile-guess-by-history) "*Functions in this list are used for guessing refile destination folder.") +(defvar wl-refile-guess-func-list wl-refile-guess-functions) +(make-obsolete-variable 'wl-refile-guess-func-list 'wl-refile-guess-functions) + (defun wl-refile-guess (entity) - (let ((flist wl-refile-guess-func-list) guess) + (let ((flist wl-refile-guess-functions) guess) (while flist (if (setq guess (funcall (car flist) entity)) (setq flist nil) @@ -132,11 +164,11 @@ 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) - (cond + (cond ((stringp rule) rule) ((listp (car rule)) (setq fields (car rule)) @@ -219,11 +251,11 @@ If RULE does not match ENTITY, returns nil." guess)) (defun wl-refile-guess-by-history (entity) - (let ((tocc-list + (let ((tocc-list (mapcar (function (lambda (entity) (downcase (wl-address-header-extract-address entity)))) - (wl-parse-addresses + (wl-parse-addresses (concat (elmo-msgdb-overview-entity-get-to entity) "," (elmo-msgdb-overview-entity-get-cc entity))))) @@ -250,11 +282,19 @@ If RULE does not match ENTITY, returns nil." (elmo-msgdb-overview-entity-get-from entity))))) ;; search from alist (or (cdr (assoc from wl-refile-alist)) - (format "%s/%s" wl-refile-default-from-folder + (format "%s/%s" wl-refile-default-from-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) wl-refile-msgid-alist))) +(defun wl-refile-guess-by-subject (entity) + (cdr (assoc (wl-summary-subject-filter-func-internal + (elmo-msgdb-overview-entity-get-subject entity)) + wl-refile-subject-alist))) + +(require 'product) +(product-provide (provide 'wl-refile) (require 'wl-version)) + ;;; wl-refile.el ends here