X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-refile.el;h=6156774cec0d9d11c37c505c8c410a29343944ae;hb=3f902466589f92d94e1e4d6c8ff4b4f22449b620;hp=b144b14c69b42e1a107ff6b85599d924ee3858e0;hpb=15dcdc8f245eac9f08b29ef28d7b7406be084f8c;p=elisp%2Fwanderlust.git diff --git a/wl/wl-refile.el b/wl/wl-refile.el index b144b14..6156774 100644 --- a/wl/wl-refile.el +++ b/wl/wl-refile.el @@ -1,10 +1,9 @@ -;;; wl-refile.el -- Refile modules for Wanderlust. +;;; 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 -;; Time-stamp: <2000-04-04 11:38:57 teranisi> ;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen). @@ -25,65 +24,76 @@ ;; ;;; 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-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)))) - -(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)))) + (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 () + (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) (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) @@ -91,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)) @@ -115,17 +131,33 @@ (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-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.") +;; 2000-11-05: *-func-list -> *-functions +(elmo-define-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) @@ -133,11 +165,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)) @@ -152,11 +184,14 @@ If RULE does not match ENTITY, returns nil." (setq pairs (cdr rule)) (setq value (wl-refile-get-field-value entity (car rule))) (while pairs - (if (and (string-match + (if (and (stringp value) + (string-match (car (car pairs)) value) - (setq guess (wl-refile-evaluate-rule (cdr (car pairs)) - entity))) + (setq guess (wl-expand-newtext + (wl-refile-evaluate-rule (cdr (car pairs)) + entity) + value))) (setq pairs nil) (setq pairs (cdr pairs)))) guess) @@ -184,11 +219,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))))) @@ -208,18 +243,26 @@ If RULE does not match ENTITY, returns nil." (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))))) ;; 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 (funcall wl-summary-subject-filter-function + (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