]> code.delx.au - gnu-emacs/blobdiff - lisp/gnus/spam.el
Merge from emacs--rel--22
[gnu-emacs] / lisp / gnus / spam.el
index 075408b8fc76b45b3f72e51af99cb5cc62750f95..512192857abe272710e8bfd077b484a40e3d6f65 100644 (file)
@@ -1,5 +1,6 @@
 ;;; spam.el --- Identifying spam
-;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
+
+;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: network
@@ -18,8 +19,8 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
@@ -77,7 +78,9 @@
 
 (defgroup spam nil
   "Spam configuration."
-  :version "21.4")
+  :version "22.1"
+  :group 'mail
+  :group 'news)
 
 (defcustom spam-directory (nnheader-concat gnus-directory "spam/")
   "Directory for spam whitelists and blacklists."
@@ -97,6 +100,12 @@ spam groups."
   :type 'boolean
   :group 'spam)
 
+(defcustom spam-mark-new-messages-in-spam-group-as-spam t
+  "Whether new messages in a spam group should get the spam-mark."
+  :type 'boolean
+  ;; :version "22.1" ;; Gnus 5.10.8 / No Gnus 0.3
+  :group 'spam)
+
 (defcustom spam-log-to-registry nil
   "Whether spam/ham processing should be logged in the registry."
   :type 'boolean
@@ -295,11 +304,25 @@ All unmarked article in such group receive the spam mark on group entry."
 
 (defcustom spam-blackhole-good-server-regex nil
   "String matching IP addresses that should not be checked in the blackholes."
-  :type '(radio (const nil)
-               (regexp :format "%t: %v\n" :size 0))
+  :type '(radio (const nil) regexp)
   :group 'spam)
 
-(defcustom spam-face 'gnus-splash-face
+(defface spam
+  '((((class color) (type tty) (background dark))
+     (:foreground "gray80" :background "gray50"))
+    (((class color) (type tty) (background light))
+     (:foreground "gray50" :background "gray80"))
+    (((class color) (background dark))
+     (:foreground "ivory2"))
+    (((class color) (background light))
+     (:foreground "ivory4"))
+    (t :inverse-video t))
+  "Face for spam-marked articles."
+  :group 'spam)
+;; backward-compatibility alias
+(put 'spam-face 'face-alias 'spam)
+
+(defcustom spam-face 'spam
   "Face for spam-marked articles."
   :type 'face
   :group 'spam)
@@ -328,14 +351,18 @@ All unmarked article in such group receive the spam mark on group entry."
   "Spam ifile configuration."
   :group 'spam)
 
-(defcustom spam-ifile-path (executable-find "ifile")
-  "File path of the ifile executable program."
+(make-obsolete-variable 'spam-ifile-path 'spam-ifile-program)
+;; "22.1" ;; Gnus 5.10.9
+(defcustom spam-ifile-program (executable-find "ifile")
+  "Name of the ifile program."
   :type '(choice (file :tag "Location of ifile")
                 (const :tag "ifile is not installed"))
   :group 'spam-ifile)
 
-(defcustom spam-ifile-database-path nil
-  "File path of the ifile database."
+(make-obsolete-variable 'spam-ifile-database-path 'spam-ifile-database)
+;; "22.1" ;; Gnus 5.10.9
+(defcustom spam-ifile-database nil
+  "File name of the ifile database."
   :type '(choice (file :tag "Location of the ifile database")
                 (const :tag "Use the default"))
   :group 'spam-ifile)
@@ -363,8 +390,10 @@ your main source of newsgroup names."
   "Spam bogofilter configuration."
   :group 'spam)
 
-(defcustom spam-bogofilter-path (executable-find "bogofilter")
-  "File path of the Bogofilter executable program."
+(make-obsolete-variable 'spam-bogofilter-path 'spam-bogofilter-program)
+;; "22.1" ;; Gnus 5.10.9
+(defcustom spam-bogofilter-program (executable-find "bogofilter")
+  "Name of the Bogofilter program."
   :type '(choice (file :tag "Location of bogofilter")
                 (const :tag "Bogofilter is not installed"))
   :group 'spam-bogofilter)
@@ -400,7 +429,8 @@ your main source of newsgroup names."
   :group 'spam-bogofilter)
 
 (defcustom spam-bogofilter-database-directory nil
-  "Directory path of the Bogofilter databases."
+  "Location of the Bogofilter database.
+When nil, use the default location."
   :type '(choice (directory
                  :tag "Location of the Bogofilter database directory")
                 (const :tag "Use the default"))
@@ -411,8 +441,8 @@ your main source of newsgroup names."
   :group 'spam)
 
 (defcustom spam-spamoracle-database nil
-  "Location of spamoracle database file. When nil, use the default
-spamoracle database."
+  "Location of spamoracle database file.
+When nil, use the default spamoracle database."
   :type '(choice (directory :tag "Location of spamoracle database file.")
                 (const :tag "Use the default"))
   :group 'spam-spamoracle)
@@ -659,15 +689,17 @@ spam-use-* variable.")
   ;; check the global list of group names spam-junk-mailgroups and the
   ;; group parameters
   (when (spam-group-spam-contents-p gnus-newsgroup-name)
-    (gnus-message 5 "Marking %s articles as spam"
+    (gnus-message 6 "Marking %s articles as spam"
                  (if spam-mark-only-unseen-as-spam
                      "unseen"
                    "unread"))
     (let ((articles (if spam-mark-only-unseen-as-spam
                        gnus-newsgroup-unseen
                      gnus-newsgroup-unreads)))
-      (dolist (article articles)
-       (gnus-summary-mark-article article gnus-spam-mark)))))
+      (if spam-mark-new-messages-in-spam-group-as-spam
+         (dolist (article articles)
+           (gnus-summary-mark-article article gnus-spam-mark))
+       (gnus-message 9 "Did not mark new messages as spam.")))))
 
 (defun spam-mark-spam-as-expired-and-move-routine (&rest groups)
   (if (and (car-safe groups) (listp (car-safe groups)))
@@ -715,7 +747,7 @@ spam-use-* variable.")
         (gnus-check-backend-function
          'request-move-article gnus-newsgroup-name))
        (respool-method (gnus-find-method-for-group gnus-newsgroup-name))
-       article mark todo deletep respool)
+       article mark deletep respool)
 
     (when (member 'respool groups)
       (setq respool t)                 ; boolean for later
@@ -1257,6 +1289,9 @@ functions")
 \f
 ;;;; Hashcash.
 
+(eval-when-compile
+  (autoload 'mail-check-payment "hashcash"))
+
 (condition-case nil
     (progn
       (require 'hashcash)
@@ -1265,9 +1300,7 @@ functions")
        "Check the headers for hashcash payments."
        (mail-check-payment)))   ;mail-check-payment returns a boolean
 
-  (file-error (progn
-               (defalias 'mail-check-payment 'ignore)
-               (defalias 'spam-check-hashcash 'ignore))))
+  (file-error))
 \f
 ;;;; BBDB
 
@@ -1276,66 +1309,67 @@ functions")
 
 ;; all this is done inside a condition-case to trap errors
 
-(condition-case nil
-    (progn
-      (require 'bbdb)
-      (require 'bbdb-com)
-
-      (defun spam-enter-ham-BBDB (addresses &optional remove)
-       "Enter an address into the BBDB; implies ham (non-spam) sender"
-       (dolist (from addresses)
-         (when (stringp from)
-           (let* ((parsed-address (gnus-extract-address-components from))
-                  (name (or (nth 0 parsed-address) "Ham Sender"))
-                  (remove-function (if remove
-                                       'bbdb-delete-record-internal
-                                     'ignore))
-                  (net-address (nth 1 parsed-address))
-                  (record (and net-address
-                               (bbdb-search-simple nil net-address))))
-             (when net-address
-               (gnus-message 5 "%s address %s %s BBDB"
-                             (if remove "Deleting" "Adding")
-                             from
-                             (if remove "from" "to"))
-               (if record
-                   (funcall remove-function record)
-                 (bbdb-create-internal name nil net-address nil nil
-                                       "ham sender added by spam.el")))))))
-
-      (defun spam-BBDB-register-routine (articles &optional unregister)
-       (let (addresses)
-         (dolist (article articles)
-           (when (stringp (spam-fetch-field-from-fast article))
-             (push (spam-fetch-field-from-fast article) addresses)))
-         ;; now do the register/unregister action
-         (spam-enter-ham-BBDB addresses unregister)))
-
-      (defun spam-BBDB-unregister-routine (articles)
-       (spam-BBDB-register-routine articles t))
-
-      (defun spam-check-BBDB ()
-       "Mail from people in the BBDB is classified as ham or non-spam"
-       (let ((who (nnmail-fetch-field "from"))
-             (spam-split-group (if spam-split-symbolic-return
-                                   'spam
-                                 spam-split-group)))
-         (when who
-           (setq who (nth 1 (gnus-extract-address-components who)))
-           (if (bbdb-search-simple nil who)
-               t
-             (if spam-use-BBDB-exclusive
-                 spam-split-group
-               nil))))))
-
-  (file-error (progn
-               (defalias 'bbdb-search-simple 'ignore)
-               (defalias 'spam-check-BBDB 'ignore)
-               (defalias 'spam-BBDB-register-routine 'ignore)
-               (defalias 'spam-enter-ham-BBDB 'ignore)
-               (defalias 'bbdb-create-internal 'ignore)
-               (defalias 'bbdb-delete-record-internal 'ignore)
-               (defalias 'bbdb-records 'ignore))))
+(eval-when-compile
+  (autoload 'bbdb-buffer "bbdb")
+  (autoload 'bbdb-create-internal "bbdb")
+  (autoload 'bbdb-search-simple "bbdb"))
+
+(eval-and-compile
+  (when (condition-case nil
+           (progn
+             (require 'bbdb)
+             (require 'bbdb-com))
+         (file-error
+          (defalias 'spam-BBDB-register-routine 'ignore)
+          (defalias 'spam-enter-ham-BBDB 'ignore)
+          nil))
+
+    (defun spam-enter-ham-BBDB (addresses &optional remove)
+      "Enter an address into the BBDB; implies ham (non-spam) sender"
+      (dolist (from addresses)
+       (when (stringp from)
+         (let* ((parsed-address (gnus-extract-address-components from))
+                (name (or (nth 0 parsed-address) "Ham Sender"))
+                (remove-function (if remove
+                                     'bbdb-delete-record-internal
+                                   'ignore))
+                (net-address (nth 1 parsed-address))
+                (record (and net-address
+                             (bbdb-search-simple nil net-address))))
+           (when net-address
+             (gnus-message 5 "%s address %s %s BBDB"
+                           (if remove "Deleting" "Adding")
+                           from
+                           (if remove "from" "to"))
+             (if record
+                 (funcall remove-function record)
+               (bbdb-create-internal name nil net-address nil nil
+                                     "ham sender added by spam.el")))))))
+
+    (defun spam-BBDB-register-routine (articles &optional unregister)
+      (let (addresses)
+       (dolist (article articles)
+         (when (stringp (spam-fetch-field-from-fast article))
+           (push (spam-fetch-field-from-fast article) addresses)))
+       ;; now do the register/unregister action
+       (spam-enter-ham-BBDB addresses unregister)))
+
+    (defun spam-BBDB-unregister-routine (articles)
+      (spam-BBDB-register-routine articles t))
+
+    (defun spam-check-BBDB ()
+      "Mail from people in the BBDB is classified as ham or non-spam"
+      (let ((who (nnmail-fetch-field "from"))
+           (spam-split-group (if spam-split-symbolic-return
+                                 'spam
+                               spam-split-group)))
+       (when who
+         (setq who (nth 1 (gnus-extract-address-components who)))
+         (if (bbdb-search-simple nil who)
+             t
+           (if spam-use-BBDB-exclusive
+               spam-split-group
+             nil)))))))
 
 \f
 ;;;; ifile
@@ -1343,11 +1377,12 @@ functions")
 ;;; check the ifile backend; return nil if the mail was NOT classified
 ;;; as spam
 
+
 (defun spam-get-ifile-database-parameter ()
-  "Get the command-line parameter for ifile's database from
-  spam-ifile-database-path."
-  (if spam-ifile-database-path
-      (format "--db-file=%s" spam-ifile-database-path)
+  "Return the command-line parameter for ifile's database.
+See `spam-ifile-database'."
+  (if spam-ifile-database
+      (format "--db-file=%s" spam-ifile-database)
     nil))
 
 (defun spam-check-ifile ()
@@ -1363,7 +1398,7 @@ functions")
        (save-excursion
          (set-buffer article-buffer-name)
          (apply 'call-process-region
-                (point-min) (point-max) spam-ifile-path
+                (point-min) (point-max) spam-ifile-program
                 nil temp-buffer-name nil "-c"
                 (if db-param `(,db-param "-q") `("-q"))))
        ;; check the return now (we're back in the temp buffer)
@@ -1391,7 +1426,7 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)."
          (when (stringp article-string)
            (insert article-string))))
       (apply 'call-process-region
-            (point-min) (point-max) spam-ifile-path
+            (point-min) (point-max) spam-ifile-program
             nil nil nil
             add-or-delete-option category
             (if db `(,db "-h") `("-h"))))))
@@ -1411,66 +1446,63 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)."
 \f
 ;;;; spam-stat
 
-(condition-case nil
-    (progn
-      (let ((spam-stat-install-hooks nil))
-       (require 'spam-stat))
-
-      (defun spam-check-stat ()
-       "Check the spam-stat backend for the classification of this message"
-       (let ((spam-split-group (if spam-split-symbolic-return
-                                   'spam
-                                 spam-split-group))
-             (spam-stat-split-fancy-spam-group spam-split-group) ; override
-             (spam-stat-buffer (buffer-name)) ; stat the current buffer
-             category return)
-         (spam-stat-split-fancy)))
-
-      (defun spam-stat-register-spam-routine (articles &optional unregister)
-       (dolist (article articles)
-         (let ((article-string (spam-get-article-as-string article)))
-           (with-temp-buffer
-             (insert article-string)
-             (if unregister
-                 (spam-stat-buffer-change-to-non-spam)
+(eval-when-compile
+  (autoload 'spam-stat-buffer-change-to-non-spam "spam-stat")
+  (autoload 'spam-stat-buffer-change-to-spam "spam-stat")
+  (autoload 'spam-stat-buffer-is-non-spam "spam-stat")
+  (autoload 'spam-stat-buffer-is-spam "spam-stat")
+  (autoload 'spam-stat-load "spam-stat")
+  (autoload 'spam-stat-save "spam-stat")
+  (autoload 'spam-stat-split-fancy "spam-stat"))
+
+(eval-and-compile
+  (when (condition-case nil
+           (let ((spam-stat-install-hooks nil))
+             (require 'spam-stat))
+         (file-error
+          (defalias 'spam-stat-register-ham-routine 'ignore)
+          (defalias 'spam-stat-register-spam-routine 'ignore)
+          nil))
+
+    (defun spam-check-stat ()
+      "Check the spam-stat backend for the classification of this message"
+      (let ((spam-split-group (if spam-split-symbolic-return
+                                 'spam
+                               spam-split-group))
+           (spam-stat-split-fancy-spam-group spam-split-group) ; override
+           (spam-stat-buffer (buffer-name)) ; stat the current buffer
+           category return)
+       (spam-stat-split-fancy)))
+
+    (defun spam-stat-register-spam-routine (articles &optional unregister)
+      (dolist (article articles)
+       (let ((article-string (spam-get-article-as-string article)))
+         (with-temp-buffer
+           (insert article-string)
+           (if unregister
+               (spam-stat-buffer-change-to-non-spam)
              (spam-stat-buffer-is-spam))))))
 
-      (defun spam-stat-unregister-spam-routine (articles)
-       (spam-stat-register-spam-routine articles t))
+    (defun spam-stat-unregister-spam-routine (articles)
+      (spam-stat-register-spam-routine articles t))
 
-      (defun spam-stat-register-ham-routine (articles &optional unregister)
-       (dolist (article articles)
-         (let ((article-string (spam-get-article-as-string article)))
-           (with-temp-buffer
-             (insert article-string)
-             (if unregister
-                 (spam-stat-buffer-change-to-spam)
+    (defun spam-stat-register-ham-routine (articles &optional unregister)
+      (dolist (article articles)
+       (let ((article-string (spam-get-article-as-string article)))
+         (with-temp-buffer
+           (insert article-string)
+           (if unregister
+               (spam-stat-buffer-change-to-spam)
              (spam-stat-buffer-is-non-spam))))))
 
-      (defun spam-stat-unregister-ham-routine (articles)
-       (spam-stat-register-ham-routine articles t))
-
-      (defun spam-maybe-spam-stat-load ()
-       (when spam-use-stat (spam-stat-load)))
-
-      (defun spam-maybe-spam-stat-save ()
-       (when spam-use-stat (spam-stat-save))))
-
-  (file-error (progn
-               (defalias 'spam-stat-load 'ignore)
-               (defalias 'spam-stat-save 'ignore)
-               (defalias 'spam-maybe-spam-stat-load 'ignore)
-               (defalias 'spam-maybe-spam-stat-save 'ignore)
-               (defalias 'spam-stat-register-ham-routine 'ignore)
-               (defalias 'spam-stat-unregister-ham-routine 'ignore)
-               (defalias 'spam-stat-register-spam-routine 'ignore)
-               (defalias 'spam-stat-unregister-spam-routine 'ignore)
-               (defalias 'spam-stat-buffer-is-spam 'ignore)
-               (defalias 'spam-stat-buffer-change-to-spam 'ignore)
-               (defalias 'spam-stat-buffer-is-non-spam 'ignore)
-               (defalias 'spam-stat-buffer-change-to-non-spam 'ignore)
-               (defalias 'spam-stat-split-fancy 'ignore)
-               (defalias 'spam-check-stat 'ignore))))
+    (defun spam-stat-unregister-ham-routine (articles)
+      (spam-stat-register-ham-routine articles t))
+
+    (defun spam-maybe-spam-stat-load ()
+      (when spam-use-stat (spam-stat-load)))
+
+    (defun spam-maybe-spam-stat-save ()
+      (when spam-use-stat (spam-stat-save)))))
 
 \f
 
@@ -1678,7 +1710,7 @@ REMOVE not nil, remove the ADDRESSES."
          (set-buffer article-buffer-name)
          (apply 'call-process-region
                 (point-min) (point-max)
-                spam-bogofilter-path
+                spam-bogofilter-program
                 nil temp-buffer-name nil
                 (if db `("-d" ,db "-v") `("-v"))))
        (setq return (spam-check-bogofilter-headers score))))
@@ -1704,7 +1736,7 @@ REMOVE not nil, remove the ADDRESSES."
 
          (apply 'call-process-region
                 (point-min) (point-max)
-                spam-bogofilter-path
+                spam-bogofilter-program
                 nil nil nil switch
                 (if db `("-d" ,db "-v") `("-v"))))))))
 
@@ -1792,8 +1824,8 @@ REMOVE not nil, remove the ADDRESSES."
   "Install the spam.el hooks and do other initialization"
   (interactive)
   (setq spam-install-hooks t)
-  ;; TODO: How do we redo this every time spam-face is customized?
-  (push '((eq mark gnus-spam-mark) . spam-face)
+  ;; TODO: How do we redo this every time the `spam' face is customized?
+  (push '((eq mark gnus-spam-mark) . spam)
        gnus-summary-highlight)
   ;; Add hooks for loading and saving the spam stats
   (add-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save)