-;;; wl-refile.el -- Refile modules for Wanderlust.
+;;; wl-refile.el --- Refile modules for Wanderlust.
;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
;;
;;; Commentary:
-;;
+;;
;;; Code:
-;;
+;;
(require 'wl-vars)
(require 'wl-util)
(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) 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 ()
(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)
(let (tocc-list from key hit ml)
(setq dst (elmo-string dst))
(setq tocc-list
- (mapcar (function
- (lambda (entity)
- (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)))))
+ (mapcar (lambda (entity)
+ (downcase (wl-address-header-extract-address entity)))
+ (append
+ (elmo-message-entity-field entity 'to)
+ (elmo-message-entity-field entity 'cc))))
(while tocc-list
(if (wl-string-member
(car tocc-list)
(setq from
(downcase
(wl-address-header-extract-address
- (elmo-msgdb-overview-entity-get-from
- entity)))))
+ (elmo-message-entity-field entity 'from)))))
(setq key from))
(if (or wl-refile-msgid-alist
(memq 'wl-refile-guess-by-msgid
(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)))))
(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
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)))
+ (let ((subject (funcall wl-summary-subject-filter-function
+ (elmo-message-entity-field entity 'subject)))
hit)
(setq dst (elmo-string dst))
(if (and subject (not (string= subject "")))
'(wl-refile-guess-by-rule
wl-refile-guess-by-msgid
wl-refile-guess-by-subject
- wl-refile-guess-by-history)
+ wl-refile-guess-by-history
+ wl-refile-guess-by-from)
"*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)
+;; 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-functions) guess)
+(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)
(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)))
(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)) 'string))
(defun wl-refile-guess-by-rule (entity)
(let ((rules wl-refile-rule-alist)
(defun wl-refile-guess-by-history (entity)
(let ((tocc-list
- (mapcar (function
- (lambda (entity)
- (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)))))
+ (mapcar (lambda (entity)
+ (downcase (wl-address-header-extract-address entity)))
+ (append
+ (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 (wl-summary-subject-filter-func-internal
- (elmo-msgdb-overview-entity-get-subject entity))
+ (cdr (assoc (funcall wl-summary-subject-filter-function
+ (elmo-message-entity-field entity 'subject))
wl-refile-subject-alist)))
(require 'product)
projects / elisp / wanderlust.git / blobdiff