wl/wl-spam.el

   1 ;;; wl-spam.el --- Spam filtering interface for Wanderlust.
   2
   3 ;; Copyright (C) 2003 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
   4 ;; Copyright (C) 2003 Yuuichi Teranishi <teranisi@gohome.org>
   5
   6 ;; Author: Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
   7 ;; Keywords: mail, net news, spam
   8
   9 ;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen).
  10
  11 ;; This program is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15 ;;
  16 ;; This program is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20 ;;
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25 ;;
  26
  27 ;;; Commentary:
  28 ;;
  29
  30 ;;; Code:
  31 ;;
  32
  33 (eval-when-compile (require 'cl))
  34
  35 (require 'elmo-spam)
  36 (require 'wl-summary)
  37 (require 'wl-action)
  38
  39 (defgroup wl-spam nil
  40   "Spam configuration for wanderlust."
  41   :group 'wl)
  42
  43 (defcustom wl-spam-folder-name "+spam"
  44   "*Spam folder."
  45   :type 'string
  46   :group 'wl-spam)
  47
  48 (defcustom wl-spam-undecided-folder-regexp-list '("inbox")
  49   "*List of folder regexp which is contained undecided domain."
  50   :type '(repeat (regexp :tag "Folder Regexp"))
  51   :group 'wl-spam)
  52
  53 (defcustom wl-spam-ignored-folder-regexp-list
  54   (list (regexp-opt (list wl-draft-folder
  55                           wl-trash-folder
  56                           wl-queue-folder)))
  57   "*List of folder regexp which is contained ignored domain."
  58   :type '(repeat (regexp :tag "Folder Regexp"))
  59   :group 'wl-spam)
  60
  61 (defcustom wl-spam-auto-check-policy-alist '(("inbox" . mark))
  62   "*Alist of Folder regexp which check spam automatically and policy."
  63   :type '(repeat (cons (regexp :tag "Folder Regexp")
  64                        (choice (const :tag "Target mark" mark)
  65                                (const :tag "Refile mark" refile)
  66                                (const :tag "none" nil))))
  67   :group 'wl-spam)
  68
  69 (defun wl-spam-folder-guess-domain (folder-name)
  70   (cond ((string= folder-name wl-spam-folder-name)
  71          'spam)
  72         ((wl-string-match-member folder-name
  73                                  wl-spam-undecided-folder-regexp-list)
  74          'undecided)
  75         ((wl-string-match-member folder-name
  76                                  wl-spam-ignored-folder-regexp-list)
  77          'ignore)
  78         (t
  79          'good)))
  80
  81 (defsubst wl-spam-map-spam-messages (folder numbers function &rest args)
  82   (let ((total (length numbers)))
  83     (elmo-with-progress-display (> total elmo-display-progress-threshold)
  84         (elmo-spam-check-spam total "Checking spam...")
  85       (dolist (number (elmo-spam-list-spam-messages (elmo-spam-processor)
  86                                                     folder
  87                                                     numbers))
  88         (apply function number args)))
  89     (message "Checking spam...done")))
  90
  91 (defun wl-spam-register-spam-messages (folder numbers)
  92   (let ((total (length numbers)))
  93     (elmo-with-progress-display (> total elmo-display-progress-threshold)
  94         (elmo-spam-register total "Register spam messages...")
  95       (elmo-spam-register-spam-messages (elmo-spam-processor)
  96                                         wl-summary-buffer-elmo-folder
  97                                         numbers))
  98     (message "Register spam messages...done")))
  99
 100 (defun wl-spam-register-good-messages (folder numbers)
 101   (let ((total (length numbers)))
 102     (elmo-with-progress-display (> total elmo-display-progress-threshold)
 103         (elmo-spam-register total "Register good messages...")
 104       (elmo-spam-register-good-messages (elmo-spam-processor)
 105                                         wl-summary-buffer-elmo-folder
 106                                         numbers))
 107     (message "Register good messages...done")))
 108
 109 (defun wl-spam-save-status ()
 110   (interactive)
 111   (elmo-spam-save-status (elmo-spam-processor)))
 112
 113 ;; insinuate into summary mode
 114 (defvar wl-summary-spam-map nil)
 115
 116 (unless wl-summary-spam-map
 117   (let ((map (make-sparse-keymap)))
 118     (define-key map "*" 'wl-summary-target-mark-spam)
 119     (define-key map "o" 'wl-summary-refile-spam)
 120     (define-key map "s" 'wl-summary-register-as-spam)
 121     (define-key map "S" 'wl-summary-register-as-spam-all)
 122     (define-key map "n" 'wl-summary-register-as-good)
 123     (define-key map "N" 'wl-summary-register-as-good-all)
 124     (setq wl-summary-spam-map map)))
 125
 126 (define-key wl-summary-mode-map "k" wl-summary-spam-map)
 127
 128 (define-key wl-summary-mode-map "ms" 'wl-summary-target-mark-register-as-spam)
 129 (define-key wl-summary-mode-map "mn" 'wl-summary-target-mark-register-as-good)
 130
 131 (eval-when-compile
 132   ;; Avoid compile warnings
 133   (defalias-maybe 'wl-summary-target-mark 'ignore)
 134   (defalias-maybe 'wl-summary-refile-mark 'ignore))
 135
 136 (defun wl-summary-target-mark-spam (&optional folder)
 137   "Set target mark to messages which is guessed spam in FOLDER."
 138   (interactive)
 139   (wl-spam-map-spam-messages (or folder wl-summary-buffer-elmo-folder)
 140                              wl-summary-buffer-number-list
 141                              #'wl-summary-target-mark))
 142
 143 (defun wl-summary-refile-spam (&optional folder)
 144   "Set refile mark to messages which is guessed spam in FOLDER."
 145   (interactive)
 146   (wl-spam-map-spam-messages (or folder wl-summary-buffer-elmo-folder)
 147                              wl-summary-buffer-number-list
 148                              #'wl-summary-refile
 149                              wl-spam-folder-name))
 150
 151 (defun wl-summary-register-as-spam ()
 152   (interactive)
 153   (let ((number (wl-summary-message-number)))
 154     (when number
 155       (wl-spam-register-spam-messages wl-summary-buffer-elmo-folder
 156                                       (list number)))))
 157
 158 (defun wl-summary-register-as-spam-all ()
 159   (interactive)
 160   (wl-spam-register-spam-messages wl-summary-buffer-elmo-folder
 161                                   wl-summary-buffer-number-list))
 162
 163 (defun wl-summary-target-mark-register-as-spam ()
 164   (interactive)
 165   (save-excursion
 166     (goto-char (point-min))
 167     (let ((inhibit-read-only t)
 168           (buffer-read-only nil)
 169           wl-summary-buffer-disp-msg)
 170       (wl-spam-register-spam-messages wl-summary-buffer-elmo-folder
 171                                       wl-summary-buffer-target-mark-list)
 172       (dolist (number wl-summary-buffer-target-mark-list)
 173         (wl-summary-unset-mark number)))))
 174
 175 (defun wl-summary-register-as-good ()
 176   (interactive)
 177   (let ((number (wl-summary-message-number)))
 178     (when number
 179       (wl-spam-register-good-messages wl-summary-buffer-elmo-folder
 180                                       (list number)))))
 181
 182 (defun wl-summary-register-as-good-all ()
 183   (interactive)
 184   (wl-spam-register-good-messages wl-summary-buffer-elmo-folder
 185                                   wl-summary-buffer-number-list))
 186
 187 (defun wl-summary-target-mark-register-as-good ()
 188   (interactive)
 189   (save-excursion
 190     (goto-char (point-min))
 191     (let ((inhibit-read-only t)
 192           (buffer-read-only nil)
 193           wl-summary-buffer-disp-msg)
 194       (wl-spam-register-good-messages wl-summary-buffer-elmo-folder
 195                                       wl-summary-buffer-target-mark-list)
 196       (dolist (number wl-summary-buffer-target-mark-list)
 197         (wl-summary-unset-mark number)))))
 198
 199 ;; hook functions and other
 200 (defun wl-summary-auto-check-spam ()
 201   (case (cdr (elmo-string-matched-assoc (wl-summary-buffer-folder-name)
 202                                         wl-spam-auto-check-policy-alist))
 203     (mark
 204      (wl-summary-target-mark-spam))
 205     (refile
 206      (wl-summary-refile-spam))))
 207
 208 (defun wl-summary-exec-action-refile-with-register (mark-list)
 209   (let ((processor (elmo-spam-processor))
 210         (folder wl-summary-buffer-elmo-folder)
 211         spam-list good-list)
 212     (when (eq (wl-spam-folder-guess-domain
 213                (elmo-folder-name-internal folder))
 214               'undecided)
 215       (dolist (info mark-list)
 216         (case (wl-spam-folder-guess-domain (nth 2 info))
 217           (spam
 218            (setq spam-list (cons (car info) spam-list)))
 219           (good
 220            (setq good-list (cons (car info) good-list)))))
 221       (let ((total (+ (length spam-list) (length good-list))))
 222         (elmo-with-progress-display (> total elmo-display-progress-threshold)
 223             (elmo-spam-register total "Register spam...")
 224           (when spam-list
 225             (elmo-spam-register-spam-messages processor folder spam-list))
 226           (when good-list
 227             (elmo-spam-register-good-messages processor folder good-list)))
 228         (message "Register spam...done")))
 229     ;; execute refile messages
 230     (wl-summary-exec-action-refile mark-list)))
 231
 232 (defun wl-refile-guess-by-spam (entity)
 233   (when (elmo-spam-message-spam-p (elmo-spam-processor)
 234                                   wl-summary-buffer-elmo-folder
 235                                   (elmo-message-entity-number entity))
 236     wl-spam-folder-name))
 237
 238 (require 'product)
 239 (product-provide (provide 'wl-spam) (require 'wl-version))
 240
 241 ;;; wl-sapm.el ends here