Move image files to etc/gnus.

[gnus] / lisp / gnus-ml.el

diff --git a/lisp/gnus-ml.el b/lisp/gnus-ml.el
index 52c4442..b2f57df 100644 (file)
--- a/lisp/gnus-ml.el
+++ b/lisp/gnus-ml.el
@@ -1,32 +1,31 @@
-;;; gnus-ml.el --- Mailing list minor mode for gnus
+;;; gnus-ml.el --- Mailing list minor mode for Gnus
 
-;; Copyright (C) 2000 by Julien Gilles 
+;; Copyright (C) 2000 Free Software Foundation, Inc.
 
 ;; Author: Julien Gilles  <jgilles@free.fr>
 ;; Keywords: news
 
-;; This program is free software; you can redistribute it and/or modify
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2 of the License, or
-;; (at your option) any later version.
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
 
-;; This program is distributed in the hope that it will be useful,
+;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with this program; if not, write to the Free Software
-;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
 
 ;;; Commentary:
 
 ;; implement (small subset of) RFC 2369
 
-;;; Usage:
-
-;; (add-hook 'gnus-summary-mode-hook 'turn-on-gnus-mailing-list-mode)
-
 ;;; Code:
 
 (require 'gnus)
@@ -46,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,6 +70,25 @@
   (when (gnus-group-get-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.
@@ -141,7 +159,10 @@
   (let ((list-archive 
         (with-current-buffer gnus-original-article-buffer
           (gnus-fetch-field "list-archive"))))
-    (cond (list-archive (browse-url list-archive))
+    (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