Commit | Line | Data |
---|---|---|
bdcfe844 | 1 | ;;; mh-comp.el --- MH-E functions for composing messages |
c26cf6c8 | 2 | |
a1b4049d | 3 | ;; Copyright (C) 1993,1995,1997,2000,2001,2002 Free Software Foundation, Inc. |
7382bcae | 4 | |
a1b4049d | 5 | ;; Author: Bill Wohler <wohler@newt.com> |
6e65a812 | 6 | ;; Maintainer: Bill Wohler <wohler@newt.com> |
7382bcae | 7 | ;; Keywords: mail |
a1b4049d | 8 | ;; See: mh-e.el |
c26cf6c8 | 9 | |
60370d40 | 10 | ;; This file is part of GNU Emacs. |
c26cf6c8 | 11 | |
9b7bc076 | 12 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
c26cf6c8 RS |
13 | ;; it under the terms of the GNU General Public License as published by |
14 | ;; the Free Software Foundation; either version 2, or (at your option) | |
15 | ;; any later version. | |
16 | ||
9b7bc076 | 17 | ;; GNU Emacs is distributed in the hope that it will be useful, |
c26cf6c8 RS |
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 | ||
22 | ;; You should have received a copy of the GNU General Public License | |
b578f267 EN |
23 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
24 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
25 | ;; Boston, MA 02111-1307, USA. | |
c26cf6c8 RS |
26 | |
27 | ;;; Commentary: | |
28 | ||
bdcfe844 | 29 | ;; Internal support for MH-E package. |
c26cf6c8 | 30 | |
847b8219 KH |
31 | ;;; Change Log: |
32 | ||
3d7ca223 | 33 | ;; $Id: mh-comp.el,v 1.173 2003/01/26 19:37:22 jchonig Exp $ |
847b8219 | 34 | |
c26cf6c8 RS |
35 | ;;; Code: |
36 | ||
a1b4049d | 37 | (require 'mh-e) |
a1b4049d BW |
38 | (require 'gnus-util) |
39 | (require 'easymenu) | |
bdcfe844 BW |
40 | (require 'cl) |
41 | ||
42 | ;; Shush the byte-compiler | |
43 | (defvar adaptive-fill-first-line-regexp) | |
44 | (defvar font-lock-defaults) | |
45 | (defvar mark-active) | |
46 | (defvar sendmail-coding-system) | |
c3d9274a BW |
47 | (defvar mh-identity-list) |
48 | (defvar mh-identity-default) | |
49 | (defvar mh-identity-menu) | |
a1b4049d | 50 | |
c3d9274a | 51 | ;;; Autoloads |
a1b4049d BW |
52 | (autoload 'Info-goto-node "info") |
53 | (autoload 'mail-mode-fill-paragraph "sendmail") | |
bdcfe844 BW |
54 | (autoload 'mm-handle-displayed-p "mm-decode") |
55 | ||
56 | (autoload 'sc-cite-original "sc" | |
57 | "Workhorse citing function which performs the initial citation. | |
58 | This is callable from the various mail and news readers' reply | |
59 | function according to the agreed upon standard. See `\\[sc-describe]' | |
60 | for more details. `sc-cite-original' does not do any yanking of the | |
61 | original message but it does require a few things: | |
62 | ||
63 | 1) The reply buffer is the current buffer. | |
64 | ||
65 | 2) The original message has been yanked and inserted into the | |
66 | reply buffer. | |
67 | ||
68 | 3) Verbose mail headers from the original message have been | |
69 | inserted into the reply buffer directly before the text of the | |
70 | original message. | |
71 | ||
72 | 4) Point is at the beginning of the verbose headers. | |
73 | ||
74 | 5) Mark is at the end of the body of text to be cited. | |
75 | ||
76 | For Emacs 19's, the region need not be active (and typically isn't | |
77 | when this function is called. Also, the hook `sc-pre-hook' is run | |
78 | before, and `sc-post-hook' is run after the guts of this function.") | |
c26cf6c8 | 79 | |
847b8219 KH |
80 | ;;; Site customization (see also mh-utils.el): |
81 | ||
82 | (defvar mh-send-prog "send" | |
83 | "Name of the MH send program. | |
84 | Some sites need to change this because of a name conflict.") | |
85 | ||
86 | (defvar mh-redist-full-contents nil | |
87 | "Non-nil if the `dist' command needs whole letter for redistribution. | |
88 | This is the case only when `send' is compiled with the BERK option. | |
89 | If MH will not allow you to redist a previously redist'd msg, set to nil.") | |
90 | ||
a1b4049d BW |
91 | (defvar mh-redist-background nil |
92 | "If non-nil redist will be done in background like send. | |
bdcfe844 BW |
93 | This allows transaction log to be visible if -watch, -verbose or -snoop are |
94 | used.") | |
847b8219 | 95 | |
c26cf6c8 RS |
96 | (defvar mh-note-repl "-" |
97 | "String whose first character is used to notate replied to messages.") | |
98 | ||
99 | (defvar mh-note-forw "F" | |
100 | "String whose first character is used to notate forwarded messages.") | |
101 | ||
102 | (defvar mh-note-dist "R" | |
103 | "String whose first character is used to notate redistributed messages.") | |
104 | ||
c26cf6c8 RS |
105 | (defvar mh-yank-hooks nil |
106 | "Obsolete hook for modifying a citation just inserted in the mail buffer. | |
107 | Each hook function can find the citation between point and mark. | |
108 | And each hook function should leave point and mark around the citation | |
109 | text as modified. | |
110 | ||
111 | This is a normal hook, misnamed for historical reasons. | |
1838eb6c | 112 | It is semi-obsolete and is only used if `mail-citation-hook' is nil.") |
c26cf6c8 RS |
113 | |
114 | (defvar mail-citation-hook nil | |
115 | "*Hook for modifying a citation just inserted in the mail buffer. | |
116 | Each hook function can find the citation between point and mark. | |
117 | And each hook function should leave point and mark around the citation | |
118 | text as modified. | |
119 | ||
120 | If this hook is entirely empty (nil), the text of the message is inserted | |
1838eb6c | 121 | with `mh-ins-buf-prefix' prefixed to each line. |
c26cf6c8 | 122 | |
1838eb6c | 123 | See also the variable `mh-yank-from-start-of-msg', which controls how |
bdcfe844 BW |
124 | much of the message passed to the hook. |
125 | ||
126 | This hook was historically provided to set up supercite. You may now leave | |
127 | this nil and set up supercite by setting the variable | |
128 | `mh-yank-from-start-of-msg' to 'supercite or, for more automatic insertion, | |
129 | to 'autosupercite.") | |
c26cf6c8 | 130 | |
c26cf6c8 RS |
131 | (defvar mh-comp-formfile "components" |
132 | "Name of file to be used as a skeleton for composing messages. | |
1838eb6c | 133 | Default is \"components\". If not an absolute file name, the file |
c26cf6c8 RS |
134 | is searched for first in the user's MH directory, then in the |
135 | system MH lib directory.") | |
136 | ||
847b8219 KH |
137 | (defvar mh-repl-formfile "replcomps" |
138 | "Name of file to be used as a skeleton for replying to messages. | |
1838eb6c | 139 | Default is \"replcomps\". If not an absolute file name, the file |
847b8219 KH |
140 | is searched for first in the user's MH directory, then in the |
141 | system MH lib directory.") | |
142 | ||
c3d6278e | 143 | (defvar mh-repl-group-formfile "replgroupcomps" |
bdcfe844 BW |
144 | "Name of file to be used as a skeleton for replying to messages. |
145 | This file is used to form replies to the sender and all recipients of a | |
146 | message. Only used if `mh-nmh-flag' is non-nil. Default is \"replgroupcomps\". | |
147 | If not an absolute file name, the file is searched for first in the user's MH | |
148 | directory, then in the system MH lib directory.") | |
a1b4049d | 149 | |
c26cf6c8 | 150 | (defvar mh-rejected-letter-start |
bdcfe844 | 151 | (format "^%s$" |
c3d9274a BW |
152 | (regexp-opt |
153 | '("Content-Type: message/rfc822" ;MIME MDN | |
154 | " ----- Unsent message follows -----" ;from sendmail V5 | |
155 | " --------Unsent Message below:" ; from sendmail at BU | |
156 | " ----- Original message follows -----" ;from sendmail V8 | |
157 | "------- Unsent Draft" ;from MH itself | |
158 | "---------- Original Message ----------" ;from zmailer | |
159 | " --- The unsent message follows ---" ;from AIX mail system | |
160 | " Your message follows:" ;from MMDF-II | |
161 | "Content-Description: Returned Content" ;1993 KJ sendmail | |
162 | )))) | |
c26cf6c8 RS |
163 | |
164 | (defvar mh-new-draft-cleaned-headers | |
847b8219 | 165 | "^Date:\\|^Received:\\|^Message-Id:\\|^From:\\|^Sender:\\|^Errors-To:\\|^Delivery-Date:\\|^Return-Path:" |
c26cf6c8 RS |
166 | "Regexp of header lines to remove before offering a message as a new draft. |
167 | Used by the \\<mh-folder-mode-map>`\\[mh-edit-again]' and `\\[mh-extract-rejected-mail]' commands.") | |
168 | ||
847b8219 | 169 | (defvar mh-to-field-choices '(("t" . "To:") ("s" . "Subject:") ("c" . "Cc:") |
c3d9274a BW |
170 | ("b" . "Bcc:") ("f" . "Fcc:") ("r" . "From:") |
171 | ("d" . "Dcc:")) | |
a1b4049d | 172 | "Alist of (final-character . field-name) choices for `mh-to-field'.") |
c26cf6c8 RS |
173 | |
174 | (defvar mh-letter-mode-map (copy-keymap text-mode-map) | |
175 | "Keymap for composing mail.") | |
176 | ||
177 | (defvar mh-letter-mode-syntax-table nil | |
bdcfe844 | 178 | "Syntax table used by MH-E while in MH-Letter mode.") |
c26cf6c8 RS |
179 | |
180 | (if mh-letter-mode-syntax-table | |
181 | () | |
c3d9274a BW |
182 | (setq mh-letter-mode-syntax-table |
183 | (make-syntax-table text-mode-syntax-table)) | |
184 | (modify-syntax-entry ?% "." mh-letter-mode-syntax-table)) | |
c26cf6c8 | 185 | |
bdcfe844 BW |
186 | (defvar mh-sent-from-folder nil |
187 | "Folder of msg assoc with this letter.") | |
188 | ||
189 | (defvar mh-sent-from-msg nil | |
190 | "Number of msg assoc with this letter.") | |
191 | ||
192 | (defvar mh-send-args nil | |
193 | "Extra args to pass to \"send\" command.") | |
194 | ||
195 | (defvar mh-annotate-char nil | |
196 | "Character to use to annotate `mh-sent-from-msg'.") | |
197 | ||
198 | (defvar mh-annotate-field nil | |
199 | "Field name for message annotation.") | |
c26cf6c8 RS |
200 | |
201 | ;;;###autoload | |
202 | (defun mh-smail () | |
203 | "Compose and send mail with the MH mail system. | |
bdcfe844 | 204 | This function is an entry point to MH-E, the Emacs front end |
847b8219 KH |
205 | to the MH mail system. |
206 | ||
207 | See documentation of `\\[mh-send]' for more details on composing mail." | |
c26cf6c8 RS |
208 | (interactive) |
209 | (mh-find-path) | |
210 | (call-interactively 'mh-send)) | |
211 | ||
c3d9274a | 212 | (defvar mh-error-if-no-draft nil) ;raise error over using old draft |
283b03f4 | 213 | |
283b03f4 | 214 | ;;;###autoload |
c3d6278e | 215 | (defun mh-smail-batch (&optional to subject other-headers &rest ignored) |
283b03f4 | 216 | "Set up a mail composition draft with the MH mail system. |
bdcfe844 | 217 | This function is an entry point to MH-E, the Emacs front end |
283b03f4 KH |
218 | to the MH mail system. This function does not prompt the user |
219 | for any header fields, and thus is suitable for use by programs | |
220 | that want to create a mail buffer. | |
a1b4049d BW |
221 | Users should use `\\[mh-smail]' to compose mail. |
222 | Optional arguments for setting certain fields include TO, SUBJECT, and | |
bdcfe844 | 223 | OTHER-HEADERS. Additional arguments are IGNORED." |
283b03f4 KH |
224 | (mh-find-path) |
225 | (let ((mh-error-if-no-draft t)) | |
016fbe59 | 226 | (mh-send (or to "") "" (or subject "")))) |
283b03f4 | 227 | |
a1b4049d BW |
228 | ;; XEmacs needs this: |
229 | ;;;###autoload | |
230 | (defun mh-user-agent-compose (&optional to subject other-headers continue | |
c3d9274a BW |
231 | switch-function yank-action |
232 | send-actions) | |
a1b4049d | 233 | "Set up mail composition draft with the MH mail system. |
bdcfe844 | 234 | This is `mail-user-agent' entry point to MH-E. |
a1b4049d BW |
235 | |
236 | The optional arguments TO and SUBJECT specify recipients and the | |
237 | initial Subject field, respectively. | |
238 | ||
239 | OTHER-HEADERS is an alist specifying additional | |
240 | header fields. Elements look like (HEADER . VALUE) where both | |
241 | HEADER and VALUE are strings. | |
242 | ||
243 | CONTINUE, SWITCH-FUNCTION, YANK-ACTION and SEND-ACTIONS are ignored." | |
244 | (mh-find-path) | |
245 | (let ((mh-error-if-no-draft t)) | |
246 | (mh-send to "" subject) | |
247 | (while other-headers | |
248 | (mh-insert-fields (concat (car (car other-headers)) ":") | |
c3d9274a | 249 | (cdr (car other-headers))) |
a1b4049d | 250 | (setq other-headers (cdr other-headers))))) |
283b03f4 | 251 | |
c3d9274a | 252 | ;;;###mh-autoload |
c26cf6c8 | 253 | (defun mh-edit-again (msg) |
a1b4049d | 254 | "Clean up a draft or a message MSG previously sent and make it resendable. |
847b8219 | 255 | Default is the current message. |
a1b4049d | 256 | The variable `mh-new-draft-cleaned-headers' specifies the headers to remove. |
c26cf6c8 RS |
257 | See also documentation for `\\[mh-send]' function." |
258 | (interactive (list (mh-get-msg-num t))) | |
259 | (let* ((from-folder mh-current-folder) | |
c3d9274a BW |
260 | (config (current-window-configuration)) |
261 | (draft | |
262 | (cond ((and mh-draft-folder (equal from-folder mh-draft-folder)) | |
263 | (pop-to-buffer (find-file-noselect (mh-msg-filename msg)) t) | |
264 | (rename-buffer (format "draft-%d" msg)) | |
bdcfe844 BW |
265 | ;; Make buffer writable... |
266 | (setq buffer-read-only nil) | |
267 | ;; If buffer was being used to display the message reinsert | |
268 | ;; from file... | |
269 | (when (eq major-mode 'mh-show-mode) | |
270 | (erase-buffer) | |
271 | (insert-file-contents buffer-file-name)) | |
c3d9274a BW |
272 | (buffer-name)) |
273 | (t | |
274 | (mh-read-draft "clean-up" (mh-msg-filename msg) nil))))) | |
c26cf6c8 | 275 | (mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil) |
a1b4049d | 276 | (mh-insert-header-separator) |
c26cf6c8 | 277 | (goto-char (point-min)) |
283b03f4 | 278 | (save-buffer) |
c26cf6c8 | 279 | (mh-compose-and-send-mail draft "" from-folder nil nil nil nil nil nil |
c3d9274a | 280 | config) |
bdcfe844 | 281 | (mh-letter-mode-message))) |
c26cf6c8 | 282 | |
c3d9274a | 283 | ;;;###mh-autoload |
c26cf6c8 | 284 | (defun mh-extract-rejected-mail (msg) |
a1b4049d | 285 | "Extract message MSG returned by the mail system and make it resendable. |
1838eb6c | 286 | Default is the current message. The variable `mh-new-draft-cleaned-headers' |
c26cf6c8 RS |
287 | gives the headers to clean out of the original message. |
288 | See also documentation for `\\[mh-send]' function." | |
289 | (interactive (list (mh-get-msg-num t))) | |
290 | (let ((from-folder mh-current-folder) | |
c3d9274a BW |
291 | (config (current-window-configuration)) |
292 | (draft (mh-read-draft "extraction" (mh-msg-filename msg) nil))) | |
c26cf6c8 RS |
293 | (goto-char (point-min)) |
294 | (cond ((re-search-forward mh-rejected-letter-start nil t) | |
c3d9274a BW |
295 | (skip-chars-forward " \t\n") |
296 | (delete-region (point-min) (point)) | |
297 | (mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil)) | |
298 | (t | |
299 | (message "Does not appear to be a rejected letter."))) | |
a1b4049d | 300 | (mh-insert-header-separator) |
c26cf6c8 | 301 | (goto-char (point-min)) |
283b03f4 | 302 | (save-buffer) |
847b8219 | 303 | (mh-compose-and-send-mail draft "" from-folder msg |
c3d9274a BW |
304 | (mh-get-header-field "To:") |
305 | (mh-get-header-field "From:") | |
306 | (mh-get-header-field "Cc:") | |
307 | nil nil config) | |
bdcfe844 | 308 | (mh-letter-mode-message))) |
c26cf6c8 | 309 | |
c3d9274a | 310 | ;;;###mh-autoload |
c26cf6c8 | 311 | (defun mh-forward (to cc &optional msg-or-seq) |
c3d9274a | 312 | "Forward one or more messages to the recipients TO and CC. |
bdcfe844 BW |
313 | |
314 | Use the optional MSG-OR-SEQ to specify a message or sequence to forward. | |
315 | ||
316 | Default is the displayed message. If optional prefix argument is given then | |
317 | prompt for the message sequence. If variable `transient-mark-mode' is non-nil | |
318 | and the mark is active, then the selected region is forwarded. | |
319 | See also documentation for `\\[mh-send]' function." | |
c26cf6c8 | 320 | (interactive (list (mh-read-address "To: ") |
c3d9274a BW |
321 | (mh-read-address "Cc: ") |
322 | (cond | |
bdcfe844 | 323 | ((mh-mark-active-p t) |
c3d9274a | 324 | (mh-region-to-msg-list (region-beginning) (region-end))) |
bdcfe844 BW |
325 | (current-prefix-arg |
326 | (mh-read-seq-default "Forward" t)) | |
327 | (t | |
328 | (mh-get-msg-num t))))) | |
c26cf6c8 | 329 | (let* ((folder mh-current-folder) |
c3d9274a BW |
330 | (msgs (cond ((numberp msg-or-seq) (list msg-or-seq)) |
331 | ((listp msg-or-seq) msg-or-seq) | |
332 | (t (mh-seq-to-msgs msg-or-seq)))) | |
333 | (config (current-window-configuration)) | |
334 | (fwd-msg-file (mh-msg-filename (car msgs) folder)) | |
335 | ;; forw always leaves file in "draft" since it doesn't have -draft | |
336 | (draft-name (expand-file-name "draft" mh-user-path)) | |
337 | (draft (cond ((or (not (file-exists-p draft-name)) | |
338 | (y-or-n-p "The file 'draft' exists. Discard it? ")) | |
339 | (mh-exec-cmd "forw" "-build" (if mh-nmh-flag "-mime") | |
340 | mh-current-folder msgs) | |
341 | (prog1 | |
342 | (mh-read-draft "" draft-name t) | |
343 | (mh-insert-fields "To:" to "Cc:" cc) | |
344 | (save-buffer))) | |
345 | (t | |
346 | (mh-read-draft "" draft-name nil))))) | |
847b8219 | 347 | (let (orig-from |
c3d9274a | 348 | orig-subject) |
41b9a988 | 349 | (save-excursion |
c3d9274a BW |
350 | (set-buffer (get-buffer-create mh-temp-buffer)) |
351 | (erase-buffer) | |
352 | (insert-file-contents fwd-msg-file) | |
353 | (setq orig-from (mh-get-header-field "From:")) | |
354 | (setq orig-subject (mh-get-header-field "Subject:"))) | |
c26cf6c8 | 355 | (let ((forw-subject |
c3d9274a BW |
356 | (mh-forwarded-letter-subject orig-from orig-subject)) |
357 | (compose)) | |
358 | (mh-insert-fields "Subject:" forw-subject) | |
359 | (goto-char (point-min)) | |
360 | ;; If using MML, translate mhn | |
361 | (if (equal mh-compose-insertion 'gnus) | |
362 | (save-excursion | |
363 | (setq compose t) | |
364 | (re-search-forward (format "^\\(%s\\)?$" | |
365 | mh-mail-header-separator)) | |
366 | (while | |
367 | (re-search-forward | |
368 | "^#forw \\[\\([^]]+\\)\\] \\(+\\S-+\\) \\(.*\\)$" | |
369 | (point-max) t) | |
370 | (let ((description (if (equal (match-string 1) | |
371 | "forwarded messages") | |
372 | "forwarded message %d" | |
373 | (match-string 1))) | |
374 | (msgs (split-string (match-string 3))) | |
375 | (i 0)) | |
376 | (beginning-of-line) | |
377 | (delete-region (point) (progn (forward-line 1) (point))) | |
378 | (dolist (msg msgs) | |
379 | (setq i (1+ i)) | |
380 | (mh-mml-forward-message (format description i) | |
381 | folder msg)))))) | |
382 | ;; Postition just before forwarded message | |
383 | (if (re-search-forward "^------- Forwarded Message" nil t) | |
384 | (forward-line -1) | |
385 | (re-search-forward (format "^\\(%s\\)?$" mh-mail-header-separator)) | |
386 | (forward-line 1)) | |
387 | (delete-other-windows) | |
388 | (mh-add-msgs-to-seq msgs 'forwarded t) | |
389 | (mh-compose-and-send-mail draft "" folder msg-or-seq | |
390 | to forw-subject cc | |
391 | mh-note-forw "Forwarded:" | |
392 | config) | |
393 | (if compose | |
394 | (setq mh-mml-compose-insert-flag t)) | |
395 | (mh-letter-mode-message))))) | |
c26cf6c8 RS |
396 | |
397 | (defun mh-forwarded-letter-subject (from subject) | |
bdcfe844 BW |
398 | "Return a Subject suitable for a forwarded message. |
399 | Original message has headers FROM and SUBJECT." | |
c26cf6c8 | 400 | (let ((addr-start (string-match "<" from)) |
c3d9274a | 401 | (comment (string-match "(" from))) |
c26cf6c8 | 402 | (cond ((and addr-start (> addr-start 0)) |
c3d9274a BW |
403 | ;; Full Name <luser@host> |
404 | (setq from (substring from 0 (1- addr-start)))) | |
405 | (comment | |
406 | ;; luser@host (Full Name) | |
407 | (setq from (substring from (1+ comment) (1- (length from))))))) | |
c26cf6c8 RS |
408 | (format mh-forward-subject-format from subject)) |
409 | ||
c26cf6c8 RS |
410 | ;;;###autoload |
411 | (defun mh-smail-other-window () | |
412 | "Compose and send mail in other window with the MH mail system. | |
bdcfe844 | 413 | This function is an entry point to MH-E, the Emacs front end |
847b8219 KH |
414 | to the MH mail system. |
415 | ||
416 | See documentation of `\\[mh-send]' for more details on composing mail." | |
c26cf6c8 RS |
417 | (interactive) |
418 | (mh-find-path) | |
419 | (call-interactively 'mh-send-other-window)) | |
420 | ||
c3d9274a | 421 | ;;;###mh-autoload |
c26cf6c8 | 422 | (defun mh-redistribute (to cc &optional msg) |
a1b4049d BW |
423 | "Redistribute displayed message to recipients TO and CC. |
424 | Use optional argument MSG to redistribute another message. | |
c26cf6c8 | 425 | Depending on how your copy of MH was compiled, you may need to change the |
1838eb6c | 426 | setting of the variable `mh-redist-full-contents'. See its documentation." |
c26cf6c8 | 427 | (interactive (list (mh-read-address "Redist-To: ") |
c3d9274a BW |
428 | (mh-read-address "Redist-Cc: ") |
429 | (mh-get-msg-num t))) | |
c26cf6c8 RS |
430 | (or msg |
431 | (setq msg (mh-get-msg-num t))) | |
432 | (save-window-excursion | |
433 | (let ((folder mh-current-folder) | |
c3d9274a BW |
434 | (draft (mh-read-draft "redistribution" |
435 | (if mh-redist-full-contents | |
436 | (mh-msg-filename msg) | |
437 | nil) | |
438 | nil))) | |
c26cf6c8 RS |
439 | (mh-goto-header-end 0) |
440 | (insert "Resent-To: " to "\n") | |
441 | (if (not (equal cc "")) (insert "Resent-cc: " cc "\n")) | |
442 | (mh-clean-msg-header (point-min) | |
c3d9274a BW |
443 | "^Message-Id:\\|^Received:\\|^Return-Path:\\|^Sender:\\|^Date:\\|^From:" |
444 | nil) | |
c26cf6c8 RS |
445 | (save-buffer) |
446 | (message "Redistributing...") | |
a1b4049d | 447 | (if (not mh-redist-background) |
c3d9274a BW |
448 | (if mh-redist-full-contents |
449 | (call-process "/bin/sh" nil 0 nil "-c" | |
450 | (format "mhdist=1 mhaltmsg=%s %s -push %s" | |
451 | buffer-file-name | |
452 | (expand-file-name mh-send-prog mh-progs) | |
453 | buffer-file-name)) | |
454 | (call-process "/bin/sh" nil 0 nil "-c" | |
455 | (format | |
456 | "mhdist=1 mhaltmsg=%s mhannotate=1 %s -push %s" | |
457 | (mh-msg-filename msg folder) | |
458 | (expand-file-name mh-send-prog mh-progs) | |
459 | buffer-file-name)))) | |
c26cf6c8 | 460 | (mh-annotate-msg msg folder mh-note-dist |
c3d9274a BW |
461 | "-component" "Resent:" |
462 | "-text" (format "\"%s %s\"" to cc)) | |
a1b4049d | 463 | (if mh-redist-background |
3d7ca223 | 464 | (mh-exec-cmd-daemon "/bin/sh" nil "-c" |
c3d9274a BW |
465 | (format "mhdist=1 mhaltmsg=%s %s %s %s" |
466 | (if mh-redist-full-contents | |
467 | buffer-file-name | |
468 | (mh-msg-filename msg folder)) | |
469 | (if mh-redist-full-contents | |
470 | "" | |
471 | "mhannotate=1") | |
472 | (mh-expand-file-name "send" mh-progs) | |
473 | buffer-file-name))) | |
c26cf6c8 RS |
474 | (kill-buffer draft) |
475 | (message "Redistributing...done")))) | |
476 | ||
bdcfe844 BW |
477 | (defun mh-show-buffer-message-number (&optional buffer) |
478 | "Message number of displayed message in corresponding show buffer. | |
479 | Return nil if show buffer not displayed. | |
480 | If in `mh-letter-mode', don't display the message number being replied to, | |
481 | but rather the message number of the show buffer associated with our | |
482 | originating folder buffer. | |
483 | Optional argument BUFFER can be used to specify the buffer." | |
484 | (save-excursion | |
485 | (if buffer | |
486 | (set-buffer buffer)) | |
487 | (cond ((eq major-mode 'mh-show-mode) | |
c3d9274a BW |
488 | (let ((number-start (mh-search-from-end ?/ buffer-file-name))) |
489 | (car (read-from-string (substring buffer-file-name | |
490 | (1+ number-start)))))) | |
bdcfe844 BW |
491 | ((and (eq major-mode 'mh-folder-mode) |
492 | mh-show-buffer | |
493 | (get-buffer mh-show-buffer)) | |
494 | (mh-show-buffer-message-number mh-show-buffer)) | |
495 | ((and (eq major-mode 'mh-letter-mode) | |
496 | mh-sent-from-folder | |
497 | (get-buffer mh-sent-from-folder)) | |
498 | (mh-show-buffer-message-number mh-sent-from-folder)) | |
499 | (t | |
500 | nil)))) | |
501 | ||
c3d9274a | 502 | ;;;###mh-autoload |
bdcfe844 | 503 | (defun mh-reply (message &optional reply-to includep) |
847b8219 | 504 | "Reply to MESSAGE (default: current message). |
bdcfe844 BW |
505 | If the optional argument REPLY-TO is not given, prompts for type of addresses |
506 | to reply to: | |
c26cf6c8 RS |
507 | from sender only, |
508 | to sender and primary recipients, | |
509 | cc/all sender and all recipients. | |
bdcfe844 BW |
510 | If optional prefix argument INCLUDEP provided, then include the message |
511 | in the reply using filter `mhl.reply' in your MH directory. | |
847b8219 KH |
512 | If the file named by `mh-repl-formfile' exists, it is used as a skeleton |
513 | for the reply. See also documentation for `\\[mh-send]' function." | |
bdcfe844 BW |
514 | (interactive (list |
515 | (mh-get-msg-num t) | |
516 | (let ((minibuffer-help-form | |
517 | "from => Sender only\nto => Sender and primary recipients\ncc or all => Sender and all recipients")) | |
518 | (or mh-reply-default-reply-to | |
519 | (completing-read "Reply to whom? (from, to, all) [from]: " | |
520 | '(("from") ("to") ("cc") ("all")) | |
521 | nil | |
522 | t))) | |
523 | current-prefix-arg)) | |
524 | (let* ((folder mh-current-folder) | |
525 | (show-buffer mh-show-buffer) | |
526 | (config (current-window-configuration)) | |
527 | (group-reply (or (equal reply-to "cc") (equal reply-to "all"))) | |
528 | (form-file (cond ((and mh-nmh-flag group-reply | |
529 | (stringp mh-repl-group-formfile)) | |
530 | mh-repl-group-formfile) | |
531 | ((stringp mh-repl-formfile) mh-repl-formfile) | |
532 | (t nil)))) | |
533 | (message "Composing a reply...") | |
534 | (mh-exec-cmd "repl" "-build" "-noquery" "-nodraftfolder" | |
535 | (if form-file | |
536 | (list "-form" form-file)) | |
537 | mh-current-folder message | |
538 | (cond ((or (equal reply-to "from") (equal reply-to "")) | |
539 | '("-nocc" "all")) | |
540 | ((equal reply-to "to") | |
541 | '("-cc" "to")) | |
542 | (group-reply (if mh-nmh-flag | |
543 | '("-group" "-nocc" "me") | |
544 | '("-cc" "all" "-nocc" "me")))) | |
c3d9274a BW |
545 | (cond ((or (eq mh-yank-from-start-of-msg 'autosupercite) |
546 | (eq mh-yank-from-start-of-msg 'autoattrib)) | |
547 | '("-noformat")) | |
548 | (includep '("-filter" "mhl.reply")) | |
549 | (t '()))) | |
bdcfe844 BW |
550 | (let ((draft (mh-read-draft "reply" |
551 | (expand-file-name "reply" mh-user-path) | |
552 | t))) | |
553 | (delete-other-windows) | |
554 | (save-buffer) | |
555 | ||
556 | (let ((to (mh-get-header-field "To:")) | |
557 | (subject (mh-get-header-field "Subject:")) | |
558 | (cc (mh-get-header-field "Cc:"))) | |
559 | (goto-char (point-min)) | |
560 | (mh-goto-header-end 1) | |
561 | (or includep | |
562 | (not mh-reply-show-message-flag) | |
563 | (mh-in-show-buffer (show-buffer) | |
564 | (mh-display-msg message folder))) | |
565 | (mh-add-msgs-to-seq message 'answered t) | |
566 | (message "Composing a reply...done") | |
567 | (mh-compose-and-send-mail draft "" folder message to subject cc | |
568 | mh-note-repl "Replied:" config)) | |
569 | (when (and (or (eq 'autosupercite mh-yank-from-start-of-msg) | |
570 | (eq 'autoattrib mh-yank-from-start-of-msg)) | |
571 | (eq (mh-show-buffer-message-number) mh-sent-from-msg)) | |
572 | (undo-boundary) | |
573 | (mh-yank-cur-msg)) | |
574 | (mh-letter-mode-message)))) | |
c26cf6c8 | 575 | |
c3d9274a | 576 | ;;;###mh-autoload |
c26cf6c8 RS |
577 | (defun mh-send (to cc subject) |
578 | "Compose and send a letter. | |
a1b4049d | 579 | |
bdcfe844 | 580 | Do not call this function from outside MH-E; use \\[mh-smail] instead. |
847b8219 | 581 | |
a1b4049d BW |
582 | The file named by `mh-comp-formfile' will be used as the form. |
583 | The letter is composed in `mh-letter-mode'; see its documentation for more | |
584 | details. | |
585 | If `mh-compose-letter-function' is defined, it is called on the draft and | |
586 | passed three arguments: TO, CC, and SUBJECT." | |
c26cf6c8 | 587 | (interactive (list |
c3d9274a BW |
588 | (mh-read-address "To: ") |
589 | (mh-read-address "Cc: ") | |
590 | (read-string "Subject: "))) | |
c26cf6c8 RS |
591 | (let ((config (current-window-configuration))) |
592 | (delete-other-windows) | |
593 | (mh-send-sub to cc subject config))) | |
594 | ||
c3d9274a | 595 | ;;;###mh-autoload |
c26cf6c8 RS |
596 | (defun mh-send-other-window (to cc subject) |
597 | "Compose and send a letter in another window. | |
a1b4049d | 598 | |
bdcfe844 | 599 | Do not call this function from outside MH-E; use \\[mh-smail-other-window] |
a1b4049d BW |
600 | instead. |
601 | ||
602 | The file named by `mh-comp-formfile' will be used as the form. | |
603 | The letter is composed in `mh-letter-mode'; see its documentation for more | |
604 | details. | |
605 | If `mh-compose-letter-function' is defined, it is called on the draft and | |
606 | passed three arguments: TO, CC, and SUBJECT." | |
c26cf6c8 | 607 | (interactive (list |
c3d9274a BW |
608 | (mh-read-address "To: ") |
609 | (mh-read-address "Cc: ") | |
610 | (read-string "Subject: "))) | |
c26cf6c8 RS |
611 | (let ((pop-up-windows t)) |
612 | (mh-send-sub to cc subject (current-window-configuration)))) | |
613 | ||
c26cf6c8 | 614 | (defun mh-send-sub (to cc subject config) |
bdcfe844 BW |
615 | "Do the real work of composing and sending a letter. |
616 | Expects the TO, CC, and SUBJECT fields as arguments. | |
617 | CONFIG is the window configuration before sending mail." | |
c26cf6c8 | 618 | (let ((folder mh-current-folder) |
c3d9274a | 619 | (msg-num (mh-get-msg-num nil))) |
c26cf6c8 RS |
620 | (message "Composing a message...") |
621 | (let ((draft (mh-read-draft | |
c3d9274a BW |
622 | "message" |
623 | (let (components) | |
624 | (cond | |
625 | ((file-exists-p | |
626 | (setq components | |
627 | (expand-file-name mh-comp-formfile mh-user-path))) | |
628 | components) | |
629 | ((file-exists-p | |
630 | (setq components | |
631 | (expand-file-name mh-comp-formfile mh-lib))) | |
632 | components) | |
633 | ((file-exists-p | |
634 | (setq components | |
635 | (expand-file-name mh-comp-formfile | |
636 | ;; What is this mh-etc ?? -sm | |
bdcfe844 BW |
637 | ;; This is dead code, so |
638 | ;; remove it. | |
c3d9274a | 639 | ;(and (boundp 'mh-etc) mh-etc) |
bdcfe844 | 640 | ))) |
c3d9274a BW |
641 | components) |
642 | (t | |
643 | (error (format "Can't find components file \"%s\"" | |
644 | components))))) | |
645 | nil))) | |
c26cf6c8 RS |
646 | (mh-insert-fields "To:" to "Subject:" subject "Cc:" cc) |
647 | (goto-char (point-max)) | |
c26cf6c8 | 648 | (mh-compose-and-send-mail draft "" folder msg-num |
c3d9274a BW |
649 | to subject cc |
650 | nil nil config) | |
bdcfe844 | 651 | (mh-letter-mode-message)))) |
c26cf6c8 RS |
652 | |
653 | (defun mh-read-draft (use initial-contents delete-contents-file) | |
bdcfe844 BW |
654 | "Read draft file into a draft buffer and make that buffer the current one. |
655 | USE is a message used for prompting about the intended use of the message. | |
656 | INITIAL-CONTENTS is filename that is read into an empty buffer, or nil | |
657 | if buffer should not be modified. Delete the initial-contents file if | |
658 | DELETE-CONTENTS-FILE flag is set. | |
659 | Returns the draft folder's name. | |
660 | If the draft folder facility is enabled in ~/.mh_profile, a new buffer is | |
661 | used each time and saved in the draft folder. The draft file can then be | |
662 | reused." | |
c26cf6c8 | 663 | (cond (mh-draft-folder |
c3d9274a BW |
664 | (let ((orig-default-dir default-directory) |
665 | (draft-file-name (mh-new-draft-name))) | |
666 | (pop-to-buffer (generate-new-buffer | |
667 | (format "draft-%s" | |
668 | (file-name-nondirectory draft-file-name)))) | |
669 | (condition-case () | |
670 | (insert-file-contents draft-file-name t) | |
671 | (file-error)) | |
672 | (setq default-directory orig-default-dir))) | |
673 | (t | |
674 | (let ((draft-name (expand-file-name "draft" mh-user-path))) | |
675 | (pop-to-buffer "draft") ; Create if necessary | |
676 | (if (buffer-modified-p) | |
677 | (if (y-or-n-p "Draft has been modified; kill anyway? ") | |
678 | (set-buffer-modified-p nil) | |
679 | (error "Draft preserved"))) | |
680 | (setq buffer-file-name draft-name) | |
681 | (clear-visited-file-modtime) | |
682 | (unlock-buffer) | |
683 | (cond ((and (file-exists-p draft-name) | |
684 | (not (equal draft-name initial-contents))) | |
685 | (insert-file-contents draft-name) | |
686 | (delete-file draft-name)))))) | |
c26cf6c8 | 687 | (cond ((and initial-contents |
c3d9274a BW |
688 | (or (zerop (buffer-size)) |
689 | (if (y-or-n-p | |
690 | (format "A draft exists. Use for %s? " use)) | |
691 | (if mh-error-if-no-draft | |
692 | (error "A prior draft exists")) | |
693 | t))) | |
694 | (erase-buffer) | |
695 | (insert-file-contents initial-contents) | |
696 | (if delete-contents-file (delete-file initial-contents)))) | |
c26cf6c8 RS |
697 | (auto-save-mode 1) |
698 | (if mh-draft-folder | |
c3d9274a | 699 | (save-buffer)) ; Do not reuse draft name |
c26cf6c8 RS |
700 | (buffer-name)) |
701 | ||
c26cf6c8 | 702 | (defun mh-new-draft-name () |
bdcfe844 | 703 | "Return the pathname of folder for draft messages." |
c26cf6c8 RS |
704 | (save-excursion |
705 | (mh-exec-cmd-quiet t "mhpath" mh-draft-folder "new") | |
706 | (buffer-substring (point-min) (1- (point-max))))) | |
707 | ||
c26cf6c8 | 708 | (defun mh-annotate-msg (msg buffer note &rest args) |
bdcfe844 | 709 | "Mark MSG in BUFFER with character NOTE and annotate message with ARGS." |
c26cf6c8 RS |
710 | (apply 'mh-exec-cmd "anno" buffer msg args) |
711 | (save-excursion | |
c3d9274a BW |
712 | (cond ((get-buffer buffer) ; Buffer may be deleted |
713 | (set-buffer buffer) | |
714 | (if (numberp msg) | |
715 | (mh-notate msg note (1+ mh-cmd-note)) | |
716 | (mh-notate-seq msg note (1+ mh-cmd-note))))))) | |
c26cf6c8 | 717 | |
c26cf6c8 | 718 | (defun mh-insert-fields (&rest name-values) |
bdcfe844 BW |
719 | "Insert the NAME-VALUES pairs in the current buffer. |
720 | If the field exists, append the value to it. | |
721 | Do not insert any pairs whose value is the empty string." | |
c26cf6c8 RS |
722 | (let ((case-fold-search t)) |
723 | (while name-values | |
724 | (let ((field-name (car name-values)) | |
c3d9274a BW |
725 | (value (car (cdr name-values)))) |
726 | (cond ((equal value "") | |
727 | nil) | |
728 | ((mh-position-on-field field-name) | |
729 | (insert " " (or value ""))) | |
730 | (t | |
731 | (insert field-name " " value "\n"))) | |
732 | (setq name-values (cdr (cdr name-values))))))) | |
c26cf6c8 | 733 | |
bdcfe844 BW |
734 | (defun mh-position-on-field (field &optional ignored) |
735 | "Move to the end of the FIELD in the header. | |
736 | Move to end of entire header if FIELD not found. | |
737 | Returns non-nil iff FIELD was found. | |
738 | The optional second arg is for pre-version 4 compatibility and is IGNORED." | |
a1b4049d | 739 | (cond ((mh-goto-header-field field) |
c3d9274a BW |
740 | (mh-header-field-end) |
741 | t) | |
742 | ((mh-goto-header-end 0) | |
743 | nil))) | |
847b8219 | 744 | |
847b8219 | 745 | (defun mh-get-header-field (field) |
bdcfe844 BW |
746 | "Find and return the body of FIELD in the mail header. |
747 | Returns the empty string if the field is not in the header of the | |
748 | current buffer." | |
847b8219 KH |
749 | (if (mh-goto-header-field field) |
750 | (progn | |
c3d9274a BW |
751 | (skip-chars-forward " \t") ;strip leading white space in body |
752 | (let ((start (point))) | |
753 | (mh-header-field-end) | |
754 | (buffer-substring-no-properties start (point)))) | |
847b8219 KH |
755 | "")) |
756 | ||
bdcfe844 | 757 | (fset 'mh-get-field 'mh-get-header-field) ;MH-E 4 compatibility |
847b8219 KH |
758 | |
759 | (defun mh-goto-header-field (field) | |
bdcfe844 BW |
760 | "Move to FIELD in the message header. |
761 | Move to the end of the FIELD name, which should end in a colon. | |
762 | Returns t if found, nil if not." | |
847b8219 KH |
763 | (goto-char (point-min)) |
764 | (let ((case-fold-search t) | |
c3d9274a BW |
765 | (headers-end (save-excursion |
766 | (mh-goto-header-end 0) | |
767 | (point)))) | |
847b8219 KH |
768 | (re-search-forward (format "^%s" field) headers-end t))) |
769 | ||
c26cf6c8 | 770 | (defun mh-goto-header-end (arg) |
bdcfe844 | 771 | "Move the cursor ARG lines after the header." |
9303c8db | 772 | (if (re-search-forward "^-*$" nil nil) |
c26cf6c8 RS |
773 | (forward-line arg))) |
774 | ||
c3d9274a BW |
775 | (defun mh-extract-from-header-value () |
776 | "Extract From: string from header." | |
777 | (save-excursion | |
778 | (if (not (mh-goto-header-field "From:")) | |
779 | (error "No From header line found") | |
780 | (skip-chars-forward " \t") | |
781 | (buffer-substring-no-properties | |
782 | (point) (progn (mh-header-field-end)(point)))))) | |
c26cf6c8 RS |
783 | |
784 | \f | |
785 | ||
786 | ;;; Mode for composing and sending a draft message. | |
787 | ||
bdcfe844 | 788 | (put 'mh-letter-mode 'mode-class 'special) |
c26cf6c8 | 789 | |
bdcfe844 BW |
790 | ;;; Menu extracted from mh-menubar.el V1.1 (31 July 2001) |
791 | (eval-when-compile (defvar mh-letter-menu nil)) | |
792 | (cond | |
793 | ((fboundp 'easy-menu-define) | |
794 | (easy-menu-define | |
795 | mh-letter-menu mh-letter-mode-map "Menu for MH-E letter mode." | |
796 | '("Letter" | |
797 | ["Send This Draft" mh-send-letter t] | |
798 | ["Split Current Line" mh-open-line t] | |
799 | ["Check Recipient" mh-check-whom t] | |
800 | ["Yank Current Message" mh-yank-cur-msg t] | |
801 | ["Insert a Message..." mh-insert-letter t] | |
802 | ["Insert Signature" mh-insert-signature t] | |
c3d9274a BW |
803 | ["GPG Sign message" |
804 | mh-mml-secure-message-sign-pgpmime mh-gnus-pgp-support-flag] | |
805 | ["GPG Encrypt message" | |
806 | mh-mml-secure-message-encrypt-pgpmime mh-gnus-pgp-support-flag] | |
bdcfe844 | 807 | ["Compose Insertion (MIME)..." mh-compose-insertion t] |
c3d9274a BW |
808 | ;; ["Compose Compressed tar (MIME)..." |
809 | ;;mh-mhn-compose-external-compressed-tar t] | |
810 | ;; ["Compose Anon FTP (MIME)..." mh-mhn-compose-anon-ftp t] | |
bdcfe844 | 811 | ["Compose Forward (MIME)..." mh-compose-forward t] |
c3d9274a BW |
812 | ;; The next two will have to be merged. But I also need to make sure the |
813 | ;; user can't mix directives of both types. | |
814 | ["Pull in All Compositions (mhn)" | |
815 | mh-edit-mhn mh-mhn-compose-insert-flag] | |
816 | ["Pull in All Compositions (gnus)" | |
817 | mh-mml-to-mime mh-mml-compose-insert-flag] | |
818 | ["Revert to Non-MIME Edit (mhn)" | |
819 | mh-revert-mhn-edit (equal mh-compose-insertion 'mhn)] | |
bdcfe844 | 820 | ["Kill This Draft" mh-fully-kill-draft t])))) |
c26cf6c8 | 821 | |
bdcfe844 BW |
822 | ;;; Help Messages |
823 | ;;; Group messages logically, more or less. | |
824 | (defvar mh-letter-mode-help-messages | |
825 | '((nil | |
826 | "Send letter: \\[mh-send-letter]" | |
827 | "\t\tOpen line: \\[mh-open-line]\n" | |
828 | "Kill letter: \\[mh-fully-kill-draft]" | |
829 | "\t\tInsert:\n" | |
830 | "Check recipients: \\[mh-check-whom]" | |
831 | "\t\t Current message: \\[mh-yank-cur-msg]\n" | |
832 | "Encrypt message: \\[mh-mml-secure-message-encrypt-pgpmime]" | |
833 | "\t\t Attachment: \\[mh-compose-insertion]\n" | |
834 | "Sign message: \\[mh-mml-secure-message-sign-pgpmime]" | |
835 | "\t\t Message to forward: \\[mh-compose-forward]\n" | |
836 | " " | |
837 | "\t\t Signature: \\[mh-insert-signature]")) | |
838 | "Key binding cheat sheet. | |
839 | ||
840 | This is an associative array which is used to show the most common commands. | |
841 | The key is a prefix char. The value is one or more strings which are | |
842 | concatenated together and displayed in the minibuffer if ? is pressed after | |
843 | the prefix character. The special key nil is used to display the | |
844 | non-prefixed commands. | |
845 | ||
846 | The substitutions described in `substitute-command-keys' are performed as | |
847 | well.") | |
848 | ||
c3d9274a | 849 | ;;;###mh-autoload |
bdcfe844 BW |
850 | (defun mh-fill-paragraph-function (arg) |
851 | "Fill paragraph at or after point. | |
852 | Prefix ARG means justify as well. This function enables `fill-paragraph' to | |
853 | work better in MH-Letter mode." | |
854 | (interactive "P") | |
855 | (let ((fill-paragraph-function) (fill-prefix)) | |
856 | (if (mh-in-header-p) | |
857 | (mail-mode-fill-paragraph arg) | |
858 | (fill-paragraph arg)))) | |
c26cf6c8 RS |
859 | |
860 | ;;;###autoload | |
f7c4478f | 861 | (define-derived-mode mh-letter-mode text-mode "MH-Letter" |
bdcfe844 | 862 | "Mode for composing letters in MH-E.\\<mh-letter-mode-map> |
a1b4049d | 863 | |
847b8219 KH |
864 | When you have finished composing, type \\[mh-send-letter] to send the message |
865 | using the MH mail handling system. | |
c26cf6c8 | 866 | |
c3d9274a BW |
867 | There are two types of MIME directives used by MH-E: Gnus and MH. The option |
868 | `mh-compose-insertion' controls what type of directives are inserted by MH-E | |
869 | commands. These directives can be converted to MIME body parts by running | |
870 | \\[mh-edit-mhn] for mhn directives or \\[mh-mml-to-mime] for Gnus directives. | |
871 | This step is mandatory if these directives are added manually. If the | |
872 | directives are inserted with MH-E commands such as \\[mh-compose-insertion], | |
873 | the directives are expanded automatically when the letter is sent. | |
c26cf6c8 | 874 | |
a1b4049d BW |
875 | Options that control this mode can be changed with |
876 | \\[customize-group]; specify the \"mh-compose\" group. | |
c26cf6c8 | 877 | |
a1b4049d BW |
878 | When a message is composed, the hooks `text-mode-hook' and |
879 | `mh-letter-mode-hook' are run. | |
c26cf6c8 | 880 | |
a1b4049d | 881 | \\{mh-letter-mode-map}" |
c26cf6c8 | 882 | |
c26cf6c8 | 883 | (or mh-user-path (mh-find-path)) |
c26cf6c8 RS |
884 | (make-local-variable 'mh-send-args) |
885 | (make-local-variable 'mh-annotate-char) | |
886 | (make-local-variable 'mh-annotate-field) | |
887 | (make-local-variable 'mh-previous-window-config) | |
888 | (make-local-variable 'mh-sent-from-folder) | |
889 | (make-local-variable 'mh-sent-from-msg) | |
890 | (make-local-variable 'mail-header-separator) | |
a1b4049d | 891 | (setq mail-header-separator mh-mail-header-separator) ;override sendmail.el |
bdcfe844 BW |
892 | (make-local-variable 'mh-help-messages) |
893 | (setq mh-help-messages mh-letter-mode-help-messages) | |
a1b4049d BW |
894 | |
895 | ;; From sendmail.el for proper paragraph fill | |
896 | ;; sendmail.el also sets a normal-auto-fill-function (not done here) | |
897 | (make-local-variable 'paragraph-separate) | |
898 | (make-local-variable 'paragraph-start) | |
899 | (make-local-variable 'fill-paragraph-function) | |
bdcfe844 | 900 | (setq fill-paragraph-function 'mh-fill-paragraph-function) |
a1b4049d BW |
901 | (make-local-variable 'adaptive-fill-regexp) |
902 | (setq adaptive-fill-regexp | |
c3d9274a BW |
903 | (concat adaptive-fill-regexp |
904 | "\\|[ \t]*[-[:alnum:]]*>+[ \t]*")) | |
a1b4049d BW |
905 | (make-local-variable 'adaptive-fill-first-line-regexp) |
906 | (setq adaptive-fill-first-line-regexp | |
c3d9274a BW |
907 | (concat adaptive-fill-first-line-regexp |
908 | "\\|[ \t]*[-[:alnum:]]*>+[ \t]*")) | |
a1b4049d BW |
909 | ;; `-- ' precedes the signature. `-----' appears at the start of the |
910 | ;; lines that delimit forwarded messages. | |
911 | ;; Lines containing just >= 3 dashes, perhaps after whitespace, | |
912 | ;; are also sometimes used and should be separators. | |
913 | (setq paragraph-start (concat (regexp-quote mail-header-separator) | |
c3d9274a BW |
914 | "\\|\t*\\([-|#;>* ]\\|(?[0-9]+[.)]\\)+$" |
915 | "\\|[ \t]*[[:alnum:]]*>+[ \t]*$\\|[ \t]*$\\|" | |
916 | "-- $\\|---+$\\|" | |
917 | page-delimiter)) | |
a1b4049d BW |
918 | (setq paragraph-separate paragraph-start) |
919 | ;; --- End of code from sendmail.el --- | |
920 | ||
921 | (if (and (boundp 'tool-bar-mode) tool-bar-mode) | |
922 | (set (make-local-variable 'tool-bar-map) mh-letter-tool-bar-map)) | |
923 | (make-local-variable 'font-lock-defaults) | |
924 | (cond | |
bdcfe844 BW |
925 | ((or (equal mh-highlight-citation-p 'font-lock) |
926 | (equal mh-highlight-citation-p 'gnus)) | |
927 | ;; Let's use font-lock even if gnus is used in show-mode. The reason | |
928 | ;; is that gnus uses static text properties which are not appropriate | |
929 | ;; for a buffer that will be edited. So the choice here is either fontify | |
930 | ;; the citations and header... | |
a1b4049d | 931 | (setq font-lock-defaults '(mh-show-font-lock-keywords-with-cite t))) |
a1b4049d | 932 | (t |
bdcfe844 | 933 | ;; ...or the header only |
a1b4049d BW |
934 | (setq font-lock-defaults '(mh-show-font-lock-keywords t)))) |
935 | (easy-menu-add mh-letter-menu) | |
936 | ;; See if a "forw: -mime" message containing a MIME composition. | |
c3d9274a | 937 | ;; Mode clears local vars, so can't do this in mh-forward. |
a1b4049d BW |
938 | (save-excursion |
939 | (goto-char (point-min)) | |
c3d9274a BW |
940 | (when (and (re-search-forward |
941 | (format "^\\(%s\\)?$" mail-header-separator) nil t) | |
a1b4049d BW |
942 | (= 0 (forward-line 1)) |
943 | (looking-at "^#forw")) | |
c3d9274a | 944 | (require 'mh-mime) ;Need mh-mhn-compose-insert-flag local var |
bdcfe844 | 945 | (setq mh-mhn-compose-insert-flag t))) |
a1b4049d | 946 | (setq fill-column mh-letter-fill-column) |
c3d9274a | 947 | ;; If text-mode-hook turned on auto-fill, tune it for messages |
f7c4478f SM |
948 | (when auto-fill-function |
949 | (make-local-variable 'auto-fill-function) | |
950 | (setq auto-fill-function 'mh-auto-fill-for-letter))) | |
c26cf6c8 | 951 | |
c26cf6c8 | 952 | (defun mh-auto-fill-for-letter () |
bdcfe844 BW |
953 | "Perform auto-fill for message. |
954 | Header is treated specially by inserting a tab before continuation lines." | |
c26cf6c8 | 955 | (if (mh-in-header-p) |
9303c8db | 956 | (let ((fill-prefix "\t")) |
c3d9274a | 957 | (do-auto-fill)) |
9303c8db | 958 | (do-auto-fill))) |
c26cf6c8 | 959 | |
a1b4049d | 960 | (defun mh-insert-header-separator () |
bdcfe844 | 961 | "Insert `mh-mail-header-separator', if absent." |
c26cf6c8 | 962 | (save-excursion |
a1b4049d BW |
963 | (goto-char (point-min)) |
964 | (rfc822-goto-eoh) | |
965 | (if (looking-at "$") | |
c3d9274a | 966 | (insert mh-mail-header-separator)))) |
c26cf6c8 | 967 | |
c3d9274a | 968 | ;;;###mh-autoload |
c26cf6c8 RS |
969 | (defun mh-to-field () |
970 | "Move point to the end of a specified header field. | |
971 | The field is indicated by the previous keystroke (the last keystroke | |
1838eb6c | 972 | of the command) according to the list in the variable `mh-to-field-choices'. |
c26cf6c8 RS |
973 | Create the field if it does not exist. Set the mark to point before moving." |
974 | (interactive) | |
975 | (expand-abbrev) | |
847b8219 | 976 | (let ((target (cdr (or (assoc (char-to-string (logior last-input-char ?`)) |
c3d9274a BW |
977 | mh-to-field-choices) |
978 | ;; also look for a char for version 4 compat | |
979 | (assoc (logior last-input-char ?`) | |
980 | mh-to-field-choices)))) | |
981 | (case-fold-search t)) | |
c26cf6c8 RS |
982 | (push-mark) |
983 | (cond ((mh-position-on-field target) | |
c3d9274a BW |
984 | (let ((eol (point))) |
985 | (skip-chars-backward " \t") | |
986 | (delete-region (point) eol)) | |
987 | (if (and (not (eq (logior last-input-char ?`) ?s)) | |
988 | (save-excursion | |
989 | (backward-char 1) | |
990 | (not (looking-at "[:,]")))) | |
991 | (insert ", ") | |
992 | (insert " "))) | |
993 | (t | |
994 | (if (mh-position-on-field "To:") | |
995 | (forward-line 1)) | |
996 | (insert (format "%s \n" target)) | |
997 | (backward-char 1))))) | |
c26cf6c8 | 998 | |
c3d9274a | 999 | ;;;###mh-autoload |
c26cf6c8 RS |
1000 | (defun mh-to-fcc (&optional folder) |
1001 | "Insert an Fcc: FOLDER field in the current message. | |
1002 | Prompt for the field name with a completion list of the current folders." | |
1003 | (interactive) | |
1004 | (or folder | |
1005 | (setq folder (mh-prompt-for-folder | |
c3d9274a BW |
1006 | "Fcc" |
1007 | (or (and mh-default-folder-for-message-function | |
1008 | (save-excursion | |
1009 | (goto-char (point-min)) | |
1010 | (funcall | |
1011 | mh-default-folder-for-message-function))) | |
1012 | "") | |
1013 | t))) | |
c26cf6c8 RS |
1014 | (let ((last-input-char ?\C-f)) |
1015 | (expand-abbrev) | |
1016 | (save-excursion | |
1017 | (mh-to-field) | |
1018 | (insert (if (mh-folder-name-p folder) | |
c3d9274a BW |
1019 | (substring folder 1) |
1020 | folder))))) | |
c26cf6c8 | 1021 | |
c3d9274a | 1022 | ;;;###mh-autoload |
c26cf6c8 | 1023 | (defun mh-insert-signature () |
bdcfe844 BW |
1024 | "Insert the file named by `mh-signature-file-name' at point. |
1025 | The value of `mh-letter-insert-signature-hook' is a list of functions to be | |
1026 | called, with no arguments, before the signature is actually inserted." | |
c26cf6c8 | 1027 | (interactive) |
bdcfe844 BW |
1028 | (let ((mh-signature-file-name mh-signature-file-name)) |
1029 | (run-hooks 'mh-letter-insert-signature-hook) | |
1030 | (if mh-signature-file-name | |
c3d9274a | 1031 | (insert-file-contents mh-signature-file-name))) |
2450bd29 | 1032 | (force-mode-line-update)) |
c26cf6c8 | 1033 | |
c3d9274a | 1034 | ;;;###mh-autoload |
c26cf6c8 | 1035 | (defun mh-check-whom () |
847b8219 | 1036 | "Verify recipients of the current letter, showing expansion of any aliases." |
c26cf6c8 | 1037 | (interactive) |
847b8219 | 1038 | (let ((file-name buffer-file-name)) |
c26cf6c8 RS |
1039 | (save-buffer) |
1040 | (message "Checking recipients...") | |
3d7ca223 | 1041 | (mh-in-show-buffer (mh-recipients-buffer) |
c26cf6c8 RS |
1042 | (bury-buffer (current-buffer)) |
1043 | (erase-buffer) | |
1044 | (mh-exec-cmd-output "whom" t file-name)) | |
1045 | (message "Checking recipients...done"))) | |
1046 | ||
3d7ca223 BW |
1047 | (defun mh-tidy-draft-buffer () |
1048 | "Run when a draft buffer is destroyed." | |
1049 | (let ((buffer (get-buffer mh-recipients-buffer))) | |
1050 | (if buffer | |
1051 | (kill-buffer buffer)))) | |
1052 | ||
c26cf6c8 RS |
1053 | \f |
1054 | ||
1055 | ;;; Routines to compose and send a letter. | |
1056 | ||
bdcfe844 BW |
1057 | (defun mh-insert-x-face () |
1058 | "Append X-Face field to header. | |
1059 | If the field already exists, this function does nothing." | |
1060 | (when (and (file-exists-p mh-x-face-file) | |
1061 | (file-readable-p mh-x-face-file)) | |
1062 | (save-excursion | |
1063 | (when (null (mh-position-on-field "X-Face")) | |
1064 | (insert "X-Face: ") | |
1065 | (goto-char (+ (point) (cadr (insert-file-contents mh-x-face-file)))) | |
1066 | (if (not (looking-at "^")) | |
1067 | (insert "\n")))))) | |
1068 | ||
a1b4049d | 1069 | (defun mh-insert-x-mailer () |
bdcfe844 BW |
1070 | "Append an X-Mailer field to the header. |
1071 | The versions of MH-E, Emacs, and MH are shown." | |
a1b4049d BW |
1072 | |
1073 | ;; Lazily initialize mh-x-mailer-string. | |
1074 | (when (null mh-x-mailer-string) | |
1075 | (save-window-excursion | |
3d7ca223 BW |
1076 | ;; User would be confused if version info buffer disappeared magically, |
1077 | ;; so don't delete buffer if it already existed. | |
1078 | (let ((info-buffer-exists-p (get-buffer mh-info-buffer))) | |
1079 | (mh-version) | |
1080 | (set-buffer mh-info-buffer) | |
1081 | (if mh-nmh-flag | |
1082 | (search-forward-regexp "^nmh-\\(\\S +\\)") | |
1083 | (search-forward-regexp "^MH \\(\\S +\\)" nil t)) | |
1084 | (let ((x-mailer-mh (buffer-substring (match-beginning 1) | |
1085 | (match-end 1)))) | |
1086 | (setq mh-x-mailer-string | |
1087 | (format "MH-E %s; %s %s; %sEmacs %s" | |
1088 | mh-version (if mh-nmh-flag "nmh" "MH") x-mailer-mh | |
1089 | (if mh-xemacs-flag "X" "GNU ") | |
1090 | (cond ((not mh-xemacs-flag) emacs-version) | |
1091 | ((string-match "[0-9.]*\\( +\([ a-z]+[0-9]+\)\\)?" | |
1092 | emacs-version) | |
1093 | (match-string 0 emacs-version)) | |
1094 | (t (format "%s.%s" | |
1095 | emacs-major-version | |
1096 | emacs-minor-version)))))) | |
1097 | (if (not info-buffer-exists-p) | |
1098 | (kill-buffer mh-info-buffer))))) | |
a1b4049d BW |
1099 | ;; Insert X-Mailer, but only if it doesn't already exist. |
1100 | (save-excursion | |
1101 | (when (null (mh-goto-header-field "X-Mailer")) | |
c3d9274a | 1102 | (mh-insert-fields "X-Mailer:" mh-x-mailer-string)))) |
a1b4049d | 1103 | |
bdcfe844 BW |
1104 | (defun mh-regexp-in-field-p (regexp &rest fields) |
1105 | "Non-nil means REGEXP was found in FIELDS." | |
1106 | (save-excursion | |
1107 | (let ((search-result nil) | |
1108 | (field)) | |
1109 | (while fields | |
1110 | (setq field (car fields)) | |
1111 | (if (and (mh-goto-header-field field) | |
1112 | (re-search-forward | |
1113 | regexp (save-excursion (mh-header-field-end)(point)) t)) | |
1114 | (setq fields nil | |
1115 | search-result t) | |
1116 | (setq fields (cdr fields)))) | |
1117 | search-result))) | |
1118 | ||
1119 | (defun mh-insert-mail-followup-to () | |
1120 | "Insert Mail-Followup-To: if To or Cc match `mh-insert-mail-followup-to-list'." | |
1121 | (save-excursion | |
1122 | (if (and (or (mh-goto-header-field "To:")(mh-goto-header-field "cc:")) | |
1123 | (not (mh-goto-header-field "Mail-Followup-To: "))) | |
1124 | (let ((list mh-insert-mail-followup-to-list)) | |
1125 | (while list | |
1126 | (let ((regexp (nth 0 (car list))) | |
1127 | (entry (nth 1 (car list)))) | |
1128 | (when (mh-regexp-in-field-p regexp "To:" "cc:") | |
1129 | (if (mh-goto-header-field "Mail-Followup-To: ") | |
1130 | (insert entry ", ") | |
1131 | (mh-goto-header-end 0) | |
1132 | (insert "Mail-Followup-To: " entry "\n"))) | |
1133 | (setq list (cdr list)))))))) | |
a1b4049d | 1134 | |
c26cf6c8 | 1135 | (defun mh-compose-and-send-mail (draft send-args |
c3d9274a BW |
1136 | sent-from-folder sent-from-msg |
1137 | to subject cc | |
1138 | annotate-char annotate-field | |
1139 | config) | |
bdcfe844 BW |
1140 | "Edit and compose a draft message in buffer DRAFT and send or save it. |
1141 | SEND-ARGS is the argument passed to the send command. | |
1142 | SENT-FROM-FOLDER is buffer containing scan listing of current folder, or | |
1143 | nil if none exists. | |
1144 | SENT-FROM-MSG is the message number or sequence name or nil. | |
1145 | The TO, SUBJECT, and CC fields are passed to the | |
1146 | `mh-compose-letter-function'. | |
1147 | If ANNOTATE-CHAR is non-null, it is used to notate the scan listing of the | |
1148 | message. In that case, the ANNOTATE-FIELD is used to build a string | |
1149 | for `mh-annotate-msg'. | |
1150 | CONFIG is the window configuration to restore after sending the letter." | |
c26cf6c8 | 1151 | (pop-to-buffer draft) |
bdcfe844 | 1152 | (if mh-insert-mail-followup-to-flag (mh-insert-mail-followup-to)) |
c26cf6c8 | 1153 | (mh-letter-mode) |
c3d9274a BW |
1154 | |
1155 | ;; mh-identity support | |
1156 | (if (and (boundp 'mh-identity-default) | |
1157 | mh-identity-default) | |
1158 | (mh-insert-identity mh-identity-default)) | |
1159 | (when (and (boundp 'mh-identity-list) | |
1160 | mh-identity-list) | |
1161 | (mh-identity-make-menu) | |
1162 | (easy-menu-add mh-identity-menu)) | |
1163 | ||
c26cf6c8 RS |
1164 | (setq mh-sent-from-folder sent-from-folder) |
1165 | (setq mh-sent-from-msg sent-from-msg) | |
1166 | (setq mh-send-args send-args) | |
1167 | (setq mh-annotate-char annotate-char) | |
1168 | (setq mh-annotate-field annotate-field) | |
1169 | (setq mh-previous-window-config config) | |
3d7ca223 BW |
1170 | (setq mode-line-buffer-identification (list " {%b}")) |
1171 | (mh-logo-display) | |
1172 | (add-hook 'kill-buffer-hook 'mh-tidy-draft-buffer nil t) | |
c26cf6c8 | 1173 | (if (and (boundp 'mh-compose-letter-function) |
c3d9274a | 1174 | mh-compose-letter-function) |
c26cf6c8 | 1175 | ;; run-hooks will not pass arguments. |
847b8219 | 1176 | (let ((value mh-compose-letter-function)) |
c3d9274a BW |
1177 | (if (and (listp value) (not (eq (car value) 'lambda))) |
1178 | (while value | |
1179 | (funcall (car value) to subject cc) | |
1180 | (setq value (cdr value))) | |
1181 | (funcall mh-compose-letter-function to subject cc))))) | |
c26cf6c8 | 1182 | |
bdcfe844 BW |
1183 | (defun mh-letter-mode-message () |
1184 | "Display a help message for users of `mh-letter-mode'. | |
1185 | This should be the last function called when composing the draft." | |
1186 | (message "%s" (substitute-command-keys | |
c3d9274a BW |
1187 | (concat "Type \\[mh-send-letter] to send message, " |
1188 | "\\[mh-help] for help.")))) | |
c26cf6c8 | 1189 | |
c3d9274a | 1190 | ;;;###mh-autoload |
c26cf6c8 RS |
1191 | (defun mh-send-letter (&optional arg) |
1192 | "Send the draft letter in the current buffer. | |
a1b4049d | 1193 | If optional prefix argument ARG is provided, monitor delivery. |
bdcfe844 BW |
1194 | The value of `mh-before-send-letter-hook' is a list of functions to be called, |
1195 | with no arguments, before doing anything. | |
c3d9274a BW |
1196 | Run `\\[mh-edit-mhn]' if variable `mh-mhn-compose-insert-flag' is set. |
1197 | Run `\\[mh-mml-to-mime]' if variable `mh-mml-compose-insert-flag' is set. | |
1198 | Insert X-Mailer field if variable `mh-insert-x-mailer-flag' is set. | |
1199 | Insert X-Face field if the file specified by `mh-x-face-file' exists." | |
c26cf6c8 RS |
1200 | (interactive "P") |
1201 | (run-hooks 'mh-before-send-letter-hook) | |
bdcfe844 BW |
1202 | (cond |
1203 | ((and (boundp 'mh-mhn-compose-insert-flag) | |
1204 | mh-mhn-compose-insert-flag) | |
1205 | (mh-edit-mhn)) | |
1206 | ((and (boundp 'mh-mml-compose-insert-flag) | |
1207 | mh-mml-compose-insert-flag) | |
1208 | (mh-mml-to-mime))) | |
1209 | (if mh-insert-x-mailer-flag (mh-insert-x-mailer)) | |
1210 | (mh-insert-x-face) | |
c26cf6c8 RS |
1211 | (save-buffer) |
1212 | (message "Sending...") | |
1213 | (let ((draft-buffer (current-buffer)) | |
c3d9274a BW |
1214 | (file-name buffer-file-name) |
1215 | (config mh-previous-window-config) | |
1216 | (coding-system-for-write | |
1217 | (if (and (local-variable-p 'buffer-file-coding-system | |
a1b4049d | 1218 | (current-buffer)) ;XEmacs needs two args |
c3d9274a BW |
1219 | ;; We're not sure why, but buffer-file-coding-system |
1220 | ;; tends to get set to undecided-unix. | |
1221 | (not (memq buffer-file-coding-system | |
1222 | '(undecided undecided-unix undecided-dos)))) | |
1223 | buffer-file-coding-system | |
1224 | (or (and (boundp 'sendmail-coding-system) sendmail-coding-system) | |
1225 | (and (boundp 'default-buffer-file-coding-system ) | |
a1b4049d | 1226 | default-buffer-file-coding-system) |
c3d9274a | 1227 | 'iso-latin-1)))) |
bdcfe844 BW |
1228 | ;; The default BCC encapsulation will make a MIME message unreadable. |
1229 | ;; With nmh use the -mime arg to prevent this. | |
1230 | (if (and mh-nmh-flag | |
c3d9274a BW |
1231 | (mh-goto-header-field "Bcc:") |
1232 | (mh-goto-header-field "Content-Type:")) | |
1233 | (setq mh-send-args (format "-mime %s" mh-send-args))) | |
c26cf6c8 | 1234 | (cond (arg |
c3d9274a BW |
1235 | (pop-to-buffer "MH mail delivery") |
1236 | (erase-buffer) | |
1237 | (mh-exec-cmd-output mh-send-prog t "-watch" "-nopush" | |
1238 | "-nodraftfolder" mh-send-args file-name) | |
1239 | (goto-char (point-max)) ; show the interesting part | |
1240 | (recenter -1) | |
1241 | (set-buffer draft-buffer)) ; for annotation below | |
1242 | (t | |
3d7ca223 | 1243 | (mh-exec-cmd-daemon mh-send-prog nil "-nodraftfolder" "-noverbose" |
c3d9274a | 1244 | mh-send-args file-name))) |
c26cf6c8 | 1245 | (if mh-annotate-char |
c3d9274a BW |
1246 | (mh-annotate-msg mh-sent-from-msg |
1247 | mh-sent-from-folder | |
1248 | mh-annotate-char | |
1249 | "-component" mh-annotate-field | |
1250 | "-text" (format "\"%s %s\"" | |
1251 | (mh-get-header-field "To:") | |
1252 | (mh-get-header-field "Cc:")))) | |
c26cf6c8 RS |
1253 | |
1254 | (cond ((or (not arg) | |
c3d9274a BW |
1255 | (y-or-n-p "Kill draft buffer? ")) |
1256 | (kill-buffer draft-buffer) | |
1257 | (if config | |
1258 | (set-window-configuration config)))) | |
c26cf6c8 | 1259 | (if arg |
c3d9274a | 1260 | (message "Sending...done") |
c26cf6c8 RS |
1261 | (message "Sending...backgrounded")))) |
1262 | ||
c3d9274a | 1263 | ;;;###mh-autoload |
847b8219 KH |
1264 | (defun mh-insert-letter (folder message verbatim) |
1265 | "Insert a message into the current letter. | |
c3d9274a BW |
1266 | Removes the header fields according to the variable `mh-invisible-headers'. |
1267 | Prefixes each non-blank line with `mh-ins-buf-prefix', unless | |
1268 | `mh-yank-from-start-of-msg' is set for supercite in which case supercite is | |
1269 | used to format the message. | |
bdcfe844 BW |
1270 | Prompts for FOLDER and MESSAGE. If prefix argument VERBATIM provided, do |
1271 | not indent and do not delete headers. Leaves the mark before the letter | |
1272 | and point after it." | |
c26cf6c8 | 1273 | (interactive |
847b8219 | 1274 | (list (mh-prompt-for-folder "Message from" mh-sent-from-folder nil) |
c3d9274a BW |
1275 | (read-input (format "Message number%s: " |
1276 | (if (numberp mh-sent-from-msg) | |
1277 | (format " [%d]" mh-sent-from-msg) | |
1278 | ""))) | |
1279 | current-prefix-arg)) | |
c26cf6c8 RS |
1280 | (save-restriction |
1281 | (narrow-to-region (point) (point)) | |
1282 | (let ((start (point-min))) | |
847b8219 | 1283 | (if (equal message "") (setq message (int-to-string mh-sent-from-msg))) |
bdcfe844 BW |
1284 | (insert-file-contents |
1285 | (expand-file-name message (mh-expand-file-name folder))) | |
1286 | (when (not verbatim) | |
1287 | (mh-clean-msg-header start mh-invisible-headers mh-visible-headers) | |
c3d9274a BW |
1288 | (goto-char (point-max)) ;Needed for sc-cite-original |
1289 | (push-mark) ;Needed for sc-cite-original | |
1290 | (goto-char (point-min)) ;Needed for sc-cite-original | |
bdcfe844 BW |
1291 | (mh-insert-prefix-string mh-ins-buf-prefix))))) |
1292 | ||
1293 | (defun mh-extract-from-attribution () | |
1294 | "Extract phrase or comment from From header field." | |
1295 | (save-excursion | |
1296 | (if (not (mh-goto-header-field "From: ")) | |
1297 | nil | |
1298 | (skip-chars-forward " ") | |
1299 | (cond | |
1300 | ((looking-at "\"\\([^\"\n]+\\)\" \\(<.+>\\)") | |
1301 | (format "%s %s %s" (match-string 1)(match-string 2) | |
1302 | mh-extract-from-attribution-verb)) | |
1303 | ((looking-at "\\([^<\n]+<.+>\\)$") | |
1304 | (format "%s %s" (match-string 1) mh-extract-from-attribution-verb)) | |
1305 | ((looking-at "\\([^ ]+@[^ ]+\\) +(\\(.+\\))$") | |
1306 | (format "%s <%s> %s" (match-string 2)(match-string 1) | |
1307 | mh-extract-from-attribution-verb)) | |
1308 | ((looking-at " *\\(.+\\)$") | |
1309 | (format "%s %s" (match-string 1) mh-extract-from-attribution-verb)))))) | |
c26cf6c8 | 1310 | |
c3d9274a | 1311 | ;;;###mh-autoload |
c26cf6c8 RS |
1312 | (defun mh-yank-cur-msg () |
1313 | "Insert the current message into the draft buffer. | |
1314 | Prefix each non-blank line in the message with the string in | |
1315 | `mh-ins-buf-prefix'. If a region is set in the message's buffer, then | |
1316 | only the region will be inserted. Otherwise, the entire message will | |
1317 | be inserted if `mh-yank-from-start-of-msg' is non-nil. If this variable | |
1318 | is nil, the portion of the message following the point will be yanked. | |
bdcfe844 | 1319 | If `mh-delete-yanked-msg-window-flag' is non-nil, any window displaying the |
c26cf6c8 RS |
1320 | yanked message will be deleted." |
1321 | (interactive) | |
bdcfe844 BW |
1322 | (if (and mh-sent-from-folder |
1323 | (save-excursion (set-buffer mh-sent-from-folder) mh-show-buffer) | |
1324 | (save-excursion (set-buffer mh-sent-from-folder) | |
1325 | (get-buffer mh-show-buffer)) | |
1326 | mh-sent-from-msg) | |
c26cf6c8 | 1327 | (let ((to-point (point)) |
c3d9274a BW |
1328 | (to-buffer (current-buffer))) |
1329 | (set-buffer mh-sent-from-folder) | |
1330 | (if mh-delete-yanked-msg-window-flag | |
1331 | (delete-windows-on mh-show-buffer)) | |
1332 | (set-buffer mh-show-buffer) ; Find displayed message | |
1333 | (let* ((from-attr (mh-extract-from-attribution)) | |
1334 | (yank-region (mh-mark-active-p nil)) | |
bdcfe844 BW |
1335 | (mh-ins-str |
1336 | (cond ((and yank-region | |
1337 | (or (eq 'supercite mh-yank-from-start-of-msg) | |
1338 | (eq 'autosupercite mh-yank-from-start-of-msg) | |
1339 | (eq t mh-yank-from-start-of-msg))) | |
1340 | ;; supercite needs the full header | |
1341 | (concat | |
1342 | (buffer-substring (point-min) (mail-header-end)) | |
1343 | "\n" | |
1344 | (buffer-substring (region-beginning) (region-end)))) | |
1345 | (yank-region | |
1346 | (buffer-substring (region-beginning) (region-end))) | |
1347 | ((or (eq 'body mh-yank-from-start-of-msg) | |
1348 | (eq 'attribution | |
1349 | mh-yank-from-start-of-msg) | |
1350 | (eq 'autoattrib | |
1351 | mh-yank-from-start-of-msg)) | |
1352 | (buffer-substring | |
1353 | (save-excursion | |
1354 | (goto-char (point-min)) | |
1355 | (mh-goto-header-end 1) | |
1356 | (point)) | |
1357 | (point-max))) | |
1358 | ((or (eq 'supercite mh-yank-from-start-of-msg) | |
1359 | (eq 'autosupercite mh-yank-from-start-of-msg) | |
1360 | (eq t mh-yank-from-start-of-msg)) | |
1361 | (buffer-substring (point-min) (point-max))) | |
1362 | (t | |
1363 | (buffer-substring (point) (point-max)))))) | |
c3d9274a BW |
1364 | (set-buffer to-buffer) |
1365 | (save-restriction | |
1366 | (narrow-to-region to-point to-point) | |
1367 | (insert (mh-filter-out-non-text mh-ins-str)) | |
bdcfe844 | 1368 | (goto-char (point-max)) ;Needed for sc-cite-original |
c3d9274a | 1369 | (push-mark) ;Needed for sc-cite-original |
bdcfe844 | 1370 | (goto-char (point-min)) ;Needed for sc-cite-original |
c3d9274a | 1371 | (mh-insert-prefix-string mh-ins-buf-prefix) |
bdcfe844 BW |
1372 | (if (or (eq 'attribution mh-yank-from-start-of-msg) |
1373 | (eq 'autoattrib mh-yank-from-start-of-msg)) | |
1374 | (insert from-attr "\n\n")) | |
c3d9274a BW |
1375 | ;; If the user has selected a region, he has already "edited" the |
1376 | ;; text, so leave the cursor at the end of the yanked text. In | |
1377 | ;; either case, leave a mark at the opposite end of the included | |
1378 | ;; text to make it easy to jump or delete to the other end of the | |
1379 | ;; text. | |
1380 | (push-mark) | |
1381 | (goto-char (point-max)) | |
1382 | (if (null yank-region) | |
1383 | (mh-exchange-point-and-mark-preserving-active-mark))))) | |
847b8219 | 1384 | (error "There is no current message"))) |
c26cf6c8 | 1385 | |
bdcfe844 BW |
1386 | (defun mh-filter-out-non-text (string) |
1387 | "Return STRING but without adornments such as MIME buttons and smileys." | |
1388 | (with-temp-buffer | |
1389 | ;; Insert the string to filter | |
1390 | (insert string) | |
1391 | (goto-char (point-min)) | |
1392 | ||
1393 | ;; Remove the MIME buttons | |
1394 | (let ((can-move-forward t) | |
1395 | (in-button nil)) | |
1396 | (while can-move-forward | |
1397 | (cond ((and (not (get-text-property (point) 'mh-data)) | |
1398 | in-button) | |
c3d9274a | 1399 | (delete-region (1- (point)) (point)) |
bdcfe844 BW |
1400 | (setq in-button nil)) |
1401 | ((get-text-property (point) 'mh-data) | |
1402 | (delete-region (point) | |
1403 | (save-excursion (forward-line) (point))) | |
1404 | (setq in-button t)) | |
1405 | (t (setq can-move-forward (= (forward-line) 0)))))) | |
1406 | ||
1407 | ;; Return the contents without properties... This gets rid of emphasis | |
1408 | ;; and smileys | |
1409 | (buffer-substring-no-properties (point-min) (point-max)))) | |
c26cf6c8 RS |
1410 | |
1411 | (defun mh-insert-prefix-string (mh-ins-string) | |
bdcfe844 BW |
1412 | "Insert prefix string before each line in buffer. |
1413 | The inserted letter is cited using `sc-cite-original' if | |
1414 | `mh-yank-from-start-of-msg' is one of 'supercite or 'autosupercite. Otherwise, | |
1415 | simply insert MH-INS-STRING before each line." | |
847b8219 | 1416 | (goto-char (point-min)) |
bdcfe844 BW |
1417 | (cond ((or (eq mh-yank-from-start-of-msg 'supercite) |
1418 | (eq mh-yank-from-start-of-msg 'autosupercite)) | |
1419 | (sc-cite-original)) | |
1420 | (mail-citation-hook | |
c3d9274a BW |
1421 | (run-hooks 'mail-citation-hook)) |
1422 | (mh-yank-hooks ;old hook name | |
1423 | (run-hooks 'mh-yank-hooks)) | |
1424 | (t | |
1425 | (or (bolp) (forward-line 1)) | |
bdcfe844 BW |
1426 | (while (< (point) (point-max)) |
1427 | (insert mh-ins-string) | |
1428 | (forward-line 1)) | |
1429 | (goto-char (point-min))))) ;leave point like sc-cite-original | |
c26cf6c8 | 1430 | |
c3d9274a | 1431 | ;;;###mh-autoload |
c26cf6c8 RS |
1432 | (defun mh-fully-kill-draft () |
1433 | "Kill the draft message file and the draft message buffer. | |
1434 | Use \\[kill-buffer] if you don't want to delete the draft message file." | |
1435 | (interactive) | |
1436 | (if (y-or-n-p "Kill draft message? ") | |
1437 | (let ((config mh-previous-window-config)) | |
c3d9274a BW |
1438 | (if (file-exists-p buffer-file-name) |
1439 | (delete-file buffer-file-name)) | |
1440 | (set-buffer-modified-p nil) | |
1441 | (kill-buffer (buffer-name)) | |
1442 | (message "") | |
1443 | (if config | |
1444 | (set-window-configuration config))) | |
c26cf6c8 RS |
1445 | (error "Message not killed"))) |
1446 | ||
a1b4049d | 1447 | (defun mh-current-fill-prefix () |
bdcfe844 | 1448 | "Return the `fill-prefix' on the current line as a string." |
a1b4049d BW |
1449 | (save-excursion |
1450 | (beginning-of-line) | |
1451 | ;; This assumes that the major-mode sets up adaptive-fill-regexp | |
1452 | ;; correctly such as mh-letter-mode or sendmail.el's mail-mode. But | |
1453 | ;; perhaps I should use the variable and simply inserts its value here, | |
1454 | ;; and set it locally in a let scope. --psg | |
1455 | (if (re-search-forward adaptive-fill-regexp nil t) | |
1456 | (match-string 0) | |
1457 | ""))) | |
1458 | ||
c3d9274a | 1459 | ;;;###mh-autoload |
a1b4049d BW |
1460 | (defun mh-open-line () |
1461 | "Insert a newline and leave point after it. | |
1462 | In addition, insert newline and quoting characters before text after point. | |
1463 | This is useful in breaking up paragraphs in replies." | |
1464 | (interactive) | |
1465 | (let ((column (current-column)) | |
a1b4049d BW |
1466 | (prefix (mh-current-fill-prefix))) |
1467 | (if (> (length prefix) column) | |
1468 | (message "Sorry, point seems to be within the line prefix") | |
1469 | (newline 2) | |
1470 | (insert prefix) | |
1471 | (while (> column (current-column)) | |
1472 | (insert " ")) | |
1473 | (forward-line -1)))) | |
847b8219 | 1474 | |
c3d9274a BW |
1475 | ;;;###mh-autoload |
1476 | (defun mh-letter-complete (arg) | |
1477 | "Perform completion on header field or word preceding point. | |
1478 | Alias completion is done within the mail header on selected fields and | |
1479 | by the function designated by `mh-letter-complete-function' elsewhere, | |
1480 | passing the prefix ARG if any." | |
1481 | (interactive "P") | |
1482 | (let ((case-fold-search t)) | |
1483 | (if (and (mh-in-header-p) | |
1484 | (save-excursion | |
1485 | (mh-header-field-beginning) | |
1486 | (looking-at "^.*\\(to\\|cc\\|from\\):"))) | |
1487 | (mh-alias-letter-expand-alias) | |
1488 | (funcall mh-letter-complete-function arg)))) | |
1489 | ||
a1b4049d | 1490 | ;;; Build the letter-mode keymap: |
bdcfe844 | 1491 | ;;; If this changes, modify mh-letter-mode-help-messages accordingly, above. |
a1b4049d | 1492 | (gnus-define-keys mh-letter-mode-map |
c3d9274a BW |
1493 | "\C-c?" mh-help |
1494 | "\C-c\C-c" mh-send-letter | |
1495 | "\C-c\C-d" mh-insert-identity | |
1496 | "\C-c\C-e" mh-edit-mhn | |
1497 | "\C-c\C-f\C-b" mh-to-field | |
1498 | "\C-c\C-f\C-c" mh-to-field | |
1499 | "\C-c\C-f\C-d" mh-to-field | |
1500 | "\C-c\C-f\C-f" mh-to-fcc | |
1501 | "\C-c\C-f\C-r" mh-to-field | |
1502 | "\C-c\C-f\C-s" mh-to-field | |
1503 | "\C-c\C-f\C-t" mh-to-field | |
1504 | "\C-c\C-fb" mh-to-field | |
1505 | "\C-c\C-fc" mh-to-field | |
1506 | "\C-c\C-fd" mh-to-field | |
1507 | "\C-c\C-ff" mh-to-fcc | |
1508 | "\C-c\C-fr" mh-to-field | |
1509 | "\C-c\C-fs" mh-to-field | |
1510 | "\C-c\C-ft" mh-to-field | |
1511 | "\C-c\C-i" mh-insert-letter | |
1512 | "\C-c\C-m\C-e" mh-mml-secure-message-encrypt-pgpmime | |
1513 | "\C-c\C-m\C-f" mh-compose-forward | |
1514 | "\C-c\C-m\C-i" mh-compose-insertion | |
1515 | "\C-c\C-m\C-m" mh-mml-to-mime | |
1516 | "\C-c\C-m\C-s" mh-mml-secure-message-sign-pgpmime | |
1517 | "\C-c\C-m\C-u" mh-revert-mhn-edit | |
1518 | "\C-c\C-me" mh-mml-secure-message-encrypt-pgpmime | |
1519 | "\C-c\C-mf" mh-compose-forward | |
1520 | "\C-c\C-mi" mh-compose-insertion | |
1521 | "\C-c\C-mm" mh-mml-to-mime | |
1522 | "\C-c\C-ms" mh-mml-secure-message-sign-pgpmime | |
1523 | "\C-c\C-mu" mh-revert-mhn-edit | |
1524 | "\C-c\C-o" mh-open-line | |
1525 | "\C-c\C-q" mh-fully-kill-draft | |
1526 | "\C-c\C-\\" mh-fully-kill-draft ;if no C-q | |
1527 | "\C-c\C-s" mh-insert-signature | |
1528 | "\C-c\C-^" mh-insert-signature ;if no C-s | |
1529 | "\C-c\C-w" mh-check-whom | |
1530 | "\C-c\C-y" mh-yank-cur-msg | |
1531 | "\M-\t" mh-letter-complete) | |
a1b4049d BW |
1532 | |
1533 | ;; "C-c /" prefix is used in mh-letter-mode by pgp.el and mailcrypt.el. | |
1534 | ||
bdcfe844 BW |
1535 | (provide 'mh-comp) |
1536 | ||
1537 | ;;; Local Variables: | |
c3d9274a | 1538 | ;;; indent-tabs-mode: nil |
bdcfe844 BW |
1539 | ;;; sentence-end-double-space: nil |
1540 | ;;; End: | |
60370d40 PJ |
1541 | |
1542 | ;;; mh-comp.el ends here |