Mercurial > emacs
annotate lisp/mail/mail-hist.el @ 13769:a17778d3f5f3
(syms_of_fileio): Doc fix.
author | Karl Heuer <kwzh@gnu.org> |
---|---|
date | Thu, 21 Dec 1995 17:00:42 +0000 |
parents | 5888dd3f1a72 |
children | 83f275dcd93a |
rev | line source |
---|---|
7267 | 1 ;;; mail-hist.el --- Headers and message body history for outgoing mail. |
2 ;; Copyright (C) 1994 Free Software Foundation, Inc. | |
3 | |
4 ;; Author: Karl Fogel <kfogel@cs.oberlin.edu> | |
5 ;; Created: March, 1994 | |
8277
824fb42f33ab
Make sure that headers are case-insensitive.
Richard M. Stallman <rms@gnu.org>
parents:
7639
diff
changeset
|
6 ;; Keywords: mail, history |
7267 | 7 |
8 ;; This file is part of GNU Emacs. | |
9 | |
10 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
11 ;; it under the terms of the GNU General Public License as published by | |
12 ;; the Free Software Foundation; either version 2, or (at your option) | |
13 ;; any later version. | |
14 | |
15 ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 ;; GNU General Public License for more details. | |
19 | |
20 ;;; Commentary: | |
21 | |
22 ;; You should have received a copy of the GNU General Public License | |
23 ;; along with GNU Emacs; see the file COPYING. If not, write to | |
24 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
25 | |
26 ;; Thanks to Jim Blandy for mentioning ring.el. It saved a lot of | |
27 ;; time. | |
28 ;; | |
29 ;; To use this package, put it in a directory in your load-path, and | |
30 ;; put this in your .emacs file: | |
31 ;; | |
32 ;; (load "mail-hist" nil t) | |
33 ;; | |
34 ;; Or you could do it with autoloads and hooks in your .emacs: | |
35 ;; | |
36 ;; (add-hook 'mail-mode-hook 'mail-hist-define-keys) | |
37 ;; (add-hook 'mail-send-hook 'mail-hist-put-headers-into-history) | |
38 ;; (add-hook 'vm-mail-mode-hook 'mail-hist-define-keys) ;or rmail, etc | |
39 ;; (autoload 'mail-hist-define-keys "mail-hist") | |
40 ;; (autoload 'mail-hist-put-headers-into-history "mail-hist") | |
41 ;; | |
42 ;; Once it's installed, use M-p and M-n from mail headers to recover | |
43 ;; previous/next contents in the history for that header, or, in the | |
44 ;; body of the message, to recover previous/next text of the message. | |
45 ;; This only applies to outgoing mail -- mail-hist ignores received | |
46 ;; messages. | |
47 ;; | |
48 ;; Although repeated history requests do clear out the text from the | |
49 ;; previous request, an isolated request just inserts its text at | |
50 ;; point, so that you can mix the histories of different messages | |
51 ;; easily. This might be confusing at times, but there should be no | |
52 ;; problems that undo can't handle. | |
53 | |
54 ;;; Code: | |
55 (require 'ring) | |
56 | |
57 ;;;###autoload | |
58 (defun mail-hist-define-keys () | |
59 "Define keys for accessing mail header history. For use in hooks." | |
60 (local-set-key "\M-p" 'mail-hist-previous-input) | |
61 (local-set-key "\M-n" 'mail-hist-next-input)) | |
62 | |
63 ;;;###autoload | |
12366
8415d665d19f
Don't autoload anything to turn on mail-hist.
Richard M. Stallman <rms@gnu.org>
parents:
11377
diff
changeset
|
64 (defun mail-hist-enable () |
8415d665d19f
Don't autoload anything to turn on mail-hist.
Richard M. Stallman <rms@gnu.org>
parents:
11377
diff
changeset
|
65 (add-hook 'mail-mode-hook 'mail-hist-define-keys) |
8415d665d19f
Don't autoload anything to turn on mail-hist.
Richard M. Stallman <rms@gnu.org>
parents:
11377
diff
changeset
|
66 (add-hook 'mail-send-hook 'mail-hist-put-headers-into-history)) |
7267 | 67 |
68 (defvar mail-hist-header-ring-alist nil | |
69 "Alist of form (header-name . history-ring). | |
70 Used for knowing which history list to look in when the user asks for | |
71 previous/next input.") | |
72 | |
73 (defvar mail-hist-history-size (or kill-ring-max 1729) | |
74 "*The maximum number of elements in a mail field's history. | |
75 Oldest elements are dumped first.") | |
76 | |
77 ;;;###autoload | |
78 (defvar mail-hist-keep-history t | |
79 "*Non-nil means keep a history for headers and text of outgoing mail.") | |
80 | |
81 ;; For handling repeated history requests | |
82 (defvar mail-hist-access-count 0) | |
83 | |
84 (defvar mail-hist-last-bounds nil) | |
85 ;; (start . end) A pair indicating the buffer positions delimiting the | |
86 ;; last inserted history, so it can be replaced by a new input if the | |
87 ;; command is repeated. | |
88 | |
89 (defvar mail-hist-header-regexp "^[^:]*:" | |
90 "Regular expression for matching headers in a mail message.") | |
91 | |
92 (defsubst mail-hist-current-header-name () | |
93 "Get name of mail header point is currently in, without the colon. | |
94 Returns nil if not in a header, implying that point is in the body of | |
95 the message." | |
96 (if (save-excursion | |
11249
19442fbb6972
Use $ at end when searching for mail-header-separator.
Richard M. Stallman <rms@gnu.org>
parents:
9425
diff
changeset
|
97 (re-search-backward (concat "^" (regexp-quote mail-header-separator) |
19442fbb6972
Use $ at end when searching for mail-header-separator.
Richard M. Stallman <rms@gnu.org>
parents:
9425
diff
changeset
|
98 "$") |
9425
7d0509b6f039
(mail-hist-put-headers-into-history)
Richard M. Stallman <rms@gnu.org>
parents:
8277
diff
changeset
|
99 nil t)) |
7267 | 100 nil ; then we are in the body of the message |
101 (save-excursion | |
102 (let* ((body-start ; limit possibility of false headers | |
103 (save-excursion | |
9425
7d0509b6f039
(mail-hist-put-headers-into-history)
Richard M. Stallman <rms@gnu.org>
parents:
8277
diff
changeset
|
104 (re-search-forward |
11249
19442fbb6972
Use $ at end when searching for mail-header-separator.
Richard M. Stallman <rms@gnu.org>
parents:
9425
diff
changeset
|
105 (concat "^" (regexp-quote mail-header-separator) "$") |
9425
7d0509b6f039
(mail-hist-put-headers-into-history)
Richard M. Stallman <rms@gnu.org>
parents:
8277
diff
changeset
|
106 nil t))) |
7267 | 107 (name-start |
108 (re-search-backward mail-hist-header-regexp nil t)) | |
109 (name-end | |
110 (prog2 (search-forward ":" body-start t) (1- (point))))) | |
111 (and | |
112 name-start | |
113 name-end | |
8277
824fb42f33ab
Make sure that headers are case-insensitive.
Richard M. Stallman <rms@gnu.org>
parents:
7639
diff
changeset
|
114 (downcase (buffer-substring name-start name-end))))))) |
7267 | 115 |
116 (defsubst mail-hist-forward-header (count) | |
117 "Move forward COUNT headers (backward if COUNT is negative). | |
118 If last/first header is encountered first, stop there and returns | |
119 nil. | |
120 | |
121 Places point on the first non-whitespace on the line following the | |
122 colon after the header name, or on the second space following that if | |
123 the header is empty." | |
124 (let ((boundary (save-excursion | |
9425
7d0509b6f039
(mail-hist-put-headers-into-history)
Richard M. Stallman <rms@gnu.org>
parents:
8277
diff
changeset
|
125 (re-search-forward |
11249
19442fbb6972
Use $ at end when searching for mail-header-separator.
Richard M. Stallman <rms@gnu.org>
parents:
9425
diff
changeset
|
126 (concat "^" (regexp-quote mail-header-separator) "$") |
9425
7d0509b6f039
(mail-hist-put-headers-into-history)
Richard M. Stallman <rms@gnu.org>
parents:
8277
diff
changeset
|
127 nil t)))) |
7267 | 128 (and |
129 boundary | |
130 (let ((unstopped t)) | |
131 (setq boundary (save-excursion | |
132 (goto-char boundary) | |
133 (beginning-of-line) | |
134 (1- (point)))) | |
135 (if (> count 0) | |
136 (while (> count 0) | |
137 (setq | |
138 unstopped | |
139 (re-search-forward mail-hist-header-regexp boundary t)) | |
140 (setq count (1- count))) | |
141 ;; because the current header will match too. | |
142 (setq count (1- count)) | |
143 ;; count is negative | |
144 (while (< count 0) | |
145 (setq | |
146 unstopped | |
147 (re-search-backward mail-hist-header-regexp nil t)) | |
148 (setq count (1+ count))) | |
149 ;; we end up behind the header, so must move to the front | |
150 (re-search-forward mail-hist-header-regexp boundary t)) | |
151 ;; Now we are right after the colon | |
152 (and (looking-at "\\s-") (forward-char 1)) | |
153 ;; return nil if didn't go as far as asked, otherwise point | |
154 unstopped)))) | |
155 | |
156 (defsubst mail-hist-beginning-of-header () | |
157 "Move to the start of the current header. | |
158 The start of the current header is defined as one space after the | |
159 colon, or just after the colon if it is not followed by whitespace." | |
160 ;; this is slick as all heck: | |
161 (if (mail-hist-forward-header -1) | |
162 (mail-hist-forward-header 1) | |
163 (mail-hist-forward-header 1) | |
164 (mail-hist-forward-header -1))) | |
165 | |
166 (defsubst mail-hist-current-header-contents () | |
167 "Get the contents of the mail header in which point is located." | |
168 (save-excursion | |
169 (mail-hist-beginning-of-header) | |
170 (let ((start (point))) | |
171 (or (mail-hist-forward-header 1) | |
9425
7d0509b6f039
(mail-hist-put-headers-into-history)
Richard M. Stallman <rms@gnu.org>
parents:
8277
diff
changeset
|
172 (re-search-forward |
11249
19442fbb6972
Use $ at end when searching for mail-header-separator.
Richard M. Stallman <rms@gnu.org>
parents:
9425
diff
changeset
|
173 (concat "^" (regexp-quote mail-header-separator) "$"))) |
7267 | 174 (beginning-of-line) |
175 (buffer-substring start (1- (point)))))) | |
176 | |
177 (defsubst mail-hist-get-header-ring (header) | |
178 "Get HEADER's history ring, or nil if none. | |
179 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
|
180 (setq header (downcase header)) |
7267 | 181 (cdr (assoc header mail-hist-header-ring-alist))) |
182 | |
12374
5888dd3f1a72
(mail-hist-text-size-limit): New var.
Richard M. Stallman <rms@gnu.org>
parents:
12366
diff
changeset
|
183 (defvar mail-hist-text-size-limit nil |
5888dd3f1a72
(mail-hist-text-size-limit): New var.
Richard M. Stallman <rms@gnu.org>
parents:
12366
diff
changeset
|
184 "*Don't store any header or body with more than this many characters. |
5888dd3f1a72
(mail-hist-text-size-limit): New var.
Richard M. Stallman <rms@gnu.org>
parents:
12366
diff
changeset
|
185 If the value is nil, that means no limit on text size.") |
5888dd3f1a72
(mail-hist-text-size-limit): New var.
Richard M. Stallman <rms@gnu.org>
parents:
12366
diff
changeset
|
186 |
5888dd3f1a72
(mail-hist-text-size-limit): New var.
Richard M. Stallman <rms@gnu.org>
parents:
12366
diff
changeset
|
187 (defun mail-hist-text-too-long-p (text) |
5888dd3f1a72
(mail-hist-text-size-limit): New var.
Richard M. Stallman <rms@gnu.org>
parents:
12366
diff
changeset
|
188 "Return t if TEXT does not exceed mail-hist's size limit. |
5888dd3f1a72
(mail-hist-text-size-limit): New var.
Richard M. Stallman <rms@gnu.org>
parents:
12366
diff
changeset
|
189 The variable `mail-hist-text-size-limit' defines this limit." |
5888dd3f1a72
(mail-hist-text-size-limit): New var.
Richard M. Stallman <rms@gnu.org>
parents:
12366
diff
changeset
|
190 (if mail-hist-text-size-limit |
5888dd3f1a72
(mail-hist-text-size-limit): New var.
Richard M. Stallman <rms@gnu.org>
parents:
12366
diff
changeset
|
191 (> (length text) mail-hist-text-size-limit))) |
5888dd3f1a72
(mail-hist-text-size-limit): New var.
Richard M. Stallman <rms@gnu.org>
parents:
12366
diff
changeset
|
192 |
7267 | 193 (defsubst mail-hist-add-header-contents-to-ring (header &optional contents) |
194 "Add the contents of HEADER to the header history ring. | |
195 Optional argument CONTENTS is a string which will be the contents | |
12374
5888dd3f1a72
(mail-hist-text-size-limit): New var.
Richard M. Stallman <rms@gnu.org>
parents:
12366
diff
changeset
|
196 \(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
|
197 (setq header (downcase header)) |
12374
5888dd3f1a72
(mail-hist-text-size-limit): New var.
Richard M. Stallman <rms@gnu.org>
parents:
12366
diff
changeset
|
198 (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
|
199 (ring (cdr (assoc header mail-hist-header-ring-alist)))) |
5888dd3f1a72
(mail-hist-text-size-limit): New var.
Richard M. Stallman <rms@gnu.org>
parents:
12366
diff
changeset
|
200 (if (mail-hist-text-too-long-p ctnts) (setq ctnts "")) |
7267 | 201 (or ring |
202 ;; If the ring doesn't exist, we'll have to make it and add it | |
203 ;; to the mail-header-ring-alist: | |
204 (prog1 | |
205 (setq ring (make-ring mail-hist-history-size)) | |
206 (setq mail-hist-header-ring-alist | |
207 (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
|
208 (ring-insert ring ctnts))) |
7267 | 209 |
210 ;;;###autoload | |
211 (defun mail-hist-put-headers-into-history () | |
212 "Put headers and contents of this message into mail header history. | |
213 Each header has its own independent history, as does the body of the | |
214 message. | |
215 | |
216 This function normally would be called when the message is sent." | |
217 (and | |
218 mail-hist-keep-history | |
11377
2de0b88cc028
(mail-hist-put-headers-into-history):
Richard M. Stallman <rms@gnu.org>
parents:
11249
diff
changeset
|
219 (save-excursion |
7267 | 220 (goto-char (point-min)) |
221 (while (mail-hist-forward-header 1) | |
222 (mail-hist-add-header-contents-to-ring | |
223 (mail-hist-current-header-name))) | |
224 (let ((body-contents | |
225 (save-excursion | |
11377
2de0b88cc028
(mail-hist-put-headers-into-history):
Richard M. Stallman <rms@gnu.org>
parents:
11249
diff
changeset
|
226 (goto-char (point-min)) |
2de0b88cc028
(mail-hist-put-headers-into-history):
Richard M. Stallman <rms@gnu.org>
parents:
11249
diff
changeset
|
227 (re-search-forward |
2de0b88cc028
(mail-hist-put-headers-into-history):
Richard M. Stallman <rms@gnu.org>
parents:
11249
diff
changeset
|
228 (concat "^" (regexp-quote mail-header-separator) "$") |
2de0b88cc028
(mail-hist-put-headers-into-history):
Richard M. Stallman <rms@gnu.org>
parents:
11249
diff
changeset
|
229 nil) |
2de0b88cc028
(mail-hist-put-headers-into-history):
Richard M. Stallman <rms@gnu.org>
parents:
11249
diff
changeset
|
230 (forward-line 1) |
2de0b88cc028
(mail-hist-put-headers-into-history):
Richard M. Stallman <rms@gnu.org>
parents:
11249
diff
changeset
|
231 (buffer-substring (point) (point-max))))) |
7267 | 232 (mail-hist-add-header-contents-to-ring "body" body-contents))))) |
233 | |
234 (defun mail-hist-previous-input (header) | |
235 "Insert the previous contents of this mail header or message body. | |
236 Moves back through the history of sent mail messages. Each header has | |
237 its own independent history, as does the body of the message. | |
238 | |
239 The history only contains the contents of outgoing messages, not | |
240 received mail." | |
241 (interactive (list (or (mail-hist-current-header-name) "body"))) | |
8277
824fb42f33ab
Make sure that headers are case-insensitive.
Richard M. Stallman <rms@gnu.org>
parents:
7639
diff
changeset
|
242 (setq header (downcase header)) |
7267 | 243 (let* ((ring (cdr (assoc header mail-hist-header-ring-alist))) |
244 (len (ring-length ring)) | |
245 (repeat (eq last-command 'mail-hist-input-access))) | |
246 (if repeat | |
247 (setq mail-hist-access-count | |
248 (ring-plus1 mail-hist-access-count len)) | |
249 (setq mail-hist-access-count 0)) | |
250 (if (null ring) | |
251 (progn | |
252 (ding) | |
253 (message "No history for \"%s\"." header)) | |
254 (if (ring-empty-p ring) | |
255 (error "\"%s\" ring is empty." header) | |
256 (and repeat | |
257 (delete-region (car mail-hist-last-bounds) | |
258 (cdr mail-hist-last-bounds))) | |
259 (let ((start (point))) | |
260 (insert (ring-ref ring mail-hist-access-count)) | |
261 (setq mail-hist-last-bounds (cons start (point))) | |
262 (setq this-command 'mail-hist-input-access)))))) | |
263 | |
264 (defun mail-hist-next-input (header) | |
265 "Insert next contents of this mail header or message body. | |
266 Moves back through the history of sent mail messages. Each header has | |
267 its own independent history, as does the body of the message. | |
268 | |
269 Although you can do so, it does not make much sense to call this | |
270 without having called `mail-hist-previous-header' first | |
8277
824fb42f33ab
Make sure that headers are case-insensitive.
Richard M. Stallman <rms@gnu.org>
parents:
7639
diff
changeset
|
271 (\\[mail-hist-previous-header]). |
7267 | 272 |
273 The history only contains the contents of outgoing messages, not | |
274 received mail." | |
275 (interactive (list (or (mail-hist-current-header-name) "body"))) | |
8277
824fb42f33ab
Make sure that headers are case-insensitive.
Richard M. Stallman <rms@gnu.org>
parents:
7639
diff
changeset
|
276 (setq header (downcase header)) |
7267 | 277 (let* ((ring (cdr (assoc header mail-hist-header-ring-alist))) |
278 (len (ring-length ring)) | |
279 (repeat (eq last-command 'mail-hist-input-access))) | |
280 (if repeat | |
281 (setq mail-hist-access-count | |
282 (ring-minus1 mail-hist-access-count len)) | |
283 (setq mail-hist-access-count 0)) | |
284 (if (null ring) | |
285 (progn | |
286 (ding) | |
287 (message "No history for \"%s\"." header)) | |
288 (if (ring-empty-p ring) | |
289 (error "\"%s\" ring is empty." header) | |
290 (and repeat | |
291 (delete-region (car mail-hist-last-bounds) | |
292 (cdr mail-hist-last-bounds))) | |
293 (let ((start (point))) | |
294 (insert (ring-ref ring mail-hist-access-count)) | |
295 (setq mail-hist-last-bounds (cons start (point))) | |
296 (setq this-command 'mail-hist-input-access)))))) | |
297 | |
298 (provide 'mail-hist) | |
299 | |
300 ;; mail-hist.el ends here |