[Mew-dist 1297] Re: mew-1.86 & im-46 beta release

[尾澤 稔]

尾澤＠沖電気です。

Kazu> (4) 現在の mew-refile.el と mew-auto-refile.el の関係を調べて下さい。> 
Kazu> nom さん

MewにAuto Refileの機能を付けていただけるのですか。
とてもうれしく思います。

現在私が個人的に使用しているAuto refileの機能を実現するパッチをつけて
おきます。
参考になれば良いのですけれど...

Summary Mode で
  my とすると、Auto Refileします。
  ml とすると、マーク(*)の付いているものに対してAuto Refileします。

  M-x mew-summary-refile-check-guess
  でどこにリファイルするかチェックできます。
-------------- next part --------------
diff -Nru mew-1.86.orig/Makefile mew-1.86/Makefile
--- mew-1.86.orig/Makefile	Tue Jun 24 16:01:16 1997
+++ mew-1.86/Makefile	Wed Jul 23 11:00:17 1997
@@ -41,7 +41,7 @@
 	mew-scan.elc mew-summary.elc mew-syntax.elc \
 	mew-ext.elc mew-virtual.elc mew-mark.elc \
 	mew-mime.elc mew-cache.elc mew-func.elc \
-	mew-minibuf.elc mew-complete.elc
+	mew-minibuf.elc mew-complete.elc mew-auto-refile.elc
 SRCS = mew.el \
 	mew-attach.el mew-env.el mew-decode.el \
 	mew-demo.el mew-draft.el mew-encode.el \
@@ -51,7 +51,8 @@
 	mew-ext.el mew-virtual.el mew-mark.el \
 	mew-mime.el mew-cache.el mew-func.el \
 	mew-minibuf.el mew-complete.el \
-	mew-mule0.el mew-mule2.el mew-mule3.el mew-xemacs.el
+	mew-mule0.el mew-mule2.el mew-mule3.el mew-xemacs.el \
+	mew-auto-refile.el
 LDPATH = lp.el
 
 RM = rm -f
diff -Nru mew-1.86.orig/mew-auto-refile.el mew-1.86/mew-auto-refile.el
--- mew-1.86.orig/mew-auto-refile.el	Thu Jan  1 09:00:00 1970
+++ mew-1.86/mew-auto-refile.el	Tue Jul 22 17:53:09 1997
@@ -0,0 +1,103 @@
+;;;			     mew-auto-refile.el
+;;;
+;;;		Copyright (C) 1997  Minoru Ozawa
+;;;
+;;;		   This emacs lisp library conforms
+;;;		GNU GENERAL PUBLIC LICENSE Version 2.
+;;;
+;;; Author:  Minoru Ozawa <ozawa at example.com>
+;;; Created: April 4, 1997
+;;; Revised: Jul   4, 1997
+;;;
+(defvar mew-auto-refile-effective-folder-guess
+  '(
+    (mew-refile-guess-by-alist		. t)
+    (mew-refile-guess-by-newsgroups	. nil)
+    (mew-refile-guess-by-folder		. nil)
+    (mew-refile-guess-by-msgid		. nil)
+    (mew-refile-guess-by-from		. nil)
+    (mew-refile-guess-by-default	. nil)
+    )
+  "When folder is fixed, the establishment or they make which associative
+list effective."
+  )
+
+(defun mew-auto-refile-get-folder (msg)
+  (let ((mew-summary-buffer-disp-msg nil)
+	(effective-guess mew-auto-refile-effective-folder-guess)
+	(current-folder (buffer-name))
+	msg-buffer folder)
+    (save-excursion
+      (mew-set-buffer-tmp)
+      (insert-file-contents (mew-expand-folder current-folder msg))
+      (goto-char (point-min))
+      (setq msg-buffer (current-buffer))
+      )
+    (save-excursion
+      (set-buffer msg-buffer)
+      (while (and effective-guess (not folder))
+	(if (cdr (car effective-guess))
+	    (setq folder (funcall (car (car effective-guess)))))
+	(setq effective-guess (cdr effective-guess)))
+      )
+    folder))
+
+(defun mew-auto-refile-set ()
+  (let (folder mark msg)
+    (setq mark (mew-summary-get-mark))
+    (setq msg (mew-summary-message-number))
+    (if (or (eq mark mew-mark-refile) (eq mark mew-mark-rmm))
+	nil
+      (setq folder (mew-auto-refile-get-folder msg)))
+    (if folder
+	(if (mew-folder-check (car folder))
+	    (progn
+	      (if mark
+		  (mew-mark-unmark))
+	      (mew-refile-set msg (car folder))
+	      (mew-summary-mark-as mew-mark-refile))
+	  ))
+    ))
+
+(defun mew-summary-auto-refile ()
+  (interactive)
+  (let ((mew-analysis nil))
+    (message "Auto refiling ...")
+    (save-window-excursion
+      (goto-char (point-min))
+      (while (not (eobp))
+	(mew-auto-refile-set)
+	;;(forward-line 1)))
+	(mew-summary-message-next)))
+    (message "Auto refileing ... done")))
+
+(defun mew-summary-mark-refile-by-guess ()
+  (interactive)
+  (let ((regex (concat mew-summary-message-regex
+                       (regexp-quote (char-to-string mew-mark-hop))))
+	(mew-analysis nil))
+    (save-window-excursion
+      (goto-char (point-min))
+      (if (not (re-search-forward regex nil t))
+          (message "No marked messages")
+	(message "Marked message refiling ...")
+	(mew-auto-refile-set)
+	(while (re-search-forward regex nil t)
+	  (mew-auto-refile-set))
+	(message "Marked message refiling ... Done"))
+      )))
+
+(defun mew-summary-refile-check-guess ()
+  (interactive)
+  (let* ((begin (save-excursion (beginning-of-line) (point)))
+	 (end (save-excursion (end-of-line) (point)))
+	 (msg (mew-summary-mark-collect mew-mark-refile begin end))
+	 folder)
+    (if (not msg)
+	(message "No refile mark")
+      (setq folder (cdr (assoc (car msg) mew-summary-buffer-refile)))
+      (message (format "Refiling folder is \"%s\"" (car folder)))
+      )
+    ))
+
+(provide 'mew-auto-refile)
diff -Nru mew-1.86.orig/mew-summary.el mew-1.86/mew-summary.el
--- mew-1.86.orig/mew-summary.el	Mon Jul 21 22:30:43 1997
+++ mew-1.86/mew-summary.el	Wed Jul 23 10:59:28 1997
@@ -153,6 +153,8 @@
   (define-key mew-summary-mode-map "?"    'mew-summary-search-mark)
   (define-key mew-summary-mode-map "m"	  (make-sparse-keymap))
   (define-key mew-summary-mode-map "mo"   'mew-summary-mark-refile)
+  (define-key mew-summary-mode-map "mo"   'mew-summary-auto-refile)
+  (define-key mew-summary-mode-map "mo"   'mew-summary-mark-refile-by-guess)
   (define-key mew-summary-mode-map "md"   'mew-summary-mark-rmm)
   (define-key mew-summary-mode-map "m@"   'mew-summary-mark-at)
   (define-key mew-summary-mode-map "m*"   'mew-summary-mark-asterisk)
diff -Nru mew-1.86.orig/mew.el mew-1.86/mew.el
--- mew-1.86.orig/mew.el	Mon Jul 21 22:28:22 1997
+++ mew-1.86/mew.el	Wed Jul 23 10:58:08 1997
@@ -947,6 +947,7 @@
 (require 'mew-attach)
 (require 'mew-demo)
 (require 'mew-refile)
+(require 'mew-auto-refile)
 (require 'mew-ext)
 (require 'mew-fib)
 ;;;
-------------- next part --------------
						尾澤 稔
						ozawa at example.com