Mercurial > emacs
comparison lisp/gnus/gnus-ml.el @ 90428:a8190f7e546e
Merge from emacs--devo--0
Patches applied:
* emacs--devo--0 (patch 285-296)
- Update from CVS
- Merge from gnus--rel--5.10
- Update from CVS: admin/FOR-RELEASE: Update refcard section.
* gnus--rel--5.10 (patch 102-104)
- Update from CVS
Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-64
author | Miles Bader <miles@gnu.org> |
---|---|
date | Wed, 07 Jun 2006 18:05:10 +0000 |
parents | c5406394f567 70b055c73c8c |
children | 95d0cdf160ea |
comparison
equal
deleted
inserted
replaced
90427:ddb25860d044 | 90428:a8190f7e546e |
---|---|
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 |