Re: gnus-group-fetch-charter

[Jesper Harder <harder@ifa.au.dk>]

[-- Attachment #1: Type: text/plain, Size: 1426 bytes --]

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  <harder@ifa.au.dk>

	* gnus.texi (Group Information): Add gnus-group-fetch-charter and
	gnus-group-fetch-control.

2002-08-26  Jesper harder  <harder@ifa.au.dk>

	* 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.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: charter.patch --]
[-- Type: text/x-patch, Size: 6946 bytes --]

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}