X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/a1506d2977a8c2eb982ad0b59416009cdfaa6f51..60b0b6685e16dd58897922e7cecd95a821aedc38:/lisp/gnus/gnus-ml.el diff --git a/lisp/gnus/gnus-ml.el b/lisp/gnus/gnus-ml.el index 156250e7f8..71183dda25 100644 --- a/lisp/gnus/gnus-ml.el +++ b/lisp/gnus/gnus-ml.el @@ -1,9 +1,10 @@ -;;; 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, 2002, 2003, 2004, +;; 2005, 2006, 2007 Free Software Foundation, Inc. ;; Author: Julien Gilles -;; Keywords: news +;; Keywords: news, mail ;; This file is part of GNU Emacs. @@ -19,17 +20,13 @@ ;; You should have received a copy of the GNU General Public License ;; 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. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; implement (small subset of) RFC 2369 -;;; Usage: - -;; (add-hook 'gnus-summary-mode-hook 'turn-on-gnus-mailing-list-mode) - ;;; Code: (require 'gnus) @@ -49,13 +46,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 () (unless (boundp 'gnus-mailing-list-menu) @@ -71,9 +67,28 @@ ;;;###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 "]*\\)>" 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. @@ -87,7 +102,8 @@ ;; Set up the menu. (when (gnus-visual-p 'mailing-list-menu 'menu) (gnus-mailing-list-make-menu-bar)) - (gnus-add-minor-mode 'gnus-mailing-list-mode " Mailing-List" gnus-mailing-list-mode-map) + (gnus-add-minor-mode 'gnus-mailing-list-mode " Mailing-List" + gnus-mailing-list-mode-map) (gnus-run-hooks 'gnus-mailing-list-mode-hook)))) ;;; Commands @@ -102,7 +118,7 @@ (t (gnus-message 1 "no list-help in this group"))))) (defun gnus-mailing-list-subscribe () - "Subscribe" + "Subscribe to mailing list." (interactive) (let ((list-subscribe (with-current-buffer gnus-original-article-buffer @@ -111,7 +127,7 @@ (t (gnus-message 1 "no list-subscribe in this group"))))) (defun gnus-mailing-list-unsubscribe () - "Unsubscribe" + "Unsubscribe from mailing list." (interactive) (let ((list-unsubscribe (with-current-buffer gnus-original-article-buffer @@ -129,7 +145,7 @@ (t (gnus-message 1 "no list-post in this group"))))) (defun gnus-mailing-list-owner () - "Mail to the owner" + "Mail to the mailing list owner." (interactive) (let ((list-owner (with-current-buffer gnus-original-article-buffer @@ -138,45 +154,31 @@ (t (gnus-message 1 "no list-owner in this group"))))) (defun gnus-mailing-list-archive () - "Browse 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 (defun gnus-mailing-list-message (address) - "" - (let ((mailto "") - (to ()) - (subject "None") - (body "") - ) - (cond - ((string-match "]*\\)>" address) - (let ((args (match-string 1 address))) - (cond ; with param - ((string-match "\\(.*\\)\\?\\(.*\\)" args) - (setq mailto (match-string 1 args)) - (let ((param (match-string 2 args))) - (if (string-match "subject=\\([^&]*\\)" param) - (setq subject (match-string 1 param))) - (if (string-match "body=\\([^&]*\\)" param) - (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 ]*\\)>" address) + (require 'gnus-art) + (gnus-url-mailto (match-string 1 address))) + ;; other case to be done. + (t nil))) (provide 'gnus-ml) +;;; arch-tag: 936c0fe6-acce-4c16-87d0-eded88078896 ;;; gnus-ml.el ends here