annotate lisp/gnus-kill.el @ 15489:5393431269db

(skeleton-autowrap): New variable. (skeleton-abbrev-cleanup): Added variable documentation. (skeleton-proxy): Added optional autowrappping feature. (skeleton-proxy, skeleton-abbrev-cleanup): Use `post-command-hook' instead of someday to be obsolete defer.
author Richard M. Stallman <rms@gnu.org>
date Sat, 22 Jun 1996 17:42:15 +0000
parents e6770e6ff02d
children 530d0d516a42
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
13401
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
1 ;;; gnus-kill.el --- kill commands for Gnus
14169
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 13401
diff changeset
2
13401
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
3 ;; Copyright (C) 1995 Free Software Foundation, Inc.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
4
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
5 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
6 ;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
7 ;; Keywords: news
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
8
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
9 ;; This file is part of GNU Emacs.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
10
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
12 ;; it under the terms of the GNU General Public License as published by
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
13 ;; the Free Software Foundation; either version 2, or (at your option)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
14 ;; any later version.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
15
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
16 ;; GNU Emacs is distributed in the hope that it will be useful,
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
19 ;; GNU General Public License for more details.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
20
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
21 ;; You should have received a copy of the GNU General Public License
14169
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 13401
diff changeset
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 13401
diff changeset
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 13401
diff changeset
24 ;; Boston, MA 02111-1307, USA.
13401
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
25
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
26 ;;; Commentary:
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
27
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
28 ;;; Code:
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
29
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
30 (require 'gnus)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
31
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
32 (defvar gnus-kill-file-mode-hook nil
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
33 "*A hook for Gnus kill file mode.")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
34
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
35 (defvar gnus-kill-expiry-days 7
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
36 "*Number of days before expiring unused kill file entries.")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
37
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
38 (defvar gnus-kill-save-kill-file nil
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
39 "*If non-nil, will save kill files after processing them.")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
40
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
41 (defvar gnus-winconf-kill-file nil)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
42
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
43
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
44
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
45 (defmacro gnus-raise (field expression level)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
46 (` (gnus-kill (, field) (, expression)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
47 (function (gnus-summary-raise-score (, level))) t)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
48
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
49 (defmacro gnus-lower (field expression level)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
50 (` (gnus-kill (, field) (, expression)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
51 (function (gnus-summary-raise-score (- (, level)))) t)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
52
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
53 ;;;
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
54 ;;; Gnus Kill File Mode
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
55 ;;;
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
56
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
57 (defvar gnus-kill-file-mode-map nil)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
58
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
59 (if gnus-kill-file-mode-map
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
60 nil
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
61 (setq gnus-kill-file-mode-map (copy-keymap emacs-lisp-mode-map))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
62 (define-key gnus-kill-file-mode-map
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
63 "\C-c\C-k\C-s" 'gnus-kill-file-kill-by-subject)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
64 (define-key gnus-kill-file-mode-map
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
65 "\C-c\C-k\C-a" 'gnus-kill-file-kill-by-author)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
66 (define-key gnus-kill-file-mode-map
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
67 "\C-c\C-k\C-t" 'gnus-kill-file-kill-by-thread)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
68 (define-key gnus-kill-file-mode-map
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
69 "\C-c\C-k\C-x" 'gnus-kill-file-kill-by-xref)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
70 (define-key gnus-kill-file-mode-map
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
71 "\C-c\C-a" 'gnus-kill-file-apply-buffer)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
72 (define-key gnus-kill-file-mode-map
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
73 "\C-c\C-e" 'gnus-kill-file-apply-last-sexp)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
74 (define-key gnus-kill-file-mode-map
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
75 "\C-c\C-c" 'gnus-kill-file-exit))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
76
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
77 (defun gnus-kill-file-mode ()
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
78 "Major mode for editing kill files.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
79
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
80 If you are using this mode - you probably shouldn't. Kill files
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
81 perform badly and paint with a pretty broad brush. Score files, on
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
82 the other hand, are vastly faster (40x speedup) and give you more
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
83 control over what to do.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
84
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
85 In addition to Emacs-Lisp Mode, the following commands are available:
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
86
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
87 \\{gnus-kill-file-mode-map}
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
88
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
89 A kill file contains Lisp expressions to be applied to a selected
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
90 newsgroup. The purpose is to mark articles as read on the basis of
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
91 some set of regexps. A global kill file is applied to every newsgroup,
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
92 and a local kill file is applied to a specified newsgroup. Since a
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
93 global kill file is applied to every newsgroup, for better performance
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
94 use a local one.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
95
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
96 A kill file can contain any kind of Emacs Lisp expressions expected
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
97 to be evaluated in the Summary buffer. Writing Lisp programs for this
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
98 purpose is not so easy because the internal working of Gnus must be
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
99 well-known. For this reason, Gnus provides a general function which
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
100 does this easily for non-Lisp programmers.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
101
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
102 The `gnus-kill' function executes commands available in Summary Mode
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
103 by their key sequences. `gnus-kill' should be called with FIELD,
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
104 REGEXP and optional COMMAND and ALL. FIELD is a string representing
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
105 the header field or an empty string. If FIELD is an empty string, the
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
106 entire article body is searched for. REGEXP is a string which is
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
107 compared with FIELD value. COMMAND is a string representing a valid
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
108 key sequence in Summary mode or Lisp expression. COMMAND defaults to
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
109 '(gnus-summary-mark-as-read nil \"X\"). Make sure that COMMAND is
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
110 executed in the Summary buffer. If the second optional argument ALL
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
111 is non-nil, the COMMAND is applied to articles which are already
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
112 marked as read or unread. Articles which are marked are skipped over
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
113 by default.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
114
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
115 For example, if you want to mark articles of which subjects contain
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
116 the string `AI' as read, a possible kill file may look like:
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
117
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
118 (gnus-kill \"Subject\" \"AI\")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
119
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
120 If you want to mark articles with `D' instead of `X', you can use
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
121 the following expression:
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
122
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
123 (gnus-kill \"Subject\" \"AI\" \"d\")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
124
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
125 In this example it is assumed that the command
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
126 `gnus-summary-mark-as-read-forward' is assigned to `d' in Summary Mode.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
127
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
128 It is possible to delete unnecessary headers which are marked with
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
129 `X' in a kill file as follows:
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
130
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
131 (gnus-expunge \"X\")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
132
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
133 If the Summary buffer is empty after applying kill files, Gnus will
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
134 exit the selected newsgroup normally. If headers which are marked
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
135 with `D' are deleted in a kill file, it is impossible to read articles
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
136 which are marked as read in the previous Gnus sessions. Marks other
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
137 than `D' should be used for articles which should really be deleted.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
138
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
139 Entry to this mode calls emacs-lisp-mode-hook and
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
140 gnus-kill-file-mode-hook with no arguments, if that value is non-nil."
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
141 (interactive)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
142 (kill-all-local-variables)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
143 (use-local-map gnus-kill-file-mode-map)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
144 (set-syntax-table emacs-lisp-mode-syntax-table)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
145 (setq major-mode 'gnus-kill-file-mode)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
146 (setq mode-name "Kill")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
147 (lisp-mode-variables nil)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
148 (run-hooks 'emacs-lisp-mode-hook 'gnus-kill-file-mode-hook))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
149
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
150 (defun gnus-kill-file-edit-file (newsgroup)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
151 "Begin editing a kill file for NEWSGROUP.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
152 If NEWSGROUP is nil, the global kill file is selected."
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
153 (interactive "sNewsgroup: ")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
154 (let ((file (gnus-newsgroup-kill-file newsgroup)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
155 (gnus-make-directory (file-name-directory file))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
156 ;; Save current window configuration if this is first invocation.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
157 (or (and (get-file-buffer file)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
158 (get-buffer-window (get-file-buffer file)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
159 (setq gnus-winconf-kill-file (current-window-configuration)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
160 ;; Hack windows.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
161 (let ((buffer (find-file-noselect file)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
162 (cond ((get-buffer-window buffer)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
163 (pop-to-buffer buffer))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
164 ((eq major-mode 'gnus-group-mode)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
165 (gnus-configure-windows 'group) ;Take all windows.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
166 (pop-to-buffer buffer))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
167 ((eq major-mode 'gnus-summary-mode)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
168 (gnus-configure-windows 'article)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
169 (pop-to-buffer gnus-article-buffer)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
170 (bury-buffer gnus-article-buffer)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
171 (switch-to-buffer buffer))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
172 (t ;No good rules.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
173 (find-file-other-window file))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
174 (gnus-kill-file-mode)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
175
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
176 ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
177 (defun gnus-kill-set-kill-buffer ()
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
178 (let* ((file (gnus-newsgroup-kill-file gnus-newsgroup-name))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
179 (buffer (find-file-noselect file)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
180 (set-buffer buffer)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
181 (gnus-kill-file-mode)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
182 (bury-buffer buffer)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
183
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
184 (defun gnus-kill-file-enter-kill (field regexp)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
185 ;; Enter kill file entry.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
186 ;; FIELD: String containing the name of the header field to kill.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
187 ;; REGEXP: The string to kill.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
188 (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
189 (let (string)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
190 (or (eq major-mode 'gnus-kill-file-mode)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
191 (gnus-kill-set-kill-buffer))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
192 (current-buffer)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
193 (goto-char (point-max))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
194 (insert (setq string (format "(gnus-kill %S %S)\n" field regexp)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
195 (gnus-kill-file-apply-string string))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
196
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
197 (defun gnus-kill-file-kill-by-subject ()
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
198 "Kill by subject."
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
199 (interactive)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
200 (gnus-kill-file-enter-kill
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
201 "Subject"
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
202 (if (vectorp gnus-current-headers)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
203 (regexp-quote
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
204 (gnus-simplify-subject (mail-header-subject gnus-current-headers)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
205 "")))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
206
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
207 (defun gnus-kill-file-kill-by-author ()
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
208 "Kill by author."
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
209 (interactive)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
210 (gnus-kill-file-enter-kill
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
211 "From"
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
212 (if (vectorp gnus-current-headers)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
213 (regexp-quote (mail-header-from gnus-current-headers))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
214 "")))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
215
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
216 (defun gnus-kill-file-kill-by-thread ()
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
217 "Kill by author."
14569
e6770e6ff02d (gnus-kill-file-kill-by-thread): Correct interactive declaration.
Erik Naggum <erik@naggum.no>
parents: 14169
diff changeset
218 (interactive)
13401
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
219 (gnus-kill-file-enter-kill
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
220 "References"
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
221 (if (vectorp gnus-current-headers)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
222 (regexp-quote (mail-header-id gnus-current-headers))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
223 "")))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
224
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
225 (defun gnus-kill-file-kill-by-xref ()
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
226 "Kill by Xref."
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
227 (interactive)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
228 (let ((xref (and (vectorp gnus-current-headers)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
229 (mail-header-xref gnus-current-headers)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
230 (start 0)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
231 group)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
232 (if xref
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
233 (while (string-match " \\([^ \t]+\\):" xref start)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
234 (setq start (match-end 0))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
235 (if (not (string=
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
236 (setq group
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
237 (substring xref (match-beginning 1) (match-end 1)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
238 gnus-newsgroup-name))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
239 (gnus-kill-file-enter-kill
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
240 "Xref" (concat " " (regexp-quote group) ":"))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
241 (gnus-kill-file-enter-kill "Xref" ""))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
242
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
243 (defun gnus-kill-file-raise-followups-to-author (level)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
244 "Raise score for all followups to the current author."
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
245 (interactive "p")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
246 (let ((name (mail-header-from gnus-current-headers))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
247 string)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
248 (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
249 (gnus-kill-set-kill-buffer)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
250 (goto-char (point-min))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
251 (setq name (read-string (concat "Add " level
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
252 " to followup articles to: ")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
253 (regexp-quote name)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
254 (setq
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
255 string
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
256 (format
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
257 "(gnus-kill %S %S '(gnus-summary-temporarily-raise-by-thread %S))\n"
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
258 "From" name level))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
259 (insert string)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
260 (gnus-kill-file-apply-string string))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
261 (message "Added temporary score file entry for followups to %s." name)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
262
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
263 (defun gnus-kill-file-apply-buffer ()
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
264 "Apply current buffer to current newsgroup."
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
265 (interactive)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
266 (if (and gnus-current-kill-article
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
267 (get-buffer gnus-summary-buffer))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
268 ;; Assume newsgroup is selected.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
269 (gnus-kill-file-apply-string (buffer-string))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
270 (ding) (message "No newsgroup is selected.")))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
271
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
272 (defun gnus-kill-file-apply-string (string)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
273 "Apply STRING to current newsgroup."
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
274 (interactive)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
275 (let ((string (concat "(progn \n" string "\n)")))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
276 (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
277 (save-window-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
278 (pop-to-buffer gnus-summary-buffer)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
279 (eval (car (read-from-string string)))))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
280
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
281 (defun gnus-kill-file-apply-last-sexp ()
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
282 "Apply sexp before point in current buffer to current newsgroup."
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
283 (interactive)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
284 (if (and gnus-current-kill-article
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
285 (get-buffer gnus-summary-buffer))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
286 ;; Assume newsgroup is selected.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
287 (let ((string
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
288 (buffer-substring
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
289 (save-excursion (forward-sexp -1) (point)) (point))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
290 (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
291 (save-window-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
292 (pop-to-buffer gnus-summary-buffer)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
293 (eval (car (read-from-string string))))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
294 (ding) (message "No newsgroup is selected.")))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
295
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
296 (defun gnus-kill-file-exit ()
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
297 "Save a kill file, then return to the previous buffer."
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
298 (interactive)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
299 (save-buffer)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
300 (let ((killbuf (current-buffer)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
301 ;; We don't want to return to article buffer.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
302 (and (get-buffer gnus-article-buffer)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
303 (bury-buffer gnus-article-buffer))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
304 ;; Delete the KILL file windows.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
305 (delete-windows-on killbuf)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
306 ;; Restore last window configuration if available.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
307 (and gnus-winconf-kill-file
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
308 (set-window-configuration gnus-winconf-kill-file))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
309 (setq gnus-winconf-kill-file nil)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
310 ;; Kill the KILL file buffer. Suggested by tale@pawl.rpi.edu.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
311 (kill-buffer killbuf)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
312
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
313 ;; For kill files
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
314
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
315 (defun gnus-Newsgroup-kill-file (newsgroup)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
316 "Return the name of a kill file for NEWSGROUP.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
317 If NEWSGROUP is nil, return the global kill file instead."
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
318 (cond ((or (null newsgroup)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
319 (string-equal newsgroup ""))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
320 ;; The global kill file is placed at top of the directory.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
321 (expand-file-name gnus-kill-file-name
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
322 (or gnus-kill-files-directory "~/News")))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
323 (gnus-use-long-file-name
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
324 ;; Append ".KILL" to capitalized newsgroup name.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
325 (expand-file-name (concat (gnus-capitalize-newsgroup newsgroup)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
326 "." gnus-kill-file-name)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
327 (or gnus-kill-files-directory "~/News")))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
328 (t
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
329 ;; Place "KILL" under the hierarchical directory.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
330 (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
331 "/" gnus-kill-file-name)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
332 (or gnus-kill-files-directory "~/News")))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
333
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
334 (defun gnus-expunge (marks)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
335 "Remove lines marked with MARKS."
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
336 (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
337 (set-buffer gnus-summary-buffer)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
338 (gnus-summary-remove-lines-marked-with marks)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
339
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
340 (defun gnus-apply-kill-file-internal ()
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
341 "Apply a kill file to the current newsgroup.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
342 Returns the number of articles marked as read."
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
343 (let* ((kill-files (list (gnus-newsgroup-kill-file nil)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
344 (gnus-newsgroup-kill-file gnus-newsgroup-name)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
345 (unreads (length gnus-newsgroup-unreads))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
346 (gnus-summary-inhibit-highlight t)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
347 beg)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
348 (setq gnus-newsgroup-kill-headers nil)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
349 (or gnus-newsgroup-headers-hashtb-by-number
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
350 (gnus-make-headers-hashtable-by-number))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
351 ;; If there are any previously scored articles, we remove these
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
352 ;; from the `gnus-newsgroup-headers' list that the score functions
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
353 ;; will see. This is probably pretty wasteful when it comes to
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
354 ;; conses, but is, I think, faster than having to assq in every
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
355 ;; single score function.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
356 (let ((files kill-files))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
357 (while files
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
358 (if (file-exists-p (car files))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
359 (let ((headers gnus-newsgroup-headers))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
360 (if gnus-kill-killed
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
361 (setq gnus-newsgroup-kill-headers
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
362 (mapcar (lambda (header) (mail-header-number header))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
363 headers))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
364 (while headers
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
365 (or (gnus-member-of-range
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
366 (mail-header-number (car headers))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
367 gnus-newsgroup-killed)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
368 (setq gnus-newsgroup-kill-headers
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
369 (cons (mail-header-number (car headers))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
370 gnus-newsgroup-kill-headers)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
371 (setq headers (cdr headers))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
372 (setq files nil))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
373 (setq files (cdr files)))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
374 (if (not gnus-newsgroup-kill-headers)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
375 ()
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
376 (save-window-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
377 (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
378 (while kill-files
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
379 (if (not (file-exists-p (car kill-files)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
380 ()
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
381 (message "Processing kill file %s..." (car kill-files))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
382 (find-file (car kill-files))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
383 (gnus-add-current-to-buffer-list)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
384 (goto-char (point-min))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
385
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
386 (if (consp (condition-case nil (read (current-buffer))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
387 (error nil)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
388 (gnus-kill-parse-gnus-kill-file)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
389 (gnus-kill-parse-rn-kill-file))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
390
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
391 (message "Processing kill file %s...done" (car kill-files)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
392 (setq kill-files (cdr kill-files)))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
393
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
394 (gnus-set-mode-line 'summary)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
395
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
396 (if beg
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
397 (let ((nunreads (- unreads (length gnus-newsgroup-unreads))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
398 (or (eq nunreads 0)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
399 (message "Marked %d articles as read" nunreads))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
400 nunreads)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
401 0))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
402
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
403 ;; Parse a Gnus killfile.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
404 (defun gnus-score-insert-help (string alist idx)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
405 (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
406 (pop-to-buffer "*Score Help*")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
407 (buffer-disable-undo (current-buffer))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
408 (erase-buffer)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
409 (insert string ":\n\n")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
410 (while alist
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
411 (insert (format " %c: %s\n" (car (car alist)) (nth idx (car alist))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
412 (setq alist (cdr alist)))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
413
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
414 (defun gnus-kill-parse-gnus-kill-file ()
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
415 (goto-char (point-min))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
416 (gnus-kill-file-mode)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
417 (let (beg form)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
418 (while (progn
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
419 (setq beg (point))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
420 (setq form (condition-case () (read (current-buffer))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
421 (error nil))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
422 (or (listp form)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
423 (error "Illegal kill entry (possibly rn kill file?): %s" form))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
424 (if (or (eq (car form) 'gnus-kill)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
425 (eq (car form) 'gnus-raise)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
426 (eq (car form) 'gnus-lower))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
427 (progn
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
428 (delete-region beg (point))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
429 (insert (or (eval form) "")))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
430 (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
431 (set-buffer gnus-summary-buffer)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
432 (condition-case () (eval form) (error nil)))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
433 (and (buffer-modified-p)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
434 gnus-kill-save-kill-file
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
435 (save-buffer))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
436 (set-buffer-modified-p nil)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
437
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
438 ;; Parse an rn killfile.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
439 (defun gnus-kill-parse-rn-kill-file ()
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
440 (goto-char (point-min))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
441 (gnus-kill-file-mode)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
442 (let ((mod-to-header
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
443 '((?a . "")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
444 (?h . "")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
445 (?f . "from")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
446 (?: . "subject")))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
447 (com-to-com
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
448 '((?m . " ")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
449 (?j . "X")))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
450 pattern modifier commands)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
451 (while (not (eobp))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
452 (if (not (looking-at "[ \t]*/\\([^/]*\\)/\\([ahfcH]\\)?:\\([a-z=:]*\\)"))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
453 ()
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
454 (setq pattern (buffer-substring (match-beginning 1) (match-end 1)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
455 (setq modifier (if (match-beginning 2) (char-after (match-beginning 2))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
456 ?s))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
457 (setq commands (buffer-substring (match-beginning 3) (match-end 3)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
458
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
459 ;; The "f:+" command marks everything *but* the matches as read,
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
460 ;; so we simply first match everything as read, and then unmark
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
461 ;; PATTERN later.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
462 (and (string-match "\\+" commands)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
463 (progn
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
464 (gnus-kill "from" ".")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
465 (setq commands "m")))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
466
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
467 (gnus-kill
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
468 (or (cdr (assq modifier mod-to-header)) "subject")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
469 pattern
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
470 (if (string-match "m" commands)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
471 '(gnus-summary-mark-as-unread nil " ")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
472 '(gnus-summary-mark-as-read nil "X"))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
473 nil t))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
474 (forward-line 1))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
475
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
476 ;; Kill changes and new format by suggested by JWZ and Sudish Joseph
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
477 ;; <joseph@cis.ohio-state.edu>.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
478 (defun gnus-kill (field regexp &optional exe-command all silent)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
479 "If FIELD of an article matches REGEXP, execute COMMAND.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
480 Optional 1st argument COMMAND is default to
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
481 (gnus-summary-mark-as-read nil \"X\").
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
482 If optional 2nd argument ALL is non-nil, articles marked are also applied to.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
483 If FIELD is an empty string (or nil), entire article body is searched for.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
484 COMMAND must be a lisp expression or a string representing a key sequence."
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
485 ;; We don't want to change current point nor window configuration.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
486 (let ((old-buffer (current-buffer)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
487 (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
488 (save-window-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
489 ;; Selected window must be summary buffer to execute keyboard
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
490 ;; macros correctly. See command_loop_1.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
491 (switch-to-buffer gnus-summary-buffer 'norecord)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
492 (goto-char (point-min)) ;From the beginning.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
493 (let ((kill-list regexp)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
494 (date (current-time-string))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
495 (command (or exe-command '(gnus-summary-mark-as-read
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
496 nil gnus-kill-file-mark)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
497 kill kdate prev)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
498 (if (listp kill-list)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
499 ;; It is a list.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
500 (if (not (consp (cdr kill-list)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
501 ;; It's on the form (regexp . date).
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
502 (if (zerop (gnus-execute field (car kill-list)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
503 command nil (not all)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
504 (if (> (gnus-days-between date (cdr kill-list))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
505 gnus-kill-expiry-days)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
506 (setq regexp nil))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
507 (setcdr kill-list date))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
508 (while (setq kill (car kill-list))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
509 (if (consp kill)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
510 ;; It's a temporary kill.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
511 (progn
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
512 (setq kdate (cdr kill))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
513 (if (zerop (gnus-execute
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
514 field (car kill) command nil (not all)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
515 (if (> (gnus-days-between date kdate)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
516 gnus-kill-expiry-days)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
517 ;; Time limit has been exceeded, so we
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
518 ;; remove the match.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
519 (if prev
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
520 (setcdr prev (cdr kill-list))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
521 (setq regexp (cdr regexp))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
522 ;; Successful kill. Set the date to today.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
523 (setcdr kill date)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
524 ;; It's a permanent kill.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
525 (gnus-execute field kill command nil (not all)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
526 (setq prev kill-list)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
527 (setq kill-list (cdr kill-list))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
528 (gnus-execute field kill-list command nil (not all))))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
529 (switch-to-buffer old-buffer)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
530 (if (and (eq major-mode 'gnus-kill-file-mode) regexp (not silent))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
531 (gnus-pp-gnus-kill
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
532 (nconc (list 'gnus-kill field
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
533 (if (consp regexp) (list 'quote regexp) regexp))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
534 (if (or exe-command all) (list (list 'quote exe-command)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
535 (if all (list t) nil))))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
536
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
537 (defun gnus-pp-gnus-kill (object)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
538 (if (or (not (consp (nth 2 object)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
539 (not (consp (cdr (nth 2 object))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
540 (and (eq 'quote (car (nth 2 object)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
541 (not (consp (cdr (car (cdr (nth 2 object))))))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
542 (concat "\n" (prin1-to-string object))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
543 (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
544 (set-buffer (get-buffer-create "*Gnus PP*"))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
545 (buffer-disable-undo (current-buffer))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
546 (erase-buffer)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
547 (insert (format "\n(%S %S\n '(" (nth 0 object) (nth 1 object)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
548 (let ((klist (car (cdr (nth 2 object))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
549 (first t))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
550 (while klist
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
551 (insert (if first (progn (setq first nil) "") "\n ")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
552 (prin1-to-string (car klist)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
553 (setq klist (cdr klist))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
554 (insert ")")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
555 (and (nth 3 object)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
556 (insert "\n "
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
557 (if (and (consp (nth 3 object))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
558 (not (eq 'quote (car (nth 3 object)))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
559 "'" "")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
560 (prin1-to-string (nth 3 object))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
561 (and (nth 4 object)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
562 (insert "\n t"))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
563 (insert ")")
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
564 (prog1
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
565 (buffer-substring (point-min) (point-max))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
566 (kill-buffer (current-buffer))))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
567
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
568 (defun gnus-execute-1 (function regexp form header)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
569 (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
570 (let (did-kill)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
571 (if (null header)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
572 nil ;Nothing to do.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
573 (if function
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
574 ;; Compare with header field.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
575 (let (value)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
576 (and header
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
577 (progn
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
578 (setq value (funcall function header))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
579 ;; Number (Lines:) or symbol must be converted to string.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
580 (or (stringp value)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
581 (setq value (prin1-to-string value)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
582 (setq did-kill (string-match regexp value)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
583 (if (stringp form) ;Keyboard macro.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
584 (execute-kbd-macro form)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
585 (funcall form))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
586 ;; Search article body.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
587 (let ((gnus-current-article nil) ;Save article pointer.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
588 (gnus-last-article nil)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
589 (gnus-break-pages nil) ;No need to break pages.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
590 (gnus-mark-article-hook nil)) ;Inhibit marking as read.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
591 (message "Searching for article: %d..." (mail-header-number header))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
592 (gnus-article-setup-buffer)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
593 (gnus-article-prepare (mail-header-number header) t)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
594 (if (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
595 (set-buffer gnus-article-buffer)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
596 (goto-char (point-min))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
597 (setq did-kill (re-search-forward regexp nil t)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
598 (if (stringp form) ;Keyboard macro.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
599 (execute-kbd-macro form)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
600 (eval form))))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
601 did-kill)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
602
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
603 (defun gnus-execute (field regexp form &optional backward ignore-marked)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
604 "If FIELD of article header matches REGEXP, execute lisp FORM (or a string).
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
605 If FIELD is an empty string (or nil), entire article body is searched for.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
606 If optional 1st argument BACKWARD is non-nil, do backward instead.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
607 If optional 2nd argument IGNORE-MARKED is non-nil, articles which are
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
608 marked as read or ticked are ignored."
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
609 (save-excursion
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
610 (let ((killed-no 0)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
611 function article header)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
612 (if (or (null field) (string-equal field ""))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
613 (setq function nil)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
614 ;; Get access function of header filed.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
615 (setq function (intern-soft (concat "gnus-header-" (downcase field))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
616 (if (and function (fboundp function))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
617 (setq function (symbol-function function))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
618 (error "Unknown header field: \"%s\"" field))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
619 ;; Make FORM funcallable.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
620 (if (and (listp form) (not (eq (car form) 'lambda)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
621 (setq form (list 'lambda nil form))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
622 ;; Starting from the current article.
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
623 (while (or (and (not article)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
624 (setq article (gnus-summary-article-number))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
625 t)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
626 (setq article
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
627 (gnus-summary-search-subject
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
628 backward (not ignore-marked))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
629 (and (or (null gnus-newsgroup-kill-headers)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
630 (memq article gnus-newsgroup-kill-headers))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
631 (vectorp (setq header (gnus-get-header-by-number article)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
632 (gnus-execute-1 function regexp form header)
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
633 (setq killed-no (1+ killed-no))))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
634 killed-no)))
178d730efae2 entered into RCS
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
635