Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523after-merge-gnus-5_10

Merge from emacs--gnus--5.10, gnus--rel--5.10

Patches applied:

 * miles@gnu.org--gnu-2004/emacs--gnus--5.10--base-0
   tag of miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-464

 * miles@gnu.org--gnu-2004/emacs--gnus--5.10--patch-1
   Import from CVS branch gnus-5_10-branch

 * miles@gnu.org--gnu-2004/emacs--gnus--5.10--patch-2
   Merge from lorentey@elte.hu--2004/emacs--multi-tty--0, emacs--cvs-trunk--0

 * miles@gnu.org--gnu-2004/emacs--gnus--5.10--patch-3
   Merge from gnus--rel--5.10

 * miles@gnu.org--gnu-2004/emacs--gnus--5.10--patch-4
   Merge from gnus--rel--5.10

 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-18
   Update from CVS

 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-19
   Remove autoconf-generated files from archive

 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-20
   Update from CVS

1 files changed, 36 insertions, 17 deletions

diff --git a/lisp/gnus/gnus-ml.el b/lisp/gnus/gnus-ml.el
index f99957971a8..de0923fcdf3 100644
--- a/lisp/gnus/gnus-ml.el
+++ b/lisp/gnus/gnus-ml.el
@@ -1,6 +1,6 @@
-;;; gnus-ml.el --- mailing list minor mode for Gnus
+;;; gnus-ml.el --- Mailing list minor mode for Gnus
 
-;; Copyright (C) 2000 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2001 Free Software Foundation, Inc.
 
 ;; Author: Julien Gilles  <jgilles@free.fr>
 ;; Keywords: news
@@ -26,10 +26,6 @@
 
 ;; implement (small subset of) RFC 2369
 
-;;; Usage:
-
-;; (add-hook 'gnus-summary-mode-hook 'turn-on-gnus-mailing-list-mode)
-
 ;;; Code:
 
 (require 'gnus)
@@ -49,12 +45,12 @@
   (setq gnus-mailing-list-mode-map (make-sparse-keymap))
 
   (gnus-define-keys gnus-mailing-list-mode-map
-    "\C-nh" gnus-mailing-list-help
-    "\C-ns" gnus-mailing-list-subscribe
-    "\C-nu" gnus-mailing-list-unsubscribe
-    "\C-np" gnus-mailing-list-post
-    "\C-no" gnus-mailing-list-owner
-    "\C-na" gnus-mailing-list-archive
+    "\C-c\C-nh" gnus-mailing-list-help
+    "\C-c\C-ns" gnus-mailing-list-subscribe
+    "\C-c\C-nu" gnus-mailing-list-unsubscribe
+    "\C-c\C-np" gnus-mailing-list-post
+    "\C-c\C-no" gnus-mailing-list-owner
+    "\C-c\C-na" gnus-mailing-list-archive
     ))
 
 (defun gnus-mailing-list-make-menu-bar ()
@@ -71,10 +67,29 @@
 
 ;;;###autoload
 (defun turn-on-gnus-mailing-list-mode ()
-  (when (gnus-group-get-parameter gnus-newsgroup-name 'to-list)
+  (when (gnus-group-find-parameter gnus-newsgroup-name 'to-list)
     (gnus-mailing-list-mode 1)))
 
 ;;;###autoload
+(defun gnus-mailing-list-insinuate (&optional force)
+  "Setup group parameters from List-Post header.
+If FORCE is non-nil, replace the old ones."
+  (interactive "P")
+  (let ((list-post
+	 (with-current-buffer gnus-original-article-buffer
+	   (gnus-fetch-field "list-post"))))
+    (if list-post
+	(if (and (not force)
+		 (gnus-group-get-parameter gnus-newsgroup-name 'to-list))
+	    (gnus-message 1 "to-list is non-nil.")
+	  (if (string-match "<mailto:\\([^>]*\\)>" list-post)
+	      (setq list-post (match-string 1 list-post)))
+	  (gnus-group-add-parameter gnus-newsgroup-name
+				    (cons 'to-list list-post))
+	  (gnus-mailing-list-mode 1))
+      (gnus-message 1 "no list-post in this message."))))
+
+;;;###autoload
 (defun gnus-mailing-list-mode (&optional arg)
   "Minor mode for providing mailing-list commands.
 
@@ -140,11 +155,15 @@
 (defun gnus-mailing-list-archive ()
   "Browse archive"
   (interactive)
+  (require 'browse-url)
   (let ((list-archive
 	 (with-current-buffer gnus-original-article-buffer
 	   (gnus-fetch-field "list-archive"))))
-    (cond (list-archive (gnus-mailing-list-message list-archive))
-	  (t (gnus-message 1 "no list-owner in this group")))))
+    (cond (list-archive
+	   (if (string-match "<\\(http:[^>]*\\)>" list-archive)
+	       (browse-url (match-string 1 list-archive))
+	     (browse-url list-archive)))
+	  (t (gnus-message 1 "no list-archive in this group")))))
 
 ;;; Utility functions
 
@@ -158,7 +177,7 @@
     (cond
      ((string-match "<mailto:\\([^>]*\\)>" address)
       (let ((args (match-string 1 address)))
-	(cond    				; with param
+	(cond				; with param
 	 ((string-match "\\(.*\\)\\?\\(.*\\)" args)
 	  (setq mailto (match-string 1 args))
 	  (let ((param (match-string 2 args)))
@@ -169,7 +188,7 @@
 	    (if (string-match "to=\\([^&]*\\)" param)
 		(push (match-string 1 param) to))
 	    ))
-	 (t (setq mailto args)))))			; without param
+	 (t (setq mailto args)))))	; without param
 
      ; other case <http://... to be done.
      (t nil))