|
101360
|
1 ;;; rmailedit.el --- "RMAIL edit mode" Edit the current message
|
|
|
2
|
|
101917
|
3 ;; Copyright (C) 1985, 1994, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
|
|
106815
|
4 ;; 2008, 2009, 2010 Free Software Foundation, Inc.
|
|
101360
|
5
|
|
|
6 ;; Maintainer: FSF
|
|
|
7 ;; Keywords: mail
|
|
|
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 3 of the License, or
|
|
|
14 ;; (at your option) 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
|
|
|
21 ;; You should have received a copy of the GNU General Public License
|
|
|
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
|
|
23
|
|
|
24 ;;; Commentary:
|
|
|
25
|
|
|
26 ;;; Code:
|
|
|
27
|
|
101917
|
28 (require 'rmail)
|
|
101360
|
29
|
|
|
30 (defcustom rmail-edit-mode-hook nil
|
|
|
31 "List of functions to call when editing an RMAIL message."
|
|
|
32 :type 'hook
|
|
|
33 :version "21.1"
|
|
|
34 :group 'rmail-edit)
|
|
|
35
|
|
|
36
|
|
101724
|
37 (defvar rmail-edit-map
|
|
|
38 (let ((map (make-sparse-keymap)))
|
|
|
39 ;; Make a keymap that inherits text-mode-map.
|
|
|
40 (set-keymap-parent map text-mode-map)
|
|
|
41 (define-key map "\C-c\C-c" 'rmail-cease-edit)
|
|
|
42 (define-key map "\C-c\C-]" 'rmail-abort-edit)
|
|
|
43 map))
|
|
|
44
|
|
101633
|
45 (declare-function rmail-summary-disable "rmailsum" ())
|
|
101360
|
46
|
|
|
47 (defun rmail-edit-mode ()
|
|
102388
|
48 "Major mode for editing the contents of an Rmail message.
|
|
|
49 The editing commands are the same as in Text mode, together with
|
|
|
50 two commands to return to regular Rmail:
|
|
|
51 * \\[rmail-abort-edit] cancels any changes and returns to Rmail
|
|
101360
|
52 * \\[rmail-cease-edit] makes them permanent.
|
|
102388
|
53 This function runs the hooks `text-mode-hook' and `rmail-edit-mode-hook'.
|
|
101360
|
54 \\{rmail-edit-map}"
|
|
|
55 (if (rmail-summary-exists)
|
|
101724
|
56 (with-current-buffer rmail-summary-buffer
|
|
101360
|
57 (rmail-summary-disable)))
|
|
102388
|
58 ;; Prevent change-major-mode-hook from unswapping the buffers.
|
|
|
59 (let ((rmail-buffer-swapped nil))
|
|
101360
|
60 (delay-mode-hooks (text-mode))
|
|
|
61 (use-local-map rmail-edit-map)
|
|
|
62 (setq major-mode 'rmail-edit-mode)
|
|
|
63 (setq mode-name "RMAIL Edit")
|
|
|
64 (if (boundp 'mode-line-modified)
|
|
|
65 (setq mode-line-modified (default-value 'mode-line-modified))
|
|
|
66 (setq mode-line-format (default-value 'mode-line-format)))
|
104016
e59e70025fe8
* mail/rmailedit.el (rmail-edit-mode): Use auto-save-include-big-deletions.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
67 ;; Don't turn off auto-saving based on the size of the buffer
|
e59e70025fe8
* mail/rmailedit.el (rmail-edit-mode): Use auto-save-include-big-deletions.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
68 ;; because that code does not understand buffer-swapping.
|
e59e70025fe8
* mail/rmailedit.el (rmail-edit-mode): Use auto-save-include-big-deletions.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
69 (make-local-variable 'auto-save-include-big-deletions)
|
e59e70025fe8
* mail/rmailedit.el (rmail-edit-mode): Use auto-save-include-big-deletions.
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
70 (setq auto-save-include-big-deletions t)
|
|
102478
|
71 ;; If someone uses C-x C-s, don't clobber the rmail file (bug#2625).
|
|
|
72 (add-hook 'write-region-annotate-functions
|
|
|
73 'rmail-write-region-annotate nil t)
|
|
101360
|
74 (run-mode-hooks 'rmail-edit-mode-hook)))
|
|
|
75
|
|
101917
|
76 ;; Rmail Edit mode is suitable only for specially formatted data.
|
|
|
77 (put 'rmail-edit-mode 'mode-class 'special)
|
|
102388
|
78
|
|
101917
|
79
|
|
|
80 (defvar rmail-old-text)
|
|
|
81 (defvar rmail-old-pruned nil
|
|
|
82 "Non-nil means the message being edited originally had pruned headers.")
|
|
101360
|
83 (put 'rmail-old-pruned 'permanent-local t)
|
|
|
84
|
|
102023
|
85 (defvar rmail-old-headers nil
|
|
|
86 "Holds the headers of this message before editing started.")
|
|
|
87 (put 'rmail-old-headers 'permanent-local t)
|
|
|
88
|
|
101360
|
89 ;;;###autoload
|
|
|
90 (defun rmail-edit-current-message ()
|
|
|
91 "Edit the contents of this message."
|
|
|
92 (interactive)
|
|
101917
|
93 (if (zerop rmail-total-messages)
|
|
101360
|
94 (error "No messages in this buffer"))
|
|
103239
|
95 (rmail-modify-format)
|
|
102023
|
96 (make-local-variable 'rmail-old-pruned)
|
|
|
97 (setq rmail-old-pruned (rmail-msg-is-pruned))
|
|
101360
|
98 (rmail-edit-mode)
|
|
102023
|
99 (make-local-variable 'rmail-old-text)
|
|
|
100 (setq rmail-old-text
|
|
|
101 (save-restriction
|
|
|
102 (widen)
|
|
|
103 (buffer-substring (point-min) (point-max))))
|
|
|
104 (make-local-variable 'rmail-old-headers)
|
|
|
105 (setq rmail-old-headers (rmail-edit-headers-alist t))
|
|
101360
|
106 (setq buffer-read-only nil)
|
|
|
107 (setq buffer-undo-list nil)
|
|
102479
|
108 ;; Whether the buffer is initially marked as modified or not
|
|
101917
|
109 ;; depends on whether or not the underlying rmail buffer was so marked.
|
|
102479
|
110 ;; Given the way this works, it has to.
|
|
|
111 ;; If you kill the edit buffer, you've killed your rmail buffer.
|
|
101360
|
112 (force-mode-line-update)
|
|
|
113 (if (and (eq (key-binding "\C-c\C-c") 'rmail-cease-edit)
|
|
|
114 (eq (key-binding "\C-c\C-]") 'rmail-abort-edit))
|
|
|
115 (message "Editing: Type C-c C-c to return to Rmail, C-c C-] to abort")
|
|
|
116 (message "%s" (substitute-command-keys
|
|
|
117 "Editing: Type \\[rmail-cease-edit] to return to Rmail, \\[rmail-abort-edit] to abort"))))
|
|
|
118
|
|
101917
|
119
|
|
|
120 (declare-function rmail-summary-enable "rmailsum" ())
|
|
|
121
|
|
101360
|
122 (defun rmail-cease-edit ()
|
|
|
123 "Finish editing message; switch back to Rmail proper."
|
|
|
124 (interactive)
|
|
|
125 (if (rmail-summary-exists)
|
|
101724
|
126 (with-current-buffer rmail-summary-buffer
|
|
101360
|
127 (rmail-summary-enable)))
|
|
|
128 (widen)
|
|
105602
|
129 (goto-char (point-min))
|
|
|
130 ;; This is far from ideal. The edit may have inadvertently
|
|
|
131 ;; removed the blank line at the end of the headers, but there
|
|
|
132 ;; are almost certainly other blank lines.
|
|
|
133 (or (search-forward "\n\n" nil t)
|
|
|
134 (error "There must be a blank line at the end of the headers"))
|
|
101360
|
135 ;; Disguise any "From " lines so they don't start a new message.
|
|
105602
|
136 (goto-char (point-min))
|
|
|
137 (or rmail-old-pruned (forward-line 1))
|
|
|
138 (while (re-search-forward "^>*From " nil t)
|
|
|
139 (beginning-of-line)
|
|
|
140 (insert ">")
|
|
|
141 (forward-line))
|
|
102407
|
142 ;; Make sure buffer ends with a blank line so as not to run this
|
|
|
143 ;; message together with the following one.
|
|
105602
|
144 (goto-char (point-max))
|
|
|
145 (rmail-ensure-blank-line)
|
|
101360
|
146 (let ((old rmail-old-text)
|
|
101917
|
147 (pruned rmail-old-pruned)
|
102165
f93f5035af02
(rmail-cease-edit): Notice changes in buffer's encoding during editing.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
148 ;; People who know what they are doing might have modified the
|
f93f5035af02
(rmail-cease-edit): Notice changes in buffer's encoding during editing.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
149 ;; buffer's encoding if editing the message included inserting
|
f93f5035af02
(rmail-cease-edit): Notice changes in buffer's encoding during editing.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
150 ;; characters that were unencodable by the original message's
|
f93f5035af02
(rmail-cease-edit): Notice changes in buffer's encoding during editing.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
151 ;; encoding. Make note of the new encoding and use it for
|
f93f5035af02
(rmail-cease-edit): Notice changes in buffer's encoding during editing.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
152 ;; encoding the edited message.
|
f93f5035af02
(rmail-cease-edit): Notice changes in buffer's encoding during editing.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
153 (edited-coding buffer-file-coding-system)
|
|
102023
|
154 new-headers
|
|
101360
|
155 character-coding is-text-message coding-system
|
|
101871
|
156 headers-end limit)
|
102165
f93f5035af02
(rmail-cease-edit): Notice changes in buffer's encoding during editing.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
157 ;; Make sure `edited-coding' can safely encode the edited message.
|
f93f5035af02
(rmail-cease-edit): Notice changes in buffer's encoding during editing.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
158 (setq edited-coding
|
f93f5035af02
(rmail-cease-edit): Notice changes in buffer's encoding during editing.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
159 (select-safe-coding-system (point-min) (point-max) edited-coding))
|
|
101360
|
160 ;; Go back to Rmail mode, but carefully.
|
|
|
161 (force-mode-line-update)
|
|
101724
|
162 (let ((rmail-buffer-swapped nil)) ; Prevent change-major-mode-hook
|
|
|
163 ; from unswapping the buffers.
|
|
101360
|
164 (kill-all-local-variables)
|
|
|
165 (rmail-mode-1)
|
|
|
166 (if (boundp 'tool-bar-map)
|
|
|
167 (set (make-local-variable 'tool-bar-map) rmail-tool-bar-map))
|
|
|
168 (setq buffer-undo-list t)
|
|
|
169 (rmail-variables))
|
|
|
170 ;; If text has really changed, mark message as edited.
|
|
|
171 (unless (and (= (length old) (- (point-max) (point-min)))
|
|
|
172 (string= old (buffer-substring (point-min) (point-max))))
|
|
|
173 (setq old nil)
|
|
|
174 (goto-char (point-min))
|
|
105477
|
175 (search-forward "\n\n")
|
|
|
176 (setq headers-end (point-marker))
|
102165
f93f5035af02
(rmail-cease-edit): Notice changes in buffer's encoding during editing.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
177 (goto-char (point-min))
|
|
105477
|
178 (save-restriction
|
|
|
179 (narrow-to-region (point) headers-end)
|
|
|
180 ;; If they changed the message's encoding, rewrite the charset=
|
|
|
181 ;; header for them, so that subsequent rmail-show-message
|
|
|
182 ;; decodes it correctly.
|
|
|
183 (let* ((buffer-read-only nil)
|
|
|
184 (new-coding (coding-system-base edited-coding))
|
|
|
185 (mime-charset (symbol-name
|
|
|
186 (or (coding-system-get new-coding :mime-charset)
|
|
|
187 (if (coding-system-equal new-coding
|
|
|
188 'undecided)
|
|
|
189 'us-ascii
|
|
|
190 new-coding))))
|
|
|
191 old-coding mime-beg mime-end content-type)
|
|
|
192 (if (re-search-forward rmail-mime-charset-pattern nil 'move)
|
|
|
193 (setq mime-beg (match-beginning 1)
|
|
|
194 mime-end (match-end 1)
|
|
|
195 old-coding (coding-system-from-name (match-string 1)))
|
|
|
196 (setq content-type (mail-fetch-field "Content-Type")))
|
|
|
197 (cond
|
|
|
198 ;; No match for rmail-mime-charset-pattern, but there was some
|
|
|
199 ;; other Content-Type. We should not insert another. (Bug#4624)
|
|
|
200 (content-type)
|
|
|
201 ((null old-coding)
|
|
|
202 ;; If there was no charset= spec, insert one.
|
|
|
203 (backward-char 1)
|
|
|
204 (insert "Content-type: text/plain; charset=" mime-charset "\n"))
|
|
|
205 ((not (coding-system-equal (coding-system-base old-coding)
|
|
|
206 new-coding))
|
|
|
207 (goto-char mime-end)
|
|
|
208 (delete-region mime-beg mime-end)
|
|
|
209 (insert mime-charset)))))
|
|
102023
|
210 (setq new-headers (rmail-edit-headers-alist t))
|
|
101360
|
211 (rmail-swap-buffers-maybe)
|
101867
07f6502ced98
(rmail-cease-edit): narrow-to-region before extracting mail message headers.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
212 (narrow-to-region (rmail-msgbeg rmail-current-message)
|
|
101871
|
213 (rmail-msgend rmail-current-message))
|
|
105602
|
214 (goto-char (point-min))
|
|
|
215 (setq limit (search-forward "\n\n"))
|
|
101871
|
216 (save-restriction
|
|
|
217 ;; All 3 of the functions we call below assume the buffer was
|
|
|
218 ;; narrowed to just the headers of the message.
|
|
105602
|
219 (narrow-to-region (point-min) limit)
|
|
101871
|
220 (setq character-coding
|
|
|
221 (mail-fetch-field "content-transfer-encoding")
|
|
|
222 is-text-message (rmail-is-text-p)
|
102165
f93f5035af02
(rmail-cease-edit): Notice changes in buffer's encoding during editing.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
223 coding-system (if (and edited-coding
|
f93f5035af02
(rmail-cease-edit): Notice changes in buffer's encoding during editing.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
224 (not (coding-system-equal
|
f93f5035af02
(rmail-cease-edit): Notice changes in buffer's encoding during editing.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
225 (coding-system-base edited-coding)
|
f93f5035af02
(rmail-cease-edit): Notice changes in buffer's encoding during editing.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
226 'undecided)))
|
f93f5035af02
(rmail-cease-edit): Notice changes in buffer's encoding during editing.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
227 edited-coding
|
f93f5035af02
(rmail-cease-edit): Notice changes in buffer's encoding during editing.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
228 (rmail-get-coding-system))))
|
|
101360
|
229 (if character-coding
|
|
|
230 (setq character-coding (downcase character-coding)))
|
|
|
231
|
|
101871
|
232 (goto-char limit)
|
101867
07f6502ced98
(rmail-cease-edit): narrow-to-region before extracting mail message headers.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
233 (let ((inhibit-read-only t))
|
07f6502ced98
(rmail-cease-edit): narrow-to-region before extracting mail message headers.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
234 (let ((data-buffer (current-buffer))
|
07f6502ced98
(rmail-cease-edit): narrow-to-region before extracting mail message headers.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
235 (end (copy-marker (point) t)))
|
07f6502ced98
(rmail-cease-edit): narrow-to-region before extracting mail message headers.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
236 (with-current-buffer rmail-view-buffer
|
07f6502ced98
(rmail-cease-edit): narrow-to-region before extracting mail message headers.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
237 (encode-coding-region headers-end (point-max) coding-system
|
07f6502ced98
(rmail-cease-edit): narrow-to-region before extracting mail message headers.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
238 data-buffer))
|
07f6502ced98
(rmail-cease-edit): narrow-to-region before extracting mail message headers.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
239 (delete-region end (point-max)))
|
|
101360
|
240
|
|
102023
|
241 ;; Apply to the mbox buffer any changes in header fields
|
|
|
242 ;; that the user made while editing in the view buffer.
|
|
|
243 (rmail-edit-update-headers (rmail-edit-diff-headers
|
|
|
244 rmail-old-headers new-headers))
|
|
|
245
|
|
101917
|
246 ;; Re-apply content-transfer-encoding, if any, on the message body.
|
|
101360
|
247 (cond
|
|
|
248 ((string= character-coding "quoted-printable")
|
101867
07f6502ced98
(rmail-cease-edit): narrow-to-region before extracting mail message headers.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
249 (mail-quote-printable-region (point) (point-max)))
|
|
101360
|
250 ((and (string= character-coding "base64") is-text-message)
|
101867
07f6502ced98
(rmail-cease-edit): narrow-to-region before extracting mail message headers.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
251 (base64-encode-region (point) (point-max)))
|
|
101871
|
252 ((and (eq character-coding 'uuencode) is-text-message)
|
|
101917
|
253 (error "uuencoded messages are not supported"))))
|
|
|
254 (rmail-set-attribute rmail-edited-attr-index t))
|
|
101360
|
255 ;;??? BROKEN perhaps.
|
|
101917
|
256 ;;; (if (boundp 'rmail-summary-vector)
|
|
|
257 ;;; (aset rmail-summary-vector (1- rmail-current-message) nil))
|
|
105602
|
258 (rmail-show-message)
|
|
|
259 (rmail-toggle-header (if pruned 1 0)))
|
|
101360
|
260 (run-hooks 'rmail-mode-hook))
|
|
|
261
|
|
|
262 (defun rmail-abort-edit ()
|
|
|
263 "Abort edit of current message; restore original contents."
|
|
|
264 (interactive)
|
|
|
265 (widen)
|
|
|
266 (delete-region (point-min) (point-max))
|
|
|
267 (insert rmail-old-text)
|
|
|
268 (rmail-cease-edit)
|
|
|
269 (rmail-highlight-headers))
|
|
102023
|
270
|
|
|
271 (defun rmail-edit-headers-alist (&optional widen markers)
|
|
|
272 "Return an alist of the headers of the message in the current buffer.
|
|
|
273 Each element has the form (HEADER-NAME . ENTIRE-STRING).
|
|
|
274 ENTIRE-STRING includes the name of the header field (which is HEADER-NAME)
|
|
|
275 and has a final newline.
|
|
|
276 If part of the text is not valid as a header field, HEADER-NAME
|
|
|
277 is an integer and we use consecutive integers.
|
|
|
278
|
|
|
279 If WIDEN is non-nil, operate on the entire buffer.
|
|
|
280
|
|
|
281 If MARKERS is non-nil, the value looks like
|
|
|
282 \(HEADER-NAME ENTIRE-STRING BEG-MARKER END-MARKER)."
|
|
|
283 (let (header-alist (no-good-header-count 1))
|
|
|
284 (save-excursion
|
|
|
285 (save-restriction
|
|
|
286 (if widen (widen))
|
|
|
287 (goto-char (point-min))
|
|
|
288 (search-forward "\n\n")
|
|
|
289 (narrow-to-region (point-min) (1- (point)))
|
|
|
290 (goto-char (point-min))
|
|
|
291 (while (not (eobp))
|
|
|
292 (let ((start (point))
|
|
|
293 name header)
|
|
|
294 ;; Match the name.
|
|
|
295 (if (looking-at "[ \t]*\\([^:\n \t]\\(\\|[^:\n]*[^:\n \t]\\)\\)[ \t]*:")
|
|
|
296 (setq name (match-string-no-properties 1))
|
|
|
297 (setq name no-good-header-count
|
|
|
298 no-good-header-count (1+ no-good-header-count)))
|
|
|
299 (forward-line 1)
|
|
|
300 (while (looking-at "[ \t]")
|
|
|
301 (forward-line 1))
|
|
|
302 (setq header (buffer-substring-no-properties start (point)))
|
|
|
303 (if markers
|
|
|
304 (push (list header (copy-marker start) (point-marker))
|
|
|
305 header-alist)
|
|
|
306 (push (cons name header) header-alist))))))
|
|
|
307 (nreverse header-alist)))
|
|
|
308
|
|
|
309
|
|
|
310 (defun rmail-edit-diff-headers (old-headers new-headers)
|
|
|
311 "Compare OLD-HEADERS and NEW-HEADERS and return field differences.
|
|
|
312 The value is a list of three lists, (INSERTED DELETED CHANGED).
|
|
|
313
|
|
|
314 INSERTED's elements describe inserted header fields
|
|
|
315 and each looks like (AFTER-WHAT INSERT-WHAT)
|
|
|
316 INSERT-WHAT is the header field to insert (a member of NEW-HEADERS).
|
|
|
317 AFTER-WHAT is the field to insert it after (a member of NEW-HEADERS)
|
|
|
318 or else nil to insert it at the beginning.
|
|
|
319
|
|
|
320 DELETED's elements are elements of OLD-HEADERS.
|
|
|
321 CHANGED's elements have the form (OLD . NEW)
|
|
|
322 where OLD is a element of OLD-HEADERS and NEW is an element of NEW-HEADERS."
|
|
|
323
|
|
|
324 (let ((reverse-new (reverse new-headers))
|
|
|
325 inserted deleted changed)
|
|
|
326 (dolist (old old-headers)
|
|
|
327 (let ((new (assoc (car old) new-headers)))
|
|
|
328 ;; If it's in OLD-HEADERS and has no new counterpart,
|
|
|
329 ;; it is a deletion.
|
|
|
330 (if (null new)
|
|
|
331 (push old deleted)
|
|
|
332 ;; If it has a new counterpart, maybe it was changed.
|
|
|
333 (unless (equal (cdr old) (cdr new))
|
|
|
334 (push (cons old new) changed))
|
|
|
335 ;; Remove the new counterpart, since it has been spoken for.
|
|
|
336 (setq new-headers (remq new new-headers)))))
|
|
|
337 ;; Look at the new headers with no old counterpart.
|
|
|
338 (dolist (new new-headers)
|
|
|
339 (let ((prev (cadr (member new reverse-new))))
|
|
102046
|
340 ;; Mark each one as an insertion.
|
|
|
341 ;; Record the previous new header, to insert it after that.
|
|
|
342 (push (list prev new) inserted)))
|
|
102023
|
343 ;; It is crucial to return the insertions in buffer order
|
|
|
344 ;; so that `rmail-edit-update-headers' can insert a field
|
|
|
345 ;; after a new field.
|
|
|
346 (list (nreverse inserted)
|
|
|
347 (nreverse deleted)
|
|
|
348 (nreverse changed))))
|
|
|
349
|
|
|
350 (defun rmail-edit-update-headers (header-diff)
|
|
|
351 "Edit the mail headers in the buffer based on HEADER-DIFF.
|
|
|
352 HEADER-DIFF should be a return value from `rmail-edit-diff-headers'."
|
|
|
353 (let ((buf-headers (rmail-edit-headers-alist nil t)))
|
|
|
354 ;; Change all the fields scheduled for being changed.
|
|
|
355 (dolist (chg (nth 2 header-diff))
|
|
|
356 (let* ((match (assoc (cdar chg) buf-headers))
|
|
|
357 (end (marker-position (nth 2 match))))
|
|
|
358 (goto-char end)
|
|
|
359 ;; Insert the new, then delete the old.
|
|
|
360 ;; That avoids collapsing markers.
|
|
|
361 (insert-before-markers (cddr chg))
|
|
|
362 (delete-region (nth 1 match) end)
|
|
|
363 ;; Remove the old field from BUF-HEADERS.
|
|
|
364 (setq buf-headers (delq match buf-headers))
|
|
|
365 ;; Update BUF-HEADERS to show the changed field.
|
|
|
366 (push (list (cddr chg) (point-marker)
|
|
|
367 (copy-marker (- (point) (length (cddr chg))))
|
|
|
368 (point-marker))
|
|
|
369 buf-headers)))
|
|
|
370 ;; Delete all the fields scheduled for deletion.
|
|
|
371 ;; We do deletion after changes
|
|
|
372 ;; because when two fields look alike and get replaced by one,
|
|
|
373 ;; the first of them is considered changed
|
|
|
374 ;; and the second is considered deleted.
|
|
|
375 (dolist (del (nth 1 header-diff))
|
|
|
376 (let ((match (assoc (cdr del) buf-headers)))
|
|
|
377 (delete-region (nth 1 match) (nth 2 match))))
|
|
|
378 ;; Insert all the fields scheduled for insertion.
|
|
|
379 (dolist (ins (nth 0 header-diff))
|
|
|
380 (let* ((new (cadr ins))
|
|
|
381 (after (car ins))
|
|
|
382 (match (assoc (cdr after) buf-headers)))
|
|
|
383 (goto-char (if match (nth 2 match) (point-min)))
|
|
|
384 (insert (cdr new))
|
|
|
385 ;; Update BUF-HEADERS to show the inserted field.
|
|
|
386 (push (list (cdr new)
|
|
|
387 (copy-marker (- (point) (length (cdr new))))
|
|
|
388 (point-marker))
|
|
|
389 buf-headers)))
|
|
|
390 ;; Disconnect the markers
|
|
|
391 (dolist (hdr buf-headers)
|
|
|
392 (set-marker (nth 1 hdr) nil)
|
|
|
393 (set-marker (nth 2 hdr) nil))))
|
|
101360
|
394
|
|
|
395 (provide 'rmailedit)
|
|
|
396
|
|
104907
|
397 ;; Local Variables:
|
|
|
398 ;; generated-autoload-file: "rmail.el"
|
|
|
399 ;; End:
|
|
|
400
|
|
101360
|
401 ;; arch-tag: 9524f335-12cc-4e95-9e9b-3208dc30550b
|
|
|
402 ;;; rmailedit.el ends here
|
