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 (require 'wl-highlight)
  39
  40 (defgroup wl-spam nil
  41   "Spam configuration for wanderlust."
  42   :group 'wl)
  43
  44 (defcustom wl-spam-folder-name "+spam"
  45   "*Spam folder."
  46   :type 'string
  47   :group 'wl-spam)
  48
  49 (defcustom wl-spam-undecided-folder-regexp-list '("inbox")
  50   "*List of folder regexp which is contained undecided domain."
  51   :type '(repeat (regexp :tag "Folder Regexp"))
  52   :group 'wl-spam)
  53
  54 (defcustom wl-spam-ignored-folder-regexp-list
  55   (list (regexp-opt (list wl-draft-folder
  56                           wl-trash-folder
  57                           wl-queue-folder)))
  58   "*List of folder regexp which is contained ignored domain."
  59   :type '(repeat (regexp :tag "Folder Regexp"))
  60   :group 'wl-spam)
  61
  62 (defcustom wl-spam-auto-check-folder-regexp-list '("[+.]inbox")
  63   "*List of Folder regexp which check spam automatically."
  64   :type '(repeat (regexp :tag "Folder Regexp"))
  65   :group 'wl-spam)
  66
  67 (defcustom wl-spam-auto-check-marks
  68   (list wl-summary-new-mark)
  69   "Persistent marks to check spam automatically."
  70   :type '(choice (const :tag "All marks" all)
  71                  (repeat (string :tag "Mark")))
  72   :group 'wl-spam)
  73
  74 (wl-defface wl-highlight-summary-spam-face
  75   '((((type tty)
  76       (background dark))
  77      (:foreground "blue"))
  78     (((class color))
  79      (:foreground "LightSlateGray")))
  80   "Face used for displaying messages mark as spam."
  81   :group 'wl-summary-faces
  82   :group 'wl-faces)
  83
  84 (defcustom wl-spam-mark-action-list
  85   '(("s"
  86      spam
  87      nil
  88      wl-summary-register-temp-mark
  89      wl-summary-exec-action-spam
  90      wl-highlight-summary-spam-face
  91      "Mark messages as spam."))
  92   "A variable to define Mark & Action for spam.
  93 Append this value to `wl-summary-mark-action-list' by `wl-spam-setup'.
  94
  95 See `wl-summary-mark-action-list' for the detail of element."
  96   :type '(repeat (string :tag "Temporary mark")
  97                  (symbol :tag "Set mark function")
  98                  (symbol :tag "Unset mark function")
  99                  (symbol :tag "Exec function")
 100                  (symbol :tag "Face symbol")
 101                  (string :tag "Document string"))
 102   :group 'wl-spam)
 103
 104 (defun wl-spam-domain (folder-name)
 105   (cond ((string= folder-name wl-spam-folder-name)
 106          'spam)
 107         ((wl-string-match-member folder-name
 108                                  wl-spam-undecided-folder-regexp-list)
 109          'undecided)
 110         ((wl-string-match-member folder-name
 111                                  wl-spam-ignored-folder-regexp-list)
 112          'ignore)
 113         (t
 114          'good)))
 115
 116 (defsubst wl-spam-auto-check-message-p (folder number)
 117   (or (eq wl-spam-auto-check-marks 'all)
 118       (member (wl-summary-message-mark folder number)
 119               wl-spam-auto-check-marks)))
 120
 121 (defsubst wl-spam-map-spam-messages (folder numbers function &rest args)
 122   (let ((total (length numbers)))
 123     (message "Checking spam...")
 124     (elmo-with-progress-display (> total elmo-display-progress-threshold)
 125         (elmo-spam-check-spam total "Checking spam...")
 126       (dolist (number (elmo-spam-list-spam-messages (elmo-spam-processor)
 127                                                     folder
 128                                                     numbers))
 129         (apply function number args)))
 130     (message "Checking spam...done")))
 131
 132 (defun wl-spam-register-spam-messages (folder numbers)
 133   (let ((total (length numbers)))
 134     (message "Registering spam...")
 135     (elmo-with-progress-display (> total elmo-display-progress-threshold)
 136         (elmo-spam-register total "Registering spam...")
 137       (elmo-spam-register-spam-messages (elmo-spam-processor)
 138                                         wl-summary-buffer-elmo-folder
 139                                         numbers))
 140     (message "Registering spam...done")))
 141
 142 (defun wl-spam-register-good-messages (folder numbers)
 143   (let ((total (length numbers)))
 144     (message "Registering good...")
 145     (elmo-with-progress-display (> total elmo-display-progress-threshold)
 146         (elmo-spam-register total "Registering good...")
 147       (elmo-spam-register-good-messages (elmo-spam-processor)
 148                                         wl-summary-buffer-elmo-folder
 149                                         numbers))
 150     (message "Registering good...done")))
 151
 152 (defun wl-spam-save-status (&optional force)
 153   (interactive "P")
 154   (let ((processor (elmo-spam-processor)))
 155     (when (or force (elmo-spam-modified-p processor))
 156       (elmo-spam-save-status processor))))
 157
 158 ;; insinuate into summary mode
 159 (defvar wl-summary-spam-map nil)
 160
 161 (unless wl-summary-spam-map
 162   (let ((map (make-sparse-keymap)))
 163     (define-key map "m" 'wl-summary-spam)
 164     (define-key map "c" 'wl-summary-test-spam)
 165     (define-key map "C" 'wl-summary-mark-spam)
 166     (define-key map "s" 'wl-summary-register-as-spam)
 167     (define-key map "S" 'wl-summary-register-as-spam-all)
 168     (define-key map "n" 'wl-summary-register-as-good)
 169     (define-key map "N" 'wl-summary-register-as-good-all)
 170     (setq wl-summary-spam-map map)))
 171
 172 (eval-when-compile
 173   ;; Avoid compile warnings
 174   (defalias-maybe 'wl-summary-spam 'ignore))
 175
 176 (defun wl-summary-test-spam (&optional folder number)
 177   (interactive)
 178   (let ((folder (or folder wl-summary-buffer-elmo-folder))
 179         (number (or number (wl-summary-message-number)))
 180         spam)
 181     (message "Cheking spam...")
 182     (when (setq spam (elmo-spam-message-spam-p (elmo-spam-processor)
 183                                                folder number))
 184       (wl-summary-spam number))
 185     (message "Cheking spam...done")
 186     (when (interactive-p)
 187       (message "No: %d is %sa spam message." number (if spam "" "not ")))))
 188
 189 (defun wl-summary-mark-spam (&optional all)
 190   "Set spam mark to messages which is spam classification."
 191   (interactive "P")
 192   (let (numbers)
 193     (if all
 194         (setq numbers wl-summary-buffer-number-list)
 195       (dolist (number wl-summary-buffer-number-list)
 196         (when (wl-spam-auto-check-message-p wl-summary-buffer-elmo-folder
 197                                             number)
 198           (setq numbers (cons number numbers)))))
 199     (if numbers
 200         (wl-spam-map-spam-messages wl-summary-buffer-elmo-folder
 201                                    numbers
 202                                    #'wl-summary-spam)
 203       (message "No message to test."))))
 204
 205 (defun wl-summary-register-as-spam ()
 206   (interactive)
 207   (let ((number (wl-summary-message-number)))
 208     (when number
 209       (wl-spam-register-spam-messages wl-summary-buffer-elmo-folder
 210                                       (list number)))))
 211
 212 (defun wl-summary-register-as-spam-all ()
 213   (interactive)
 214   (wl-spam-register-spam-messages wl-summary-buffer-elmo-folder
 215                                   wl-summary-buffer-number-list))
 216
 217 (defun wl-summary-target-mark-register-as-spam ()
 218   (interactive)
 219   (save-excursion
 220     (goto-char (point-min))
 221     (let ((inhibit-read-only t)
 222           (buffer-read-only nil)
 223           wl-summary-buffer-disp-msg)
 224       (wl-spam-register-spam-messages wl-summary-buffer-elmo-folder
 225                                       wl-summary-buffer-target-mark-list)
 226       (dolist (number wl-summary-buffer-target-mark-list)
 227         (wl-summary-unset-mark number)))))
 228
 229 (defun wl-summary-register-as-good ()
 230   (interactive)
 231   (let ((number (wl-summary-message-number)))
 232     (when number
 233       (wl-spam-register-good-messages wl-summary-buffer-elmo-folder
 234                                       (list number)))))
 235
 236 (defun wl-summary-register-as-good-all ()
 237   (interactive)
 238   (wl-spam-register-good-messages wl-summary-buffer-elmo-folder
 239                                   wl-summary-buffer-number-list))
 240
 241 (defun wl-summary-target-mark-register-as-good ()
 242   (interactive)
 243   (save-excursion
 244     (goto-char (point-min))
 245     (let ((inhibit-read-only t)
 246           (buffer-read-only nil)
 247           wl-summary-buffer-disp-msg)
 248       (wl-spam-register-good-messages wl-summary-buffer-elmo-folder
 249                                       wl-summary-buffer-target-mark-list)
 250       (dolist (number wl-summary-buffer-target-mark-list)
 251         (wl-summary-unset-mark number)))))
 252
 253 ;; hook functions and other
 254 (defun wl-summary-auto-check-spam ()
 255   (when (elmo-string-match-member (wl-summary-buffer-folder-name)
 256                                   wl-spam-auto-check-folder-regexp-list)
 257     (wl-summary-mark-spam)))
 258
 259 (defun wl-summary-exec-action-spam (mark-list)
 260   (let ((domain (wl-spam-domain (elmo-folder-name-internal
 261                                  wl-summary-buffer-elmo-folder)))
 262         (total (length mark-list)))
 263     (when (memq domain '(undecided good))
 264       (message "Registering spam...")
 265       (elmo-with-progress-display (> total elmo-display-progress-threshold)
 266           (elmo-spam-register total "Registering spam...")
 267         (elmo-spam-register-spam-messages (elmo-spam-processor)
 268                                           wl-summary-buffer-elmo-folder
 269                                           (mapcar #'car mark-list)
 270                                           (eq domain 'good)))
 271       (message "Registering spam...done"))
 272     (wl-summary-move-mark-list-messages mark-list
 273                                         wl-spam-folder-name
 274                                         "Refiling spam...")))
 275
 276 (defun wl-summary-exec-action-refile-with-register (mark-list)
 277   (let* ((processor (elmo-spam-processor))
 278          (folder wl-summary-buffer-elmo-folder)
 279          (domain (wl-spam-domain (elmo-folder-name-internal folder)))
 280          spam-list good-list total)
 281     (unless (eq domain 'ignore)
 282       (dolist (info mark-list)
 283         (case (wl-spam-domain (nth 2 info))
 284           (spam
 285            (setq spam-list (cons (car info) spam-list)))
 286           (good
 287            (setq good-list (cons (car info) good-list)))))
 288       (case domain
 289         (spam (setq spam-list nil))
 290         (good (setq good-list nil)))
 291       (when (or spam-list good-list)
 292         (message "Registering spam...")
 293         (setq total (+ (length spam-list) (length good-list)))
 294         (elmo-with-progress-display (> total elmo-display-progress-threshold)
 295             (elmo-spam-register total "Registering spam...")
 296           (when spam-list
 297             (elmo-spam-register-spam-messages processor folder spam-list
 298                                               (eq domain 'good)))
 299           (when good-list
 300             (elmo-spam-register-good-messages processor folder good-list
 301                                               (eq domain 'spam))))
 302         (message "Registering spam...done")))
 303     ;; execute refile messages
 304     (wl-summary-exec-action-refile mark-list)))
 305
 306 (defun wl-message-check-spam ()
 307   (let ((original (wl-message-get-original-buffer))
 308         (number wl-message-buffer-cur-number)
 309         spam)
 310     (message "Cheking spam...")
 311     (when (elmo-spam-buffer-spam-p (elmo-spam-processor) original)
 312       (with-current-buffer wl-message-buffer-cur-summary-buffer
 313         (wl-summary-spam number)))
 314     (message "Cheking spam...done")
 315     (when (interactive-p)
 316       (message "No: %d is %sa spam message." number (if spam "" "not ")))))
 317
 318 (defun wl-refile-guess-by-spam (entity)
 319   (when (elmo-spam-message-spam-p (elmo-spam-processor)
 320                                   wl-summary-buffer-elmo-folder
 321                                   (elmo-message-entity-number entity))
 322     wl-spam-folder-name))
 323
 324 (defun wl-spam-setup ()
 325   (when wl-spam-mark-action-list
 326     (setq wl-summary-mark-action-list (append
 327                                        wl-summary-mark-action-list
 328                                        wl-spam-mark-action-list))
 329     (dolist (action wl-spam-mark-action-list)
 330       (setq wl-summary-reserve-mark-list
 331             (cons (wl-summary-action-mark action)
 332                   wl-summary-reserve-mark-list))
 333       (setq wl-summary-skip-mark-list
 334             (cons (wl-summary-action-mark action)
 335                   wl-summary-skip-mark-list))))
 336   (define-key wl-summary-mode-map "k" wl-summary-spam-map)
 337   (define-key wl-summary-mode-map "ms" 'wl-summary-target-mark-register-as-spam)
 338   (define-key wl-summary-mode-map "mn" 'wl-summary-target-mark-register-as-good))
 339
 340 (require 'product)
 341 (product-provide (provide 'wl-spam) (require 'wl-version))
 342
 343 (unless noninteractive
 344   (wl-spam-setup))
 345
 346 ;;; wl-spam.el ends here