[Mew-dist 369] mew-my-refile.el

[Tomoyuki Kudou]

工藤@Pacifitech です。

社内の mew ユーザから refile を一括で行う際に毎回 minibuffer で
パターン(プロンプト)を打たなくてはいけないのが煩わしいので、これ
をユーザ設定しておいてキー一発で refile できないかという要望があ
りました。特に流量の激しいメーリングリストに参加している場合には、
この機能があるとメールの一括処理ができてとても便利です。

mew の機能を調べたところ、どうもこのような機能がないようなので、
作ってしまいました(作ったといっても既にある関数をもとに多少変更
しただけですが)。ひょっとしたらもっと手軽な方法があるかもしれま
せんが、これで結構満足しています。次の mew のリリースでデフォル
トでこの機能を組み込んでもらえればとっても嬉しいです。バグとかが
あれば教えてください。

使い方は +inbox で my とタイプすると、.emacs 内で指定したパターン
のメールが、自動的に 指定したフォルダへの refile 対象として "o" 
マークが付けられます。実際に refile するには、その後で、x とタイプ
します。

この機能を使うには、オリジナルの mew.el と mew-summary.el を少し
だけ変更します。

-- mew.el -- の一番後ろ
(require 'mew-my-refile)	;; <== ここ

-- mew-summary.el --
(if mew-summary-mode-map
    ()
  (setq mew-summary-mode-map (make-sparse-keymap))
  (define-key mew-summary-mode-map " "    'mew-summary-show)
  ...
  (define-key mew-summary-mode-map "mu"   'mew-summary-mark-undo-all)
  (define-key mew-summary-mode-map "my"   'mew-summary-my-refile)	;; <== このへん
  ...

また次のファイル mew-my-refile.el を適当な elisp のパスの通った
場所に置きます。

-- mew-my-refile.el --
;; mew-my-refile.el
;; $Header: /d/salt/sd7g/home/kudou/elisp/mew-my-refile.el,v 1.3 1997/01/07 06:59:57 kudou Exp $

(defconst mew-summary-my-refile "mew-my-refile.el version 0.02")

(require 'mew)

(defvar mew-my-refile-alist '()
  "alist which consists of mail pattern and folder name")

(defun mew-summary-my-refile ()
  (interactive)
  (let ((a mew-my-refile-alist)
	prompt folder)
  (while (not (null a))
    (progn
      (setq prompt (car (car a)))
      (setq folder (cdr (car a)))
      (mew-summary-my-refile-x prompt folder)
      (setq a (cdr a))))))

(defun mew-summary-my-refile-x (prompt &optional folder)
  (interactive)
  (progn
    (mew-summary-search-mark-x prompt)
    (mew-summary-mark-refile-x folder)))

(defun mew-summary-mark-refile-x (folder)
  (interactive)
  (let ((regex (concat mew-summary-message-regex
		       (regexp-quote (char-to-string mew-mark-hop))))
	(mew-summary-buffer-disp-msg nil)
	)
    (save-excursion
      (goto-char (point-min))
      (if (not (re-search-forward regex nil t))
	  (message "No marked messages")
	(beginning-of-line)
	(let ((mew-summary-refile-last-destination nil)
	      (mew-analysis nil))
	  (if (if (null folder)
		  (setq folder (mew-decide-folder))
		folder)
	      (while (re-search-forward regex nil t)
		(let ((buffer-read-only nil));; mew-summary-unmark
		  (delete-backward-char 1)
		  (insert " "))
		(mew-summary-refile-mark folder)
		(forward-line 1))
	    ))
	)
      ))
  )

(defun mew-summary-search-mark-x (prompt)
  (interactive)
  (if (equal (point-min) (point-max))
      (message "No messages in this buffer.")
    (let ((folder (buffer-name))
	  (pattern nil)
	  (first nil)
	  (last nil)
	  (range nil))
      (setq pattern (mew-pick-input-pattern-x prompt))
      (message "Picking messages in %s ..." folder)
      (goto-char (point-min))
      (setq first (mew-summary-message-number))
      (goto-char (point-max))
      (forward-line -1)
      (setq last (mew-summary-message-number))
      (setq range (mew-summary-pick folder pattern (concat first "-" last)))
      (message "Picking messages in %s ... done" folder)
      (if (null range)
	  ()
	(message "Marking messages ... ")
	(goto-char (point-min))
	(while (not (eobp))
	  (if (and (null (mew-summary-marked-p))
		   (mew-member-del (mew-summary-message-number) range))
	      (mew-summary-mark mew-mark-hop))
	  (forward-line))
	(message "Marking messages ... done")
	)
      )))

(defun mew-pick-input-pattern-x (&optional prompt)
  (mew-pick-macro-expand
   (mew-pick-input-pattern-raw-x prompt)))

(defun mew-pick-input-pattern-raw-x (&optional prompt)
  (let ((pat nil))
    (if (string= prompt "")
	(setq pat (read-from-minibuffer 
		   (format "Pattern%s (%s) : "
			    (if prompt prompt "")
			    mew-prog-pick-default-arg)
		   "-" mew-pick-map nil))
      (setq pat prompt))
    (setq pat (downcase pat))
    (cond
     ((string-match " " pat)
      (mapcar (function mew-summary-search-blace)
	      (mew-header-delete-nullstring-list
	       (mew-header-split pat 32))));; 32 is " "
     (t 
      (if (or (string= pat "") (string= pat "-"))
	  (setq pat mew-prog-pick-default-arg))
      (cond
       ((mew-member pat mew-prog-pick-arglogic-unary)
	(cons pat (mew-pick-input-pattern-raw (format " for %s" pat))))
       ((mew-member pat mew-prog-pick-arglogic-binary)
	(mew-pick-input-logic pat))
       ((mew-member pat mew-prog-pick-argdate)
	(cons pat (mew-pick-input-value (format "Date for %s" pat)
					mew-prog-pick-argdatealist)))
       ((assoc pat mew-pick-macro-alist)
	(let* ((assoc (assoc pat mew-pick-macro-alist))
	       (args (nth 1 assoc)) arg n datep res)
	  (setq res (list pat))
	  (while args
	    (setq arg (car args))
	    (setq args (cdr args))
	    (setq n (and (string-match "[0-9]+" arg) (mew-match 0 arg)))
	    (setq datep (string-match "d" arg))
	    (setq res
		  (nconc
		   (mew-pick-input-value 
		    (cond ((and n datep)
			   (format "Date arg %s for %s" n pat))
			  (n
			   (format "Arg %s for %s" n pat))
			  (datep
			   (format "Date for %s" pat))
			  (t
			   (format "Value for %s" pat)))
		    (and datep mew-prog-pick-argdatealist))
		   res)))
	  (nreverse res)))
       (t (cons pat (mew-pick-input-value (format "Value for %s" pat))))
       )
      )
    )))

(provide 'mew-my-refile)
<--- ココマデ

最後に、.emacs の中で自分の好みに合わせて、次のように
mew-my-refile-alist という連想リストを定義すれば設定は完了です。

(setq mew-my-refile-alist
      '(("-to mew-dist at example.com" . "+mew-dist")
	("-subject test" . "+test")
	("-subject baz")
	("-subject foo" . "+foo")
	("-subject bar" . "+bar")
	))

連想リストの各要素の car 部分(左側)は +inbox で ? をタイプした
時に minibuffer に入力するパターンと同じです。いわゆるプロンプト
というやつです。
cdr 部分(右側)は folder の名称を指定します。文字列の頭に + を
付けるのに気を付けてください。cdr 部分は省略することが可能で、
その場合には、folder 名は +inbox で mo とタイプした時と同じよ
うにフォルダ名が推測されインタラクティブに処理されます。上記の
例では "-subuject baz" にあたります。

作ったあとで後悔したのですが、mew-my-refile というのはちょっと
名前が悪かったかなと思っています。もっといいネーミングがあるか
もしれませんが、キーバインドも my ということで勘弁してください。

---
Pacifitech Corporation
Tomoyuki Kudou <kudou at example.com>