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   (elmo-with-progress-display (elmo-spam-check-spam (length numbers))
 157       "Checking spam"
 158     (dolist (number (elmo-spam-list-spam-messages (elmo-spam-processor)
 159                                                   folder
 160                                                   numbers))
 161       (apply function number args))))
 162
 163 (defun wl-spam-apply-partitions (folder partitions function msg)
 164   (when partitions
 165     (let ((total 0))
 166       (dolist (partition partitions)
 167         (setq total (+ total (length (cdr partition)))))
 168       (elmo-with-progress-display (elmo-spam-register total) msg
 169         (dolist (partition partitions)
 170           (funcall function folder (cdr partition) (car partition)))))))
 171
 172 (defun wl-spam-register-spam-messages (folder numbers)
 173   "Register messages specified by FOLDER and NUMBERS as spam.
 174 Put spam mark unless FOLDER is a spam folder."
 175   (elmo-with-progress-display (elmo-spam-register (length numbers))
 176       "Registering spam"
 177     (elmo-spam-register-spam-messages (elmo-spam-processor)
 178                                       folder
 179                                       numbers))
 180   (unless (eq (wl-spam-domain (elmo-folder-name-internal folder))
 181               'spam)
 182     (dolist (number numbers)
 183       (wl-summary-spam number))))
 184
 185 (defun wl-spam-register-good-messages (folder numbers)
 186   "Register messages specified by FOLDER and NUMBERS as non-spam.
 187 Remove spam mark."
 188   (elmo-with-progress-display (elmo-spam-register (length numbers))
 189       "Registering good"
 190     (elmo-spam-register-good-messages (elmo-spam-processor)
 191                                       folder
 192                                       numbers))
 193   (dolist (number numbers)
 194     (wl-summary-unmark-spam number)))
 195
 196 (defun wl-spam-save-status (&optional force)
 197   (interactive "P")
 198   (let ((processor (elmo-spam-processor (not force))))
 199     (when (or force
 200               (and processor (elmo-spam-modified-p processor)))
 201       (elmo-spam-save-status processor))))
 202
 203 ;; insinuate into summary mode
 204 (defvar wl-summary-spam-map nil)
 205
 206 (unless wl-summary-spam-map
 207   (let ((map (make-sparse-keymap)))
 208     (define-key map "m" 'wl-summary-spam)
 209     (define-key map "c" 'wl-summary-test-spam)
 210     (define-key map "C" 'wl-summary-mark-spam)
 211     (define-key map "s" 'wl-summary-register-as-spam)
 212     (define-key map "S" 'wl-summary-register-as-spam-all)
 213     (define-key map "n" 'wl-summary-register-as-good)
 214     (define-key map "N" 'wl-summary-register-as-good-all)
 215     (setq wl-summary-spam-map map)))
 216
 217 (eval-when-compile
 218   ;; Avoid compile warnings
 219   (defalias-maybe 'wl-summary-spam 'ignore)
 220   (defalias-maybe 'wl-summary-unmark-spam 'ignore))
 221
 222 (defun wl-summary-test-spam (&optional folder number)
 223   (interactive)
 224   (let ((folder (or folder wl-summary-buffer-elmo-folder))
 225         (number (or number (wl-summary-message-number)))
 226         spam)
 227     (message "Checking spam...")
 228     (if (setq spam (elmo-spam-message-spam-p (elmo-spam-processor)
 229                                              folder number))
 230         (wl-summary-spam number)
 231       (wl-summary-unmark-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-messages (folder numbers &rest args)
 237   (elmo-with-progress-display (elmo-spam-check-spam (length numbers))
 238       "Checking spam"
 239     (let* ((spams (elmo-spam-list-spam-messages (elmo-spam-processor)
 240                                                 folder
 241                                                 numbers))
 242            (goods (car (elmo-list-diff numbers spams))))
 243       (dolist (number spams)
 244         (wl-summary-spam number args))
 245       (dolist (number goods)
 246         (wl-summary-unmark-spam number)))))
 247
 248 (defun wl-summary-test-spam-region (beg end)
 249   (interactive "r")
 250   (let ((numbers (wl-summary-collect-numbers-region beg end)))
 251     (cond (numbers
 252            (wl-summary-test-spam-messages wl-summary-buffer-elmo-folder
 253                                           numbers))
 254           ((interactive-p)
 255            (message "No message to test.")))))
 256
 257 (defun wl-thread-test-spam (&optional arg)
 258   (interactive "P")
 259   (wl-thread-call-region-func 'wl-summary-test-spam-region arg))
 260
 261 (defun wl-summary-mark-spam (&optional all)
 262   "Set spam mark to messages which is spam classification."
 263   (interactive "P")
 264   (let (numbers)
 265     (if all
 266         (setq numbers wl-summary-buffer-number-list)
 267       (dolist (number wl-summary-buffer-number-list)
 268         (when (wl-spam-auto-check-message-p wl-summary-buffer-elmo-folder
 269                                             number)
 270           (setq numbers (cons number numbers)))))
 271     (cond (numbers
 272            (wl-spam-map-spam-messages wl-summary-buffer-elmo-folder
 273                                       numbers
 274                                       #'wl-summary-spam))
 275           ((interactive-p)
 276            (message "No message to test.")))))
 277
 278 (defun wl-summary-register-as-spam ()
 279   "Register current message as spam.
 280 Put spam mark unless current folder is a spam folder."
 281   (interactive)
 282   (let ((number (wl-summary-message-number)))
 283     (when number
 284       (wl-spam-register-spam-messages wl-summary-buffer-elmo-folder
 285                                       (list number)))))
 286
 287 (defun wl-summary-register-as-spam-region (beg end)
 288   "Register messages in the region between BEG and END as spam.
 289 Put spam mark unless current folder is a spam folder."
 290   (interactive "r")
 291   (let ((numbers (wl-summary-collect-numbers-region beg end)))
 292     (cond (numbers
 293            (wl-spam-register-spam-messages wl-summary-buffer-elmo-folder
 294                                            numbers))
 295           ((interactive-p)
 296            (message "No message to register as spam.")))))
 297
 298 (defun wl-thread-register-as-spam (&optional arg)
 299   "Register messages which are the descendant of the current thread as spam.
 300 Put spam mark unless current folder is a spam folder.
 301 With prefix argument, it affects on the all messages in the thread tree."
 302   (interactive "P")
 303   (wl-thread-call-region-func 'wl-summary-register-as-spam-region arg))
 304
 305 (defun wl-summary-register-as-spam-all ()
 306   "Register all messages in the folder as spam.
 307 Put spam mark unless current folder is a spam folder."
 308   (interactive)
 309   (wl-spam-register-spam-messages wl-summary-buffer-elmo-folder
 310                                   wl-summary-buffer-number-list))
 311
 312 (defun wl-summary-target-mark-register-as-spam ()
 313   "Register messages with the target mark as spam.
 314 Put spam mark unless current folder is a spam folder."
 315   (interactive)
 316   (save-excursion
 317     (goto-char (point-min))
 318     (let ((inhibit-read-only t)
 319           (buffer-read-only nil)
 320           wl-summary-buffer-disp-msg)
 321       (wl-spam-register-spam-messages wl-summary-buffer-elmo-folder
 322                                       wl-summary-buffer-target-mark-list)
 323       (dolist (number wl-summary-buffer-target-mark-list)
 324         (wl-summary-unset-mark number)))))
 325
 326 (defun wl-summary-register-as-good ()
 327   "Register current message as non-spam.
 328 Remove spam mark."
 329   (interactive)
 330   (let ((number (wl-summary-message-number)))
 331     (when number
 332       (wl-spam-register-good-messages wl-summary-buffer-elmo-folder
 333                                       (list number)))))
 334
 335 (defun wl-summary-register-as-good-region (beg end)
 336   "Register messages in the region between BEG and END as non-spam.
 337 Remove spam mark."
 338   (interactive "r")
 339   (let ((numbers (wl-summary-collect-numbers-region beg end)))
 340     (cond (numbers
 341            (wl-spam-register-good-messages wl-summary-buffer-elmo-folder
 342                                            numbers))
 343           ((interactive-p)
 344            (message "No message to register as good.")))))
 345
 346 (defun wl-thread-register-as-good (&optional arg)
 347   "Register messages which are the descendant of the current thread as non-spam.
 348 Remove spam mark.
 349 With prefix argument, it affects on the all messages in the thread tree."
 350   (interactive "P")
 351   (wl-thread-call-region-func 'wl-summary-register-as-good-region arg))
 352
 353 (defun wl-summary-register-as-good-all ()
 354   "Register all messages in the folder as non-spam.
 355 Remove spam mark."
 356   (interactive)
 357   (wl-spam-register-good-messages wl-summary-buffer-elmo-folder
 358                                   wl-summary-buffer-number-list))
 359
 360 (defun wl-summary-target-mark-register-as-good ()
 361   "Register messages with the target mark as non-spam.
 362 Remove spam mark."
 363   (interactive)
 364   (save-excursion
 365     (goto-char (point-min))
 366     (let ((inhibit-read-only t)
 367           (buffer-read-only nil)
 368           wl-summary-buffer-disp-msg)
 369       (wl-spam-register-good-messages wl-summary-buffer-elmo-folder
 370                                       wl-summary-buffer-target-mark-list)
 371       (dolist (number wl-summary-buffer-target-mark-list)
 372         (wl-summary-unset-mark number)))))
 373
 374 ;; hook functions and other
 375 (defun wl-summary-auto-check-spam ()
 376   (when (elmo-string-match-member (wl-summary-buffer-folder-name)
 377                                   wl-spam-auto-check-folder-regexp-list)
 378     (wl-summary-mark-spam)))
 379
 380 (defun wl-summary-exec-action-spam (mark-list)
 381   (let ((folder wl-summary-buffer-elmo-folder))
 382     (wl-folder-confirm-existence (wl-folder-get-elmo-folder wl-spam-folder))
 383     (wl-spam-apply-partitions
 384      folder
 385      (wl-filter-associations
 386       '(undecided good)
 387       (wl-spam-split-numbers folder (mapcar #'car mark-list)))
 388      (lambda (folder numbers domain)
 389        (elmo-spam-register-spam-messages (elmo-spam-processor)
 390                                          folder numbers
 391                                          (eq domain 'good)))
 392      "Registering spam")
 393     (wl-summary-move-mark-list-messages mark-list
 394                                         wl-spam-folder
 395                                         "Refiling spam")))
 396
 397 (defun wl-summary-exec-action-refile-with-register (mark-list)
 398   (let ((folder wl-summary-buffer-elmo-folder)
 399         spam-list good-list)
 400     (dolist (info mark-list)
 401       (case (wl-spam-domain (nth 2 info))
 402         (spam
 403          (setq spam-list (cons (car info) spam-list)))
 404         (good
 405          (setq good-list (cons (car info) good-list)))))
 406     (wl-spam-apply-partitions
 407      folder
 408      (wl-filter-associations '(undecided good)
 409                              (wl-spam-split-numbers folder spam-list))
 410      (lambda (folder numbers domain)
 411        (elmo-spam-register-spam-messages (elmo-spam-processor)
 412                                          folder numbers
 413                                          (eq domain 'good)))
 414      "Registering spam")
 415     (wl-spam-apply-partitions
 416      folder
 417      (wl-filter-associations '(undecided spam)
 418                              (wl-spam-split-numbers folder good-list))
 419      (lambda (folder numbers domain)
 420        (elmo-spam-register-good-messages (elmo-spam-processor)
 421                                          folder numbers
 422                                          (eq domain 'spam)))
 423      "Registering good")
 424     ;; execute refile messages
 425     (wl-summary-exec-action-refile mark-list)))
 426
 427 (defun wl-message-check-spam ()
 428   (let ((original (wl-message-get-original-buffer))
 429         (number wl-message-buffer-cur-number)
 430         spam)
 431     (message "Checking spam...")
 432     (when (setq spam (elmo-spam-buffer-spam-p (elmo-spam-processor) original))
 433       (with-current-buffer wl-message-buffer-cur-summary-buffer
 434         (wl-summary-spam number)))
 435     (message "Checking spam...done")
 436     (message "No: %d is %sa spam message." number (if spam "" "not "))))
 437
 438 (defun wl-refile-guess-by-spam (entity)
 439   (when (elmo-spam-message-spam-p (elmo-spam-processor)
 440                                   wl-summary-buffer-elmo-folder
 441                                   (elmo-message-entity-number entity))
 442     wl-spam-folder))
 443
 444 (defun wl-spam-setup ()
 445   (add-hook 'wl-summary-sync-updated-hook #'wl-summary-auto-check-spam)
 446   (let ((actions wl-summary-mark-action-list)
 447         action)
 448     (while actions
 449       (setq action  (car actions)
 450             actions (cdr actions))
 451       (when (eq (wl-summary-action-symbol action) 'refile)
 452         (setcar (nthcdr 4 action) 'wl-summary-exec-action-refile-with-register)
 453         (setq actions nil))))
 454   (when wl-spam-mark-action-list
 455     (setq wl-summary-mark-action-list (append
 456                                        wl-summary-mark-action-list
 457                                        wl-spam-mark-action-list))
 458     (dolist (action wl-spam-mark-action-list)
 459       (setq wl-summary-reserve-mark-list
 460             (cons (wl-summary-action-mark action)
 461                   wl-summary-reserve-mark-list))
 462       (setq wl-summary-skip-mark-list
 463             (cons (wl-summary-action-mark action)
 464                   wl-summary-skip-mark-list))))
 465   (define-key wl-summary-mode-map "k" wl-summary-spam-map)
 466   (define-key
 467     wl-summary-mode-map "rkm" 'wl-summary-spam-region)
 468   (define-key
 469     wl-summary-mode-map "rkc" 'wl-summary-test-spam-region)
 470   (define-key
 471     wl-summary-mode-map "rks" 'wl-summary-register-as-spam-region)
 472   (define-key
 473     wl-summary-mode-map "rkn" 'wl-summary-register-as-good-region)
 474   (define-key
 475     wl-summary-mode-map "tkm" 'wl-thread-spam)
 476   (define-key
 477     wl-summary-mode-map "tkc" 'wl-thread-test-spam)
 478   (define-key
 479     wl-summary-mode-map "tks" 'wl-thread-register-as-spam)
 480   (define-key
 481     wl-summary-mode-map "tkn" 'wl-thread-register-as-good)
 482   (define-key
 483     wl-summary-mode-map "mk" 'wl-summary-target-mark-spam)
 484   (define-key
 485     wl-summary-mode-map "ms" 'wl-summary-target-mark-register-as-spam)
 486   (define-key
 487     wl-summary-mode-map "mn" 'wl-summary-target-mark-register-as-good))
 488
 489 (require 'product)
 490 (product-provide (provide 'wl-spam) (require 'wl-version))
 491
 492 (unless noninteractive
 493   (wl-spam-setup))
 494
 495 ;;; wl-spam.el ends here