Import initial

darcs-hash:20050923221100-d1718-18cf49098c5f784cd75be0cd5379b045e348758f.gz

news/moderation.el

@@ -0,0 +1,149 @@
+(require 'gnus-start)
+
+(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
+ gnus-use-dribble-file nil)
+
+; 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 effectuée."))
+	(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
+		(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))))
+  
+	    ;; 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)