Mercurial > emacs
comparison lisp/gnus/spam-wash.el @ 85712:a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-911
author | Miles Bader <miles@gnu.org> |
---|---|
date | Sun, 28 Oct 2007 09:18:39 +0000 |
parents | |
children | 4a101c5e6b9f |
comparison
equal
deleted
inserted
replaced
85711:b6f5dc84b2e1 | 85712:a3c27999decb |
---|---|
1 ;;; spam-wash.el --- wash spam before analysis | |
2 | |
3 ;; Copyright (C) 2004 Free Software Foundation, Inc. | |
4 | |
5 ;; Author: Andrew Cohen <cohen@andy.bu.edu> | |
6 ;; Keywords: mail | |
7 | |
8 ;; This file is part of GNU Emacs. | |
9 | |
10 ;; This is free software; you can redistribute it and/or modify it | |
11 ;; under the terms of the GNU General Public License as published by | |
12 ;; the Free Software Foundation; either version 3, or (at your option) | |
13 ;; any later version. | |
14 | |
15 ;; This is distributed in the hope that it will be useful, but WITHOUT | |
16 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY | |
17 ;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public | |
18 ;; License for more details. | |
19 | |
20 ;; You should have received a copy of the GNU General Public License | |
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, | |
23 ;; Boston, MA 02110-1301, USA. | |
24 | |
25 ;;; Commentary: | |
26 | |
27 ;; This library decodes MIME encodings such as base64 and | |
28 ;; quoted-printable to allow for better spam analysis. | |
29 ;; | |
30 ;; `spam-wash' should be called in a buffer containing the message. | |
31 | |
32 ;;; Code: | |
33 | |
34 (require 'gnus-art) | |
35 | |
36 (defun spam-wash () | |
37 "Treat the current buffer prior to spam analysis." | |
38 (interactive) | |
39 (run-hooks 'gnus-article-decode-hook) | |
40 (save-excursion | |
41 (save-restriction | |
42 (let* ((buffer-read-only nil) | |
43 (gnus-inhibit-treatment t) | |
44 (gnus-article-buffer (current-buffer)) | |
45 (handles (or (mm-dissect-buffer nil gnus-article-loose-mime) | |
46 (and gnus-article-emulate-mime | |
47 (mm-uu-dissect)))) | |
48 handle) | |
49 (when gnus-article-mime-handles | |
50 (mm-destroy-parts gnus-article-mime-handles) | |
51 (setq gnus-article-mime-handle-alist nil)) | |
52 (setq gnus-article-mime-handles handles) | |
53 (when (and handles | |
54 (or (not (stringp (car handles))) | |
55 (cdr handles))) | |
56 (article-goto-body) | |
57 (delete-region (point) (point-max)) | |
58 (spam-treat-parts handles)))))) | |
59 | |
60 (defun spam-treat-parts (handle) | |
61 (if (stringp (car handle)) | |
62 (mapcar 'spam-treat-parts (cdr handle)) | |
63 (if (bufferp (car handle)) | |
64 (save-restriction | |
65 (narrow-to-region (point) (point)) | |
66 (when (let ((case-fold-search t)) | |
67 (string-match "text" (car (mm-handle-type handle)))) | |
68 (mm-insert-part handle)) | |
69 (goto-char (point-max))) | |
70 (mapcar 'spam-treat-parts handle)))) | |
71 | |
72 (provide 'spam-wash) | |
73 | |
74 ;;; arch-tag: 3c7f94a7-c96d-4c77-bb59-950df12bc85f | |
75 ;;; spam-wash.el ends here |