[Mew-dist 08945] Re: +fromへのrefile
Yoshinari NOMURA
nom at example.com
1999年 5月 25日 (火) 14:18:08 JST
On Tue, 25 May 1999 11:11:14 +0900,
Kazu TAKAMUNE (高宗和暁) <takamune at example.com> said:
> 下記の件であることを期待します。
どうもありがとうございます。
> 山本> あんまり関係ないかもしれませんが、
> 山本> C-u M-x mew-summary-auto-refile
> 山本> とすると '*' マークが付いたメッセージだけを refile するというのはどう
> 山本> でしょう？ 任せた。> nom
結局、これを実現すればいいのですね。以下パッチです。前に流した
guess-by-from/guess-by-default 関係のパッチも一緒に入っちゃって
ますので、オリジナルに当てて下さい。
--
nom
--- mew-refile.el.orig Mon Apr 5 13:07:35 1999
+++ mew-refile.el Tue May 25 14:11:35 1999
@@ -3,11 +3,11 @@
;; Author: Yoshinari NOMURA <nom at example.com>
;; Kazu Yamamoto <Kazu at example.com>
;; Created: Jun 11, 1994
-;; Revised: Sep 1, 1998
+;; Revised: May 25, 1999
;;; Code:
-(defconst mew-refile-version "mew-refile.el version 0.65")
+(defconst mew-refile-version "mew-refile.el version 0.67")
(require 'mew)
@@ -71,6 +71,9 @@
"*If *non-nil*, mew-summary-auto-refile doesn't touch
any alredy marked message.")
+(defvar mew-refile-guess-strip-domainpart t
+ "*If *non-nil*, mew-refile-guess-by-default strips domainpart of from")
+
;;
;; initialize function
;;
@@ -244,12 +247,9 @@
;; by from returns: guess1
;;
(defun mew-refile-guess-by-from (&optional addr)
- (let ((from (or addr (mew-header-parse-address mew-from:) "")) default)
+ (let ((from (or addr (mew-header-parse-address mew-from:) "")))
;; search from alist
- (setq default (mew-refile-guess-by-default from))
- (if (file-exists-p (mew-expand-folder default))
- default
- (cdr (assoc from mew-refile-from-alist)))))
+ (cdr (assoc from mew-refile-from-alist))))
;;
;; by To: or Cc: when From: is mine. (Undocumented)
@@ -274,12 +274,13 @@
;; by default returns: guess1
;;
(defun mew-refile-guess-by-default (&optional addr)
- (let ((from (or addr (mew-header-parse-address mew-from:) "")))
+ (let ((from (downcase (or addr (mew-header-parse-address mew-from:) ""))))
+ (if mew-refile-guess-strip-domainpart
+ (setq from (mew-addrstr-extract-user from)))
(if (and mew-folders-default-folder
(not (equal "" mew-folders-default-folder)))
- (concat (file-name-as-directory mew-folders-default-folder)
- (downcase (mew-addrstr-extract-user from)))
- (concat "+" (downcase (mew-addrstr-extract-user from))))))
+ (concat (file-name-as-directory mew-folders-default-folder) from)
+ (concat "+" from))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
@@ -342,30 +343,45 @@
;; learn from "From:" field
;;
(defun mew-refile-guess-by-from-learn (chosen info)
- (let ((from (mew-header-parse-address mew-from:))
- (folder nil)
- ;; ohter people's honest opinion and my honest opinion.
- (oho info)
- (mho (cdr (assoc 'mew-refile-guess-by-from info))))
- (if (or (not from) (not chosen))
- ()
- ;; if my opninion was right, I learn it.
- ;; or a folder was not in other people's opinion,
- ;; I accept it.
+ (let* ((from (mew-header-parse-address mew-from:))
+ (folder nil)
+ (first (car chosen))
+ (entry (or (cdr (assoc from mew-refile-from-alist)) ""))
+ ;; my honest opinion.
+ (mho (cdr (assoc 'mew-refile-guess-by-from info))))
+ (if (or (or (null from) (null chosen)) ;; if from/chosen is empty or
+ (and mho (member mho chosen))) ;; my opninion was right.
+ () ;; do nothing.
+ ;; else, search "+from/.." folder from chosen folders.
(catch 'match
(while chosen
- (if (or (member (car chosen) mho)
- (not (catch 'find
- (while oho
- (and (member (car chosen) (car oho)) (throw 'find t))
- (setq oho (cdr oho))))))
+ (if (mew-refile-guess-default-folder-p (car chosen))
(throw 'match (setq folder (car chosen))))
(setq chosen (cdr chosen))))
- (if folder
- (setq mew-refile-from-alist
- (cons (cons from folder)
- (delete (assoc from mew-refile-from-alist)
- mew-refile-from-alist)))))))
+ (cond
+ ;; if "+from/..." is found in chosen folders, learn it.
+ (folder
+ (setq mew-refile-from-alist
+ (cons (cons from folder)
+ (delete (assoc from mew-refile-from-alist)
+ mew-refile-from-alist))))
+ ;; if chosen folder is not the form of "+from/..."
+ ;; mew-refile-from-alist should be updated only in case of
+ ;; 1. the entry of mew-refile-from-alist is not in mew-folder-list,
+ ;; 2. the entry of mew-refile-from-alist is not the form of "+from/.."
+ ((or (not (mew-folder-member entry mew-folder-list))
+ (not (mew-refile-guess-default-folder-p entry)))
+ (setq mew-refile-from-alist
+ (cons (cons from first)
+ (delete (assoc from mew-refile-from-alist)
+ mew-refile-from-alist))))))))
+
+
+(defun mew-refile-guess-default-folder-p (folder)
+ (string-match
+ (concat "^"(file-name-as-directory
+ mew-folders-default-folder))
+ folder))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
@@ -499,9 +515,13 @@
(mew-summary-only
(mew-summary-refile mew-refile-last-folder)))
-(defun mew-summary-auto-refile ()
- "Refile each message in the folder automatically."
- (interactive)
+(defun mew-summary-auto-refile (&optional mew-mark-review-only)
+ "Refile each message in the folder automatically. If
+'mew-refile-auto-refile-skip-any-mark' is non-nil,
+any previousely marked message will be skipped.
+If 'C-u' is specified, only messages marked with
+'mew-mark-review' will be conserned."
+ (interactive "P")
(mew-summary-only
(let ((after-change-function nil)
(after-change-functions nil)
@@ -514,10 +534,13 @@
(goto-char (point-min))
(while (not (eobp))
(setq mark (mew-summary-get-mark))
- (or (equal mark mew-mark-refile)
- (equal mark mew-mark-delete)
- (and mark mew-refile-auto-refile-skip-any-mark)
- (mew-summary-refile nil t))
+ (if mew-mark-review-only
+ (and (equal mark mew-mark-review)
+ (mew-summary-refile nil t))
+ (or (equal mark mew-mark-refile)
+ (equal mark mew-mark-delete)
+ (and mark mew-refile-auto-refile-skip-any-mark)
+ (mew-summary-refile nil t)))
(forward-line)
(if (equal (% (/ (* 100 line) lines) 10) 0)
(message "Auto refiling ... %s%%"
Mew-dist メーリングリストの案内