cgit.sxemacs.org Git - packages/blob - xemacs-packages/mew/mew/contrib/mew-sol.el

   1 ;;; mew-sol.el --- mark messages w/ From: matching addresses in Addrbook
   2
   3 ;;; Written by: Sen Nagata <sen@eccosys.com>
   4 ;;; Important Note: most of the functions in here are based on code in
   5 ;;;                 mew-picks.el which was not written by me
   6
   7 ;; Keywords: solicited, unsolicited, mew
   8 ;; Version: 0.3
   9
  10 ;;; Commentary:
  11 ;;
  12 ;; installation:
  13 ;;
  14 ;;   -put this file in an appropriate directory so emacs can find it
  15 ;;
  16 ;;   -put:
  17 ;;
  18 ;;     (add-hook 'mew-init-hook (lambda () (require 'mew-sol)))
  19 ;;
  20 ;;    in .emacs (or wherever you place your mew settings)
  21 ;;
  22 ;; usage:
  23 ;;
  24 ;;   -invoke mew
  25 ;;
  26 ;;   -use the command `mew-summary-mark-sol' to mark solicited
  27 ;;    messages for a given folder in summary mode.  by 'solicited messages'
  28 ;;    i mean messages w/ From: addresses that appear in Addrbook
  29 ;;
  30 ;;   -use the command `mew-summary-mark-unsol' to mark unsolicited
  31 ;;    messages for a given folder in summary mode.  by 'unsolicited messages'
  32 ;;    i mean messages w/ From: addresses that do not appear in Addrbook
  33 ;;
  34 ;; notes:
  35 ;;
  36 ;;   -hacked mew-dups.el :-)
  37
  38 ;;; History:
  39 ;;
  40 ;; 0.3:
  41 ;;
  42 ;;  patches from Hideyuki SHIRAI <shirai@rdmg.mgcs.mei.co.jp> for
  43 ;;  `mew-summary-pick-unsol' and the defadvice bit (`mew-status-update' ->
  44 ;;  `mew-addrbook-setup')
  45 ;;
  46 ;; 0.2:
  47 ;;
  48 ;;  first version of `mew-summary-mark-unsol'
  49 ;;  thanks to Hideyuki SHIRAI <shirai@rdmg.mgcs.mei.co.jp> for help
  50 ;;
  51 ;;  abstracted out portions of `mew-summary-mark-sol-region' as
  52 ;;  `mew-summary-mark-region-skel' and implemented a second version of
  53 ;;  `mew-summary-mark-unsol-region'
  54 ;;
  55 ;; 0.1:
  56 ;;
  57 ;;  initial implementation
  58
  59 ;;; Code:
  60 (defconst mew-sol-version "mew-sol.el 0.3")
  61
  62 (defconst mew-sol-address-alist nil
  63   "Association list of addresses from which mail is solicited.")
  64
  65 ;; based heavily on `mew-summary-search-mark-region'
  66 ;; there are basically two major changes:
  67 ;;
  68 ;;   1) no pattern
  69 ;;   2) can call functions other than `mew-summary-pick'
  70 ;;
  71 (defun mew-summary-mark-region-skel (r1 r2 pick-function)
  72   (if (equal (point-min) (point-max))
  73       (message "No messages in this buffer.")
  74     (let ((folder (buffer-name))
  75           first last range)
  76       (message "Picking messages in %s ..." folder)
  77       (goto-char r1)
  78       (if (eobp)
  79           () ;; r1 <= r2, so if r1 = (point-max) then no message.
  80         (setq first (mew-summary-message-number))
  81         (goto-char r2)
  82         (if (eobp)
  83             (progn
  84               (forward-line -1)
  85               (setq r2 (point))))
  86         (setq last (mew-summary-message-number))
  87         ;; this is the major change
  88         (setq range
  89               (apply pick-function (list folder (concat first "-" last)))))
  90       (message "Picking messages in %s ... done" folder)
  91       (if (null range)
  92           (message "No message to be marked.")
  93         (message "Marking messages ... ")
  94         (goto-char r1)
  95         (while (and range (< (point) r2))
  96           (if (re-search-forward (format "^[ ]*%s[^0-9]" (car range)) nil t)
  97               (if (not (mew-summary-marked-p))
  98                   (mew-summary-mark-as mew-mark-review)))
  99           (setq range (cdr range)))
 100         (beginning-of-line)
 101         (set-buffer-modified-p nil)
 102         (message "Marking messages ... done")))))
 103
 104 ;; based heavily on `mew-summary-pick'
 105 (defun mew-summary-pick-sol (folder &optional range)
 106   (let (msgs address)
 107     (setq range (or range "all"))
 108     (save-excursion
 109       (mew-set-buffer-tmp)
 110       (mew-im-call-process nil mew-prog-imls
 111                            (format "--src=%s" folder)
 112                            "--form=%n %P"
 113                            range)
 114
 115       ;; imls doesn't fail?
 116       ;; two sections removed that were in mew-summary-picks
 117
 118       (goto-char (point-min))
 119       (while (not (eobp))
 120         ;; why are there trailing spaces?
 121         ;; cheating on regex for address probably...
 122         (if (re-search-forward "^\\([0-9]+\\) \\([^ ]+\\) .*$")
 123             (if (assoc (mew-match 2) mew-sol-address-alist)
 124                 (setq msgs (cons (mew-match 1) msgs))))
 125         (forward-line))
 126       (nreverse msgs))))
 127
 128 ;; based heavily on `mew-summary-pick'
 129 (defun mew-summary-pick-unsol (folder &optional range)
 130   (let (msgs address)
 131     (setq range (or range "all"))
 132     (save-excursion
 133       (mew-set-buffer-tmp)
 134       (mew-im-call-process nil mew-prog-imls
 135                            (format "--src=%s" folder)
 136                            "--form=%n %P"
 137                            range)
 138
 139       ;; imls doesn't fail?
 140       ;; two sections removed that were in mew-summary-picks
 141
 142       (goto-char (point-min))
 143       (while (not (eobp))
 144         ;; why are there trailing spaces?
 145         ;; cheating on regex for address probably...
 146         (if (re-search-forward "^\\([0-9]+\\) \\([^ ]+\\) .*$")
 147             (if (and (not (assoc (mew-match 2) mew-sol-address-alist))
 148                      (not (string-match "^to:" (mew-match 2))))
 149                 (setq msgs (cons (mew-match 1) msgs))))
 150         (forward-line))
 151       (nreverse msgs))))
 152
 153 (defun mew-summary-mark-sol-region (r1 r2)
 154   (interactive "r")
 155   (mew-summary-mark-region-skel r1 r2 'mew-summary-pick-sol))
 156
 157 (defun mew-summary-mark-unsol-region (r1 r2)
 158   (interactive "r")
 159   (mew-summary-mark-region-skel r1 r2 'mew-summary-pick-unsol))
 160
 161 ;; based heavily on `mew-summary-search-mark'
 162 (defun mew-summary-mark-skel (region-function &optional arg)
 163   (mew-summary-only
 164    (if arg
 165        (apply region-function (list (region-beginning) (region-end)))
 166      (apply region-function (list (point-min) (point-max))))))
 167
 168 (defun mew-summary-mark-sol (&optional arg)
 169   "Pick solicited messages."
 170   (interactive "P")
 171   (mew-summary-mark-skel 'mew-summary-mark-sol-region arg))
 172
 173 (defun mew-summary-mark-unsol (&optional arg)
 174   "Pick unsolicited messages."
 175   (interactive "P")
 176   (mew-summary-mark-skel 'mew-summary-mark-unsol-region arg))
 177
 178 (defun mew-sol-get-addresses-from-addrbook ()
 179   "Build `mew-sol-address-alist' from `mew-addrbook-alist'. "
 180   (let (result-alist)
 181     (mapcar
 182
 183      (lambda (x)
 184        ;; we are looking for elements of mew-addrbook-alist which are
 185        ;; lists of email addresses
 186        (if (listp (car (cdr x)))
 187            (mapcar
 188             ;; create a cons cell using each email address and add the result
 189             ;; to our alist
 190             (lambda (y)
 191               (setq result-alist
 192                     (cons (cons y "")
 193                           result-alist)))
 194             (car (cdr x)))))
 195
 196      mew-addrbook-alist)
 197     result-alist))
 198
 199 (defun mew-sol-make-address-alist ()
 200   (setq mew-sol-address-alist (mew-sol-get-addresses-from-addrbook)))
 201
 202 ;; this needs to happen after Addrbook is read in...unfortunately,
 203 ;; that happens after mew-init-hook -- so my hack for the moment is to
 204 ;; use advice
 205 (require 'advice)
 206 (defadvice mew-addrbook-setup (after mew-sol-address-alist-calc activate)
 207   (mew-sol-make-address-alist))
 208
 209 ; why didn't using mew-addrbook-make-alist work?  however, it looks like
 210 ; `mew-status-update' might be a good place to do things anyway
 211 ;(defadvice mew-addrbook-make-alist (after mew-sol-address-alist-calc activate)
 212
 213
 214 (provide 'mew-sol)
 215
 216 ;;; mew-sol.el ends here
 217
 218 ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 219
 220 ; ;; by Hideyuki SHIRAI <shirai@rdmg.mgcs.mei.co.jp>
 221 ; (defun mew-summary-mark-exchange (&optional arg)
 222 ;   (interactive "P")
 223 ;   (let ((mark-tmp ?#))
 224 ;     (mew-summary-exchange-mark mew-mark-multi mark-tmp)
 225 ;     (mew-summary-mark-swap)
 226 ;     (mew-summary-mark-all)
 227 ;     (if (not arg)
 228 ;       (mew-summary-batch-unmark (list mew-mark-multi) nil))
 229 ;     (mew-summary-exchange-mark mark-tmp mew-mark-multi))
 230 ;   (message "Marks exchanged."))
 231
 232 ; ;; quick hack version
 233 ; (defun mew-summary-mark-unsol (&optional arg)
 234 ;   "Pick unsolicited messages."
 235 ;   (interactive "P")
 236 ;   (if arg
 237 ;       (mew-summary-mark-sol arg)
 238 ;     (mew-summary-mark-sol))
 239 ;   (mew-summary-mark-swap)
 240 ;   (mew-summary-mark-all)
 241 ;   ;; from `mew-summary-undo-all'
 242 ;   (let ((char ?@))
 243 ;     (mew-summary-batch-unmark (list char) 'msg)))
 244
 245 ; (defun mew-summary-mark-unsol (&optional arg)
 246 ;   "Pick unsolicited messages."
 247 ;   (interactive "P")
 248 ;   (if arg
 249 ;       (mew-summary-mark-sol arg)
 250 ;     (mew-summary-mark-sol))
 251 ;   (mew-summary-mark-exchange))
 252
 253 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;