Mercurial > emacs
annotate lisp/mail/mail-hist.el @ 107357:0f6a30c8d91a
Additional fix for rfc822-addresses (Bug#5692).
* mail/rfc822.el (rfc822-addresses): Use nested catches to ensure
that all errors are caught, and that the return value is always a
list (Bug#5692).
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Mon, 08 Mar 2010 11:17:30 -0500 |
parents | 1d1d5d9bd884 |
children | 280c8ae2476d 376148b31b5e |
rev | line source |
---|---|
38436
b174db545cfd
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
35027
diff
changeset
|
1 ;;; mail-hist.el --- headers and message body history for outgoing mail |
15191 | 2 |
74509 | 3 ;; Copyright (C) 1994, 2001, 2002, 2003, 2004, 2005, |
106815 | 4 ;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. |
7267 | 5 |
30519
d732477f0678
(mail-hist-previous-input, mail-hist-next-input): do the obvious code
Karl Fogel <kfogel@red-bean.com>
parents:
24519
diff
changeset
|
6 ;; Author: Karl Fogel <kfogel@red-bean.com> |
7267 | 7 ;; Created: March, 1994 |
8277
824fb42f33ab
Make sure that headers are case-insensitive.
Richard M. Stallman <rms@gnu.org>
parents:
7639
diff
changeset
|
8 ;; Keywords: mail, history |
7267 | 9 |
10 ;; This file is part of GNU Emacs. | |
11 | |
94674
ef65fa4dca3b
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
12 ;; GNU Emacs is free software: you can redistribute it and/or modify |
7267 | 13 ;; it under the terms of the GNU General Public License as published by |
94674
ef65fa4dca3b
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
14 ;; the Free Software Foundation, either version 3 of the License, or |
ef65fa4dca3b
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
15 ;; (at your option) any later version. |
7267 | 16 |
17 ;; GNU Emacs is distributed in the hope that it will be useful, | |
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 ;; GNU General Public License for more details. | |
21 | |
15191 | 22 ;; You should have received a copy of the GNU General Public License |
94674
ef65fa4dca3b
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
15191 | 24 |
7267 | 25 ;;; Commentary: |
26 | |
27 ;; Thanks to Jim Blandy for mentioning ring.el. It saved a lot of | |
28 ;; time. | |
29 ;; | |
30 ;; To use this package, put it in a directory in your load-path, and | |
31 ;; put this in your .emacs file: | |
32 ;; | |
33 ;; (load "mail-hist" nil t) | |
34 ;; | |
35 ;; Or you could do it with autoloads and hooks in your .emacs: | |
36 ;; | |
37 ;; (add-hook 'mail-mode-hook 'mail-hist-define-keys) | |
38 ;; (add-hook 'mail-send-hook 'mail-hist-put-headers-into-history) | |
39 ;; (add-hook 'vm-mail-mode-hook 'mail-hist-define-keys) ;or rmail, etc | |
40 ;; (autoload 'mail-hist-define-keys "mail-hist") | |
41 ;; (autoload 'mail-hist-put-headers-into-history "mail-hist") | |
42 ;; | |
43 ;; Once it's installed, use M-p and M-n from mail headers to recover | |
44 ;; previous/next contents in the history for that header, or, in the | |
45 ;; body of the message, to recover previous/next text of the message. | |
46 ;; This only applies to outgoing mail -- mail-hist ignores received | |
47 ;; messages. | |
48 ;; | |
49 ;; Although repeated history requests do clear out the text from the | |
50 ;; previous request, an isolated request just inserts its text at | |
51 ;; point, so that you can mix the histories of different messages | |
52 ;; easily. This might be confusing at times, but there should be no | |
53 ;; problems that undo can't handle. | |
54 | |
55 ;;; Code: | |
56 (require 'ring) | |
21868 | 57 (require 'sendmail) |
7267 | 58 |
20962 | 59 (defgroup mail-hist nil |
60 "Headers and message body history for outgoing mail." | |
61 :prefix "mail-hist-" | |
62 :group 'mail) | |
63 | |
7267 | 64 ;;;###autoload |
65 (defun mail-hist-define-keys () | |
66 "Define keys for accessing mail header history. For use in hooks." | |
67 (local-set-key "\M-p" 'mail-hist-previous-input) | |
68 (local-set-key "\M-n" 'mail-hist-next-input)) | |
69 | |
70 ;;;###autoload | |
15191 | 71 (defun mail-hist-enable () |
72 (add-hook 'mail-mode-hook 'mail-hist-define-keys) | |
73 (add-hook 'mail-send-hook 'mail-hist-put-headers-into-history)) | |
7267 | 74 |
75 (defvar mail-hist-header-ring-alist nil | |
76 "Alist of form (header-name . history-ring). | |
77 Used for knowing which history list to look in when the user asks for | |
78 previous/next input.") | |
79 | |
20962 | 80 (defcustom mail-hist-history-size (or kill-ring-max 1729) |
7267 | 81 "*The maximum number of elements in a mail field's history. |
20962 | 82 Oldest elements are dumped first." |
83 :type 'integer | |
84 :group 'mail-hist) | |
7267 | 85 |
86 ;;;###autoload | |
20962 | 87 (defcustom mail-hist-keep-history t |
88 "*Non-nil means keep a history for headers and text of outgoing mail." | |
89 :type 'boolean | |
90 :group 'mail-hist) | |
7267 | 91 |
92 ;; For handling repeated history requests | |
93 (defvar mail-hist-access-count 0) | |
94 | |
95 (defvar mail-hist-last-bounds nil) | |
96 ;; (start . end) A pair indicating the buffer positions delimiting the | |
97 ;; last inserted history, so it can be replaced by a new input if the | |
98 ;; command is repeated. | |
99 | |
100 (defvar mail-hist-header-regexp "^[^:]*:" | |
101 "Regular expression for matching headers in a mail message.") | |
102 | |
103 (defsubst mail-hist-current-header-name () | |
104 "Get name of mail header point is currently in, without the colon. | |
105 Returns nil if not in a header, implying that point is in the body of | |
106 the message." | |
24519
2a1ffba95a70
(mail-hist-current-header-name): Don't make
Karl Heuer <kwzh@gnu.org>
parents:
23194
diff
changeset
|
107 (if (>= (point) (mail-text-start)) |
7267 | 108 nil ; then we are in the body of the message |
109 (save-excursion | |
21868 | 110 (let* ((body-start |
111 (mail-text-start)) | |
7267 | 112 (name-start |
113 (re-search-backward mail-hist-header-regexp nil t)) | |
114 (name-end | |
115 (prog2 (search-forward ":" body-start t) (1- (point))))) | |
116 (and | |
117 name-start | |
118 name-end | |
15581
4d843931581c
(mail-hist-current-header-name): Use buffer-substring-no-properties.
Miles Bader <miles@gnu.org>
parents:
15191
diff
changeset
|
119 (downcase (buffer-substring-no-properties name-start name-end))))))) |
7267 | 120 |
121 (defsubst mail-hist-forward-header (count) | |
122 "Move forward COUNT headers (backward if COUNT is negative). | |
123 If last/first header is encountered first, stop there and returns | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
47637
diff
changeset
|
124 nil. |
7267 | 125 |
15191 | 126 Places point on the first non-whitespace on the line following the |
127 colon after the header name, or on the second space following that if | |
128 the header is empty." | |
21868 | 129 (let ((boundary (mail-header-end))) |
15191 | 130 (and |
21868 | 131 (> boundary 0) |
15191 | 132 (let ((unstopped t)) |
133 (setq boundary (save-excursion | |
134 (goto-char boundary) | |
135 (beginning-of-line) | |
136 (1- (point)))) | |
137 (if (> count 0) | |
138 (while (> count 0) | |
139 (setq | |
140 unstopped | |
141 (re-search-forward mail-hist-header-regexp boundary t)) | |
142 (setq count (1- count))) | |
143 ;; because the current header will match too. | |
144 (setq count (1- count)) | |
145 ;; count is negative | |
146 (while (< count 0) | |
147 (setq | |
148 unstopped | |
149 (re-search-backward mail-hist-header-regexp nil t)) | |
150 (setq count (1+ count))) | |
151 ;; we end up behind the header, so must move to the front | |
152 (re-search-forward mail-hist-header-regexp boundary t)) | |
153 ;; Now we are right after the colon | |
154 (and (looking-at "\\s-") (forward-char 1)) | |
155 ;; return nil if didn't go as far as asked, otherwise point | |
156 unstopped)))) | |
7267 | 157 |
158 (defsubst mail-hist-beginning-of-header () | |
159 "Move to the start of the current header. | |
160 The start of the current header is defined as one space after the | |
161 colon, or just after the colon if it is not followed by whitespace." | |
162 ;; this is slick as all heck: | |
163 (if (mail-hist-forward-header -1) | |
164 (mail-hist-forward-header 1) | |
165 (mail-hist-forward-header 1) | |
166 (mail-hist-forward-header -1))) | |
167 | |
168 (defsubst mail-hist-current-header-contents () | |
169 "Get the contents of the mail header in which point is located." | |
170 (save-excursion | |
171 (mail-hist-beginning-of-header) | |
172 (let ((start (point))) | |
173 (or (mail-hist-forward-header 1) | |
23194
d9b783c53049
(mail-hist-current-header-contents):
Karl Heuer <kwzh@gnu.org>
parents:
23106
diff
changeset
|
174 (goto-char (mail-header-end))) |
7267 | 175 (beginning-of-line) |
176 (buffer-substring start (1- (point)))))) | |
177 | |
178 (defsubst mail-hist-get-header-ring (header) | |
179 "Get HEADER's history ring, or nil if none. | |
180 HEADER is a string without the colon." | |
8277
824fb42f33ab
Make sure that headers are case-insensitive.
Richard M. Stallman <rms@gnu.org>
parents:
7639
diff
changeset
|
181 (setq header (downcase header)) |
7267 | 182 (cdr (assoc header mail-hist-header-ring-alist))) |
183 | |
20962 | 184 (defcustom mail-hist-text-size-limit nil |
15191 | 185 "*Don't store any header or body with more than this many characters. |
20962 | 186 If the value is nil, that means no limit on text size." |
187 :type '(choice (const nil) integer) | |
188 :group 'mail-hist) | |
12374
5888dd3f1a72
(mail-hist-text-size-limit): New var.
Richard M. Stallman <rms@gnu.org>
parents:
12366
diff
changeset
|
189 |
15191 | 190 (defun mail-hist-text-too-long-p (text) |
35027
5664773f9e07
mail/mail-hist.el (mail-hist-text-too-long-p): doc fix.
Karl Fogel <kfogel@red-bean.com>
parents:
30519
diff
changeset
|
191 "Return non-nil if TEXT's length exceeds `mail-hist-text-size-limit'." |
15191 | 192 (if mail-hist-text-size-limit |
193 (> (length text) mail-hist-text-size-limit))) | |
12374
5888dd3f1a72
(mail-hist-text-size-limit): New var.
Richard M. Stallman <rms@gnu.org>
parents:
12366
diff
changeset
|
194 |
7267 | 195 (defsubst mail-hist-add-header-contents-to-ring (header &optional contents) |
15191 | 196 "Add the contents of HEADER to the header history ring. |
7267 | 197 Optional argument CONTENTS is a string which will be the contents |
15191 | 198 \(instead of whatever's found in the header)." |
8277
824fb42f33ab
Make sure that headers are case-insensitive.
Richard M. Stallman <rms@gnu.org>
parents:
7639
diff
changeset
|
199 (setq header (downcase header)) |
12374
5888dd3f1a72
(mail-hist-text-size-limit): New var.
Richard M. Stallman <rms@gnu.org>
parents:
12366
diff
changeset
|
200 (let ((ctnts (or contents (mail-hist-current-header-contents))) |
5888dd3f1a72
(mail-hist-text-size-limit): New var.
Richard M. Stallman <rms@gnu.org>
parents:
12366
diff
changeset
|
201 (ring (cdr (assoc header mail-hist-header-ring-alist)))) |
15191 | 202 (if (mail-hist-text-too-long-p ctnts) (setq ctnts "")) |
7267 | 203 (or ring |
204 ;; If the ring doesn't exist, we'll have to make it and add it | |
205 ;; to the mail-header-ring-alist: | |
206 (prog1 | |
207 (setq ring (make-ring mail-hist-history-size)) | |
208 (setq mail-hist-header-ring-alist | |
209 (cons (cons header ring) mail-hist-header-ring-alist)))) | |
12374
5888dd3f1a72
(mail-hist-text-size-limit): New var.
Richard M. Stallman <rms@gnu.org>
parents:
12366
diff
changeset
|
210 (ring-insert ring ctnts))) |
7267 | 211 |
212 ;;;###autoload | |
213 (defun mail-hist-put-headers-into-history () | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
47637
diff
changeset
|
214 "Put headers and contents of this message into mail header history. |
7267 | 215 Each header has its own independent history, as does the body of the |
216 message. | |
217 | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
47637
diff
changeset
|
218 This function normally would be called when the message is sent." |
7267 | 219 (and |
220 mail-hist-keep-history | |
11377
2de0b88cc028
(mail-hist-put-headers-into-history):
Richard M. Stallman <rms@gnu.org>
parents:
11249
diff
changeset
|
221 (save-excursion |
7267 | 222 (goto-char (point-min)) |
223 (while (mail-hist-forward-header 1) | |
224 (mail-hist-add-header-contents-to-ring | |
225 (mail-hist-current-header-name))) | |
226 (let ((body-contents | |
21868 | 227 (buffer-substring (mail-text-start) (point-max)))) |
7267 | 228 (mail-hist-add-header-contents-to-ring "body" body-contents))))) |
30519
d732477f0678
(mail-hist-previous-input, mail-hist-next-input): do the obvious code
Karl Fogel <kfogel@red-bean.com>
parents:
24519
diff
changeset
|
229 |
d732477f0678
(mail-hist-previous-input, mail-hist-next-input): do the obvious code
Karl Fogel <kfogel@red-bean.com>
parents:
24519
diff
changeset
|
230 |
7267 | 231 |
30519
d732477f0678
(mail-hist-previous-input, mail-hist-next-input): do the obvious code
Karl Fogel <kfogel@red-bean.com>
parents:
24519
diff
changeset
|
232 (defun mail-hist-retrieve-and-insert (header access-func) |
d732477f0678
(mail-hist-previous-input, mail-hist-next-input): do the obvious code
Karl Fogel <kfogel@red-bean.com>
parents:
24519
diff
changeset
|
233 "Helper for `mail-hist-previous-input' and `mail-hist-next-input'." |
15191 | 234 (setq header (downcase header)) |
235 (let* ((ring (cdr (assoc header mail-hist-header-ring-alist))) | |
236 (len (ring-length ring)) | |
237 (repeat (eq last-command 'mail-hist-input-access))) | |
238 (if repeat | |
239 (setq mail-hist-access-count | |
30519
d732477f0678
(mail-hist-previous-input, mail-hist-next-input): do the obvious code
Karl Fogel <kfogel@red-bean.com>
parents:
24519
diff
changeset
|
240 (funcall access-func mail-hist-access-count len)) |
15191 | 241 (setq mail-hist-access-count 0)) |
242 (if (null ring) | |
243 (progn | |
244 (ding) | |
245 (message "No history for \"%s\"." header)) | |
246 (if (ring-empty-p ring) | |
38436
b174db545cfd
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
35027
diff
changeset
|
247 (error "\"%s\" ring is empty" header) |
15191 | 248 (and repeat |
249 (delete-region (car mail-hist-last-bounds) | |
250 (cdr mail-hist-last-bounds))) | |
251 (let ((start (point))) | |
252 (insert (ring-ref ring mail-hist-access-count)) | |
253 (setq mail-hist-last-bounds (cons start (point))) | |
30519
d732477f0678
(mail-hist-previous-input, mail-hist-next-input): do the obvious code
Karl Fogel <kfogel@red-bean.com>
parents:
24519
diff
changeset
|
254 (setq this-command 'mail-hist-input-access) |
d732477f0678
(mail-hist-previous-input, mail-hist-next-input): do the obvious code
Karl Fogel <kfogel@red-bean.com>
parents:
24519
diff
changeset
|
255 ;; Special case: when flipping through message bodies, it's |
d732477f0678
(mail-hist-previous-input, mail-hist-next-input): do the obvious code
Karl Fogel <kfogel@red-bean.com>
parents:
24519
diff
changeset
|
256 ;; usually most useful for point to stay at the top. This |
d732477f0678
(mail-hist-previous-input, mail-hist-next-input): do the obvious code
Karl Fogel <kfogel@red-bean.com>
parents:
24519
diff
changeset
|
257 ;; is because the unique part of a message in a thread is |
d732477f0678
(mail-hist-previous-input, mail-hist-next-input): do the obvious code
Karl Fogel <kfogel@red-bean.com>
parents:
24519
diff
changeset
|
258 ;; more likely to be at the top than the bottom, as the |
d732477f0678
(mail-hist-previous-input, mail-hist-next-input): do the obvious code
Karl Fogel <kfogel@red-bean.com>
parents:
24519
diff
changeset
|
259 ;; bottom is often just the same quoted history for every |
d732477f0678
(mail-hist-previous-input, mail-hist-next-input): do the obvious code
Karl Fogel <kfogel@red-bean.com>
parents:
24519
diff
changeset
|
260 ;; message in the thread, differing only in indentation |
d732477f0678
(mail-hist-previous-input, mail-hist-next-input): do the obvious code
Karl Fogel <kfogel@red-bean.com>
parents:
24519
diff
changeset
|
261 ;; level. |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
47637
diff
changeset
|
262 (if (string-equal header "body") |
30519
d732477f0678
(mail-hist-previous-input, mail-hist-next-input): do the obvious code
Karl Fogel <kfogel@red-bean.com>
parents:
24519
diff
changeset
|
263 (goto-char start))) |
d732477f0678
(mail-hist-previous-input, mail-hist-next-input): do the obvious code
Karl Fogel <kfogel@red-bean.com>
parents:
24519
diff
changeset
|
264 )))) |
d732477f0678
(mail-hist-previous-input, mail-hist-next-input): do the obvious code
Karl Fogel <kfogel@red-bean.com>
parents:
24519
diff
changeset
|
265 |
d732477f0678
(mail-hist-previous-input, mail-hist-next-input): do the obvious code
Karl Fogel <kfogel@red-bean.com>
parents:
24519
diff
changeset
|
266 |
d732477f0678
(mail-hist-previous-input, mail-hist-next-input): do the obvious code
Karl Fogel <kfogel@red-bean.com>
parents:
24519
diff
changeset
|
267 (defun mail-hist-previous-input (header) |
d732477f0678
(mail-hist-previous-input, mail-hist-next-input): do the obvious code
Karl Fogel <kfogel@red-bean.com>
parents:
24519
diff
changeset
|
268 "Insert the previous contents of this mail header or message body. |
d732477f0678
(mail-hist-previous-input, mail-hist-next-input): do the obvious code
Karl Fogel <kfogel@red-bean.com>
parents:
24519
diff
changeset
|
269 Moves back through the history of sent mail messages. Each header has |
d732477f0678
(mail-hist-previous-input, mail-hist-next-input): do the obvious code
Karl Fogel <kfogel@red-bean.com>
parents:
24519
diff
changeset
|
270 its own independent history, as does the body of the message. |
d732477f0678
(mail-hist-previous-input, mail-hist-next-input): do the obvious code
Karl Fogel <kfogel@red-bean.com>
parents:
24519
diff
changeset
|
271 |
d732477f0678
(mail-hist-previous-input, mail-hist-next-input): do the obvious code
Karl Fogel <kfogel@red-bean.com>
parents:
24519
diff
changeset
|
272 The history only contains the contents of outgoing messages, not |
d732477f0678
(mail-hist-previous-input, mail-hist-next-input): do the obvious code
Karl Fogel <kfogel@red-bean.com>
parents:
24519
diff
changeset
|
273 received mail." |
d732477f0678
(mail-hist-previous-input, mail-hist-next-input): do the obvious code
Karl Fogel <kfogel@red-bean.com>
parents:
24519
diff
changeset
|
274 (interactive (list (or (mail-hist-current-header-name) "body"))) |
d732477f0678
(mail-hist-previous-input, mail-hist-next-input): do the obvious code
Karl Fogel <kfogel@red-bean.com>
parents:
24519
diff
changeset
|
275 (mail-hist-retrieve-and-insert header 'ring-plus1)) |
d732477f0678
(mail-hist-previous-input, mail-hist-next-input): do the obvious code
Karl Fogel <kfogel@red-bean.com>
parents:
24519
diff
changeset
|
276 |
7267 | 277 |
278 (defun mail-hist-next-input (header) | |
279 "Insert next contents of this mail header or message body. | |
280 Moves back through the history of sent mail messages. Each header has | |
281 its own independent history, as does the body of the message. | |
282 | |
283 Although you can do so, it does not make much sense to call this | |
284 without having called `mail-hist-previous-header' first | |
47637
61adc32aad68
(mail-hist-next-input): Fix docstring.
Simon Josefsson <jas@extundo.com>
parents:
38436
diff
changeset
|
285 \(\\[mail-hist-previous-header]). |
7267 | 286 |
287 The history only contains the contents of outgoing messages, not | |
288 received mail." | |
289 (interactive (list (or (mail-hist-current-header-name) "body"))) | |
30519
d732477f0678
(mail-hist-previous-input, mail-hist-next-input): do the obvious code
Karl Fogel <kfogel@red-bean.com>
parents:
24519
diff
changeset
|
290 (mail-hist-retrieve-and-insert header 'ring-minus1)) |
d732477f0678
(mail-hist-previous-input, mail-hist-next-input): do the obvious code
Karl Fogel <kfogel@red-bean.com>
parents:
24519
diff
changeset
|
291 |
7267 | 292 |
293 (provide 'mail-hist) | |
294 | |
93975
1e3a407766b9
Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
79712
diff
changeset
|
295 ;; arch-tag: 9ff9a07c-9dca-482d-ba87-54f42778559d |
38436
b174db545cfd
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
35027
diff
changeset
|
296 ;;; mail-hist.el ends here |