[mew-dist 28904] Re: 特定フォルダ以下をauto-refileの対象から外すには？

[Hideyuki SHIRAI ( 白井秀行 )]

白井です。

From: Tatsuo Ishii <ishii at example.com> さん曰く
Subject: [mew-dist 28903] Re: 特定フォルダ以下をauto-refileの対象から外すには？
Message-ID: <20090309.124539.82127671.t-ishii at example.com>
Date: Mon, 09 Mar 2009 12:45:39 +0900 (JST)

> お察しの通り、mew-refile-guess-by-folder のようです。この関数をいじっ
> て、"Mail-2008"の方に行きそうだったらそうならないようにすることになる
> のでしょうか？

> mew-refile-guess-by-folder        return: +Mail-2008/PostgreSQL/jpug-kyushu

そうなります。しかし、mew-refile-guess-by-folder 自体を改造する
のはよろしくないので、流用して他の関数を定義する方が良いと思います。

例えば、以下のように mew-refile-guess-by-folder-not-old() を定義
して、mew-refile-guess-control に追加すれば OK でしょう。

(defvar mew-refile-guess-by-folder-not-old-alist nil)

(defun mew-refile-guess-by-folder-not-old ()
  (let ((to-cc (mew-header-parse-address-list mew-refile-guess-key-list))
	(proto mew-inherit-refile-proto)
	(case mew-inherit-refile-case)
	alist tmp sep ent ret ml-addr ml-name)
    (when (mew-folder-localp proto)
      (setq sep mew-path-separator)
      (if mew-refile-guess-by-folder-not-old-alist
	  (setq alist mew-refile-guess-by-folder-not-old-alist)
	(setq alist (mew-proto-folder-alist proto case))
	(while alist
	  (unless (string-match "^\\+Mail-[12][0-9][0-9][0-9]" (car (car alist)))
	    (setq tmp (cons (car alist) tmp)))
	  (setq alist (cdr alist)))
	(setq alist (nreverse tmp))
	(setq mew-refile-guess-by-folder-not-old-alist alist))
      (dolist (tc to-cc)
	(setq ml-addr (mew-addrstr-parse-address (or tc "")))
	(when ml-addr
	  (setq ml-name (mew-addrstr-extract-user ml-addr))
	  (setq ent (or (funcall mew-assoc-folder ml-addr alist sep)
			(funcall mew-assoc-folder ml-name alist sep)))
	  (mew-addq ret (nth 0 ent))))
      (nreverse ret))))

(setq mew-refile-guess-control
      '(mew-refile-guess-by-alist
	mew-refile-ctrl-throw
	mew-refile-guess-by-newsgroups
	mew-refile-guess-by-folder-not-old	;; 追加
	mew-refile-ctrl-throw
	mew-refile-ctrl-auto-boundary
	mew-refile-guess-by-folder		;; 適当な位置に動かす(消すのもあり)
	mew-refile-guess-by-thread
	mew-refile-ctrl-throw
	mew-refile-guess-by-from-folder
	mew-refile-ctrl-throw
	mew-refile-guess-by-from
	mew-refile-ctrl-throw
	mew-refile-guess-by-default))

これで、M-o のときに +Mail-2008/... が出てくることはなくなると思
います。

なお、

(1) 二回目以降は +Mail-XXXX を除いた alist を使いまわしているた
    め、後からフォルダを追加したり、削除したりしたら、Emacs を立
    ち上げ直すか、
    (setq mew-refile-guess-by-folder-not-old-alist nil)
    としないとダメです。 

(2) ローカルフォルダ限定です。IMAP にも対応出来ますが、少々面倒
    くさくなるので、もし必要ならまた今度。

といった感じです。

-- 
白井秀行 (mailto:shirai at example.com)

# 似たようなものを使っているので、すぐ出来てしまいました ^^;;;