;;; 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 <jgilles@free.fr>
-;; Keywords: news
+;; Keywords: news, mail
;; This file is part of GNU Emacs.
;; 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:
;;; Code:
(require 'gnus)
+(require 'gnus-msg)
(eval-when-compile (require 'cl))
;;; Mailing list minor mode
(defvar gnus-mailing-list-mode-map nil)
+(defvar gnus-mailing-list-menu)
+
(unless gnus-mailing-list-mode-map
(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)
["Mail to owner" gnus-mailing-list-owner t]
["Browse archive" gnus-mailing-list-archive t]))))
+;;;###autoload
(defun turn-on-gnus-mailing-list-mode ()
- (when (gnus-group-get-parameter group '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.
;; 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
(defun gnus-mailing-list-help ()
"Get help from mailing list server."
- (interactive)
- (cond (list-help (gnus-mailing-list-message list-help))
- (t (display-message 'no-log "no list-help in this group"))))
+ (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))
+ (t (gnus-message 1 "no list-help in this group")))))
(defun gnus-mailing-list-subscribe ()
- "Subscribe"
+ "Subscribe to mailing list."
(interactive)
- (cond (list-subscribe (gnus-mailing-list-message list-subscribe))
- (t (display-message 'no-log "no list-subscribe in this group"))))
-
+ (let ((list-subscribe
+ (with-current-buffer gnus-original-article-buffer
+ (gnus-fetch-field "list-subscribe"))))
+ (cond (list-subscribe (gnus-mailing-list-message list-subscribe))
+ (t (gnus-message 1 "no list-subscribe in this group")))))
(defun gnus-mailing-list-unsubscribe ()
- "Unsubscribe"
+ "Unsubscribe from mailing list."
(interactive)
- (cond (list-unsubscribe (gnus-mailing-list-message list-unsubscribe))
- (t (display-message 'no-log "no list-unsubscribe in this group"))))
+ (let ((list-unsubscribe
+ (with-current-buffer gnus-original-article-buffer
+ (gnus-fetch-field "list-unsubscribe"))))
+ (cond (list-unsubscribe (gnus-mailing-list-message list-unsubscribe))
+ (t (gnus-message 1 "no list-unsubscribe in this group")))))
(defun gnus-mailing-list-post ()
"Post message (really useful ?)"
(interactive)
- (cond (list-post (gnus-mailing-list-message list-post))
- (t (display-message 'no-log "no list-post in this group")))
- )
+ (let ((list-post
+ (with-current-buffer gnus-original-article-buffer
+ (gnus-fetch-field "list-post"))))
+ (cond (list-post (gnus-mailing-list-message list-post))
+ (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)
- (cond (list-owner (gnus-mailing-list-message list-owner))
- (t (display-message 'no-log "no list-owner in this group")))
- )
+ (let ((list-owner
+ (with-current-buffer gnus-original-article-buffer
+ (gnus-fetch-field "list-owner"))))
+ (cond (list-owner (gnus-mailing-list-message list-owner))
+ (t (gnus-message 1 "no list-owner in this group")))))
(defun gnus-mailing-list-archive ()
- "Browse archive"
+ "Browse archive."
(interactive)
- (cond (list-archive (gnus-mailing-list-message list-archive))
- (t (display-message 'no-log "no list-owner in this group")))
- )
+ (require 'browse-url)
+ (let ((list-archive
+ (with-current-buffer gnus-original-article-buffer
+ (gnus-fetch-field "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
-(defun gnus-xmas-mailing-list-menu-add ()
- (gnus-xmas-menu-add mailing-list
- gnus-mailing-list-menu))
-
-(add-hook 'gnus-mailing-list-mode-hook 'gnus-xmas-mailing-list-menu-add)
-
(defun gnus-mailing-list-message (address)
- ""
- (let ((mailto "")
- (to ())
- (subject "None")
- (body "")
- )
- (cond
- ((string-match "<mailto:\\([^>]*\\)>" 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 <http://... to be done.
- (t nil))
- (gnus-setup-message 'message (message-mail mailto subject))
- (insert body)
- ))
+ "Send message to ADDRESS.
+ADDRESS is specified by a \"mailto:\" URL."
+ (cond
+ ((string-match "<\\(mailto:[^>]*\\)>" address)
+ (require 'gnus-art)
+ (gnus-url-mailto (match-string 1 address)))
+ ;; other case <http://...> to be done.
+ (t nil)))
(provide 'gnus-ml)
+;;; arch-tag: 936c0fe6-acce-4c16-87d0-eded88078896
;;; gnus-ml.el ends here