Mercurial > emacs

comparison lisp/gnus/gnus-ml.el @ 71262:70b055c73c8c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merge from gnus--rel--5.10 Patches applied: * gnus--rel--5.10 (patch 103-104) - Update from CVS Revision: emacs@sv.gnu.org/emacs--devo--0--patch-295
author Miles Bader <miles@gnu.org>
date Wed, 07 Jun 2006 16:39:16 +0000
parents 1077b8039c32
children e3694f1cb928 a8190f7e546e
comparison
equal deleted inserted replaced
71261:c6e18badb0a7 71262:70b055c73c8c
2 2
3 ;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 3 ;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
4 ;; 2005, 2006 Free Software Foundation, Inc. 4 ;; 2005, 2006 Free Software Foundation, Inc.
5 5
6 ;; Author: Julien Gilles <jgilles@free.fr> 6 ;; Author: Julien Gilles <jgilles@free.fr>
7 ;; Keywords: news 7 ;; Keywords: news, mail
8 8
9 ;; This file is part of GNU Emacs. 9 ;; This file is part of GNU Emacs.
10 10
11 ;; GNU Emacs is free software; you can redistribute it and/or modify 11 ;; GNU Emacs is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by 12 ;; it under the terms of the GNU General Public License as published by
49 "\C-c\C-nh" gnus-mailing-list-help 49 "\C-c\C-nh" gnus-mailing-list-help
50 "\C-c\C-ns" gnus-mailing-list-subscribe 50 "\C-c\C-ns" gnus-mailing-list-subscribe
51 "\C-c\C-nu" gnus-mailing-list-unsubscribe 51 "\C-c\C-nu" gnus-mailing-list-unsubscribe
52 "\C-c\C-np" gnus-mailing-list-post 52 "\C-c\C-np" gnus-mailing-list-post
53 "\C-c\C-no" gnus-mailing-list-owner 53 "\C-c\C-no" gnus-mailing-list-owner
54 "\C-c\C-na" gnus-mailing-list-archive 54 "\C-c\C-na" gnus-mailing-list-archive))
55 ))
56 55
57 (defun gnus-mailing-list-make-menu-bar () 56 (defun gnus-mailing-list-make-menu-bar ()
58 (unless (boundp 'gnus-mailing-list-menu) 57 (unless (boundp 'gnus-mailing-list-menu)
59 (easy-menu-define 58 (easy-menu-define
60 gnus-mailing-list-menu gnus-mailing-list-mode-map "" 59 gnus-mailing-list-menu gnus-mailing-list-mode-map ""
101 (if (null arg) (not gnus-mailing-list-mode) 100 (if (null arg) (not gnus-mailing-list-mode)
102 (> (prefix-numeric-value arg) 0))) 101 (> (prefix-numeric-value arg) 0)))
103 ;; Set up the menu. 102 ;; Set up the menu.
104 (when (gnus-visual-p 'mailing-list-menu 'menu) 103 (when (gnus-visual-p 'mailing-list-menu 'menu)
105 (gnus-mailing-list-make-menu-bar)) 104 (gnus-mailing-list-make-menu-bar))
106 (gnus-add-minor-mode 'gnus-mailing-list-mode " Mailing-List" gnus-mailing-list-mode-map) 105 (gnus-add-minor-mode 'gnus-mailing-list-mode " Mailing-List"
106 gnus-mailing-list-mode-map)
107 (gnus-run-hooks 'gnus-mailing-list-mode-hook)))) 107 (gnus-run-hooks 'gnus-mailing-list-mode-hook))))
108 108
109 ;;; Commands 109 ;;; Commands
110 110
111 (defun gnus-mailing-list-help () 111 (defun gnus-mailing-list-help ()
116 (gnus-fetch-field "list-help")))) 116 (gnus-fetch-field "list-help"))))
117 (cond (list-help (gnus-mailing-list-message list-help)) 117 (cond (list-help (gnus-mailing-list-message list-help))
118 (t (gnus-message 1 "no list-help in this group"))))) 118 (t (gnus-message 1 "no list-help in this group")))))
119 119
120 (defun gnus-mailing-list-subscribe () 120 (defun gnus-mailing-list-subscribe ()
121 "Subscribe" 121 "Subscribe to mailing list."
122 (interactive) 122 (interactive)
123 (let ((list-subscribe 123 (let ((list-subscribe
124 (with-current-buffer gnus-original-article-buffer 124 (with-current-buffer gnus-original-article-buffer
125 (gnus-fetch-field "list-subscribe")))) 125 (gnus-fetch-field "list-subscribe"))))
126 (cond (list-subscribe (gnus-mailing-list-message list-subscribe)) 126 (cond (list-subscribe (gnus-mailing-list-message list-subscribe))
127 (t (gnus-message 1 "no list-subscribe in this group"))))) 127 (t (gnus-message 1 "no list-subscribe in this group")))))
128 128
129 (defun gnus-mailing-list-unsubscribe () 129 (defun gnus-mailing-list-unsubscribe ()
130 "Unsubscribe" 130 "Unsubscribe from mailing list."
131 (interactive) 131 (interactive)
132 (let ((list-unsubscribe 132 (let ((list-unsubscribe
133 (with-current-buffer gnus-original-article-buffer 133 (with-current-buffer gnus-original-article-buffer
134 (gnus-fetch-field "list-unsubscribe")))) 134 (gnus-fetch-field "list-unsubscribe"))))
135 (cond (list-unsubscribe (gnus-mailing-list-message list-unsubscribe)) 135 (cond (list-unsubscribe (gnus-mailing-list-message list-unsubscribe))
143 (gnus-fetch-field "list-post")))) 143 (gnus-fetch-field "list-post"))))
144 (cond (list-post (gnus-mailing-list-message list-post)) 144 (cond (list-post (gnus-mailing-list-message list-post))
145 (t (gnus-message 1 "no list-post in this group"))))) 145 (t (gnus-message 1 "no list-post in this group")))))
146 146
147 (defun gnus-mailing-list-owner () 147 (defun gnus-mailing-list-owner ()
148 "Mail to the owner" 148 "Mail to the mailing list owner."
149 (interactive) 149 (interactive)
150 (let ((list-owner 150 (let ((list-owner
151 (with-current-buffer gnus-original-article-buffer 151 (with-current-buffer gnus-original-article-buffer
152 (gnus-fetch-field "list-owner")))) 152 (gnus-fetch-field "list-owner"))))
153 (cond (list-owner (gnus-mailing-list-message list-owner)) 153 (cond (list-owner (gnus-mailing-list-message list-owner))
154 (t (gnus-message 1 "no list-owner in this group"))))) 154 (t (gnus-message 1 "no list-owner in this group")))))
155 155
156 (defun gnus-mailing-list-archive () 156 (defun gnus-mailing-list-archive ()
157 "Browse archive" 157 "Browse archive."
158 (interactive) 158 (interactive)
159 (require 'browse-url) 159 (require 'browse-url)
160 (let ((list-archive 160 (let ((list-archive
161 (with-current-buffer gnus-original-article-buffer 161 (with-current-buffer gnus-original-article-buffer
162 (gnus-fetch-field "list-archive")))) 162 (gnus-fetch-field "list-archive"))))
167 (t (gnus-message 1 "no list-archive in this group"))))) 167 (t (gnus-message 1 "no list-archive in this group")))))
168 168
169 ;;; Utility functions 169 ;;; Utility functions
170 170
171 (defun gnus-mailing-list-message (address) 171 (defun gnus-mailing-list-message (address)
172 "" 172 "Send message to ADDRESS.
173 (let ((mailto "") 173 ADDRESS is specified by a \"mailto:\" URL."
174 (to ()) 174 (cond
175 (subject "None") 175 ((string-match "<\\(mailto:[^>]*\\)>" address)
176 (body "") 176 (require 'gnus-art)
177 ) 177 (gnus-url-mailto (match-string 1 address)))
178 (cond 178 ;; other case <http://...> to be done.
179 ((string-match "<mailto:\\([^>]*\\)>" address) 179 (t nil)))
180 (let ((args (match-string 1 address)))
181 (cond ; with param
182 ((string-match "\\(.*\\)\\?\\(.*\\)" args)
183 (setq mailto (match-string 1 args))
184 (let ((param (match-string 2 args)))
185 (if (string-match "subject=\\([^&]*\\)" param)
186 (setq subject (match-string 1 param)))
187 (if (string-match "body=\\([^&]*\\)" param)
188 (setq body (match-string 1 param)))
189 (if (string-match "to=\\([^&]*\\)" param)
190 (push (match-string 1 param) to))
191 ))
192 (t (setq mailto args))))) ; without param
193
194 ; other case <http://... to be done.
195 (t nil))
196 (gnus-setup-message 'message (message-mail mailto subject))
197 (insert body)
198 ))
199 180
200 (provide 'gnus-ml) 181 (provide 'gnus-ml)
201 182
202 ;;; arch-tag: 936c0fe6-acce-4c16-87d0-eded88078896 183 ;;; arch-tag: 936c0fe6-acce-4c16-87d0-eded88078896
203 ;;; gnus-ml.el ends here 184 ;;; gnus-ml.el ends here