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