Download
(require 'rmail)
(defun rmail-spamprobe-original-message (&optional n)
"Return an approximation of a pre-babylized RMAIL message.
With optional arg N, use the nth message in the current RMAIL file,
else use the current message."
(with-current-buffer rmail-buffer
(or n (setq n rmail-current-message))
(save-restriction
(narrow-to-region (rmail-msgbeg n) (rmail-msgend n))
(let ((msg (buffer-substring-no-properties (point-min) (point-max))))
(with-temp-buffer
(insert msg)
(goto-char (point-min))
(when (looking-at "\C-_\C-l")
(forward-line 2)
(while (looking-at "Summary-line:\\|X-Coding-System:")
(forward-line 1))
(when (looking-at "^\\(Mail-from:[ \t]+\\)")
(goto-char (match-end 1)))
(delete-region (point-min) (point)))
(when (re-search-forward "^\\*\\*\\* EOOH \\*\\*\\*\n" nil t)
(forward-line -1)
(delete-region (point) (search-forward "\n\n")))
(buffer-string))))))
(defun rmail-spamprobe-narrow-to-header ()
"Narrow to the header of a mail message.
Point is placed at the beginning of the header."
(narrow-to-region
(goto-char (point-min))
(if (search-forward "\n\n" nil t)
(1- (point))
(point-max)))
(goto-char (point-min)))
(defun rmail-spamprobe-get-header-field (field-name)
"Return the text value for FIELD-NAME, or nil if no such header exists."
(let ((name (concat "^" (regexp-quote field-name) "[ \t]*:[ \t]*"))
(inhibit-point-motion-hooks t)
(case-fold-search t)
value start)
(save-excursion
(save-restriction
(rmail-spamprobe-narrow-to-header)
(when (re-search-forward name nil t)
(setq start (point))
(end-of-line)
(push (buffer-substring start (point)) value)
(while (progn (forward-line 1) (looking-at "[ \t]+"))
(setq start (match-end 0))
(end-of-line)
(push (buffer-substring start (point)) value))))
(when value
(mapconcat 'identity (nreverse value) " ")))))
(defun rmail-spamprobe-delete-header-field (field-name)
"Delete the header field FIELD-NAME."
(let ((name (concat "^" (regexp-quote field-name) "[ \t]*:[ \t]*"))
(inhibit-point-motion-hooks t)
(case-fold-search t)
start)
(save-excursion
(save-restriction
(rmail-spamprobe-narrow-to-header)
(when (re-search-forward name nil t)
(setq start (match-beginning 0))
(end-of-line)
(while (progn (forward-line 1) (looking-at "[ \t]+"))
(end-of-line))
(delete-region start (point)))))))
(defun rmail-spamprobe-retrain-dwim ()
(interactive)
(let ((msg (rmail-spamprobe-original-message))
(action nil))
(with-temp-buffer
(insert msg)
(goto-char (point-min))
(let ((field (rmail-spamprobe-get-header-field "x-spamprobe")))
(if (not field)
(error "spamprobe doesn't know about this message")
(setq action (cond ((string-match "SPAM" field)
"good")
((string-match "GOOD" field)
"spam")))))
(if (not (stringp action))
(error "unable to determine what to do with message")
(rmail-spamprobe-delete-header-field "x-spamprobe")
(call-process-region
(point-min) (point-max)
(executable-find "spamprobe")
nil 0 nil action)
(call-process-region
(point-min) (point-max)
(executable-find "procmail")
nil 0 nil)))
(rmail-delete-forward)))
(provide 'rmail-spamprobe)