[Mew-dist 14842] mew-refile-guess-by-folder

[KOIE Hidetaka ( 鯉江英隆 )]

mew-refile-guess-by-folderは一つしか候補を返してくれないのですが
他方の候補が欲しいときもあるので、全ての候補を返すようにしてみました。

--
KOIE Hidetaka 鯉江英隆 <hide at example.com>
-------------- next part --------------
(defun mew-refile-guess-by-folder2 ()
  (let ((to-cc (mew-header-parse-address-list mew-refile-guess-key-list))
	ent ret ml-name)
    (while to-cc
      (setq ml-name (mew-addrstr-extract-user (or (car to-cc) "")))
      (setq ent (mew-assoc-case-equal2 ml-name mew-folder-alist 1))
      (if ent (setq ret (append (mapcar (lambda (x) (nth 0 x)) ent) ret)))
      (setq to-cc (cdr to-cc)))
    (mew-uniq-list (nreverse ret))))
(defun mew-assoc-case-equal2 (key alist nth)
  (let ((skey (downcase key)) a n ret)
    (catch 'loop
      (while alist
	(setq a (car alist))
	(setq n (nth nth a))
	(if (and (stringp n) (string= (downcase n) skey))
            (setq ret (cons a ret)))
        (if (eq n t)
            (progn
              (setq ret (cons a ret))
              (throw 'loop a)))
	(setq alist (cdr alist))))
    ret))
-------------- next part --------------
--- 1	Sat Nov  4 00:47:25 2000
+++ 2	Sat Nov  4 00:46:18 2000
@@ -4,16 +4,20 @@
     (while to-cc
       (setq ml-name (mew-addrstr-extract-user (or (car to-cc) "")))
       (setq ent (mew-assoc-case-equal ml-name mew-folder-alist 1))
-      (if ent (setq ret (cons (nth 0 ent) ret)))
+      (if ent (setq ret (append (mapcar (lambda (x) (nth 0 x)) ent) ret)))
       (setq to-cc (cdr to-cc)))
     (mew-uniq-list (nreverse ret))))
 (defun mew-assoc-case-equal (key alist nth)
-  (let ((skey (downcase key)) a n)
+  (let ((skey (downcase key)) a n ret)
     (catch 'loop
       (while alist
 	(setq a (car alist))
 	(setq n (nth nth a))
-	(if (or (and (stringp n) (string= (downcase n) skey))
-		(eq n t))
-	    (throw 'loop a))
-	(setq alist (cdr alist))))))
+	(if (and (stringp n) (string= (downcase n) skey))
+            (setq ret (cons a ret)))
+        (if (eq n t)
+            (progn
+              (setq ret (cons a ret))
+              (throw 'loop a)))
+	(setq alist (cdr alist))))
+    ret))