]> code.delx.au - gnu-emacs/blob - lisp/mail/mh-comp.el
Upgraded to mh-e version 6.1.1.
[gnu-emacs] / lisp / mail / mh-comp.el
1 ;;; mh-comp.el --- mh-e functions for composing messages
2
3 ;; Copyright (C) 1993,1995,1997,2000,2001,2002 Free Software Foundation, Inc.
4
5 ;; Author: Bill Wohler <wohler@newt.com>
6 ;; Maintainer: Bill Wohler <wohler@newt.com>
7 ;; Keywords: mail
8 ;; See: mh-e.el
9
10 ;; This file is part of GNU Emacs.
11
12 ;; GNU Emacs is free software; you can redistribute it and/or modify
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
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
21
22 ;; You should have received a copy of the GNU General Public License
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.
26
27 ;;; Commentary:
28
29 ;; Internal support for mh-e package.
30
31 ;;; Change Log:
32
33 ;; $Id: mh-comp.el,v 1.56 2002/04/07 19:20:56 wohler Exp $
34
35 ;;; Code:
36
37 (provide 'mh-comp)
38 (require 'mh-e)
39 (require 'mh-utils)
40 (require 'gnus-util)
41 (require 'easymenu)
42
43 ;;; autoloads from mh-mime
44
45 (autoload 'mh-mhn-compose-insertion "mh-mime"
46 "Add a directive to insert a MIME message part from a file.
47 This is the typical way to insert non-text parts in a message.
48 See also \\[mh-edit-mhn]." t)
49
50 (autoload 'mh-mhn-compose-anon-ftp "mh-mime"
51 "Add a directive for a MIME anonymous ftp external body part.
52 This directive tells MH to include a reference to a
53 message/external-body part retrievable by anonymous FTP.
54 See also \\[mh-edit-mhn]." t)
55
56 (autoload 'mh-mhn-compose-external-compressed-tar "mh-mime"
57 "Add a directive to include a MIME reference to a compressed tar file.
58 The file should be available via anonymous ftp. This directive
59 tells MH to include a reference to a message/external-body part.
60 See also \\[mh-edit-mhn]." t)
61
62 (autoload 'mh-mhn-compose-forw "mh-mime"
63 "Add a forw directive to this message, to forward a message with MIME.
64 This directive tells MH to include another message in this one.
65 See also \\[mh-edit-mhn]." t)
66
67 (autoload 'mh-edit-mhn "mh-mime"
68 "Format the current draft for MIME, expanding any mhn directives.
69 Process the current draft with the mhn program, which,
70 using directives already inserted in the draft, fills in
71 all the MIME components and header fields.
72 This step should be done last just before sending the message.
73 The mhn program is part of MH version 6.8 or later.
74 The \\[mh-revert-mhn-edit] command undoes this command.
75 For assistance with creating mhn directives to insert
76 various types of components in a message, see
77 \\[mh-mhn-compose-insertion] (generic insertion from a file),
78 \\[mh-mhn-compose-anon-ftp] (external reference to file via anonymous ftp),
79 \\[mh-mhn-compose-external-compressed-tar] \
80 \(reference to compressed tar file via anonymous ftp), and
81 \\[mh-mhn-compose-forw] (forward message)." t)
82
83 (autoload 'mh-revert-mhn-edit "mh-mime"
84 "Undoes the effect of \\[mh-edit-mhn] by reverting to the backup file.
85 Optional non-nil argument means don't ask for confirmation." t)
86
87 ;;; Other Autoloads.
88
89 (autoload 'Info-goto-node "info")
90 (autoload 'mail-mode-fill-paragraph "sendmail")
91
92 ;;; Site customization (see also mh-utils.el):
93
94 (defgroup mh-compose nil
95 "Mh-e functions for composing messages."
96 :prefix "mh-"
97 :group 'mh)
98
99
100 (defvar mh-send-prog "send"
101 "Name of the MH send program.
102 Some sites need to change this because of a name conflict.")
103
104 (defvar mh-redist-full-contents nil
105 "Non-nil if the `dist' command needs whole letter for redistribution.
106 This is the case only when `send' is compiled with the BERK option.
107 If MH will not allow you to redist a previously redist'd msg, set to nil.")
108
109 (defvar mh-redist-background nil
110 "If non-nil redist will be done in background like send.
111 This allows transaction log to be visible if -watch, -verbose or -snoop are used.")
112
113 (defvar mh-note-repl "-"
114 "String whose first character is used to notate replied to messages.")
115
116 (defvar mh-note-forw "F"
117 "String whose first character is used to notate forwarded messages.")
118
119 (defvar mh-note-dist "R"
120 "String whose first character is used to notate redistributed messages.")
121
122 (defvar mh-yank-hooks nil
123 "Obsolete hook for modifying a citation just inserted in the mail buffer.
124 Each hook function can find the citation between point and mark.
125 And each hook function should leave point and mark around the citation
126 text as modified.
127
128 This is a normal hook, misnamed for historical reasons.
129 It is semi-obsolete and is only used if `mail-citation-hook' is nil.")
130
131 (defvar mail-citation-hook nil
132 "*Hook for modifying a citation just inserted in the mail buffer.
133 Each hook function can find the citation between point and mark.
134 And each hook function should leave point and mark around the citation
135 text as modified.
136
137 If this hook is entirely empty (nil), the text of the message is inserted
138 with `mh-ins-buf-prefix' prefixed to each line.
139
140 See also the variable `mh-yank-from-start-of-msg', which controls how
141 much of the message passed to the hook.")
142
143 ;;; Personal preferences:
144
145 (defcustom mh-insert-x-mailer-p t
146 "*If t, append an X-Mailer field to the header."
147 :type 'boolean
148 :group 'mh-compose)
149
150 (defvar mh-x-mailer-string nil
151 "*String containing the contents of the X-Mailer header field.
152 If nil, this variable is initialized to show the version of mh-e, Emacs, and
153 MH the first time a message is composed.")
154
155 (defcustom mh-delete-yanked-msg-window nil
156 "*Controls window display when a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg].
157 If non-nil, yanking the current message into a draft letter deletes any
158 windows displaying the message."
159 :type 'boolean
160 :group 'mh-compose)
161
162 (defcustom mh-yank-from-start-of-msg t
163 "*Controls which part of a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg].
164 If non-nil, include the entire message. If the symbol `body', then yank the
165 message minus the header. If nil, yank only the portion of the message
166 following the point. If the show buffer has a region, this variable is
167 ignored."
168 :type '(choice (const :tag "Below point" nil)
169 (const :tag "Without header" body)
170 (other :tag "Entire message" t))
171 :group 'mh-compose)
172
173 (defcustom mh-ins-buf-prefix "> "
174 "*String to put before each non-blank line of a yanked or inserted message.
175 \\<mh-letter-mode-map>Used when the message is inserted into an outgoing letter
176 by \\[mh-insert-letter] or \\[mh-yank-cur-msg]."
177 :type 'string
178 :group 'mh-compose)
179
180 (defcustom mh-reply-default-reply-to nil
181 "*Sets the person or persons to whom a reply will be sent.
182 If nil, prompt for recipient. If non-nil, then \\<mh-folder-mode-map>`\\[mh-reply]' will use this
183 value and it should be one of \"from\", \"to\", \"cc\", or \"all\".
184 The values \"cc\" and \"all\" do the same thing."
185 :type '(choice (const :tag "Prompt" nil)
186 (const "from") (const "to")
187 (const "cc") (const "all"))
188 :group 'mh-compose)
189
190 (defcustom mh-signature-file-name "~/.signature"
191 "*Name of file containing the user's signature.
192 Inserted into message by \\<mh-letter-mode-map>\\[mh-insert-signature]."
193 :type 'file
194 :group 'mh-compose)
195
196 (defcustom mh-forward-subject-format "%s: %s"
197 "*Format to generate the Subject: line contents for a forwarded message.
198 The two string arguments to the format are the sender of the original
199 message and the original subject line."
200 :type 'string
201 :group 'mh-compose)
202
203 (defvar mh-comp-formfile "components"
204 "Name of file to be used as a skeleton for composing messages.
205 Default is \"components\". If not an absolute file name, the file
206 is searched for first in the user's MH directory, then in the
207 system MH lib directory.")
208
209 (defvar mh-repl-formfile "replcomps"
210 "Name of file to be used as a skeleton for replying to messages.
211 Default is \"replcomps\". If not an absolute file name, the file
212 is searched for first in the user's MH directory, then in the
213 system MH lib directory.")
214
215 (defvar mh-repl-group-formfile "replgroupcomps"
216 "Name of file to be used as a skeleton for replying to the sender and all recipients of a message.
217 Only used if `mh-nmh-p' is non-nil. Default is \"replgroupcomps\". If not an
218 absolute file name, the file is searched for first in the user's MH directory,
219 then in the system MH lib directory.")
220
221 (defcustom mh-reply-show-message-p t
222 "*Whether the show buffer is displayed using \\<mh-letter-mode-map>\\[mh-reply].
223
224 The setting of this variable determines whether the MH `show-buffer' is
225 displayed with the current message when using `mh-reply' without a prefix
226 argument. Set it to nil if you already include the message automatically
227 in your draft using
228 repl: -filter repl.filter
229 in your ~/.mh_profile file."
230 :type 'boolean
231 :group 'mh-compose)
232
233 (defcustom mh-letter-fill-column 72
234 "*Fill column to use in `mh-letter-mode'.
235 This is usually less than in other text modes because email messages get
236 quoted by some prefix (sometimes many times) when they are replied-to,
237 and it's best to avoid quoted lines that span more than 80 columns."
238 :type 'integer
239 :group 'mh-compose)
240
241 ;;; Hooks:
242
243 (defcustom mh-letter-mode-hook nil
244 "Invoked in `mh-letter-mode' on a new letter."
245 :type 'hook
246 :group 'mh-compose)
247
248 (defcustom mh-compose-letter-function nil
249 "Invoked when setting up a letter draft.
250 It is passed three arguments: TO recipients, SUBJECT, and CC recipients."
251 :type '(choice (const nil) function)
252 :group 'mh-compose)
253
254 (defcustom mh-before-send-letter-hook nil
255 "Invoked at the beginning of the \\<mh-letter-mode-map>\\[mh-send-letter] command."
256 :type 'hook
257 :group 'mh-compose)
258
259 (defvar mh-rejected-letter-start
260 (regexp-opt
261 '("^Content-Type: message/rfc822$" ;MIME MDN
262 "^ ----- Unsent message follows -----$" ;from sendmail V5
263 "^ ----- Original message follows -----$" ;from sendmail V8
264 "^------- Unsent Draft$" ;from MH itself
265 "^---------- Original Message ----------$" ;from zmailer
266 "^ --- The unsent message follows ---$" ;from AIX mail system
267 "^ Your message follows:$" ;from MMDF-II
268 "^Content-Description: Returned Content$" ;1993 KJ sendmail
269 )))
270
271 (defvar mh-new-draft-cleaned-headers
272 "^Date:\\|^Received:\\|^Message-Id:\\|^From:\\|^Sender:\\|^Errors-To:\\|^Delivery-Date:\\|^Return-Path:"
273 "Regexp of header lines to remove before offering a message as a new draft.
274 Used by the \\<mh-folder-mode-map>`\\[mh-edit-again]' and `\\[mh-extract-rejected-mail]' commands.")
275
276 (defvar mh-to-field-choices '(("t" . "To:") ("s" . "Subject:") ("c" . "Cc:")
277 ("b" . "Bcc:") ("f" . "Fcc:") ("r" . "From:")
278 ("d" . "Dcc:"))
279 "Alist of (final-character . field-name) choices for `mh-to-field'.")
280
281 (defvar mh-letter-mode-map (copy-keymap text-mode-map)
282 "Keymap for composing mail.")
283
284 (defvar mh-letter-mode-syntax-table nil
285 "Syntax table used by mh-e while in MH-Letter mode.")
286
287 (if mh-letter-mode-syntax-table
288 ()
289 (setq mh-letter-mode-syntax-table
290 (make-syntax-table text-mode-syntax-table))
291 (modify-syntax-entry ?% "." mh-letter-mode-syntax-table))
292
293
294 ;;;###autoload
295 (defun mh-smail ()
296 "Compose and send mail with the MH mail system.
297 This function is an entry point to mh-e, the Emacs front end
298 to the MH mail system.
299
300 See documentation of `\\[mh-send]' for more details on composing mail."
301 (interactive)
302 (mh-find-path)
303 (call-interactively 'mh-send))
304
305
306 (defvar mh-error-if-no-draft nil) ;raise error over using old draft
307
308
309 ;;;###autoload
310 (defun mh-smail-batch (&optional to subject other-headers &rest ignored)
311 "Set up a mail composition draft with the MH mail system.
312 This function is an entry point to mh-e, the Emacs front end
313 to the MH mail system. This function does not prompt the user
314 for any header fields, and thus is suitable for use by programs
315 that want to create a mail buffer.
316 Users should use `\\[mh-smail]' to compose mail.
317 Optional arguments for setting certain fields include TO, SUBJECT, and
318 OTHER-HEADERS."
319 (mh-find-path)
320 (let ((mh-error-if-no-draft t))
321 (mh-send (or to "") "" (or subject ""))))
322
323 ;; XEmacs needs this:
324 ;;;###autoload
325 (defun mh-user-agent-compose (&optional to subject other-headers continue
326 switch-function yank-action
327 send-actions)
328 "Set up mail composition draft with the MH mail system.
329 This is `mail-user-agent' entry point to mh-e.
330
331 The optional arguments TO and SUBJECT specify recipients and the
332 initial Subject field, respectively.
333
334 OTHER-HEADERS is an alist specifying additional
335 header fields. Elements look like (HEADER . VALUE) where both
336 HEADER and VALUE are strings.
337
338 CONTINUE, SWITCH-FUNCTION, YANK-ACTION and SEND-ACTIONS are ignored."
339 (mh-find-path)
340 (let ((mh-error-if-no-draft t))
341 (mh-send to "" subject)
342 (while other-headers
343 (mh-insert-fields (concat (car (car other-headers)) ":")
344 (cdr (car other-headers)))
345 (setq other-headers (cdr other-headers)))))
346
347 (defun mh-edit-again (msg)
348 "Clean up a draft or a message MSG previously sent and make it resendable.
349 Default is the current message.
350 The variable `mh-new-draft-cleaned-headers' specifies the headers to remove.
351 See also documentation for `\\[mh-send]' function."
352 (interactive (list (mh-get-msg-num t)))
353 (let* ((from-folder mh-current-folder)
354 (config (current-window-configuration))
355 (draft
356 (cond ((and mh-draft-folder (equal from-folder mh-draft-folder))
357 (pop-to-buffer (find-file-noselect (mh-msg-filename msg)) t)
358 (rename-buffer (format "draft-%d" msg))
359 (buffer-name))
360 (t
361 (mh-read-draft "clean-up" (mh-msg-filename msg) nil)))))
362 (mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil)
363 (mh-insert-header-separator)
364 (goto-char (point-min))
365 (save-buffer)
366 (mh-compose-and-send-mail draft "" from-folder nil nil nil nil nil nil
367 config)))
368
369
370 (defun mh-extract-rejected-mail (msg)
371 "Extract message MSG returned by the mail system and make it resendable.
372 Default is the current message. The variable `mh-new-draft-cleaned-headers'
373 gives the headers to clean out of the original message.
374 See also documentation for `\\[mh-send]' function."
375 (interactive (list (mh-get-msg-num t)))
376 (let ((from-folder mh-current-folder)
377 (config (current-window-configuration))
378 (draft (mh-read-draft "extraction" (mh-msg-filename msg) nil)))
379 (goto-char (point-min))
380 (cond ((re-search-forward mh-rejected-letter-start nil t)
381 (skip-chars-forward " \t\n")
382 (delete-region (point-min) (point))
383 (mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil))
384 (t
385 (message "Does not appear to be a rejected letter.")))
386 (mh-insert-header-separator)
387 (goto-char (point-min))
388 (save-buffer)
389 (mh-compose-and-send-mail draft "" from-folder msg
390 (mh-get-header-field "To:")
391 (mh-get-header-field "From:")
392 (mh-get-header-field "Cc:")
393 nil nil config)))
394
395
396 (defun mh-forward (to cc &optional msg-or-seq)
397 "Forward displayed message to recipients TO and CC.
398 If optional prefix argument MSG-OR-SEQ provided, then prompt for the message
399 sequence. See also documentation for `\\[mh-send]' function."
400 (interactive (list (mh-read-address "To: ")
401 (mh-read-address "Cc: ")
402 (if current-prefix-arg
403 (mh-read-seq-default "Forward" t)
404 (mh-get-msg-num t))))
405 (or msg-or-seq
406 (setq msg-or-seq (mh-get-msg-num t)))
407 (let* ((folder mh-current-folder)
408 (config (current-window-configuration))
409 (fwd-msg-file (mh-msg-filename (if (numberp msg-or-seq)
410 msg-or-seq
411 (car (mh-seq-to-msgs msg-or-seq)))
412 folder))
413 ;; forw always leaves file in "draft" since it doesn't have -draft
414 (draft-name (expand-file-name "draft" mh-user-path))
415 (draft (cond ((or (not (file-exists-p draft-name))
416 (y-or-n-p "The file 'draft' exists. Discard it? "))
417 (mh-exec-cmd "forw" "-build"
418 mh-current-folder msg-or-seq)
419 (prog1
420 (mh-read-draft "" draft-name t)
421 (mh-insert-fields "To:" to "Cc:" cc)
422 (save-buffer)))
423 (t
424 (mh-read-draft "" draft-name nil)))))
425 (let (orig-from
426 orig-subject)
427 (save-excursion
428 (set-buffer (get-buffer-create mh-temp-buffer))
429 (erase-buffer)
430 (insert-file-contents fwd-msg-file)
431 (setq orig-from (mh-get-header-field "From:"))
432 (setq orig-subject (mh-get-header-field "Subject:")))
433 (let ((forw-subject
434 (mh-forwarded-letter-subject orig-from orig-subject))
435 (mail-header-separator mh-mail-header-separator))
436 (mh-insert-fields "Subject:" forw-subject)
437 (goto-char (point-min))
438 (if (re-search-forward "^------- Forwarded Message" nil t)
439 (forward-line -1)
440 (re-search-forward mail-header-separator)
441 (forward-line 1))
442 (delete-other-windows)
443 (if (numberp msg-or-seq)
444 (mh-add-msgs-to-seq msg-or-seq 'forwarded t)
445 (mh-add-msgs-to-seq (mh-seq-to-msgs msg-or-seq) 'forwarded t))
446 (mh-compose-and-send-mail draft "" folder msg-or-seq
447 to forw-subject cc
448 mh-note-forw "Forwarded:"
449 config)))))
450
451 (defun mh-forwarded-letter-subject (from subject)
452 ;; Return a Subject suitable for a forwarded message.
453 ;; Original message has headers FROM and SUBJECT.
454 (let ((addr-start (string-match "<" from))
455 (comment (string-match "(" from)))
456 (cond ((and addr-start (> addr-start 0))
457 ;; Full Name <luser@host>
458 (setq from (substring from 0 (1- addr-start))))
459 (comment
460 ;; luser@host (Full Name)
461 (setq from (substring from (1+ comment) (1- (length from)))))))
462 (format mh-forward-subject-format from subject))
463
464
465 ;;;###autoload
466 (defun mh-smail-other-window ()
467 "Compose and send mail in other window with the MH mail system.
468 This function is an entry point to mh-e, the Emacs front end
469 to the MH mail system.
470
471 See documentation of `\\[mh-send]' for more details on composing mail."
472 (interactive)
473 (mh-find-path)
474 (call-interactively 'mh-send-other-window))
475
476
477 (defun mh-redistribute (to cc &optional msg)
478 "Redistribute displayed message to recipients TO and CC.
479 Use optional argument MSG to redistribute another message.
480 Depending on how your copy of MH was compiled, you may need to change the
481 setting of the variable `mh-redist-full-contents'. See its documentation."
482 (interactive (list (mh-read-address "Redist-To: ")
483 (mh-read-address "Redist-Cc: ")
484 (mh-get-msg-num t)))
485 (or msg
486 (setq msg (mh-get-msg-num t)))
487 (save-window-excursion
488 (let ((folder mh-current-folder)
489 (draft (mh-read-draft "redistribution"
490 (if mh-redist-full-contents
491 (mh-msg-filename msg)
492 nil)
493 nil)))
494 (mh-goto-header-end 0)
495 (insert "Resent-To: " to "\n")
496 (if (not (equal cc "")) (insert "Resent-cc: " cc "\n"))
497 (mh-clean-msg-header (point-min)
498 "^Message-Id:\\|^Received:\\|^Return-Path:\\|^Sender:\\|^Date:\\|^From:"
499 nil)
500 (save-buffer)
501 (message "Redistributing...")
502 (if (not mh-redist-background)
503 (if mh-redist-full-contents
504 (call-process "/bin/sh" nil 0 nil "-c"
505 (format "mhdist=1 mhaltmsg=%s %s -push %s"
506 buffer-file-name
507 (expand-file-name mh-send-prog mh-progs)
508 buffer-file-name))
509 (call-process "/bin/sh" nil 0 nil "-c"
510 (format "mhdist=1 mhaltmsg=%s mhannotate=1 %s -push %s"
511 (mh-msg-filename msg folder)
512 (expand-file-name mh-send-prog mh-progs)
513 buffer-file-name))))
514 (mh-annotate-msg msg folder mh-note-dist
515 "-component" "Resent:"
516 "-text" (format "\"%s %s\"" to cc))
517 (if mh-redist-background
518 (mh-exec-cmd-daemon "/bin/sh" "-c"
519 (format "mhdist=1 mhaltmsg=%s %s %s %s"
520 (if mh-redist-full-contents
521 buffer-file-name
522 (mh-msg-filename msg folder))
523 (if mh-redist-full-contents
524 ""
525 "mhannotate=1")
526 (mh-expand-file-name "send" mh-progs)
527 buffer-file-name)))
528 (kill-buffer draft)
529 (message "Redistributing...done"))))
530
531
532 (defun mh-reply (message &optional includep)
533 "Reply to MESSAGE (default: current message).
534 If optional prefix argument INCLUDEP provided, then include the message
535 in the reply using filter `mhl.reply' in your MH directory.
536 Prompts for type of addresses to reply to:
537 from sender only,
538 to sender and primary recipients,
539 cc/all sender and all recipients.
540 If the file named by `mh-repl-formfile' exists, it is used as a skeleton
541 for the reply. See also documentation for `\\[mh-send]' function."
542 (interactive (list (mh-get-msg-num t) current-prefix-arg))
543 (let ((minibuffer-help-form
544 "from => Sender only\nto => Sender and primary recipients\ncc or all => Sender and all recipients"))
545 (let* ((reply-to (or mh-reply-default-reply-to
546 (completing-read "Reply to whom: "
547 '(("from") ("to") ("cc") ("all"))
548 nil
549 t)))
550 (folder mh-current-folder)
551 (show-buffer mh-show-buffer)
552 (config (current-window-configuration))
553 (group-reply (or (equal reply-to "cc") (equal reply-to "all")))
554 (form-file (cond ((and mh-nmh-p group-reply
555 (stringp mh-repl-group-formfile))
556 mh-repl-group-formfile)
557 ((stringp mh-repl-formfile) mh-repl-formfile)
558 (t nil))))
559 (message "Composing a reply...")
560 (mh-exec-cmd "repl" "-build" "-noquery" "-nodraftfolder"
561 (if form-file
562 (list "-form" form-file))
563 mh-current-folder message
564 (cond ((or (equal reply-to "from") (equal reply-to ""))
565 '("-nocc" "all"))
566 ((equal reply-to "to")
567 '("-cc" "to"))
568 (group-reply (if mh-nmh-p
569 '("-group" "-nocc" "me")
570 '("-cc" "all" "-nocc" "me"))))
571 (if includep
572 '("-filter" "mhl.reply")))
573 (let ((draft (mh-read-draft "reply"
574 (expand-file-name "reply" mh-user-path)
575 t)))
576 (delete-other-windows)
577 (save-buffer)
578
579 (let ((to (mh-get-header-field "To:"))
580 (subject (mh-get-header-field "Subject:"))
581 (cc (mh-get-header-field "Cc:")))
582 (goto-char (point-min))
583 (mh-goto-header-end 1)
584 (or includep
585 (not mh-reply-show-message-p)
586 (mh-in-show-buffer (show-buffer)
587 (mh-display-msg message folder)))
588 (mh-add-msgs-to-seq message 'answered t)
589 (message "Composing a reply...done")
590 (mh-compose-and-send-mail draft "" folder message to subject cc
591 mh-note-repl "Replied:" config))))))
592
593
594 (defun mh-send (to cc subject)
595 "Compose and send a letter.
596
597 Do not call this function from outside mh-e; use \\[mh-smail] instead.
598
599 The file named by `mh-comp-formfile' will be used as the form.
600 The letter is composed in `mh-letter-mode'; see its documentation for more
601 details.
602 If `mh-compose-letter-function' is defined, it is called on the draft and
603 passed three arguments: TO, CC, and SUBJECT."
604 (interactive (list
605 (mh-read-address "To: ")
606 (mh-read-address "Cc: ")
607 (read-string "Subject: ")))
608 (let ((config (current-window-configuration)))
609 (delete-other-windows)
610 (mh-send-sub to cc subject config)))
611
612
613 (defun mh-send-other-window (to cc subject)
614 "Compose and send a letter in another window.
615
616 Do not call this function from outside mh-e; use \\[mh-smail-other-window]
617 instead.
618
619 The file named by `mh-comp-formfile' will be used as the form.
620 The letter is composed in `mh-letter-mode'; see its documentation for more
621 details.
622 If `mh-compose-letter-function' is defined, it is called on the draft and
623 passed three arguments: TO, CC, and SUBJECT."
624 (interactive (list
625 (mh-read-address "To: ")
626 (mh-read-address "Cc: ")
627 (read-string "Subject: ")))
628 (let ((pop-up-windows t))
629 (mh-send-sub to cc subject (current-window-configuration))))
630
631
632 (defun mh-send-sub (to cc subject config)
633 ;; Do the real work of composing and sending a letter.
634 ;; Expects the TO, CC, and SUBJECT fields as arguments.
635 ;; CONFIG is the window configuration before sending mail.
636 (let ((folder mh-current-folder)
637 (msg-num (mh-get-msg-num nil)))
638 (message "Composing a message...")
639 (let ((draft (mh-read-draft
640 "message"
641 (let (components)
642 (cond
643 ((file-exists-p
644 (setq components
645 (expand-file-name mh-comp-formfile mh-user-path)))
646 components)
647 ((file-exists-p
648 (setq components
649 (expand-file-name mh-comp-formfile mh-lib)))
650 components)
651 ((file-exists-p
652 (setq components
653 (expand-file-name mh-comp-formfile
654 ;; What is this mh-etc ?? -sm
655 (and (boundp 'mh-etc) mh-etc))))
656 components)
657 (t
658 (error (format "Can't find components file \"%s\""
659 components)))))
660 nil)))
661 (mh-insert-fields "To:" to "Subject:" subject "Cc:" cc)
662 (goto-char (point-max))
663 (message "Composing a message...done")
664 (mh-compose-and-send-mail draft "" folder msg-num
665 to subject cc
666 nil nil config))))
667
668
669 (defun mh-read-draft (use initial-contents delete-contents-file)
670 ;; Read draft file into a draft buffer and make that buffer the current one.
671 ;; USE is a message used for prompting about the intended use of the message.
672 ;; INITIAL-CONTENTS is filename that is read into an empty buffer, or NIL
673 ;; if buffer should not be modified. Delete the initial-contents file if
674 ;; DELETE-CONTENTS-FILE flag is set.
675 ;; Returns the draft folder's name.
676 ;; If the draft folder facility is enabled in ~/.mh_profile, a new buffer is
677 ;; used each time and saved in the draft folder. The draft file can then be
678 ;; reused.
679 (cond (mh-draft-folder
680 (let ((orig-default-dir default-directory)
681 (draft-file-name (mh-new-draft-name)))
682 (pop-to-buffer (generate-new-buffer
683 (format "draft-%s"
684 (file-name-nondirectory draft-file-name))))
685 (condition-case ()
686 (insert-file-contents draft-file-name t)
687 (file-error))
688 (setq default-directory orig-default-dir)))
689 (t
690 (let ((draft-name (expand-file-name "draft" mh-user-path)))
691 (pop-to-buffer "draft") ; Create if necessary
692 (if (buffer-modified-p)
693 (if (y-or-n-p "Draft has been modified; kill anyway? ")
694 (set-buffer-modified-p nil)
695 (error "Draft preserved")))
696 (setq buffer-file-name draft-name)
697 (clear-visited-file-modtime)
698 (unlock-buffer)
699 (cond ((and (file-exists-p draft-name)
700 (not (equal draft-name initial-contents)))
701 (insert-file-contents draft-name)
702 (delete-file draft-name))))))
703 (cond ((and initial-contents
704 (or (zerop (buffer-size))
705 (if (y-or-n-p
706 (format "A draft exists. Use for %s? " use))
707 (if mh-error-if-no-draft
708 (error "A prior draft exists"))
709 t)))
710 (erase-buffer)
711 (insert-file-contents initial-contents)
712 (if delete-contents-file (delete-file initial-contents))))
713 (auto-save-mode 1)
714 (if mh-draft-folder
715 (save-buffer)) ; Do not reuse draft name
716 (buffer-name))
717
718
719 (defun mh-new-draft-name ()
720 ;; Returns the pathname of folder for draft messages.
721 (save-excursion
722 (mh-exec-cmd-quiet t "mhpath" mh-draft-folder "new")
723 (buffer-substring (point-min) (1- (point-max)))))
724
725
726 (defun mh-annotate-msg (msg buffer note &rest args)
727 ;; Mark the MESSAGE in BUFFER listing with the character NOTE and annotate
728 ;; the saved message with ARGS.
729 (apply 'mh-exec-cmd "anno" buffer msg args)
730 (save-excursion
731 (cond ((get-buffer buffer) ; Buffer may be deleted
732 (set-buffer buffer)
733 (if (symbolp msg)
734 (mh-notate-seq msg note (1+ mh-cmd-note))
735 (mh-notate msg note (1+ mh-cmd-note)))))))
736
737
738 (defun mh-insert-fields (&rest name-values)
739 ;; Insert the NAME-VALUE pairs in the current buffer.
740 ;; If field NAME exists, append VALUE to it.
741 ;; Do not insert any pairs whose value is the empty string.
742 (let ((case-fold-search t))
743 (while name-values
744 (let ((field-name (car name-values))
745 (value (car (cdr name-values))))
746 (cond ((equal value "")
747 nil)
748 ((mh-position-on-field field-name)
749 (insert " " (or value "")))
750 (t
751 (insert field-name " " value "\n")))
752 (setq name-values (cdr (cdr name-values)))))))
753
754
755 (defun mh-position-on-field (field &optional ignore)
756 ;; Move to the end of the FIELD in the header.
757 ;; Move to end of entire header if FIELD not found.
758 ;; Returns non-nil iff FIELD was found.
759 ;; The optional second arg is for pre-version 4 compatibility.
760 (cond ((mh-goto-header-field field)
761 (mh-header-field-end)
762 t)
763 ((mh-goto-header-end 0)
764 nil)))
765
766
767 (defun mh-get-header-field (field)
768 ;; Find and return the body of FIELD in the mail header.
769 ;; Returns the empty string if the field is not in the header of the
770 ;; current buffer.
771 (if (mh-goto-header-field field)
772 (progn
773 (skip-chars-forward " \t") ;strip leading white space in body
774 (let ((start (point)))
775 (mh-header-field-end)
776 (buffer-substring start (point))))
777 ""))
778
779 (fset 'mh-get-field 'mh-get-header-field) ;mh-e 4 compatibility
780
781 (defun mh-goto-header-field (field)
782 ;; Move to FIELD in the message header.
783 ;; Move to the end of the FIELD name, which should end in a colon.
784 ;; Returns T if found, NIL if not.
785 (goto-char (point-min))
786 (let ((case-fold-search t)
787 (headers-end (save-excursion
788 (mh-goto-header-end 0)
789 (point))))
790 (re-search-forward (format "^%s" field) headers-end t)))
791
792 (defun mh-goto-header-end (arg)
793 ;; Find the end of the message header in the current buffer and position
794 ;; the cursor at the ARG'th newline after the header.
795 (if (re-search-forward "^-*$" nil nil)
796 (forward-line arg)))
797
798
799 (defun mh-read-address (prompt)
800 ;; Read a To: or Cc: address, prompting in the minibuffer with PROMPT.
801 ;; May someday do completion on aliases.
802 (read-string prompt))
803
804 \f
805
806 ;;; Mode for composing and sending a draft message.
807
808 (defvar mh-sent-from-folder nil) ;Folder of msg assoc with this letter.
809
810 (defvar mh-sent-from-msg nil) ;Number of msg assoc with this letter.
811
812 (defvar mh-send-args nil) ;Extra args to pass to "send" command.
813
814 (defvar mh-annotate-char nil) ;Character to use to annotate mh-sent-from-msg.
815
816 (defvar mh-annotate-field nil) ;Field name for message annotation.
817
818 (put 'mh-letter-mode 'mode-class 'special)
819
820 ;;;###autoload
821 (define-derived-mode mh-letter-mode text-mode "MH-Letter"
822 "Mode for composing letters in mh-e.\\<mh-letter-mode-map>
823
824 When you have finished composing, type \\[mh-send-letter] to send the message
825 using the MH mail handling system.
826
827 If MH MIME directives are added manually, you must first run \\[mh-edit-mhn]
828 before sending the message. MIME directives that are added by mh-e commands
829 such as \\[mh-mhn-compose-insertion] are processed automatically when the
830 message is sent.
831
832 Options that control this mode can be changed with
833 \\[customize-group]; specify the \"mh-compose\" group.
834
835 When a message is composed, the hooks `text-mode-hook' and
836 `mh-letter-mode-hook' are run.
837
838 \\{mh-letter-mode-map}"
839
840 (or mh-user-path (mh-find-path))
841 (make-local-variable 'mh-send-args)
842 (make-local-variable 'mh-annotate-char)
843 (make-local-variable 'mh-annotate-field)
844 (make-local-variable 'mh-previous-window-config)
845 (make-local-variable 'mh-sent-from-folder)
846 (make-local-variable 'mh-sent-from-msg)
847 (make-local-variable 'mail-header-separator)
848 (setq mail-header-separator mh-mail-header-separator) ;override sendmail.el
849
850 ;; From sendmail.el for proper paragraph fill
851 ;; sendmail.el also sets a normal-auto-fill-function (not done here)
852 (make-local-variable 'paragraph-separate)
853 (make-local-variable 'paragraph-start)
854 (make-local-variable 'fill-paragraph-function)
855 (setq fill-paragraph-function 'mail-mode-fill-paragraph)
856 (make-local-variable 'adaptive-fill-regexp)
857 (setq adaptive-fill-regexp
858 (concat adaptive-fill-regexp
859 "\\|[ \t]*[-[:alnum:]]*>+[ \t]*"))
860 (make-local-variable 'adaptive-fill-first-line-regexp)
861 (setq adaptive-fill-first-line-regexp
862 (concat adaptive-fill-first-line-regexp
863 "\\|[ \t]*[-[:alnum:]]*>+[ \t]*"))
864 ;; `-- ' precedes the signature. `-----' appears at the start of the
865 ;; lines that delimit forwarded messages.
866 ;; Lines containing just >= 3 dashes, perhaps after whitespace,
867 ;; are also sometimes used and should be separators.
868 (setq paragraph-start (concat (regexp-quote mail-header-separator)
869 "\\|\t*\\([-|#;>* ]\\|(?[0-9]+[.)]\\)+$"
870 "\\|[ \t]*[[:alnum:]]*>+[ \t]*$\\|[ \t]*$\\|"
871 "-- $\\|---+$\\|"
872 page-delimiter))
873 (setq paragraph-separate paragraph-start)
874 ;; --- End of code from sendmail.el ---
875
876 (if (and (boundp 'tool-bar-mode) tool-bar-mode)
877 (set (make-local-variable 'tool-bar-map) mh-letter-tool-bar-map))
878 (make-local-variable 'font-lock-defaults)
879 (cond
880 ((equal mh-highlight-citation-p 'font-lock)
881 (setq font-lock-defaults '(mh-show-font-lock-keywords-with-cite t)))
882 ((equal mh-highlight-citation-p 'gnus)
883 (setq font-lock-defaults '(mh-show-font-lock-keywords t))
884 (mh-gnus-article-highlight-citation))
885 (t
886 (setq font-lock-defaults '(mh-show-font-lock-keywords t))))
887 (easy-menu-add mh-letter-menu)
888 ;; See if a "forw: -mime" message containing a MIME composition.
889 ;; mode clears local vars, so can't do this in mh-forward.
890 (save-excursion
891 (goto-char (point-min))
892 (when (and (re-search-forward mail-header-separator nil t)
893 (= 0 (forward-line 1))
894 (looking-at "^#forw"))
895 (require 'mh-mime) ;Need mh-mhn-compose-insert-p local var
896 (setq mh-mhn-compose-insert-p t)))
897 (setq fill-column mh-letter-fill-column)
898 ;; if text-mode-hook turned on auto-fill, tune it for messages
899 (when auto-fill-function
900 (make-local-variable 'auto-fill-function)
901 (setq auto-fill-function 'mh-auto-fill-for-letter)))
902
903
904 (defun mh-auto-fill-for-letter ()
905 ;; Auto-fill in letters treats the header specially by inserting a tab
906 ;; before continuation line.
907 (if (mh-in-header-p)
908 (let ((fill-prefix "\t"))
909 (do-auto-fill))
910 (do-auto-fill)))
911
912
913 (defun mh-insert-header-separator ()
914 ;; Inserts `mh-mail-header-separator', if absent.
915 (save-excursion
916 (goto-char (point-min))
917 (rfc822-goto-eoh)
918 (if (looking-at "$")
919 (insert mh-mail-header-separator))))
920
921 (defun mh-to-field ()
922 "Move point to the end of a specified header field.
923 The field is indicated by the previous keystroke (the last keystroke
924 of the command) according to the list in the variable `mh-to-field-choices'.
925 Create the field if it does not exist. Set the mark to point before moving."
926 (interactive)
927 (expand-abbrev)
928 (let ((target (cdr (or (assoc (char-to-string (logior last-input-char ?`))
929 mh-to-field-choices)
930 ;; also look for a char for version 4 compat
931 (assoc (logior last-input-char ?`) mh-to-field-choices))))
932 (case-fold-search t))
933 (push-mark)
934 (cond ((mh-position-on-field target)
935 (let ((eol (point)))
936 (skip-chars-backward " \t")
937 (delete-region (point) eol))
938 (if (and (not (eq (logior last-input-char ?`) ?s))
939 (save-excursion
940 (backward-char 1)
941 (not (looking-at "[:,]"))))
942 (insert ", ")
943 (insert " ")))
944 (t
945 (if (mh-position-on-field "To:")
946 (forward-line 1))
947 (insert (format "%s \n" target))
948 (backward-char 1)))))
949
950
951 (defun mh-to-fcc (&optional folder)
952 "Insert an Fcc: FOLDER field in the current message.
953 Prompt for the field name with a completion list of the current folders."
954 (interactive)
955 (or folder
956 (setq folder (mh-prompt-for-folder
957 "Fcc"
958 (or (and mh-default-folder-for-message-function
959 (save-excursion
960 (goto-char (point-min))
961 (funcall mh-default-folder-for-message-function)))
962 "")
963 t)))
964 (let ((last-input-char ?\C-f))
965 (expand-abbrev)
966 (save-excursion
967 (mh-to-field)
968 (insert (if (mh-folder-name-p folder)
969 (substring folder 1)
970 folder)))))
971
972
973 (defun mh-insert-signature ()
974 "Insert the file named by `mh-signature-file-name' at point."
975 (interactive)
976 (insert-file-contents mh-signature-file-name)
977 (force-mode-line-update))
978
979
980 (defun mh-check-whom ()
981 "Verify recipients of the current letter, showing expansion of any aliases."
982 (interactive)
983 (let ((file-name buffer-file-name))
984 (save-buffer)
985 (message "Checking recipients...")
986 (mh-in-show-buffer ("*Recipients*")
987 (bury-buffer (current-buffer))
988 (erase-buffer)
989 (mh-exec-cmd-output "whom" t file-name))
990 (message "Checking recipients...done")))
991
992 \f
993
994 ;;; Routines to compose and send a letter.
995
996 (defun mh-insert-x-mailer ()
997 ;; Appends an X-Mailer field to the header.
998 ;; The versions of mh-e, Emacs, and MH are shown.
999
1000 ;; Lazily initialize mh-x-mailer-string.
1001 (when (null mh-x-mailer-string)
1002 (save-window-excursion
1003 (mh-version)
1004 (set-buffer mh-temp-buffer)
1005 (if mh-nmh-p
1006 (search-forward-regexp "^nmh-\\(\\S +\\)")
1007 (search-forward-regexp "^MH \\(\\S +\\)" nil t))
1008 (let ((x-mailer-mh (buffer-substring (match-beginning 1) (match-end 1))))
1009 (setq mh-x-mailer-string
1010 (format "mh-e %s; %s %s; Emacs %d.%d"
1011 mh-version (if mh-nmh-p "nmh" "MH") x-mailer-mh
1012 emacs-major-version emacs-minor-version)))
1013 (kill-buffer mh-temp-buffer)))
1014 ;; Insert X-Mailer, but only if it doesn't already exist.
1015 (save-excursion
1016 (when (null (mh-goto-header-field "X-Mailer"))
1017 (mh-insert-fields "X-Mailer:" mh-x-mailer-string))))
1018
1019
1020 (defun mh-compose-and-send-mail (draft send-args
1021 sent-from-folder sent-from-msg
1022 to subject cc
1023 annotate-char annotate-field
1024 config)
1025 ;; Edit and compose a draft message in buffer DRAFT and send or save it.
1026 ;; SENT-FROM-FOLDER is buffer containing scan listing of current folder, or
1027 ;; nil if none exists.
1028 ;; SENT-FROM-MSG is the message number or sequence name or nil.
1029 ;; SEND-ARGS is an optional argument passed to the send command.
1030 ;; The TO, SUBJECT, and CC fields are passed to the
1031 ;; mh-compose-letter-function.
1032 ;; If ANNOTATE-CHAR is non-null, it is used to notate the scan listing of the
1033 ;; message. In that case, the ANNOTATE-FIELD is used to build a string
1034 ;; for mh-annotate-msg.
1035 ;; CONFIG is the window configuration to restore after sending the letter.
1036 (pop-to-buffer draft)
1037 (mh-letter-mode)
1038 (setq mh-sent-from-folder sent-from-folder)
1039 (setq mh-sent-from-msg sent-from-msg)
1040 (setq mh-send-args send-args)
1041 (setq mh-annotate-char annotate-char)
1042 (setq mh-annotate-field annotate-field)
1043 (setq mh-previous-window-config config)
1044 (setq mode-line-buffer-identification (list "{%b}"))
1045 (if (and (boundp 'mh-compose-letter-function)
1046 mh-compose-letter-function)
1047 ;; run-hooks will not pass arguments.
1048 (let ((value mh-compose-letter-function))
1049 (if (and (listp value) (not (eq (car value) 'lambda)))
1050 (while value
1051 (funcall (car value) to subject cc)
1052 (setq value (cdr value)))
1053 (funcall mh-compose-letter-function to subject cc)))))
1054
1055
1056 (defun mh-send-letter (&optional arg)
1057 "Send the draft letter in the current buffer.
1058 If optional prefix argument ARG is provided, monitor delivery.
1059 Run `mh-before-send-letter-hook' before actually doing anything.
1060 Run `\\[mh-edit-mhn]' if variable `mh-mhn-compose-insert-p' is set."
1061 (interactive "P")
1062 (run-hooks 'mh-before-send-letter-hook)
1063 (if (and (boundp 'mh-mhn-compose-insert-p)
1064 mh-mhn-compose-insert-p)
1065 (mh-edit-mhn))
1066 (if mh-insert-x-mailer-p (mh-insert-x-mailer))
1067 (save-buffer)
1068 (message "Sending...")
1069 (let ((draft-buffer (current-buffer))
1070 (file-name buffer-file-name)
1071 (config mh-previous-window-config)
1072 (coding-system-for-write
1073 (if (and (local-variable-p 'buffer-file-coding-system
1074 (current-buffer)) ;XEmacs needs two args
1075 ;; We're not sure why, but buffer-file-coding-system
1076 ;; tends to get set to undecided-unix.
1077 (not (memq buffer-file-coding-system
1078 '(undecided undecided-unix undecided-dos))))
1079 buffer-file-coding-system
1080 (or (and (boundp 'sendmail-coding-system) sendmail-coding-system)
1081 (and (boundp 'default-buffer-file-coding-system )
1082 default-buffer-file-coding-system)
1083 'iso-latin-1))))
1084 (cond (arg
1085 (pop-to-buffer "MH mail delivery")
1086 (erase-buffer)
1087 (mh-exec-cmd-output mh-send-prog t "-watch" "-nopush"
1088 "-nodraftfolder" mh-send-args file-name)
1089 (goto-char (point-max)) ; show the interesting part
1090 (recenter -1)
1091 (set-buffer draft-buffer)) ; for annotation below
1092 (t
1093 (mh-exec-cmd-daemon mh-send-prog "-nodraftfolder" "-noverbose"
1094 mh-send-args file-name)))
1095 (if mh-annotate-char
1096 (mh-annotate-msg mh-sent-from-msg
1097 mh-sent-from-folder
1098 mh-annotate-char
1099 "-component" mh-annotate-field
1100 "-text" (format "\"%s %s\""
1101 (mh-get-header-field "To:")
1102 (mh-get-header-field "Cc:"))))
1103
1104 (cond ((or (not arg)
1105 (y-or-n-p "Kill draft buffer? "))
1106 (kill-buffer draft-buffer)
1107 (if config
1108 (set-window-configuration config))))
1109 (if arg
1110 (message "Sending...done")
1111 (message "Sending...backgrounded"))))
1112
1113
1114 (defun mh-insert-letter (folder message verbatim)
1115 "Insert a message into the current letter.
1116 Removes the message's headers using `mh-invisible-headers'. Prefixes
1117 each non-blank line with `mh-ins-buf-prefix'. Prompts for FOLDER and
1118 MESSAGE. If prefix argument VERBATIM provided, do not indent and do
1119 not delete headers. Leaves the mark before the letter and point after it."
1120 (interactive
1121 (list (mh-prompt-for-folder "Message from" mh-sent-from-folder nil)
1122 (read-input (format "Message number%s: "
1123 (if mh-sent-from-msg
1124 (format " [%d]" mh-sent-from-msg)
1125 "")))
1126 current-prefix-arg))
1127 (save-restriction
1128 (narrow-to-region (point) (point))
1129 (let ((start (point-min)))
1130 (if (equal message "") (setq message (int-to-string mh-sent-from-msg)))
1131 (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear"
1132 (expand-file-name message
1133 (mh-expand-file-name folder)))
1134 (cond ((not verbatim)
1135 (mh-clean-msg-header start mh-invisible-headers mh-visible-headers)
1136 (set-mark start) ; since mh-clean-msg-header moves it
1137 (mh-insert-prefix-string mh-ins-buf-prefix))))))
1138
1139
1140 (defun mh-yank-cur-msg ()
1141 "Insert the current message into the draft buffer.
1142 Prefix each non-blank line in the message with the string in
1143 `mh-ins-buf-prefix'. If a region is set in the message's buffer, then
1144 only the region will be inserted. Otherwise, the entire message will
1145 be inserted if `mh-yank-from-start-of-msg' is non-nil. If this variable
1146 is nil, the portion of the message following the point will be yanked.
1147 If `mh-delete-yanked-msg-window' is non-nil, any window displaying the
1148 yanked message will be deleted."
1149 (interactive)
1150 (if (and mh-sent-from-folder mh-sent-from-msg)
1151 (let ((to-point (point))
1152 (to-buffer (current-buffer)))
1153 (set-buffer mh-sent-from-folder)
1154 (if mh-delete-yanked-msg-window
1155 (delete-windows-on mh-show-buffer))
1156 (set-buffer mh-show-buffer) ; Find displayed message
1157 (let ((mh-ins-str (cond ((if (boundp 'mark-active)
1158 mark-active ;Emacs 19
1159 (mark)) ;Emacs 18
1160 (buffer-substring (region-beginning)
1161 (region-end)))
1162 ((eq 'body mh-yank-from-start-of-msg)
1163 (buffer-substring
1164 (save-excursion
1165 (goto-char (point-min))
1166 (mh-goto-header-end 1)
1167 (point))
1168 (point-max)))
1169 (mh-yank-from-start-of-msg
1170 (buffer-substring (point-min) (point-max)))
1171 (t
1172 (buffer-substring (point) (point-max))))))
1173 (set-buffer to-buffer)
1174 (save-restriction
1175 (narrow-to-region to-point to-point)
1176 (push-mark)
1177 (insert mh-ins-str)
1178 (mh-insert-prefix-string mh-ins-buf-prefix)
1179 (insert "\n"))))
1180 (error "There is no current message")))
1181
1182
1183 (defun mh-insert-prefix-string (mh-ins-string)
1184 ;; Run mail-citation-hook to insert a prefix string before each line
1185 ;; in the buffer. Generality for supercite users.
1186 (set-mark (point-max))
1187 (goto-char (point-min))
1188 (cond (mail-citation-hook
1189 (run-hooks 'mail-citation-hook))
1190 (mh-yank-hooks ;old hook name
1191 (run-hooks 'mh-yank-hooks))
1192 (t
1193 (or (bolp) (forward-line 1))
1194 (let ((zmacs-regions nil)) ;so "(mark)" works in XEmacs
1195 (while (< (point) (mark))
1196 (insert mh-ins-string)
1197 (forward-line 1))))))
1198
1199
1200 (defun mh-fully-kill-draft ()
1201 "Kill the draft message file and the draft message buffer.
1202 Use \\[kill-buffer] if you don't want to delete the draft message file."
1203 (interactive)
1204 (if (y-or-n-p "Kill draft message? ")
1205 (let ((config mh-previous-window-config))
1206 (if (file-exists-p buffer-file-name)
1207 (delete-file buffer-file-name))
1208 (set-buffer-modified-p nil)
1209 (kill-buffer (buffer-name))
1210 (message "")
1211 (if config
1212 (set-window-configuration config)))
1213 (error "Message not killed")))
1214
1215
1216 (defun mh-current-fill-prefix ()
1217 ;; Return the fill-prefix on the current line as a string.
1218 (save-excursion
1219 (beginning-of-line)
1220 ;; This assumes that the major-mode sets up adaptive-fill-regexp
1221 ;; correctly such as mh-letter-mode or sendmail.el's mail-mode. But
1222 ;; perhaps I should use the variable and simply inserts its value here,
1223 ;; and set it locally in a let scope. --psg
1224 (if (re-search-forward adaptive-fill-regexp nil t)
1225 (match-string 0)
1226 "")))
1227
1228
1229 (defun mh-open-line ()
1230 "Insert a newline and leave point after it.
1231 In addition, insert newline and quoting characters before text after point.
1232 This is useful in breaking up paragraphs in replies."
1233 (interactive)
1234 (let ((column (current-column))
1235 (point (point))
1236 (prefix (mh-current-fill-prefix)))
1237 (if (> (length prefix) column)
1238 (message "Sorry, point seems to be within the line prefix")
1239 (newline 2)
1240 (insert prefix)
1241 (while (> column (current-column))
1242 (insert " "))
1243 (forward-line -1))))
1244
1245
1246 ;;; Build the letter-mode keymap:
1247 (gnus-define-keys mh-letter-mode-map
1248 "\C-c\C-f\C-b" mh-to-field
1249 "\C-c\C-f\C-c" mh-to-field
1250 "\C-c\C-f\C-d" mh-to-field
1251 "\C-c\C-f\C-f" mh-to-fcc
1252 "\C-c\C-f\C-r" mh-to-field
1253 "\C-c\C-f\C-s" mh-to-field
1254 "\C-c\C-f\C-t" mh-to-field
1255 "\C-c\C-fb" mh-to-field
1256 "\C-c\C-fc" mh-to-field
1257 "\C-c\C-fd" mh-to-field
1258 "\C-c\C-ff" mh-to-fcc
1259 "\C-c\C-fr" mh-to-field
1260 "\C-c\C-fs" mh-to-field
1261 "\C-c\C-ft" mh-to-field
1262 "\C-c\C-i" mh-insert-letter
1263 "\C-c\C-o" mh-open-line
1264 "\C-c\C-q" mh-fully-kill-draft
1265 "\C-c\C-\\" mh-fully-kill-draft ;if no C-q
1266 "\C-c\C-s" mh-insert-signature
1267 "\C-c\C-^" mh-insert-signature ;if no C-s
1268 "\C-c\C-w" mh-check-whom
1269 "\C-c\C-y" mh-yank-cur-msg
1270 "\C-c\C-c" mh-send-letter
1271 "\C-c\C-m\C-f" mh-mhn-compose-forw
1272 "\C-c\C-m\C-e" mh-mhn-compose-anon-ftp
1273 "\C-c\C-m\C-t" mh-mhn-compose-external-compressed-tar
1274 "\C-c\C-m\C-i" mh-mhn-compose-insertion
1275 "\C-c\C-e" mh-edit-mhn
1276 "\C-c\C-m\C-u" mh-revert-mhn-edit)
1277
1278 ;; "C-c /" prefix is used in mh-letter-mode by pgp.el and mailcrypt.el.
1279
1280 ;;; Menu extracted from mh-menubar.el V1.1 (31 July 2001)
1281 (cond
1282 ((fboundp 'easy-menu-define)
1283 (easy-menu-define
1284 mh-letter-menu mh-letter-mode-map "Menu for mh-e letter mode."
1285 '("Letter"
1286 ["Send This Draft" mh-send-letter t]
1287 ["Split Current Line" mh-open-line t]
1288 ["Check Recipient" mh-check-whom t]
1289 ["Yank Current Message" mh-yank-cur-msg t]
1290 ["Insert a Message..." mh-insert-letter t]
1291 ["Insert Signature" mh-insert-signature t]
1292 ["Compose Insertion (MIME)..." mh-mhn-compose-insertion t]
1293 ["Compose Compressed tar (MIME)..." mh-mhn-compose-external-compressed-tar t]
1294 ["Compose Anon FTP (MIME)..." mh-mhn-compose-anon-ftp t]
1295 ["Compose Forward (MIME)..." mh-mhn-compose-forw t]
1296 ["Pull in All Compositions (MIME)" mh-edit-mhn t]
1297 ["Revert to Non-MIME Edit" mh-revert-mhn-edit t]
1298 ["Kill This Draft" mh-fully-kill-draft t]))))
1299
1300 (defun mh-customize ()
1301 "Customize mh-e variables."
1302 (interactive)
1303 (customize-group 'mh))
1304
1305 ;;; Support for emacs21 toolbar using gnus/message.el icons (and code).
1306 (eval-when-compile (defvar tool-bar-map))
1307 (when (and (fboundp 'tool-bar-add-item)
1308 tool-bar-mode)
1309 (defvar mh-letter-tool-bar-map
1310 (let ((tool-bar-map (make-sparse-keymap)))
1311 (tool-bar-add-item "mail_send" 'mh-send-letter 'mh-letter-send
1312 :help "Send this letter")
1313 (tool-bar-add-item "attach" 'mh-mhn-compose-insertion 'mh-letter-compose
1314 :help "Insert attachment")
1315 (tool-bar-add-item "spell" 'ispell-message 'mh-letter-ispell
1316 :help "Check spelling")
1317 (tool-bar-add-item-from-menu 'save-buffer "save")
1318 (tool-bar-add-item-from-menu 'undo "undo")
1319 (tool-bar-add-item-from-menu 'kill-region "cut")
1320 (tool-bar-add-item-from-menu 'menu-bar-kill-ring-save "copy")
1321 (tool-bar-add-item "close" 'mh-fully-kill-draft 'mh-letter-kill
1322 :help "Kill this draft")
1323 (tool-bar-add-item "preferences" (lambda ()
1324 (interactive)
1325 (customize-group "mh-compose"))
1326 'mh-letter-customize
1327 :help "mh-e composition preferences")
1328 (tool-bar-add-item "help" (lambda ()
1329 (interactive)
1330 (Info-goto-node "(mh-e)Draft Editing"))
1331 'mh-letter-help :help "Help")
1332 tool-bar-map)))
1333
1334 ;;; mh-comp.el ends here