* wl-summary.el (wl-summary-detect-mark-position): Follow the API
[elisp/wanderlust.git] / wl / wl-refile.el
index 467289f..607e410 100644 (file)
@@ -1,4 +1,4 @@
-;;; 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)
        (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 ()
@@ -77,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)
@@ -89,8 +89,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)
           (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 'decode)))
        hit)
     (setq dst (elmo-string dst))
     (if (and subject (not (string= 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)
+;; 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)
@@ -187,7 +187,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)))
@@ -198,48 +198,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)
@@ -257,8 +216,8 @@ 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
@@ -275,23 +234,23 @@ 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)))))
+                   (elmo-message-entity-field entity 'from)))))
     ;; 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)))))
-  
+
 (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 'decode))
              wl-refile-subject-alist)))
 
 (require 'product)