Commit | Line | Data |
---|---|---|
e8af40ee | 1 | ;;; mail-hist.el --- headers and message body history for outgoing mail |
25e2c3c7 | 2 | |
f2e3589a | 3 | ;; Copyright (C) 1994, 2001, 2002, 2003, 2004, 2005, |
49f70d46 | 4 | ;; 2006, 2007, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc. |
813f532d | 5 | |
aeb4c63e | 6 | ;; Author: Karl Fogel <kfogel@red-bean.com> |
813f532d | 7 | ;; Created: March, 1994 |
9081378e | 8 | ;; Keywords: mail, history |
813f532d RS |
9 | |
10 | ;; This file is part of GNU Emacs. | |
11 | ||
b1fc2b50 | 12 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
813f532d | 13 | ;; it under the terms of the GNU General Public License as published by |
b1fc2b50 GM |
14 | ;; the Free Software Foundation, either version 3 of the License, or |
15 | ;; (at your option) any later version. | |
813f532d RS |
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 | ||
25e2c3c7 | 22 | ;; You should have received a copy of the GNU General Public License |
b1fc2b50 | 23 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
25e2c3c7 | 24 | |
813f532d RS |
25 | ;;; Commentary: |
26 | ||
813f532d RS |
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 | \f | |
55 | ;;; Code: | |
56 | (require 'ring) | |
43c2d6cf | 57 | (require 'sendmail) |
813f532d | 58 | |
0b5bb3ec SE |
59 | (defgroup mail-hist nil |
60 | "Headers and message body history for outgoing mail." | |
61 | :prefix "mail-hist-" | |
62 | :group 'mail) | |
63 | ||
813f532d RS |
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 | |
25e2c3c7 RS |
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)) | |
813f532d RS |
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 | ||
0b5bb3ec | 80 | (defcustom mail-hist-history-size (or kill-ring-max 1729) |
813f532d | 81 | "*The maximum number of elements in a mail field's history. |
0b5bb3ec SE |
82 | Oldest elements are dumped first." |
83 | :type 'integer | |
84 | :group 'mail-hist) | |
813f532d RS |
85 | |
86 | ;;;###autoload | |
0b5bb3ec SE |
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) | |
813f532d RS |
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 | \f | |
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." | |
91245cb0 | 107 | (if (>= (point) (mail-text-start)) |
813f532d RS |
108 | nil ; then we are in the body of the message |
109 | (save-excursion | |
43c2d6cf RS |
110 | (let* ((body-start |
111 | (mail-text-start)) | |
813f532d RS |
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 | |
384bc96c | 119 | (downcase (buffer-substring-no-properties name-start name-end))))))) |
813f532d RS |
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 | |
a1506d29 | 124 | nil. |
25e2c3c7 RS |
125 | |
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." | |
43c2d6cf | 129 | (let ((boundary (mail-header-end))) |
25e2c3c7 | 130 | (and |
43c2d6cf | 131 | (> boundary 0) |
25e2c3c7 RS |
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)))) | |
813f532d RS |
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) | |
3ec353b1 | 174 | (goto-char (mail-header-end))) |
813f532d RS |
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." | |
9081378e | 181 | (setq header (downcase header)) |
813f532d RS |
182 | (cdr (assoc header mail-hist-header-ring-alist))) |
183 | ||
0b5bb3ec | 184 | (defcustom mail-hist-text-size-limit nil |
25e2c3c7 | 185 | "*Don't store any header or body with more than this many characters. |
0b5bb3ec SE |
186 | If the value is nil, that means no limit on text size." |
187 | :type '(choice (const nil) integer) | |
188 | :group 'mail-hist) | |
5f98a1d8 | 189 | |
25e2c3c7 | 190 | (defun mail-hist-text-too-long-p (text) |
43c4b570 | 191 | "Return non-nil if TEXT's length exceeds `mail-hist-text-size-limit'." |
25e2c3c7 RS |
192 | (if mail-hist-text-size-limit |
193 | (> (length text) mail-hist-text-size-limit))) | |
5f98a1d8 | 194 | |
813f532d | 195 | (defsubst mail-hist-add-header-contents-to-ring (header &optional contents) |
25e2c3c7 | 196 | "Add the contents of HEADER to the header history ring. |
813f532d | 197 | Optional argument CONTENTS is a string which will be the contents |
25e2c3c7 | 198 | \(instead of whatever's found in the header)." |
9081378e | 199 | (setq header (downcase header)) |
5f98a1d8 RS |
200 | (let ((ctnts (or contents (mail-hist-current-header-contents))) |
201 | (ring (cdr (assoc header mail-hist-header-ring-alist)))) | |
25e2c3c7 | 202 | (if (mail-hist-text-too-long-p ctnts) (setq ctnts "")) |
813f532d RS |
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)))) | |
5f98a1d8 | 210 | (ring-insert ring ctnts))) |
813f532d RS |
211 | |
212 | ;;;###autoload | |
213 | (defun mail-hist-put-headers-into-history () | |
a1506d29 | 214 | "Put headers and contents of this message into mail header history. |
813f532d RS |
215 | Each header has its own independent history, as does the body of the |
216 | message. | |
217 | ||
a1506d29 | 218 | This function normally would be called when the message is sent." |
813f532d RS |
219 | (and |
220 | mail-hist-keep-history | |
019434e1 | 221 | (save-excursion |
813f532d RS |
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 | |
43c2d6cf | 227 | (buffer-substring (mail-text-start) (point-max)))) |
813f532d | 228 | (mail-hist-add-header-contents-to-ring "body" body-contents))))) |
25e2c3c7 | 229 | |
aeb4c63e KF |
230 | |
231 | \f | |
232 | (defun mail-hist-retrieve-and-insert (header access-func) | |
233 | "Helper for `mail-hist-previous-input' and `mail-hist-next-input'." | |
9081378e | 234 | (setq header (downcase header)) |
813f532d RS |
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 | |
aeb4c63e | 240 | (funcall access-func mail-hist-access-count len)) |
813f532d RS |
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) | |
e8af40ee | 247 | (error "\"%s\" ring is empty" header) |
25e2c3c7 | 248 | (and repeat |
813f532d | 249 | (delete-region (car mail-hist-last-bounds) |
25e2c3c7 | 250 | (cdr mail-hist-last-bounds))) |
813f532d RS |
251 | (let ((start (point))) |
252 | (insert (ring-ref ring mail-hist-access-count)) | |
253 | (setq mail-hist-last-bounds (cons start (point))) | |
aeb4c63e KF |
254 | (setq this-command 'mail-hist-input-access) |
255 | ;; Special case: when flipping through message bodies, it's | |
256 | ;; usually most useful for point to stay at the top. This | |
257 | ;; is because the unique part of a message in a thread is | |
258 | ;; more likely to be at the top than the bottom, as the | |
259 | ;; bottom is often just the same quoted history for every | |
260 | ;; message in the thread, differing only in indentation | |
261 | ;; level. | |
a1506d29 | 262 | (if (string-equal header "body") |
aeb4c63e KF |
263 | (goto-char start))) |
264 | )))) | |
265 | ||
266 | ||
267 | (defun mail-hist-previous-input (header) | |
268 | "Insert the previous contents of this mail header or message body. | |
269 | Moves back through the history of sent mail messages. Each header has | |
270 | its own independent history, as does the body of the message. | |
271 | ||
272 | The history only contains the contents of outgoing messages, not | |
273 | received mail." | |
274 | (interactive (list (or (mail-hist-current-header-name) "body"))) | |
275 | (mail-hist-retrieve-and-insert header 'ring-plus1)) | |
276 | ||
813f532d RS |
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 | |
05f829ce | 285 | \(\\[mail-hist-previous-header]). |
813f532d RS |
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"))) | |
aeb4c63e KF |
290 | (mail-hist-retrieve-and-insert header 'ring-minus1)) |
291 | ||
813f532d RS |
292 | \f |
293 | (provide 'mail-hist) | |
294 | ||
cbee283d | 295 | ;; arch-tag: 9ff9a07c-9dca-482d-ba87-54f42778559d |
e8af40ee | 296 | ;;; mail-hist.el ends here |