moderation.el 5.14 KB
Newer Older
bernat's avatar
bernat committed
1
(require 'gnus-start)
2
(require 'gnus-agent)
bernat's avatar
bernat committed
3 4 5 6 7 8 9 10 11 12 13 14 15

(setq
 ; Fichier d'initialisation :
 gnus-init-file (nnheader-concat gnus-home-directory ".gnus-moderation")
 ; Fichier contenant les inscriptions
 gnus-startup-file ".newsrc-moderation"
 ; Par defaut, on est abonn  crans.*
 gnus-default-subscribed-newsgroups t
 ; On ne lit pas le .newsrc
 gnus-read-newsrc-file nil
 ; On ne le sauve pas
 gnus-save-newsrc-file nil
 ; Pas d'auto save
16 17 18
 gnus-use-dribble-file nil
 ; Pas d'agent
 gnus-agent nil)
bernat's avatar
bernat committed
19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122

; Comment souscrire  un nouveau groupe ?
(defun crans-gnus-subscribe-alphabetically (newgroup)
  (if (string-match "^crans\..*" newgroup)
      (gnus-subscribe-alphabetically newgroup)
    (gnus-subscribe-zombies newgroup)))

(setq
 ; On utilise la methode ci-dessus pour s'inscrire aux nouveaux groupes
 gnus-subscribe-newsgroup-method 'crans-gnus-subscribe-alphabetically
 ; On s'inscrit automatiquement  tous les groupes
 gnus-auto-subscribed-groups "^nntp"
 ; Uniquement les groupes CRANS
 gnus-options-subscribe "^crans\..*")

(require 'message)
(require 'mml)

; On ne peut annuler un message qui n'est pas dans un groupe CRANS
(defun message-is-yours-p ()
  (save-excursion
    (save-restriction
      (message-narrow-to-head-1)
      (let ((newsgroups (message-fetch-field "Newsgroups")))
	(if (and newsgroups
		 (string-match "crans\.[a-z-]*" newsgroups))
	    ; OK
	    t
	  (error "Ce message n'est pas dans un groupe CRANS"))))))

; On envoie un mail indiquant ce qui est annul
(defun message-cancel-news (&optional arg)
  "Cancel an article you posted."
  (interactive)
  (unless (message-news-p)
    (error "Il n'est pas possible d'annuler cet article"))
  (let (from newsgroups message-id distribution origbuf buf subject)
    (setq origbuf (buffer-name))
    (save-excursion
      ;; Get header info from original article.
      (save-restriction
	(message-narrow-to-head-1)
	(setq from (message-fetch-field "from")
	      newsgroups (message-fetch-field "newsgroups")
	      subject (message-fetch-field "subject")
	      message-id (message-fetch-field "message-id" t)
	      distribution (message-fetch-field "distribution")))
      ;; Make sure that this article was written by the user.
      (unless (message-is-yours-p)
	(error "Impossible d'annuler cet article"))
      (when (yes-or-no-p "Voulez-vous vraiment annuler cet article ? ")
	;; Annulation du message
	(setq buf (set-buffer (get-buffer-create " *message cancel*")))
	(erase-buffer)
	(insert "Newsgroups: " newsgroups "\n"
		"From: moderateurs@crans.org\n"
		"Subject: cmsg cancel " message-id "\n"
		"Control: cancel " message-id "\n"
		(if distribution
		    (concat "Distribution: " distribution "\n")
		  "")
		mail-header-separator "\n"
		message-cancel-message)

	
	(message "Annulation du message...")
	(if (let ((message-syntax-checks
		   'dont-check-for-anything-just-trust-me))
	      (funcall message-send-news-function))
	    (message "Annulation du message effectue."))
	(kill-buffer buf)

	;; Envoi du mail dans moderateurs
	(setq buf (set-buffer (get-buffer-create " *message cancel notification*")))
	(erase-buffer)
	(insert "From: " (message-make-from) "\n"
		"To: moderateurs@crans.org\n"
		"Subject: Annulation du message " message-id "\n"
		mail-header-separator "\n"
		"Annulation du message suivant : \n\n"
		"  message-id: " message-id "\n"
		"     subject: " subject "\n"
		"        from: " from "\n"
		"  newsgroups: " newsgroups "\n"
		"\n")
	; On attache le message original
	(mml-attach-buffer origbuf "message/rfc822" "Message annul")

	(message-send-via-mail nil)
	(kill-buffer buf)
	(message "Envoi de la notification ok.")))))

; Verifie si le message en cours a un supersedes
(defun crans-check-supersedes ()
  (save-excursion
    (save-restriction
      (message-narrow-to-head-1)
      (if (message-fetch-field "supersedes")
	  (let (buf message-id from subject newsgroups)
	    ;; On a un supersedes, on va dire que l'article original est
	    ;; dans *Article* et que le supersede est dans *supersede*
	    (save-excursion
	      (set-buffer "*Article*")
	      (save-restriction
bernat's avatar
bernat committed
123
		(message-narrow-to-headers)
bernat's avatar
bernat committed
124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152
		(setq from (message-fetch-field "from")
		      newsgroups (message-fetch-field "newsgroups")
		      subject (message-fetch-field "subject")
		      message-id (message-fetch-field "message-id" t))))
  
	    ;; Envoi du mail dans moderateurs
	    (setq buf (set-buffer (get-buffer-create " *message cancel notification*")))
	    (erase-buffer)
	    (insert "From: " (message-make-from) "\n"
		    "To: moderateurs@crans.org\n"
		    "Subject: Modification du message " message-id "\n"
		    mail-header-separator "\n"
		    "Modification du message suivant : \n\n"
		    "  message-id: " message-id "\n"
		    "     subject: " subject "\n"
		    "        from: " from "\n"
		    "  newsgroups: " newsgroups "\n"
		    "\n")
	    ;; On attache le message original
	    (mml-attach-buffer "*Article*" "message/rfc822" "Message original")
	    ;; Et le message modifi
	    (mml-attach-buffer "*supersede*" "message/rfc822" "Message modifi")

	    (message-send-via-mail nil)
	    (kill-buffer buf)
	    (message "Envoi de la notification ok."))))))

;; Mise en place du hook
(setq message-send-news-hook 'crans-check-supersedes)