cgit.sxemacs.org Git - gnus/blob - gnus-mdrtn.el

   1 ;;; gnus-mdrtn.el --- a group moderation package for Gnus
   2 ;; Copyright (C) 1996 Lars Magne Ingebrigtsen
   3
   4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
   5 ;; Keywords: news, moderation
   6
   7 ;; This file is not part of GNU Emacs.
   8
   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)
  12 ;; any later version.
  13
  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.
  18
  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.
  23
  24 ;;; Commentary:
  25
  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
  34 ;; please?
  35
  36 ;; The moderation package is implemented as a minor mode for
  37 ;; summary buffers.  Put
  38 ;;
  39 ;; (add-hook 'gnus-summary-mode-hook 'gnus-moderate)
  40 ;;
  41 ;; in your .gnus.el file.
  42
  43 ;; If you are the moderation of rec.zoofle, this is how it's supposed
  44 ;; to work:
  45 ;;
  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.
  49 ;;
  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)
  52 ;; commands.
  53 ;;
  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.
  57 ;;
  58 ;; To use moderation mode in these two groups, say
  59 ;;
  60 ;; (setq gnus-moderated-groups "nnml:rec.zoofle\\|rec.zoofle")
  61
  62 ;;; Code:
  63
  64 (require 'gnus-load)
  65
  66 (defvar gnus-moderated-groups nil
  67   "Regexp that match groups you moderate.")
  68
  69 (defvar gnus-moderation-ignored-headers "^\\(Received\\|To\\|Cc\\|X-From-Line\\|Return-Path\\|Xref\\):"
  70   "Headers to be removed before posting an approved article.")
  71
  72 (defvar gnus-moderation-mode nil
  73   "Minor mode for providing a moderation interface in Gnus summary buffers.")
  74
  75 (defvar gnus-moderation-mode-hook nil
  76   "Hook run in summary moderation mode buffers.")
  77
  78 ;;; Internal variables.
  79
  80 (defvar gnus-moderation-mode-map nil)
  81
  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))
  88
  89 (defun gnus-moderation-make-menu-bar ()
  90   (unless (boundp 'gnus-moderation-menu)
  91     (easy-menu-define
  92      gnus-moderation-menu gnus-moderation-mode-map ""
  93      '("Moderation"
  94        ("Moderation"
  95         "Cancel" gnus-moderation-cancel-article
  96         "Send" gnus-moderation-send-article
  97         "Edit" gnus-moderation-edit-article)))))
  98
  99 (defun gnus-moderation-mode (&optional arg)
 100   "Minor mode for providing a moderation interface in Gnus summary buffers.
 101
 102 \\{gnus-moderation-mode-map}"
 103   (interactive "P")
 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
 109       ;; Set up the menu.
 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))))
 119
 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)))
 125
 126 ;;; Commands
 127
 128 (defun gnus-moderation-cancel-article (n)
 129   "Cancel the current article, even if it isn't yours."
 130   (interactive "P")
 131   (gnus-set-global-variables)
 132   (let ((articles (gnus-summary-work-articles n))
 133         (message-post-method
 134          `(lambda (arg)
 135             (gnus-post-method nil ,gnus-newsgroup-name)))
 136         article)
 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
 144                        (format
 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))))
 152
 153 (defun gnus-moderation-edit-article ()
 154   "Edit an article before sending it."
 155   (interactive)
 156   (save-excursion
 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
 162      `(lambda ()
 163         (gnus-moderation-send-buffer)))))
 164
 165 (defun gnus-moderation-send-article ()
 166   "Post the current article after inserting an Approved header."
 167   (interactive)
 168   (gnus-summary-select-article)
 169   (gnus-eval-in-buffer-window gnus-original-article-buffer
 170     (gnus-moderation-send-buffer)))
 171
 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))
 180       (widen)
 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)))))))
 190
 191 (provide 'gnus-mdrtn)
 192
 193 ;;; gnus-mdrtn ends here