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