1 ;;; gnus-mdrtn.el --- a group moderation package for Gnus
2 ;; Copyright (C) 1996 Lars Magne Ingebrigtsen
4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
5 ;; Keywords: news, moderation
7 ;; This file is not part of GNU Emacs.
9 ;; GNU Emacs is free software; you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 2, or (at your option)
14 ;; GNU Emacs is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs; see the file COPYING. If not, write to the
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 ;; Boston, MA 02111-1307, USA.
26 ;; This package is designed for enabling moderators to do various
27 ;; spiffy things while moderating groups. Some of these things are
28 ;; rather evil if done by non-moderators -- cancelling other people's
29 ;; articles, including Approved headers and so on. So while this file
30 ;; is GPL'd and there therefore is no distribution restriction --
31 ;; please do not put this file at any public sites. All people who
32 ;; want a copy can get one, but let's try to keep this potentially
33 ;; dangerous package out of the hands of Evil People, ok? Pretty
36 ;; The moderation package is implemented as a minor mode for
37 ;; summary buffers. Put
39 ;; (add-hook 'gnus-summary-mode-hook 'gnus-moderate)
41 ;; in your .gnus.el file.
43 ;; If you are the moderation of rec.zoofle, this is how it's supposed
46 ;; 1) You split your incoming mail by matching on
47 ;; "Newsgroups:.*rec.zoofle", which will put all the to-be-posted
48 ;; articles in some mail group -- "nnml:rec.zoofle", for instance.
50 ;; 2) You enter that group once in a while and post articles
51 ;; using the `e' (edit-and-post) or `s' (just send unedited)
54 ;; 3) If, while reading the rec.zoofle group, you happen upon
55 ;; some articles that weren't approved by you, you can cancel
56 ;; them with the `c' command.
58 ;; To use moderation mode in these two groups, say
60 ;; (setq gnus-moderated-groups "nnml:rec.zoofle\\|rec.zoofle")
66 (defvar gnus-moderated-groups nil
67 "Regexp that match groups you moderate.")
69 (defvar gnus-moderation-ignored-headers "^\\(Received\\|To\\|Cc\\|X-From-Line\\|Return-Path\\|Xref\\|NNTP-Posting-Host\\|X-Trace\\NNTP-Posting-Date\\):"
70 "Headers to be removed before posting an approved article.")
72 (defvar gnus-moderation-mode nil
73 "Minor mode for providing a moderation interface in Gnus summary buffers.")
75 (defvar gnus-moderation-mode-hook nil
76 "Hook run in summary moderation mode buffers.")
78 ;;; Internal variables.
80 (defvar gnus-moderation-mode-map nil)
82 (unless gnus-moderation-mode-map
83 (setq gnus-moderation-mode-map (make-sparse-keymap))
84 (gnus-define-keys gnus-moderation-mode-map
85 "c" gnus-moderation-cancel-article
86 "s" gnus-moderation-send-article
87 "e" gnus-moderation-edit-article))
89 (defun gnus-moderation-make-menu-bar ()
90 (unless (boundp 'gnus-moderation-menu)
92 gnus-moderation-menu gnus-moderation-mode-map ""
95 "Cancel" gnus-moderation-cancel-article
96 "Send" gnus-moderation-send-article
97 "Edit" gnus-moderation-edit-article)))))
99 (defun gnus-moderation-mode (&optional arg)
100 "Minor mode for providing a moderation interface in Gnus summary buffers.
102 \\{gnus-moderation-mode-map}"
104 (when (eq major-mode 'gnus-summary-mode)
105 (set (make-local-variable 'gnus-moderation-mode)
106 (if (null arg) (not gnus-moderation-mode)
107 (> (prefix-numeric-value arg) 0)))
108 (when gnus-moderation-mode
110 (when (and menu-bar-mode
111 (gnus-visual-p 'moderation-menu 'menu))
112 (gnus-moderation-make-menu-bar))
113 (unless (assq 'gnus-moderation-mode minor-mode-alist)
114 (push '(gnus-moderation-mode " Moderation") minor-mode-alist))
115 (unless (assq 'gnus-moderation-mode minor-mode-map-alist)
116 (push (cons 'gnus-moderation-mode gnus-moderation-mode-map)
117 minor-mode-map-alist))
118 (run-hooks 'gnus-moderation-mode-hook))))
120 (defun gnus-moderate ()
121 "Turn on moderation mode in some buffers."
122 (when (and gnus-moderated-groups
123 (string-match gnus-moderated-groups gnus-newsgroup-name))
124 (gnus-moderation-mode 1)))
128 (defun gnus-moderation-cancel-article (n)
129 "Cancel the current article, even if it isn't yours."
131 (gnus-set-global-variables)
132 (let ((articles (gnus-summary-work-articles n))
135 (gnus-post-method nil ,gnus-newsgroup-name)))
137 (while (setq article (pop articles))
138 (when (gnus-summary-select-article t nil nil article)
139 (when (gnus-eval-in-buffer-window gnus-original-article-buffer
140 (let ((user-mail-address
141 (nth 1 (mail-extract-address-components
142 (mail-fetch-field "from"))))
145 (goto-char (point-min))
146 (insert "Approved: " (message-make-from) "\n")))
147 (message-cancel-message
149 "Moderator %s cancelling a message in a group I moderate.\n"
150 (message-make-from))))
151 (message-cancel-news)))
152 (gnus-summary-mark-as-read article gnus-canceled-mark)
153 (gnus-cache-remove-article 1))
154 (gnus-article-hide-headers-if-wanted))
155 (gnus-summary-remove-process-mark article))))
157 (defun gnus-moderation-edit-article ()
158 "Edit an article before sending it."
161 (set-buffer gnus-summary-buffer)
162 (gnus-set-global-variables)
163 ;; Select article if needed.
164 (gnus-summary-show-article t)
165 (gnus-article-edit-article
166 `(lambda (&optional arg)
167 (gnus-moderation-send-buffer)))))
169 (defun gnus-moderation-send-article ()
170 "Post the current article after inserting an Approved header."
172 (gnus-summary-select-article)
173 (gnus-eval-in-buffer-window gnus-original-article-buffer
174 (gnus-moderation-send-buffer)))
176 (defun gnus-moderation-send-buffer ()
177 "Send the current buffer as a message after inserting an Approved header."
178 (let ((buf (current-buffer)))
179 (nnheader-temp-write nil
180 (insert-buffer-substring buf)
181 (message-narrow-to-head)
182 (message-remove-header gnus-moderation-ignored-headers t)
183 (goto-char (point-max))
185 (insert "Approved: " (message-make-from) "\n")
186 (let ((method (if (message-functionp message-post-method)
187 (funcall message-post-method)
188 message-post-method)))
189 (require (car method))
190 (funcall (intern (format "%s-open-server" (car method)))
191 (cadr method) (cddr method))
192 (unless (funcall (intern (format "%s-request-post" (car method))))
193 (error "Couldn't post: %s" (nnheader-get-report 'nntp)))))))
195 (provide 'gnus-mdrtn)
197 ;;; gnus-mdrtn ends here