moderation.el 5.08 KB
Newer Older
bernat's avatar
bernat committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 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 123 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
(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 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
		(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)