Commit | Line | Data |
---|---|---|
537ab246 BG |
1 | ;;; rmailedit.el --- "RMAIL edit mode" Edit the current message |
2 | ||
3 | ;; Copyright (C) 1985, 1994, 2001, 2002, 2003, 2004, 2005, 2006, | |
4 | ;; 2007, 2008, 2009 Free Software Foundation, Inc. | |
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 | ||
28 | (eval-when-compile | |
29 | (require 'rmail) | |
30 | (require 'rmailsum)) | |
31 | ||
32 | (defcustom rmail-edit-mode-hook nil | |
33 | "List of functions to call when editing an RMAIL message." | |
34 | :type 'hook | |
35 | :version "21.1" | |
36 | :group 'rmail-edit) | |
37 | ||
38 | (defvar rmail-old-text) | |
39 | ||
befa8175 SM |
40 | (defvar rmail-edit-map |
41 | (let ((map (make-sparse-keymap))) | |
42 | ;; Make a keymap that inherits text-mode-map. | |
43 | (set-keymap-parent map text-mode-map) | |
44 | (define-key map "\C-c\C-c" 'rmail-cease-edit) | |
45 | (define-key map "\C-c\C-]" 'rmail-abort-edit) | |
46 | map)) | |
47 | ||
537ab246 BG |
48 | |
49 | ;; Rmail Edit mode is suitable only for specially formatted data. | |
50 | (put 'rmail-edit-mode 'mode-class 'special) | |
51 | ||
04c17bea | 52 | (declare-function rmail-summary-disable "rmailsum" ()) |
537ab246 BG |
53 | (declare-function rmail-summary-enable "rmailsum" ()) |
54 | ||
55 | (defun rmail-edit-mode () | |
56 | "Major mode for editing the contents of an RMAIL message. | |
57 | The editing commands are the same as in Text mode, together with two commands | |
58 | to return to regular RMAIL: | |
59 | * \\[rmail-abort-edit] cancels the changes | |
60 | you have made and returns to RMAIL | |
61 | * \\[rmail-cease-edit] makes them permanent. | |
62 | This functions runs the normal hook `rmail-edit-mode-hook'. | |
63 | \\{rmail-edit-map}" | |
64 | (if (rmail-summary-exists) | |
befa8175 | 65 | (with-current-buffer rmail-summary-buffer |
537ab246 | 66 | (rmail-summary-disable))) |
befa8175 SM |
67 | (let ((rmail-buffer-swapped nil)) ; Prevent change-major-mode-hook |
68 | ; from unswapping the buffers. | |
537ab246 BG |
69 | (delay-mode-hooks (text-mode)) |
70 | (use-local-map rmail-edit-map) | |
71 | (setq major-mode 'rmail-edit-mode) | |
72 | (setq mode-name "RMAIL Edit") | |
73 | (if (boundp 'mode-line-modified) | |
74 | (setq mode-line-modified (default-value 'mode-line-modified)) | |
75 | (setq mode-line-format (default-value 'mode-line-format))) | |
76 | (run-mode-hooks 'rmail-edit-mode-hook))) | |
77 | ||
78 | (defvar rmail-old-pruned nil) | |
79 | (put 'rmail-old-pruned 'permanent-local t) | |
80 | ||
81 | ;;;###autoload | |
82 | (defun rmail-edit-current-message () | |
83 | "Edit the contents of this message." | |
84 | (interactive) | |
85 | (if (= rmail-total-messages 0) | |
86 | (error "No messages in this buffer")) | |
87 | (make-local-variable 'rmail-old-pruned) | |
88 | (setq rmail-old-pruned (eq rmail-header-style 'normal)) | |
89 | (rmail-edit-mode) | |
90 | (make-local-variable 'rmail-old-text) | |
91 | (save-restriction | |
92 | (widen) | |
93 | (setq rmail-old-text (buffer-substring (point-min) (point-max)))) | |
94 | (setq buffer-read-only nil) | |
95 | (setq buffer-undo-list nil) | |
96 | (force-mode-line-update) | |
97 | (if (and (eq (key-binding "\C-c\C-c") 'rmail-cease-edit) | |
98 | (eq (key-binding "\C-c\C-]") 'rmail-abort-edit)) | |
99 | (message "Editing: Type C-c C-c to return to Rmail, C-c C-] to abort") | |
100 | (message "%s" (substitute-command-keys | |
101 | "Editing: Type \\[rmail-cease-edit] to return to Rmail, \\[rmail-abort-edit] to abort")))) | |
102 | ||
103 | (defun rmail-cease-edit () | |
104 | "Finish editing message; switch back to Rmail proper." | |
105 | (interactive) | |
106 | (if (rmail-summary-exists) | |
befa8175 | 107 | (with-current-buffer rmail-summary-buffer |
537ab246 BG |
108 | (rmail-summary-enable))) |
109 | (widen) | |
110 | ;; Disguise any "From " lines so they don't start a new message. | |
111 | (save-excursion | |
112 | (goto-char (point-min)) | |
b3a51d1d | 113 | (while (re-search-forward "^>*From " nil t) |
537ab246 | 114 | (beginning-of-line) |
b3a51d1d CY |
115 | (insert ">") |
116 | (forward-line))) | |
537ab246 BG |
117 | ;; Make sure buffer ends with a blank line |
118 | ;; so as not to run this message together with the following one. | |
119 | (save-excursion | |
120 | (goto-char (point-max)) | |
121 | (if (/= (preceding-char) ?\n) | |
122 | (insert "\n")) | |
123 | (unless (looking-back "\n\n") | |
124 | (insert "\n"))) | |
125 | (let ((old rmail-old-text) | |
126 | character-coding is-text-message coding-system | |
127 | headers-end) | |
128 | ;; Go back to Rmail mode, but carefully. | |
129 | (force-mode-line-update) | |
befa8175 SM |
130 | (let ((rmail-buffer-swapped nil)) ; Prevent change-major-mode-hook |
131 | ; from unswapping the buffers. | |
537ab246 BG |
132 | (kill-all-local-variables) |
133 | (rmail-mode-1) | |
134 | (if (boundp 'tool-bar-map) | |
135 | (set (make-local-variable 'tool-bar-map) rmail-tool-bar-map)) | |
136 | (setq buffer-undo-list t) | |
137 | (rmail-variables)) | |
138 | ;; If text has really changed, mark message as edited. | |
139 | (unless (and (= (length old) (- (point-max) (point-min))) | |
140 | (string= old (buffer-substring (point-min) (point-max)))) | |
141 | (setq old nil) | |
142 | (goto-char (point-min)) | |
143 | (search-forward "\n\n") | |
144 | (setq headers-end (point)) | |
145 | ||
146 | (rmail-swap-buffers-maybe) | |
147 | ||
148 | (setq character-coding (mail-fetch-field "content-transfer-encoding") | |
149 | is-text-message (rmail-is-text-p) | |
150 | coding-system (rmail-get-coding-system)) | |
151 | (if character-coding | |
152 | (setq character-coding (downcase character-coding))) | |
153 | ||
154 | (narrow-to-region (rmail-msgbeg rmail-current-message) | |
155 | (rmail-msgend rmail-current-message)) | |
156 | (goto-char (point-min)) | |
157 | (search-forward "\n\n") | |
158 | (let ((inhibit-read-only t) | |
159 | (headers-end-1 (point))) | |
160 | (insert-buffer-substring rmail-view-buffer headers-end) | |
161 | (delete-region (point) (point-max)) | |
162 | ||
163 | ;; Re-encode the message body in whatever | |
164 | ;; way it was decoded. | |
165 | (cond | |
166 | ((string= character-coding "quoted-printable") | |
167 | (mail-quote-printable-region headers-end-1 (point-max))) | |
168 | ((and (string= character-coding "base64") is-text-message) | |
169 | (base64-encode-region headers-end-1 (point-max))) | |
170 | ((eq character-coding 'uuencode) | |
171 | (error "Not supported yet.")) | |
172 | (t | |
173 | (if (or (not coding-system) (not (coding-system-p coding-system))) | |
174 | (setq coding-system 'undecided)) | |
175 | (encode-coding-region headers-end-1 (point-max) coding-system))) | |
176 | )) | |
177 | ||
178 | (rmail-set-attribute rmail-edited-attr-index t) | |
179 | ||
180 | ;;??? BROKEN perhaps. | |
181 | ;; I think that the Summary-Line header may not be kept there any more. | |
182 | ;;; (if (boundp 'rmail-summary-vector) | |
183 | ;;; (progn | |
184 | ;;; (aset rmail-summary-vector (1- rmail-current-message) nil) | |
185 | ;;; (save-excursion | |
186 | ;;; (rmail-widen-to-current-msgbeg | |
187 | ;;; (function (lambda () | |
188 | ;;; (forward-line 2) | |
189 | ;;; (if (looking-at "Summary-line: ") | |
190 | ;;; (let ((buffer-read-only nil)) | |
191 | ;;; (delete-region (point) | |
192 | ;;; (progn (forward-line 1) | |
193 | ;;; (point))))))))))) | |
194 | ) | |
195 | ||
196 | (save-excursion | |
197 | (rmail-show-message) | |
198 | (rmail-toggle-header (if rmail-old-pruned 1 0))) | |
199 | (run-hooks 'rmail-mode-hook)) | |
200 | ||
201 | (defun rmail-abort-edit () | |
202 | "Abort edit of current message; restore original contents." | |
203 | (interactive) | |
204 | (widen) | |
205 | (delete-region (point-min) (point-max)) | |
206 | (insert rmail-old-text) | |
207 | (rmail-cease-edit) | |
208 | (rmail-highlight-headers)) | |
209 | ||
210 | (provide 'rmailedit) | |
211 | ||
537ab246 BG |
212 | ;; arch-tag: 9524f335-12cc-4e95-9e9b-3208dc30550b |
213 | ;;; rmailedit.el ends here |