[Mew-dist 10164] mew-sol.el: marking 'solicited messages' in summary mode

[sen_ml at example.com]

folder 内のメッセージで、From: address が AddrBook にあるものだけを mark
するコードを書いてみました。正確には mew-addrbook-alist から抽出した 
address をもとに mark します。

インストール方法は mew-sol.el を load-path 上におき、.emacs に

  (add-hook 'mew-init-hook (lambda () (require 'mew-sol)))

と記述するだけです。

`mew-summary-mark-sol' というコマンドを提供してくれます。

＃ まだ AddrBook に登録を行っていない address を探すのにもつかえるかも
-------------- next part --------------
;;; mew-sol.el --- mark messages w/ From: matching addresses in AddrBook

;;; Written by: Sen Nagata <sen at example.com>
;;; Important Note: most of the functions in here are based on code in
;;;                 mew-picks.el which was not written by me

;; Keywords: solicited, mew
;; Version: 0.1

;;; Commentary:
;;
;; installation:
;;
;;   -put this file in an appropriate directory so emacs can find it
;;
;;   -put:
;;
;;     (add-hook 'mew-init-hook (lambda () (require 'mew-sol)))
;;
;;    in .emacs (or wherever you place your mew settings)
;;
;; usage:
;;
;;   -invoke mew
;;
;;   -use the command `mew-summary-mark-sol' to mark solicited
;;    messages for a given folder in summary mode.  by 'solicited messages'
;;    i mean messages w/ From: addresses that appear in AddrBook
;;
;; todo:
;;
;;   -implement marking unsolicited messages.
;;
;; notes:
;;
;;   -hacked mew-dups.el :-)

;;; History:
;;
;; 0.1:
;;
;;  initial implementation

;;; Code:
(defconst mew-sol-version "mew-sol.el 0.1")

(defconst mew-sol-address-alist nil
  "Association list of addresses from which mail is solicited.")

;; based heavily on `mew-summary-search-mark'
(defun mew-summary-mark-sol (&optional arg)
  "Pick solicited messages."
  (interactive "P")
  (mew-summary-only
   (if arg
       (mew-summary-mark-sol-region (region-beginning) (region-end))
     (mew-summary-mark-sol-region (point-min) (point-max)))))

;; based heavily on `mew-summary-search-mark-region'
;; there are basically two major changes:
;;
;;   1) no pattern
;;   2) call mew-summary-pick-sol instead of mew-summary-pick
;;
(defun mew-summary-mark-sol-region (r1 r2)
  (interactive "r")
  (if (equal (point-min) (point-max))
      (message "No messages in this buffer.")
    (let ((folder (buffer-name))
	  first last range)
      (message "Picking messages in %s ..." folder)
      (goto-char r1)
      (if (eobp)
	  () ;; r1 <= r2, so if r1 = (point-max) then no message.
	(setq first (mew-summary-message-number))
	(goto-char r2)
	(if (eobp)
	    (progn
	      (forward-line -1)
	      (setq r2 (point))))
	(setq last (mew-summary-message-number))
	;; this is the major change
	(setq range (mew-summary-pick-sol folder (concat first "-" last))))
      (message "Picking messages in %s ... done" folder)
      (if (null range)
	  (message "No message to be marked.")
	(message "Marking messages ... ")
	(goto-char r1)
	(while (and range (< (point) r2))
	  (if (re-search-forward (format "^[ ]*%s[^0-9]" (car range)) nil t)
	      (if (not (mew-summary-marked-p))
		  (mew-summary-mark-as mew-mark-review)))
	  (setq range (cdr range)))
	(beginning-of-line)
	(set-buffer-modified-p nil)
	(message "Marking messages ... done")))))

;; based heavily on `mew-summary-pick'
(defun mew-summary-pick-sol (folder &optional range)
  (let (msgs address)
    (setq range (or range "all"))
    (save-excursion
      (mew-set-buffer-tmp)
      (mew-im-call-process nil mew-prog-imls
			   (format "--src=%s" folder)
			   "--form=%n %P"
			   range)

      ;; imls doesn't fail?
      ;; two sections removed that were in mew-summary-picks

      (goto-char (point-min))
      (while (not (eobp))
	;; why are there trailing spaces?
	;; cheating on regex for address probably...
	(if (re-search-forward "^\\([0-9]+\\) \\([^ ]+\\) .*$")
	    (if (assoc (mew-match 2) mew-sol-address-alist)
		(setq msgs (cons (mew-match 1) msgs))))
	(forward-line))
      (nreverse msgs))))

(defun mew-sol-get-addresses-from-addrbook ()
  "Build `mew-sol-address-alist' from `mew-addrbook-alist'. "
  (let (result-alist)
    (mapcar

     (lambda (x)
       ;; we are looking for elements of mew-addrbook-alist which are
       ;; lists of email addresses
       (if (listp (car (cdr x)))
	   (mapcar
	    ;; create a cons cell using each email address and add the result
	    ;; to our alist
	    (lambda (y)
	      (setq result-alist
		    (cons (cons y "")
			  result-alist)))
	    (car (cdr x)))))

     mew-addrbook-alist)
    result-alist))

(defun mew-sol-make-address-alist ()
  (setq mew-sol-address-alist (mew-sol-get-addresses-from-addrbook)))

;; this needs to happen after AddrBook is read in...unfortunately,
;; that happens after mew-init-hook -- so my hack for the moment is to
;; use advice
(require 'advice)
(defadvice mew-status-update (after mew-sol-address-alist-calc activate)
  (mew-sol-make-address-alist))

; why didn't using mew-addrbook-make-alist work?
;(defadvice mew-addrbook-make-alist (after mew-sol-address-alist-calc activate)

(provide 'mew-sol)

;;; mew-sol.el ends here