1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
|
;;; rmail-kill.el --- Mail filtering for rmail
;; Copyright status unknown
;; Author: Unknown
;; Keywords: mail
;; This file is part of XEmacs.
;; XEmacs 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.
;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the Free
;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
;; 02111-1307, USA.
;;; Synched up with: Not in FSF.
;;; Commentary:
;; This is the Original Notice on this file:
;; GNU Emacs and this file "rmail-kill.el", is distributed in the hope
;; that it will be useful, but WITHOUT ANY WARRANTY. No author or
;; distributor accepts responsibility to anyone for the consequences
;; of using it or for whether it serves any particular purpose or
;; works at all, unless he says so in writing. Refer to the GNU Emacs
;; General Public License for full details.
;; Everyone is granted permission to copy, modify and redistribute GNU
;; Emacs and rmail-kill.el, but only under the conditions described in
;; the GNU Emacs General Public License. A copy of this license is
;; supposed to have been given to you along with GNU Emacs so you can
;; know your rights and responsibilities. It should be in a file
;; named COPYING. Among other things, the copyright notice and this
;; notice must be preserved on all copies.
;;; Code:
(setq rmail-message-filter 'rmail-maybe-execute-message
rmail-mode-hook '((lambda ()
(define-key rmail-mode-map "e" 'rmail-extract-rejected-message)
(define-key rmail-mode-map "b" 'rmail-beginning-of-message)
(define-key rmail-mode-map "K" 'rmail-execute-messages))))
;; a-list with each entry (rmail-field-name . pattern)
(defvar rmail-usual-suspects
'(("subject" . "Smithsonian Astronomical Observatory")
("subject" . "MGR, Bellcore window manager, Part"))
"An alist used to kill rmail messages based on regex matches to different fields.
The car of each entry is the name of a mail header, the cdr is a pattern.
Case is not significant.)
See also the documentation for rmail-maybe-execute-message and
rmail-execute-messages.")
(setq kill-emacs-hook 'maybe-book-some-suspects)
(defun maybe-book-some-suspects ()
(save-window-excursion
(find-file "~/.emacs")
(goto-char (point-min))
(re-search-forward "^(defvar rmail-usual-suspects$")
(down-list 1)
(backward-char 1)
(if (not (equal rmail-usual-suspects
(save-excursion (read (current-buffer)))))
(progn
(switch-to-buffer-other-window "SUSPECTS")
(erase-buffer)
(mapcar '(lambda (x) (print x (current-buffer)))
rmail-usual-suspects)
(set-buffer-modified-p nil)
(if (y-or-n-p "Save the usual suspects? ")
(progn
(set-buffer ".emacs")
(kill-sexp 1)
(prin1 rmail-usual-suspects (get-buffer ".emacs"))
(save-buffer)))))))
(defun rmail-maybe-execute-message (&optional suspects dont-move)
"Kill the current message if it matches an entry in SUSPECTS.
SUSPECTS is alist of the form of rmail-usual-suspects (which see).
If the current message contains a mail header that matches pattern,
it is deleted.
This function can be used as a rmail-message-filter (which see)."
(if (null suspects)
(setq suspects rmail-usual-suspects))
(while suspects
(if (and (string-match (cdr (car suspects))
;; if not such field, can never match
(or (mail-fetch-field (car (car suspects))) "$^"))
(not (rmail-message-deleted-p rmail-current-message)))
(progn
(message "Deleted message %d" rmail-current-message)
(if dont-move
(rmail-delete-message)
(rmail-delete-forward))
(setq suspects nil))
(setq suspects (cdr suspects)))))
(defun rmail-execute-messages (round-up-the-usual-suspects)
"Kill some rmail messages based on regex matches to a kill-alist.
With a prefix arg, use rmail-usual-suspects as the kill-alist, otherwise
prompt for a field name."
(interactive "P")
(let ((scene-of-the-crime rmail-current-message)
(alleged-perpetrator)
(cuffed-all-suspects nil))
(if round-up-the-usual-suspects
(setq alleged-perpetrator rmail-usual-suspects)
(let* ((weapon (rmail-get-current-header "Kill what field? (default Subject) " "Subject"))
(default-description (or (regexp-quote (mail-fetch-field weapon))
"some regex"))
(most-wanted-notice (format "Kill messages having a \"%s\" field matching? (default %s) "
weapon default-description))
(suspect-description (read-string-with-default most-wanted-notice default-description)))
(setq alleged-perpetrator (list (cons weapon suspect-description)))
(if (y-or-n-p "Add it to rmail-usual-suspects? ")
(setq rmail-usual-suspects (append alleged-perpetrator rmail-usual-suspects)))))
(while (not cuffed-all-suspects)
(rmail-maybe-execute-message alleged-perpetrator 'dont-move)
;;
;; rmail-next-undeleted-message returns a string when there are no more, but
;; we also want a chance to delete that last message...
;;
(if (stringp alleged-perpetrator)
(setq cuffed-all-suspects t)
(setq cuffed-all-suspects (rmail-next-undeleted-message 1))))
(rmail-show-message scene-of-the-crime)
(if (rmail-message-deleted-p rmail-current-message)
(rmail-next-undeleted-message 1))
(if (rmail-message-deleted-p rmail-current-message)
(rmail-previous-undeleted-message 1))))
(defun rmail-get-current-header (prompt default)
(save-excursion
(let* ((end (progn (end-of-line) (point))))
(beginning-of-line)
(if (re-search-forward "^\\([^ \t]*\\):" end t)
(buffer-substring (match-beginning 1) (match-end 1))
(read-string-with-default prompt default)))))
(defun read-string-with-default (prompt default)
(let ((s (read-string prompt)))
(if (string= s "") default s)))
(provide 'rmail-kill)
;;; rmail-kill.el ends here
|
