diff options
Diffstat (limited to 'lisp/gnus/gnus-ml.el')
| -rw-r--r-- | lisp/gnus/gnus-ml.el | 53 |
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)) |