diff -ur gnus/lisp/gnus-group.el cvsgnus/lisp/gnus-group.el --- gnus/lisp/gnus-group.el Sat Jun 1 23:13:46 2002 +++ cvsgnus/lisp/gnus-group.el Mon Aug 26 22:19:47 2002 @@ -38,6 +38,7 @@ (require 'gnus-undo) (require 'time-date) (require 'gnus-ems) +(require 'mm-url) (defcustom gnus-group-archive-directory "*ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/" @@ -701,6 +702,8 @@ "f" gnus-score-flush-cache) (gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map) + "c" gnus-group-fetch-charter + "C" gnus-group-fetch-control "d" gnus-group-describe-group "f" gnus-group-fetch-faq "v" gnus-version) @@ -745,6 +748,12 @@ ,@(if (featurep 'xemacs) nil '(:help "Display description of the current group"))] ["Fetch FAQ" gnus-group-fetch-faq (gnus-group-group-name)] + ["Fetch charter" gnus-group-fetch-charter :active (gnus-group-group-name) + ,@(if (featurep 'xemacs) nil + '(:help "Display the charter of the current group"))] + ["Fetch control message" gnus-group-fetch-control :active (gnus-group-group-name) + ,@(if (featurep 'xemacs) nil + '(:help "Display the archived control message for the current group"))] ;; Actually one should check, if any of the marked groups gives t for ;; (gnus-check-backend-function 'request-expire-articles ...) ["Expire articles" gnus-group-expire-articles @@ -3513,6 +3522,44 @@ (find-file file) (setq found t)))))) +(defun gnus-group-fetch-charter (group) + "Fetch the charter for the current group." + (interactive + (list (or (gnus-group-group-name) + gnus-newsgroup-name))) + (unless group + (error "No group name given")) + (let ((name (mm-url-form-encode-xwfu (gnus-group-real-name group))) + url hierarchy) + (when (string-match "\\(^[^\\.]+\\)\\..*" name) + (setq hierarchy (match-string 1 name)) + (if (setq url (cdr (assoc hierarchy gnus-group-charter-alist))) + (browse-url (eval url)) + (gnus-group-fetch-control group))))) + +(defun gnus-group-fetch-control (group) + "Fetch the archived control messages for the current group." + (interactive + (list (or (gnus-group-group-name) + gnus-newsgroup-name))) + (unless group + (error "No group name given")) + (let ((name (gnus-group-real-name group)) + hierarchy) + (when (string-match "\\(^[^\\.]+\\)\\..*" name) + (setq hierarchy (match-string 1 name)) + (if gnus-group-fetch-control-use-browse-url + (browse-url (concat "ftp://ftp.isc.org:/usenet/control/" + hierarchy "/" name ".Z")) + (let ((enable-local-variables nil)) + (gnus-group-read-ephemeral-group + group + `(nndoc ,group (nndoc-address + ,(find-file-noselect + (concat "/ftp@ftp.isc.org:/usenet/control/" + hierarchy "/" name ".Z"))) + (nndoc-article-type mbox)) t nil nil)))))) + (defun gnus-group-describe-group (force &optional group) "Display a description of the current newsgroup." (interactive (list current-prefix-arg (gnus-group-group-name))) diff -ur gnus/lisp/gnus.el cvsgnus/lisp/gnus.el --- gnus/lisp/gnus.el Mon Aug 26 21:49:09 2002 +++ cvsgnus/lisp/gnus.el Mon Aug 26 22:19:28 2002 @@ -1246,6 +1246,41 @@ :type '(choice directory (repeat directory))) +(defcustom gnus-group-charter-alist + '(("no" . (concat "http://no.news-admin.org/charter/" name ".txt")) + ("de" . (concat "http://purl.net/charta/" name ".html")) + ("dk" . (concat "http://www.usenet.dk/grupper.pl?get=" name)) + ("england" . (concat "http://england.news-admin.org/charters/" name)) + ("fr" . (concat "http://www.usenet-fr.net/fur/chartes/" name ".html")) + ("europa" . (concat "http://www.europa.usenet.eu.org/chartas/charta-en-" + (gnus-replace-in-string name "europa\\." "") ".html")) + ("nl" . (concat "http://www.xs4all.nl/~sister/usenet/charters/" name)) + ("aus" . (concat "http://aus.news-admin.org/groupinfo.php/" name)) + ("pl" . (concat "http://www.usenet.pl/opisy/" name)) + ("ch" . (concat "http://www.use-net.ch/Usenet/charter.html#" name)) + ("at" . (concat "http://www.usenet.at/chartas/" name "/charta")) + ("uk" . (concat "http://www.usenet.org.uk/" name ".html")) + ("wales" . (concat "http://www.wales-usenet.org/english/groups/" name ".html")) + ("dfw" . (concat "http://www.cirr.com/dfw/charters/" name ".html")) + ("se" . (concat "http://www.usenet-se.net/Reglementen/" + (gnus-replace-in-string name "\\." "_") ".html")) + ("milw" . (concat "http://usenet.mil.wi.us/" + (gnus-replace-in-string name "milw\\." "") "-charter")) + ("ca" . (concat "http://www.sbay.org/ca/charter-" name ".html")) + ("netins" . (concat "http://www.netins.net/usenet/charter/" + (gnus-replace-in-string name "\\." "-") "-charter.html"))) + "*An alist of (HIERARCHY . FORM) pairs used to construct the URL of a charter. + When FORM is evaluated `name' is bound to the name of the group." + :group 'gnus-group-various + :type '(repeat (cons (string :tag "Hierarchy") (sexp :tag "Form")))) + +(defcustom gnus-group-fetch-control-use-browse-url nil + "*Non-nil means that control messages are displayed using `browse-url'. +Otherwise they are fetched with ange-ftp and displayed in an ephemeral +group." + :group 'gnus-group-various + :type 'boolean) + (defcustom gnus-use-cross-reference t "*Non-nil means that cross referenced articles will be marked as read. If nil, ignore cross references. If t, mark articles as read in diff -ur gnus/texi/gnus.texi cvsgnus/texi/gnus.texi --- gnus/texi/gnus.texi Fri Aug 23 00:09:47 2002 +++ cvsgnus/texi/gnus.texi Mon Aug 26 22:20:01 2002 @@ -4080,6 +4080,34 @@ If fetching from the first site is unsuccessful, Gnus will attempt to go through @code{gnus-group-faq-directory} and try to open them one by one. +@item H c +@kindex H c (Group) +@findex gnus-group-fetch-charter +@vindex gnus-group-charter-alist +@cindex charter +Try to open the charter for the current group in a web browser +(@code{gnus-group-fetch-charter}). Gnus will use +@code{gnus-group-charter-alist} to find the location of the charter. +If no location is known, Gnus will fetch the control messages for the +group, which in some cases includes the charter. + +@item H C +@kindex H C (Group) +@findex gnus-group-fetch-control +@vindex gnus-group-fetch-control-use-browse-url +@cindex control message +Fetch the control messages for the group from the archive at +@code{ftp.isc.org} (@code{gnus-group-fetch-control}). + +If @code{gnus-group-fetch-control-use-browse-url} is non-nil, Gnus +will open the control messages in a browser using @code{browse-url}. +Otherwise they are fetched using @code{ange-ftp} and displayed in an +ephemeral group. + +Note that the control messages are compressed. To use this command +you need to turn on @code{auto-compression-mode} +(@pxref{(emacs)Compressed Files}). + @item H d @itemx C-c C-d @c @icon{gnus-group-describe-group}