(require 'gnus-start)
(require 'gnus-agent)

(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
 ; Pas d'agent
 gnus-agent nil)

; Comment souscrire à un nouveau groupe ?

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

(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 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"))
  (unless (not (eq (user-uid) 0))
    (error "Ce script ne se lance pas en tant que root"))
  (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")
	      approved (message-fetch-field "approved")))
      ;; 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")
		  "")
		(if approved
		    (concat "Approved: " approved "\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-headers)
		(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)