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