152 lines
5 KiB
EmacsLisp
152 lines
5 KiB
EmacsLisp
(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)
|