X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-ml.el;h=25f6685ad8b6b3414acc4b883117ef0e0e1b2827;hb=9b741e050b400987d68ff761c6cc3276c932839c;hp=5eb0fd0c56c628e6e232d0a72023fec7d0d03779;hpb=2cc5659442ce551b395b9aeebe213947e415ac6d;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-ml.el b/lisp/gnus-ml.el index 5eb0fd0..25f6685 100644 --- a/lisp/gnus-ml.el +++ b/lisp/gnus-ml.el @@ -1,6 +1,6 @@ ;;; 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 ;; 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,7 +67,7 @@ ;;;###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 @@ -79,7 +75,7 @@ "Setup group parameters from List-Post header. If FORCE is non-nil, replace the old ones." (interactive "P") - (let ((list-post + (let ((list-post (with-current-buffer gnus-original-article-buffer (gnus-fetch-field "list-post")))) (if list-post @@ -88,7 +84,7 @@ If FORCE is non-nil, replace the old ones." (gnus-message 1 "to-list is non-nil.") (if (string-match "]*\\)>" list-post) (setq list-post (match-string 1 list-post))) - (gnus-group-add-parameter gnus-newsgroup-name + (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.")))) @@ -113,8 +109,8 @@ If FORCE is non-nil, replace the old ones." (defun gnus-mailing-list-help () "Get help from mailing list server." - (interactive) - (let ((list-help + (interactive) + (let ((list-help (with-current-buffer gnus-original-article-buffer (gnus-fetch-field "list-help")))) (cond (list-help (gnus-mailing-list-message list-help)) @@ -123,7 +119,7 @@ If FORCE is non-nil, replace the old ones." (defun gnus-mailing-list-subscribe () "Subscribe" (interactive) - (let ((list-subscribe + (let ((list-subscribe (with-current-buffer gnus-original-article-buffer (gnus-fetch-field "list-subscribe")))) (cond (list-subscribe (gnus-mailing-list-message list-subscribe)) @@ -132,7 +128,7 @@ If FORCE is non-nil, replace the old ones." (defun gnus-mailing-list-unsubscribe () "Unsubscribe" (interactive) - (let ((list-unsubscribe + (let ((list-unsubscribe (with-current-buffer gnus-original-article-buffer (gnus-fetch-field "list-unsubscribe")))) (cond (list-unsubscribe (gnus-mailing-list-message list-unsubscribe)) @@ -141,7 +137,7 @@ If FORCE is non-nil, replace the old ones." (defun gnus-mailing-list-post () "Post message (really useful ?)" (interactive) - (let ((list-post + (let ((list-post (with-current-buffer gnus-original-article-buffer (gnus-fetch-field "list-post")))) (cond (list-post (gnus-mailing-list-message list-post)) @@ -150,7 +146,7 @@ If FORCE is non-nil, replace the old ones." (defun gnus-mailing-list-owner () "Mail to the owner" (interactive) - (let ((list-owner + (let ((list-owner (with-current-buffer gnus-original-article-buffer (gnus-fetch-field "list-owner")))) (cond (list-owner (gnus-mailing-list-message list-owner)) @@ -160,10 +156,10 @@ If FORCE is non-nil, replace the old ones." "Browse archive" (interactive) (require 'browse-url) - (let ((list-archive + (let ((list-archive (with-current-buffer gnus-original-article-buffer (gnus-fetch-field "list-archive")))) - (cond (list-archive + (cond (list-archive (if (string-match "<\\(http:[^>]*\\)>" list-archive) (browse-url (match-string 1 list-archive)) (browse-url list-archive))) @@ -178,10 +174,10 @@ If FORCE is non-nil, replace the old ones." (subject "None") (body "") ) - (cond + (cond ((string-match "]*\\)>" 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))) @@ -191,9 +187,9 @@ If FORCE is non-nil, replace the old ones." (setq body (match-string 1 param))) (if (string-match "to=\\([^&]*\\)" param) (push (match-string 1 param) to)) - )) + )) (t (setq mailto args))))) ; without param - + ; other case