[Mew-dist 08936] Re: +fromへのrefile

[Yoshinari NOMURA]

On Mon, 24 May 1999 20:14:00 +0900,
	Yoshinari NOMURA <nom at example.com> said:

> 1. guess-by-from    は、+from/ 以下からしか guess しない。
> 2. guess-by-default +from/ に新規フォルダを作る場合にのみ使われ
>    るはずなので、@domainpart strip するかどうかの flag を付けるだけにする。
> 
> のような変更をしようと思うのですが、どうでしょうか。

とりあえずこの方針に沿って mew-refile.el を変更してみました。

・ mew-refile-guess-by-default に

  (defvar mew-refile-guess-strip-domainpart t
    "*If *non-nil*, mew-refile-guess-by-default strips domainpart of from")

  を導入した。

・mew-refile-guess-by-from の学習を以下のように変更した。

  ユーザが選んだフォルダの中に +from/... の形をしたフォルダがあ
  る場合は、優先的にそれを学習する。

  +from/... 以外の形をしたフォルダは以下の特別な場合に限り学習する。

   今迄学習していた +from/... なフォルダが既になくなっている。
   今迄学習していたフォルダがそもそも +from/... な形ではない。

一回入力してやれば、次からは mew-refile-guess-by-from がずっと覚
えてくれるので +from/foo/bar/baz や +from/foo at example.com のいずれが
好みの人でも問題ないはずです。

from-alist をアドレス補完に使わなくなって、妙な学習をしなくてよ
くなったので、だいぶマシな返事をするようになると思います。

あと、auto-refile がらみで、何かやることがあったような気がしたの
ですが、すみません、手元で見付けられません。
--
nom


--- mew-refile.el.orig	Mon Apr  5 13:07:35 1999
+++ mew-refile.el	Mon May 24 23:31:26 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 24, 1999
 
 ;;; Code:
 
-(defconst mew-refile-version "mew-refile.el version 0.65")
+(defconst mew-refile-version "mew-refile.el version 0.66")
 
 (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))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;