X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-refile.el;h=bba8e51804a9de022531d9a56b6d8fad375ae96b;hb=9e39553b80115a949a7f04ddced4459a7797f8bd;hp=ccecc93ad5b54ff5549926dbd249a86a6c0e7043;hpb=806725e3db0748ddc973ba045053a6681e840287;p=elisp%2Fwanderlust.git diff --git a/wl/wl-refile.el b/wl/wl-refile.el index ccecc93..bba8e51 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 +;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi ;; Author: Yuuichi Teranishi ;; Keywords: mail, net news @@ -24,15 +24,13 @@ ;; ;;; Commentary: -;; +;; ;;; Code: -;; +;; (require 'wl-vars) (require 'wl-util) -(require 'product) -(product-provide (provide 'wl-refile) (require 'wl-version)) (defvar wl-refile-alist nil) (defvar wl-refile-alist-file-name "refile-alist") @@ -45,24 +43,24 @@ (defvar wl-refile-alist-max-length 1000) (defun wl-refile-alist-setup () - (let ((flist wl-refile-guess-func-list)) + (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))) + 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-dir) elmo-mime-charset))) + 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-dir) elmo-mime-charset)))) + elmo-msgdb-directory) elmo-mime-charset)))) (setq flist (cdr flist))))) (defun wl-refile-alist-save () @@ -79,7 +77,7 @@ (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) + (elmo-object-save (expand-file-name file-name elmo-msgdb-directory) alist elmo-mime-charset)) (defun wl-refile-learn (entity dst) @@ -111,15 +109,15 @@ (setq key from)) (if (or wl-refile-msgid-alist (memq 'wl-refile-guess-by-msgid - wl-refile-guess-func-list)) + 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-func-list)) + 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 (delq hit wl-refile-alist))) (setq wl-refile-alist (cons (cons key dst) wl-refile-alist))))) @@ -147,15 +145,19 @@ ;; ;; 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) @@ -163,7 +165,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) @@ -186,7 +188,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))) @@ -207,39 +209,6 @@ If RULE does not match ENTITY, returns nil." 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))) - (defun wl-refile-guess-by-rule (entity) (let ((rules wl-refile-rule-alist) guess) @@ -274,7 +243,7 @@ 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 @@ -283,7 +252,7 @@ If RULE does not match ENTITY, returns nil." (or (cdr (assoc from wl-refile-alist)) (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))) @@ -293,4 +262,7 @@ If RULE does not match ENTITY, returns nil." (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