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 -- canceling 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\\):"
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"))))
143 (message-cancel-message
145 "Moderator %s canceling a message in a group I moderate.\n"
146 (message-make-from))))
147 (message-cancel-news)))
148 (gnus-summary-mark-as-read article gnus-canceled-mark)
149 (gnus-cache-remove-article 1))
150 (gnus-article-hide-headers-if-wanted))
151 (gnus-summary-remove-process-mark article))))
153 (defun gnus-moderation-edit-article ()
154 "Edit an article before sending it."
157 (set-buffer gnus-summary-buffer)
158 (gnus-set-global-variables)
159 ;; Select article if needed.
160 (gnus-summary-show-article t)
161 (gnus-article-edit-article
163 (gnus-moderation-send-buffer)))))
165 (defun gnus-moderation-send-article ()
166 "Post the current article after inserting an Approved header."
168 (gnus-summary-select-article)
169 (gnus-eval-in-buffer-window gnus-original-article-buffer
170 (gnus-moderation-send-buffer)))
172 (defun gnus-moderation-send-buffer ()
173 "Send the current buffer as a message after inserting an Approved header."
174 (let ((buf (current-buffer)))
175 (nnheader-temp-write nil
176 (insert-buffer-substring buf)
177 (message-narrow-to-head)
178 (message-remove-header gnus-moderation-ignored-headers t)
179 (goto-char (point-max))
181 (insert "Approved: " (message-make-from) "\n")
182 (let ((method (if (message-functionp message-post-method)
183 (funcall message-post-method)
184 message-post-method)))
185 (require (car method))
186 (funcall (intern (format "%s-open-server" (car method)))
187 (cadr method) (cddr method))
188 (unless (funcall (intern (format "%s-request-post" (car method))))
189 (error "Couldn't post: %s" (nnheader-get-report 'nntp)))))))
191 (provide 'gnus-mdrtn)
193 ;;; gnus-mdrtn ends here