Mercurial > emacs
diff lisp/gnus/gnus-ml.el @ 82951:0fde48feb604
Import Gnus 5.10 from the v5_10 branch of the Gnus repository.
author | Andreas Schwab <schwab@suse.de> |
---|---|
date | Thu, 22 Jul 2004 16:45:51 +0000 |
parents | 695cf19ef79e |
children | 18a818a2ee7c cce1c0ee76ee |
line wrap: on
line diff
--- a/lisp/gnus/gnus-ml.el Thu Jul 22 14:26:26 2004 +0000 +++ b/lisp/gnus/gnus-ml.el Thu Jul 22 16:45:51 2004 +0000 @@ -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))