;;; rmail-spam-filter.el  --- spam filter for rmail, the emacs mail reader.

;; Copyright (C) 2002 Free Software Foundation, Inc.

;; Keywords: email, spam, filter, rmail
;; Author: Eli Tziperman <eli AT deas.harvard.edu>
;; Version: 2.4g, Sep 3, 2004

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; 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.

;;; Commentary:
;;; -----------

;;; Automatically recognize and delete junk email before it is
;;; displayed in rmail/rmail-summary.  Spam emails are defined by
;;; specifying one or more of the sender, subject and contents.
;;; URL: http://deas.harvard.edu/climate/eli/Downloads/rmail-spam-filter/

;;; Usage:
;;; ------

;;; put in your .emacs:

;;; (load "rmail-spam-filter.el")

;;; and use customize (in rmail-spam-filter group) to:

;;; (*) turn on the variable rmail-use-spam-filter,

;;; (*) specify in variable rsf-definitions-alist what sender,
;;; subject and contents make an email be considered spam.

;;; in addition, you may:

;;; (*) Block future mail with the subject or sender of a message
;;; while reading it in RMAIL: just click on the "Spam" item on the
;;; menubar, and add the subject or sender to the list of spam
;;; definitions using the mouse and the appropriate menu item. You
;;; need to later also save the list of spam definitions using the
;;; same menu item, or alternatively, see variable
;;; `rsf-autosave-newly-added-definitions'.

;;; (*) specify if blind-cc'ed mail (no "To:" header field) is to be
;;; treated as spam (variable rsf-no-blind-cc; Thanks to Ethan
;;; Brown <ethan@gso.saic.com> for this).

;;; (*) specify if rmail-spam-filter should ignore case of spam
;;; definitions (variable rsf-ignore-case; Thanks to
;;; Ethan Brown <ethan@gso.saic.com> for the suggestion).

;;; (*) Specify a "white-list" of trusted senders. If any
;;; rsf-white-list regexp matches a substring of the `From' header,
;;; the message is flagged as a valid, non-spam message.  If
;;; rsf-white-list-recipients-also is non-nil, the `To', `Cc',
;;; `Apparently-To', and `X-Apparently-To' headers are tested as well
;;; as the `From' header.  (Ethan Brown <ethan@gso.saic.com>).

;;; (*) rmail-spam-filter is best used with a general purpose spam
;;; filter such as the procmail-based http://www.spambouncer.org/.
;;; Spambouncer is set to only mark messages as spam/blocked/bulk/OK
;;; via special headers, and these headers may then be defined in
;;; rmail-spam-filter such that the spam is rejected by
;;; rmail-spam-filter itself.

;;; (*) rmail spam filter also works with bbdb to prevent spam senders
;;; from entering into the .bbdb file.  See variable
;;; "rsf-auto-delete-spam-bbdb-entries".  This is done
;;; in two ways: (a) bbdb is made not to auto-create entries for
;;; messages that are deleted by the rmail-spam-filter, (b) when a
;;; message is deleted in rmail, the user is offered to delete the
;;; sender's bbdb entry as well _if_ it was created at the same day.

(require 'rmail)
(require 'rmailsum)

;; For find-if and other cool common lisp functions we may want to use.
(eval-when-compile
  (require 'cl))

;; Record and display the version number.
(defconst rsf-version "2.4f"
  "Version number of rmail-spam-filter.")

(defun rsf-version ()
  "Return a string describing the version of rmail-spam-filter.
When called interactively, displays the version."
  (interactive)
  (if (interactive-p)
      (message "Rmail spam filter version %s" (rsf-version))
    rsf-version))

;; Used as a type definition by customizable variables.
(defconst rsf-action-type-definition
  '(choice :tag "Action selection"
	   (const :tag "output to spam folder and delete" output-and-delete)
	   (const :tag "delete" delete-spam)
	   )
  "The :type definition of an action specification.
This is named separately because several defcustom's use it and this makes
sure that they stay coordinated.
These values must be coordinated with the `case' in `rmail-spam-filter'.
They are documented in the docstring for `rsf-definitions-alist'.")

(defgroup rmail-spam-filter nil
  "Spam filter for RMAIL, the mail reader for Emacs."
  :group 'rmail)

;;; These customizable variables are listed first, as they are the
;;; most important.

;;;###autoload
(defcustom rmail-use-spam-filter nil
  "*Non-nil to activate the rmail spam filter.
Specify `rsf-definitions-alist' to define what you consider spam emails."
  :type 'boolean
  :group 'rmail-spam-filter)

;; This variable is here because it must be defined before the :type
;; for rsf-definitions-alist can be processed.
(defcustom rsf-default-action-for-new-filters 'output-and-delete
  "*When a new spam filter is created by an `rsf-add-*-to-spam-list'
function, it specifies that this action is to be taken on messages
that match the filter.  The new filter's action can be altered by
editing the new element of `rsf-definitions-alist'."
  :type rsf-action-type-definition
  :group 'rmail-spam-filter)

(defcustom rsf-definitions-alist nil
  "*List containing the spam definitions.

Each definition may contain specifications of one or more of the
elements: subject, sender, recipients, content-type or contents, as
well as specifying what to do with spam messages that match this definition.

Each definition is an alist, containing in order elements with car's:
`from', `to', `subject', `content-type', `contents', `action'.
Elements with cdr's that are the null string are ignored for testing.
Elements with cdr's that are strings are regexp-matched against the
corresponding parts of the message.  A message is matched if all
elements with specified regexps match their parts of the message.

For example, to specify that the subject may be either `this is spam'
or `another spam', use the regexp: `this is spam\\|another spam'
(without the quotes).  

All From: headers are are concatenated with `, ' to form the `from'
string.  All To:, Cc:, Apparently-To:, and X-Apparently-To: headers
are concatenated with `, ' to form the `to' string.  All Subject:
headers are concatenated with spaces to form the `subject' string.
The Content-Type: header should be unique.  The `contents' string is
the text of the message, including headers and body.

Defined actions are:
output-and-delete - Output to the spam folder and delete from the rmail file.
delete-spam - Delete from the rmail file."
  ;; The value for :type is backquoted because it contains comma-insertions.
  :type `(repeat
          (list :format "%v"
	   (cons :format "%v" :value (from . "")
		 (const :format ""  from)
		 (string :tag "From"  ""))
	   (cons :format "%v" :value (to . "")
		 (const :format ""  to)
		 (string :tag "To"  ""))
	   (cons :format "%v" :value (subject . "")
		 (const :format ""  subject)
		 (string :tag "Subject"  ""))
	   (cons :format "%v" :value (content-type . "")
		 (const :format ""  content-type)
		 (string :tag "Content-Type"  ""))
	   (cons :format "%v" :value (contents . "")
		 (const :format ""  contents)
		 (string :tag "Contents"  ""))
	   (cons :format "%v"
		 :value (action . ,rsf-default-action-for-new-filters)
		 (const :format "" action)
		 ,rsf-action-type-definition)
   ))
  :group 'rmail-spam-filter)

(defcustom rsf-white-list nil
  "*List of regexps to identify valid senders.  If any
`rsf-white-list' regexp matches a substring of the `From' header, a
message is considered a valid, non-spam message, regardless of whether
it matches any item in `rsf-definitions-alist'.  If
`rsf-white-list-recipients-also' is non-nil, a message is also
considered non-spam if any `To', `Cc', `Apparently-To', or
`X-Apparently-To' header is matched by any `rsf-white-list' regexp.
(See also `rsf-apparently-to-also.)

Example:  If your domain is emacs.com, then including `emacs\\.com' in
`rsf-white-list' would flag all mail from your colleagues as valid."
  :type '(repeat string)
  :group 'rmail-spam-filter)

;;; These variables are relatively minor customizations.

(defcustom rsf-file "~/XRMAIL-SPAM"
  "*Name of rmail file for optionally saving some of the spam.
Spam may be either just deleted, or saved in a separate spam file to
be looked at at a later time.  Whether the spam is just deleted or
also saved in a separate spam file is specified for each definition of
spam, as one of the fields of `rsf-definitions-alist'"
  :type 'string
  :group 'rmail-spam-filter)

(defcustom rsf-no-blind-cc nil
  "*Non-nil to treat blind CC's (messages with no To: header) as spam."
  :type 'boolean
  :group 'rmail-spam-filter)

(defcustom rsf-blind-cc-action 'output-and-delete
  "*Action to take on rejected blind CC's."
  :type rsf-action-type-definition
  :group 'rmail-spam-filter)

(defcustom rsf-ignore-case nil
  "*Non-nil to ignore case when testing messages for spam."
  :type 'boolean
  :group 'rmail-spam-filter)

(defcustom rsf-min-region-to-spam-list 7
  "*User may highlight a region in an incoming message and use
the menubar to add this region to the spam definitions.  This
variable specifies the minimum number of characters of region
that may be added to spam list, to avoid accidentally adding a
too short region which would result in false positive
identification of spam messages."
  :type 'integer
  :group 'rmail-spam-filter)

(defcustom rsf-auto-delete-spam-bbdb-entries nil
  "*Non-nil to make sure no entries are made in bbdb for spam emails.
This is done in two ways: (1) bbdb is made not to auto-create entries
for messages that are deleted by the `rmail-spam-filter', (2) when a
message is deleted in rmail, the user is offered to delete the
sender's bbdb entry as well if it was created at the same day.  Note
that Emacs needs to be restarted after setting this option for it to
take an effect."
  :type 'boolean
  :group 'rmail-spam-filter)

(defcustom rsf-autosave-newly-added-definitions nil
  "*Non-nil to auto save new spam definitions.
Modifications to the spam definitions made via the spam menu bar
functions are then saved to the customization file immediately after
they are made, and do not require explicitly saving customizations."
  :type 'boolean
  :group 'rmail-spam-filter)

(defcustom rsf-white-list-recipients-also nil
  "*When non-nil, causes the regexps in `rsf-white-list' to be matched
against `To', `Cc', `Apparently-To' and `X-Apparently-To' headers as
well as `From' headers.  Can be used to ensure mail sent to mailing
lists is always recognized as non-spam."
  :type 'boolean
  :group 'rmail-spam-filter)

(defcustom rsf-apparently-to-also t
  "*When non-nil, causes recipients to be extracted from any
`Apparently-To' and `X-Apparently-To' headers as from `To' and `Cc'
headers.  When nil, `Apparently-To' and `X-Apparently-To' headers are
ignored."
  :type 'boolean
  :group 'rmail-spam-filter)

(defcustom rsf-explain-decisions nil
  "*When non-nil, messages will have an `X-Rmail-Spam-Filter:' header
inserted that explains why rmail-spam-filter processed them as it
did."
  :type 'boolean
  :group 'rmail-spam-filter)

;;; Variables used only by debugging code.

(defcustom rsf-beep nil
  "*Used only by debugging code:  Non-nil to beep if spam is found."
  :type 'boolean
  :group 'rmail-spam-filter)

(defcustom rsf-sleep-after-message 2.0
  "*Used only by debugging code:  Seconds to wait after display of
message that spam was found."
  :type 'number
  :group 'rmail-spam-filter)

;;; Internal variables

(defvar rsf-scanning-messages-now nil
  "Non nil while rmail-spam-filter scans messages.
Used for interaction with `rsf-bbdb-auto-delete-spam-entries'.")

;; the advantage over the automatic filter definitions is the AND conjunction
;; of in-one-definition-elements
(defun rsf-check-field (field-symbol message-data definition)
  "Check to see if a message matches a particular item in a particular
spam definition.
Test if FIELD-SYMBOL is in the alist DEFINITION, which is an
element from `rsf-definitions-alist'.  If so, check to see whether
MESSAGE-DATA matches the regexp corresponding to FIELD-SYMBOL.
If the regexp is absent in any way (there is no test for this item), returns t.
Otherwise, if MESSAGE-DATA is nil (there is no header for this test),
returns nil.
Otherwise, if the regexp matches MESSAGE-DATA, returns t.
Else returns nil."
  (let ((definition-field (cdr (assoc field-symbol definition))))
    ;; Since (cdr nil) = nil and (length nil) = 0, if field-symbol does
    ;; not appear in this definition, or its value is nil, or its value
    ;; is the null string, this `if' will fail, and the test will be
    ;; trivially satisfied.  This provides upward compatibility when we
    ;; add new tests.
    (or (= (length definition-field) 0)
	(and message-data
	     (string-match definition-field message-data)))))
        

(defun rmail-spam-filter (msg)
  "Return nil if msg is spam based on `rsf-definitions-alist'.
If spam, optionally output msg to a file `rsf-file' and delete
it from rmail file.  Called for each new message retrieved by
`rmail-get-new-mail'."

  (let (message-sender
	message-to
	message-recipients
	message-subject
	message-content-type
	message-text
	;; make sure bbdb does not create entries for messages while spam
	;; filter is scanning the rmail file:
	(bbdb/mail_auto_create_p nil)
	;; let `rsf-bbdb-auto-delete-spam-entries' know that rmail spam
	;; filter is running, so that deletion of rmail messages should be
	;; ignored for now:
	(rsf-scanning-messages-now t)
	;;; do we want to ignore case in spam definitions:
	(case-fold-search rsf-ignore-case)
	)

    (save-excursion
      ;; Narrow buffer to header of message and get header fields to
      ;; be used below:
      (save-restriction
	(goto-char (rmail-msgbeg msg))
	(narrow-to-region (point) (progn (search-forward "\n\n") (point)))
	;; Separate the From: values with `, '.
	;; mail-fetch-field will do this for us, but may return nil.
	(setq message-sender (mail-fetch-field "From" nil t))
	;; Get the recipients
	(let ((temp (rsf-find-recipient-fields)))
	  (setq message-to (nth 2 temp))
	  (setq message-recipients (nth 0 temp)))
	;; Separate the Subject: values with space.
	(setq message-subject
	      (mapconcat (function identity)
			 (nreverse (mail-fetch-field "Subject" nil nil t))
			 " "))
	;; Content-Type: should be unique.
	(setq message-content-type (mail-fetch-field "Content-Type"))
	)
      ;; Buffer now widened to the entire message.
      (setq message-text
	    (buffer-substring (rmail-msgbeg msg) (rmail-msgend msg)))

      (let ((matching-spam-definition
	     ;; Establish a catch so we can exit loops easily.
	     ;; The catch will return a spam definition that matches
	     ;; this message, or nil if it is not spam.
	     (catch 'matching-spam-definition
	       ;; Check white list:  If sender (or possibly recipient)
	       ;; is on the white list, the message is not spam.
	       ;; mapc applies the function that is its second argument to each
	       ;; element of the list that is its third argument.
	       (mapc
		(function
		 (lambda (regexp)
		   ;; Check the regexp against the sender, and if
		   ;; rsf-white-list-recipients-also is set, against
		   ;; the recipients as well.
		   ;; Note message-sender may be nil if there is no
		   ;; From: header.
		   (when (or (and message-sender
				  (string-match regexp message-sender))
			     (and rsf-white-list-recipients-also
				  (string-match regexp message-recipients)))
		     (when rsf-explain-decisions
		       ;; Annotate message with whitelist regexp that
		       ;; matched it.
		       (rsf-insert-explanation-header
			  (format "matches whitelist regexp %S" regexp)))
		     (throw 'matching-spam-definition nil))))
		rsf-white-list)

	       ;; Check for blind CC condition, that is, if the message contains
	       ;; no To: header, it is considered spam.
	       (when (and rsf-no-blind-cc
			  (null message-to))
		 (when rsf-explain-decisions
		   ;; Annotate message that it's a blind CC.
		   (rsf-insert-explanation-header "no To: header"))
		 ;; The action to be taken is determined by
		 ;; rsf-blind-cc-action.
		 (throw 'matching-spam-definition
			`((action . ,rsf-blind-cc-action))))

	       ;; Test the message against each spam definition in the
	       ;; list rsf-definitions-alist.
	       (mapc
		(function
		 (lambda (definition)
		   ;; Test whether this message matches all fields for which
		   ;; tests are defined.
		   (when (and
			  (rsf-check-field 'from message-sender definition)
			  (rsf-check-field 'to message-recipients definition)
			  (rsf-check-field 'subject message-subject definition)
			  (rsf-check-field 'content-type message-content-type
					   definition)
			  (rsf-check-field 'contents message-text
					   definition))
		     (when rsf-explain-decisions
		       ;; Annotate message with filter that matched it.
		       (rsf-insert-explanation-header
			  (format "matches definition %S" definition)))
		     (throw 'matching-spam-definition definition))))
		rsf-definitions-alist)

	       ;; All remaining messages are legitimate.
	       (when rsf-explain-decisions
		 ;; Annotate message.
		 (rsf-insert-explanation-header "No match"))
	       ;; Return nil.
	       nil)))

	;; If found to be spam, do the appropriate processing.
	(when matching-spam-definition
	  ;; Debugging output.
	  ;;(message "Found spam!")
	  ;;(if rsf-beep (ding 1))
	  ;;(sleep-for rsf-sleep-after-message)

	  ;; Temporarily set rmail-current-message in order to
	  ;; output and delete the spam msg if needed:
	  (let* ((rmail-current-message msg)
		 ;; Extract the action from rsf-definitions-alist
		 (action (cdr (assoc 'action matching-spam-definition)))
		 ;; If action is a list, get the first element.
		 (verb (if (consp action) (car action) action)))
	    (case verb
	      ;; Action output-and-delete outputs the message to the spam
	      ;; folder and deletes it.
	      (output-and-delete
	       (rmail-output-to-rmail-file rsf-file 1 t)
	       ;; Don't delete now if automatic deletion after output
	       ;; is turned on
	       (unless rmail-delete-after-output (rmail-delete-message)))
	      ;; Action delete-spam just deletes the message.
	      (delete-spam
	       (rmail-delete-message))
	      (t
	       (error "Unknown action found: %S" verb)))))
	;; Return t if the message is legitimate, nil if it has been found to
	;; be spam.
	(not matching-spam-definition)))))


(defun rsf-insert-explanation-header (value)
  "Insert into a message an `X-Rmail-Spam-Filter:' header explaining how
the filter classified it.  VALUE is the value part of the header.  Any
newlines in VALUE will be converted to `\\n'."
  (goto-char (rmail-msgbeg msg))
  (search-forward "\n*** EOOH ***\n")
  (let ((buffer-read-only nil))
    (insert "X-Rmail-Spam-Filter: "
	    (replace-regexp-in-string "\n" "\\n" value nil t)
	    "\n")))


;; Functions for interactively adding spam definitions or white-list
;; entries based on the subject/sender/recpient/body of the current message.
;; These can be used easily from the menu bar.

(defun rsf-add-subject-to-spam-list ()
  (interactive)
  ;; Go to the rmail-buffer (until the end of this command).
  (set-buffer rmail-buffer)
  ;; Save the point in rmail-buffer, and the current restriction (which should
  ;; be showing just one message).
  (save-excursion
    (save-restriction
      ;; Narrow the buffer to just the headers, so mail-fetch-field works
      ;; correctly.
      (goto-char (point-min))
      (narrow-to-region (point) (search-forward "\n\n"))
      ;; Extract the Subject: value and convert it into a regular expression.
      (let* ((field (mapconcat (function identity)
			       (nreverse (mail-fetch-field "Subject" nil nil t))
			       " "))
	     (message-subject
	      (if (string= field "")
		  (error "No Subject: header in this message")
		(regexp-quote field))))
	;; Assemble the filter definition using backquote.
	(add-to-list 'rsf-definitions-alist
		     `((from . "")
		       (to . "")
		       (subject . ,message-subject)
		       (content-type . "")
		       (contents . "")
		       (action . ,rsf-default-action-for-new-filters))
		     t)
	(rsf-after-adding 'rsf-definitions-alist message-subject "subject"
			  "spam definitions")))))


(defun rsf-add-sender-to-spam-list ()
  (interactive)
  ;; Go to the rmail-buffer (until the end of this command).
  (set-buffer rmail-buffer)
  ;; Save the point in rmail-buffer, and the current restriction (which should
  ;; be showing just one message).
  (save-excursion
    (save-restriction
      ;; Narrow the buffer to just the headers, so mail-fetch-field works
      ;; correctly.
      (goto-char (point-min))
      (narrow-to-region (point) (search-forward "\n\n"))
      ;; Extract the From: value and convert it into a regular expression.
      (let* ((field (mail-fetch-field "From" nil t))
	     (message-sender
	      ;; mail-fetch-field returns nil if there are no From: headers.
	      (if (or (not field) (string= field ""))
		  (error "No From: header in this message")
		(regexp-quote field))))
	;; Assemble the filter definition using backquote.
	(add-to-list 'rsf-definitions-alist
		     `((from . ,message-sender)
		       (to . "")
		       (subject . "")
		       (content-type . "")
		       (contents . "")
		       (action . ,rsf-default-action-for-new-filters))
		     t)
	(rsf-after-adding 'rsf-definitions-alist message-sender "sender"
			  "spam definitions")))))


(defun rsf-add-recipient-to-spam-list ()
  (interactive)
  ;; Go to the rmail-buffer (until the end of this command).
  (set-buffer rmail-buffer)
  ;; Save the point in rmail-buffer, and the current restriction (which should
  ;; be showing just one message).
  (save-excursion
    (save-restriction
      ;; Narrow the buffer to just the headers, so mail-fetch-field works
      ;; correctly.
      (goto-char (point-min))
      (narrow-to-region (point) (search-forward "\n\n"))
      ;; Extract the To:, Cc:, Apparently-To:, and X-Apparently-To:
      ;; values and convert them into a regular expression.
      (let* ((temp (rsf-find-recipient-fields))
	     (field (nth 0 temp))
	     (message-recipients
	      (if (string= field "")
		  (error "No %s headers in this message" (nth 1 temp))
		(regexp-quote field))))
	;; Assemble the filter definition using backquote.
	(add-to-list 'rsf-definitions-alist
		     `((from . "")
		       (to . ,message-recipients)
		       (subject . "")
		       (content-type . "")
		       (contents . "")
		       (action . ,rsf-default-action-for-new-filters))
		     t)
	(rsf-after-adding 'rsf-definitions-alist message-recipients "recipient"
			  "spam definitions")))))


(defun rsf-add-sender-to-white-list ()
  (interactive)
  ;; Go to the rmail-buffer (until the end of this command).
  (set-buffer rmail-buffer)
  ;; Save the point in rmail-buffer, and the current restriction (which should
  ;; be showing just one message).
  (save-excursion
    (save-restriction
      ;; Narrow the buffer to just the headers, so mail-fetch-field works
      ;; correctly.
      (goto-char (point-min))
      (narrow-to-region (point) (search-forward "\n\n"))
      ;; Extract the From: value and convert it into a regular expression.
      (let* ((field (mail-fetch-field "From" nil t))
	     (message-sender
	      ;; mail-fetch-field returns nil if there are no From: headers.
	      (if (or (not field) (string= field ""))
		  (error "No From: header in this message")
		(regexp-quote field))))
	(add-to-list 'rsf-white-list message-sender t)
	(rsf-after-adding 'rsf-white-list message-sender "sender"
			  "white-list")))))


(defun rsf-add-recipient-to-white-list ()
  (interactive)
  ;; Go to the rmail-buffer (until the end of this command).
  (set-buffer rmail-buffer)
  ;; Save the point in rmail-buffer, and the current restriction (which should
  ;; be showing just one message).
  (save-excursion
    (save-restriction
      ;; Narrow the buffer to just the headers, so mail-fetch-field works
      ;; correctly.
      (goto-char (point-min))
      (narrow-to-region (point) (search-forward "\n\n"))
      ;; Extract the To:, Cc:, Apparently-To:, and X-Apparently-To:
      ;; values and convert them into a regular expression.
      (let* ((temp (rsf-find-recipient-fields))
	     (field (nth 0 temp))
	     (message-recipients
	      (if (string= field "")
		  (error "No %s headers in this message" (nth 1 temp))
		(regexp-quote field))))
	(add-to-list 'rsf-white-list message-recipients t)
	(rsf-after-adding 'rsf-white-list message-recipients "recipient"
			  "white-list")))))


(defun rsf-add-region-to-spam-list ()
  "Add the region marked by user in the rmail buffer to spam list as a
contents field filter."
  (interactive)
  (set-buffer rmail-buffer)
  ;; Check that the region is OK.
  ;; The mark must be active.
  (unless mark-active
    (error "The mark is not set now"))
  ;; The region must not have zero length.
  (if (= (region-beginning) (region-end))
      (error "Region has zero length"))
  (if (< (- (region-end) (region-beginning)) rsf-min-region-to-spam-list)
      (error
       "Region is too small; min length is `rsf-min-region-to-spam-list' = %d"
       rsf-min-region-to-spam-list))
  ;; Add the region to list of spam definitions:
  (let ((region-for-spam-list
	 (buffer-substring (region-beginning) (region-end))))
    ;; Assemble the filter definition using backquote.
    (add-to-list 'rsf-definitions-alist
		 `((from . "")
		   (to . "")
		   (subject . "")
		   (content-type . "")
		   (contents . ,(regexp-quote region-for-spam-list))
		   (action . ,rsf-default-action-for-new-filters))
		 t)
    (rsf-after-adding 'rsf-definitions-alist region-for-spam-list
		      "highlighted text" "spam definitions")))


;; Add a regexp to the white list from the keyboard.
(defun rsf-add-regexp-to-white-list (regexp)
  "Add a regexp to the white list.  Prompts for the regexp as an argument,
rather than constructing it from a current message."
  (interactive "sRegexp to add to white list: ")
  (if (string= regexp "")
      (error "Regexp must not be empty"))
  (add-to-list 'rsf-white-list regexp t)
  (rsf-after-adding 'rsf-white-list regexp "regexp" "white-list"))


;; Add a spam pattern from the keyboard.
(defun rsf-add-spam-pattern (sender-regexp recipient-regexp subject-regexp
					   content-type-regexp contents-regexp)
  "Add a spam pattern to the list of spam definitions.
Prompts for regexps with which to test the sender, recipient, subject, and
content-type headers, and the whole message."
  (interactive
   "sSender regexp: \nsRecipient regexp: \nsSubject regexp: \nsContent-Type regexp: \nsContents regexp: ")
  (if (and (string= sender-regexp "")
	   (string= recipient-regexp "")
	   (string= subject-regexp "")
	   (string= content-type-regexp "")
	   (string= contents-regexp ""))
      (error "At least one regexp must be non-empty"))
  ;; Assemble the filter definition using backquote.
  (let ((pattern `((from . ,sender-regexp)
		   (to . ,recipient-regexp)
		   (subject . ,subject-regexp)
		   (content-type . ,content-type-regexp)
		   (contents . ,contents-regexp)
		   (action . ,rsf-default-action-for-new-filters))))
    (add-to-list 'rsf-definitions-alist pattern t)
    (rsf-after-adding 'rsf-definitions-alist pattern "pattern"
		      "spam definitions")))


(defun rsf-after-adding (variable value thing list)
  "After changing a spam definition, call this function.
VARIABLE is the variable whose value was changed, usually
`rsf-definitions-alist' or `rsf-white-list'.
VALUE is the item that was added to the list which is the value of VARIABLE.
THING is a string describing the new item, such as \"sender\",
\"recipient\", or  \"region\".
LIST is a string describing the list the item was added to, such as
\"spam definitions\" or \"white list\"."
  ;; Mark the variable as changed in this session, so it will be saved the next
  ;; time custom-save-customized is called.
  (customize-set-variable variable (symbol-value variable))
  ;; Check whether we are to auto-save changes.
  (if rsf-autosave-newly-added-definitions
      ;; If so, save everything that has been customized or saved before.
      (customize-save-customized))
  ;; Give the user an appropriate message.
  (message "Added %s `%s' to %s%s"
	   thing value list
	   (if rsf-autosave-newly-added-definitions
	       " and saved the spam definitions to file."
	     ".  Remember to save the spam definitions to file using the spam menu.")))

(defun rsf-find-recipient-fields ()
  "Get the recipient header fields (To:, etc.) from the current message.

Call with the buffer narrowed to the headers of a message.  Returns a
three-element list.  The first element is the concatenation of all
recipient header fields, separated with `, '.  The second element is
text describing the list of all header types that are considered
recipients, to be used to compose messages to the user.  The third
element is nil if no To: header was found (the message is apparently a
blind Cc) and non-nil if To: was found.

`To:' and `Cc:' headers are always considered recipient headers.  If
`rsf-apparently-to-also' is non-nil, then `Apparently-To:'  and
`X-Apparently-To:' are considered recipient headers also."
  (let ((message-to (mail-fetch-field "To" nil nil t)))
    (list
     ;; Concatenate the To:, Cc:, and optionally Apparently-To:,
     ;; X-Apparently-To: header values to get a complete list of
     ;; recipients.
     (mapconcat
      (function identity)
      ;; The lists returned by mail-fetch-field are in reverse of the
      ;; order they appear in the text, so we reverse them before
      ;; concatenating, to avoid confusing the user.
      (append (nreverse message-to)
	      (nreverse (mail-fetch-field "Cc" nil nil t))
	      ;; Include Apparently-To: and X-Apparently-To: headers only
	      ;; if rsf-apparently-to-also.
	      (if rsf-apparently-to-also
		  (nreverse (mail-fetch-field "Apparently-To" nil nil t))
		nil)
	      (if rsf-apparently-to-also
		  (nreverse (mail-fetch-field "X-Apparently-To" nil nil t))
		nil))
      ", ")
     (if rsf-apparently-to-also
	 "To:, Cc:, Apparently-To:, or X-Apparently-To:"
       "To: or Cc:")
     message-to)))

;; Functions to invoke the customization system on the spam filter variables.

(defun rsf-customize-spam-definitions ()
  (interactive)
  (customize-variable (quote rsf-definitions-alist)))

(defun rsf-customize-group ()
  (interactive)
  (customize-group (quote rmail-spam-filter)))

;; Save the variables that have been customized in the current session, but
;; not saved yet.
(defun rsf-custom-save-all ()
  (interactive)
  ;; customize-save-customized saves the current values of all variables
  ;; that are flagged as having been customized in the current session
  ;; by having non-nil customized-value properties.
  (customize-save-customized))

;; Add the menu items and keyboard shortcuts to both rmail and
;; rmail-summary modes.

(define-key rmail-summary-mode-map [menu-bar spam]
  (cons "Spam" (make-sparse-keymap "Spam")))
(define-key rmail-mode-map [menu-bar spam]
  (cons "Spam" (make-sparse-keymap "Spam")))

(defun rsf-add-binding (function key menu-text menu-symbol)
  "Add keyboard bindings and menu items to rmail and rmail-summary modes
for a spam filter function.
FUNCTION is the name of the function.
KEY is the keyboard binding string (after the spam keyboard prefix).
MENU-TEXT is the text for the menu item.
MENU-SYMBOL is the event symbol for the menu item."
  (let ((binding (concat "\C-cS" key))
	(menu-event (vector 'menu-bar 'spam menu-symbol))
	(menu-action (cons menu-text function)))
    (define-key rmail-summary-mode-map menu-event menu-action)
    (define-key rmail-mode-map menu-event menu-action)
    (define-key rmail-summary-mode-map binding function)
    (define-key rmail-mode-map binding function)))

;; Assemble the pull-down menus from the bottom up.

(rsf-add-binding 'rsf-custom-save-all "a"
		 "Save all customizations to customization file"
		 'rsf-custom-save-all)

(define-key rmail-summary-mode-map [menu-bar spam separator-save-all] '("----"))
(define-key rmail-mode-map [menu-bar spam separator-save-all] '("----"))

(rsf-add-binding 'rsf-customize-group "g"
		 "Browse customizations of rmail spam filter" 'customize-group)
(rsf-add-binding 'rsf-customize-spam-definitions "d"
		 "Customize list of spam definitions" 'customize-spam-list)

(define-key rmail-summary-mode-map [menu-bar spam separator-customize]
  '("----"))
(define-key rmail-mode-map [menu-bar spam separator-customize] '("----"))

(rsf-add-binding 'rsf-add-regexp-to-white-list "W"
		 "Add regexp to white list" 'add-regexp-to-white-list)
(rsf-add-binding 'rsf-add-spam-pattern "S"
		 "Add definition to spam list" 'add-spam-pattern)

(rsf-add-binding 'rsf-add-recipient-to-white-list "x"
		 "Add recipient to white list" 'add-recipient-to-white-list)
(rsf-add-binding 'rsf-add-sender-to-white-list "w" "Add sender to white list"
		 'add-sender-to-white-list)
(rsf-add-binding 'rsf-add-region-to-spam-list "n" "Add region to spam list"
		 'add-region-to-spam-list)
(rsf-add-binding 'rsf-add-recipient-to-spam-list "i"
		 "Add recipient to spam list" 'add-recipient-to-spam-list)
(rsf-add-binding 'rsf-add-sender-to-spam-list "r" "Add sender to spam list"
		 'add-sender-to-spam-list)
(rsf-add-binding 'rsf-add-subject-to-spam-list "t" "Add subject to spam list"
		 'add-subject-to-spam-list)

(defun rsf-add-content-type-field ()
  "Maintain backward compatibility with previous versions of rmail-spam-filter.
The most recent version of rmail-spam-filter checks the contents
field of the incoming mail to see if it spam.  The format of
`rsf-definitions-alist' has therefore changed.  This function
checks to see if old format is used, and if it is, it converts
`rsf-definitions-alist' to the new format.  Invoked
automatically, no user input is required."
  (interactive)
  (if (and rsf-definitions-alist
           (not (assoc 'content-type (car rsf-definitions-alist))))
      (let ((result nil)
            (current nil)
            (definitions rsf-definitions-alist))
        (while definitions
          (setq current (car definitions))
          (setq definitions (cdr definitions))
          (setq result
                (append result
                        (list
                         (list (assoc 'from current)
                               (assoc 'to current)
                               (assoc 'subject current)
                               (cons 'content-type "")
                               (assoc 'contents current)
                               (assoc 'action current))))))
        (setq rsf-definitions-alist result)
        (customize-mark-to-save 'rsf-definitions-alist)
        (if rsf-autosave-newly-added-definitions
            (progn
              (custom-save-all)
              (message (concat "converted spam definitions to new format\n"
                               "and saved the spam definitions to file.")))
          (message (concat "converted spam definitions to new format\n"
                           "Don't forget to save the spam definitions to file using the
                           spam menu"))
          ))))

(provide 'rmail-spam-filter)

;;; arch-tag: 03e1d45d-b72f-4dd7-8f04-e7fd78249746
;;; rmail-spam-filter ends here