From mboxrd@z Thu Jan 1 00:00:00 1970 X-Msuck: nntp://news.gmane.io/gmane.emacs.gnus.general/46253 Path: main.gmane.org!not-for-mail From: Jesper Harder Newsgroups: gmane.emacs.gnus.general Subject: Re: gnus-group-fetch-charter Date: Mon, 26 Aug 2002 23:11:43 +0200 Sender: owner-ding@hpc.uh.edu Message-ID: References: NNTP-Posting-Host: localhost.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: main.gmane.org 1030396807 16478 127.0.0.1 (26 Aug 2002 21:20:07 GMT) X-Complaints-To: usenet@main.gmane.org NNTP-Posting-Date: Mon, 26 Aug 2002 21:20:07 +0000 (UTC) Return-path: Original-Received: from malifon.math.uh.edu ([129.7.128.13]) by main.gmane.org with esmtp (Exim 3.35 #1 (Debian)) id 17jRHC-0004E5-00 for ; Mon, 26 Aug 2002 23:19:59 +0200 Original-Received: from sina.hpc.uh.edu ([129.7.128.10] ident=lists) by malifon.math.uh.edu with esmtp (Exim 3.20 #1) id 17jRBR-0004lM-00; Mon, 26 Aug 2002 16:14:01 -0500 Original-Received: by sina.hpc.uh.edu (TLB v0.09a (1.20 tibbs 1996/10/09 22:03:07)); Mon, 26 Aug 2002 16:14:33 -0500 (CDT) Original-Received: from sclp3.sclp.com (qmailr@sclp3.sclp.com [209.196.61.66]) by sina.hpc.uh.edu (8.9.3/8.9.3) with SMTP id QAA09044 for ; Mon, 26 Aug 2002 16:14:09 -0500 (CDT) Original-Received: (qmail 19768 invoked by alias); 26 Aug 2002 21:13:24 -0000 Original-Received: (qmail 19763 invoked from network); 26 Aug 2002 21:13:23 -0000 Original-Received: from pfepb.post.tele.dk (193.162.153.3) by gnus.org with SMTP; 26 Aug 2002 21:13:23 -0000 Original-Received: from defun.localdomain (0xc3d7608a.esnxr5.ras.tele.dk [195.215.96.138]) by pfepb.post.tele.dk (Postfix) with ESMTP id A0B0A5EF129 for ; Mon, 26 Aug 2002 23:13:09 +0200 (CEST) Original-To: ding@gnus.org In-Reply-To: (Kai.Grossjohann@CS.Uni-Dortmund.DE's message of "Sat, 24 Aug 2002 17:27:27 +0200") Original-Lines: 50 User-Agent: Gnus/5.090008 (Oort Gnus v0.08) Emacs/21.2 (i386-redhat-linux-gnu) Precedence: list X-Majordomo: 1.94.jlt7 Xref: main.gmane.org gmane.emacs.gnus.general:46253 X-Report-Spam: http://spam.gmane.org/gmane.emacs.gnus.general:46253 --=-=-= Content-Type: text/plain; charset=iso-8859-1 Content-Transfer-Encoding: 8bit Kai.Grossjohann@CS.Uni-Dortmund.DE (Kai Großjohann) writes: > This is starting to look good (I mean, it's looking good already). If > you need my help in getting this into CVS, please holler. (I don't > know who has CVS access.) Of course, the less work for me, the better > :-) A patch together with a ChangeLog entry would be nifty. > > Where should the command go? I split it in two: One to fetch charters and another to fetch control messages (you might want to see the control msg. rather than the charter). They're most similar to `gnus-group-fetch-faq', so I placed them next to it in gnus-group.el. > Where should the variable go? The customizeable variables for g-g-fetch-faq are in gnus.el, so I put them the same place. > Keybinding? g-g-fetch-faq is `H f', so I used H c for gnus-group-fetch-charter, and H C for gnus-group-fetch-control > Documentation? > > And then, there is the paperwork thing. I have signed the copyright assignment-thingie. 2002-08-26 Jesper harder * gnus.texi (Group Information): Add gnus-group-fetch-charter and gnus-group-fetch-control. 2002-08-26 Jesper harder * gnus.el (gnus-group-charter-alist): New option. (gnus-group-fetch-control-use-browse-url): New option. * gnus-group.el (gnus-group-fetch-charter): New function. (gnus-group-fetch-control): New function. Add them to the keymap and menu. Require mm-url. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=charter.patch 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} --=-=-=--