X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fspam.el;h=23ebda714472d24fcec309ee937e9d9044499aa9;hb=27688c4fe73986a46e3f2cb9051170f41ef82f4c;hp=946f7153480b04b7ca867d35f385bc299f5cb04f;hpb=f242c8c653a4b1e6101e6899d388cae9bc15ee3e;p=elisp%2Fgnus.git- diff --git a/lisp/spam.el b/lisp/spam.el index 946f715..23ebda7 100644 --- a/lisp/spam.el +++ b/lisp/spam.el @@ -1,5 +1,5 @@ ;;; spam.el --- Identifying spam -;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: network @@ -18,8 +18,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: @@ -80,7 +80,9 @@ Populated by spam-install-backend-super.") (defgroup spam nil "Spam configuration." - :version "21.4") + :version "22.1" + :group 'mail + :group 'news) (defcustom spam-summary-exit-behavior 'default "Exit behavior at the time of summary exit. @@ -347,11 +349,25 @@ Only meaningful if you enable `spam-use-blackholes'." (defcustom spam-blackhole-good-server-regex nil "String matching IP addresses that should not be checked in the blackholes. Only meaningful if you enable `spam-use-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) @@ -1316,6 +1332,10 @@ addition to the set values for the group." (unless gnus-group-is-exiting-without-update-p (gnus-message 6 "Exiting summary buffer and applying spam rules") + ;; before we begin, remove any article limits +; (ignore-errors +; (gnus-summary-pop-limit t)) + ;; first of all, unregister any articles that are no longer ham or spam ;; we have to iterate over the processors, or else we'll be too slow (dolist (classification (spam-classifications)) @@ -2000,6 +2020,9 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." ;;{{{ Hashcash. +(eval-when-compile + (autoload 'mail-check-payment "hashcash")) + (condition-case nil (progn (require 'hashcash) @@ -2008,9 +2031,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." "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)) ;;}}} ;;{{{ BBDB @@ -2020,88 +2041,92 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." ;; all this is done inside a condition-case to trap errors -(condition-case nil - (progn - (require 'bbdb) - (require 'bbdb-com) - - ;; when the BBDB changes, we want to clear out our cache - (defun spam-clear-cache-BBDB (&rest immaterial) - (spam-clear-cache 'spam-use-BBDB)) - - (add-hook 'bbdb-change-hook 'spam-clear-cache-BBDB) - - (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 6 "%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 (message-fetch-field "from")) - bbdb-cache bbdb-hashtable) - (when spam-cache-lookups - (setq bbdb-cache (gethash 'spam-use-BBDB spam-caches)) - (unless bbdb-cache - (setq bbdb-cache - ;; this is the expanded (bbdb-hashtable) macro - ;; without the debugging support - (with-current-buffer (bbdb-buffer) - (save-excursion - (save-window-excursion - (bbdb-records nil t) - bbdb-hashtable)))) - (puthash 'spam-use-BBDB bbdb-cache spam-caches))) - (when who - (setq who (nth 1 (gnus-extract-address-components who))) - (if - (if spam-cache-lookups - (symbol-value - (intern-soft who bbdb-cache)) - (bbdb-search-simple nil who)) - t - (if spam-use-BBDB-exclusive - spam-split-group - nil)))))) - - (file-error (progn - (defalias 'bbdb-search-simple 'ignore) - (defalias 'bbdb-records 'ignore) - (defalias 'bbdb-buffer '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 + ;; `bbdb-records' should not be bound as an autoload function + ;; before loading bbdb because of `bbdb-hashtable-size'. + (defalias 'bbdb-records 'ignore) + (defalias 'spam-BBDB-register-routine 'ignore) + (defalias 'spam-enter-ham-BBDB 'ignore) + nil)) + + ;; when the BBDB changes, we want to clear out our cache + (defun spam-clear-cache-BBDB (&rest immaterial) + (spam-clear-cache 'spam-use-BBDB)) + + (add-hook 'bbdb-change-hook 'spam-clear-cache-BBDB) + + (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 6 "%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 (message-fetch-field "from")) + bbdb-cache bbdb-hashtable) + (when spam-cache-lookups + (setq bbdb-cache (gethash 'spam-use-BBDB spam-caches)) + (unless bbdb-cache + (setq bbdb-cache (make-vector 17 0)) ; a good starting hash value + ;; this is based on the expanded (bbdb-hashtable) macro + ;; without the debugging support + (with-current-buffer (bbdb-buffer) + (save-excursion + (save-window-excursion + (bbdb-records nil t) + (mapatoms + (lambda (symbol) + (intern (downcase (symbol-name symbol)) bbdb-cache)) + bbdb-hashtable)))) + (puthash 'spam-use-BBDB bbdb-cache spam-caches))) + (when who + (setq who (nth 1 (gnus-extract-address-components who))) + (if + (if spam-cache-lookups + (intern-soft (downcase who) bbdb-cache) + (bbdb-search-simple nil who)) + t + (if spam-use-BBDB-exclusive + spam-split-group + nil))))))) ;;}}} @@ -2176,65 +2201,60 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)." ;;{{{ 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-stat-split-fancy-spam-group spam-split-group) ; override - (spam-stat-buffer (buffer-name)) ; stat the current buffer - category return) - (spam-stat-split-fancy))) +(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")) - (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-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-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))))) ;;}}} @@ -2863,8 +2883,8 @@ installed through spam-necessary-extra-headers." (add-to-list 'gnus-extra-headers header)) (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)