(mouse-wheel-inhibit-click-time): Fix custom type.
[bpt/emacs.git] / lisp / mail / mh-comp.el
CommitLineData
60370d40 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
29;; Internal support for mh-e package.
30
847b8219
KH
31;;; Change Log:
32
a1b4049d 33;; $Id: mh-comp.el,v 1.56 2002/04/07 19:20:56 wohler Exp $
847b8219 34
c26cf6c8
RS
35;;; Code:
36
37(provide 'mh-comp)
a1b4049d 38(require 'mh-e)
c26cf6c8 39(require 'mh-utils)
a1b4049d
BW
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.
47This is the typical way to insert non-text parts in a message.
48See 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.
52This directive tells MH to include a reference to a
53message/external-body part retrievable by anonymous FTP.
54See 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.
58The file should be available via anonymous ftp. This directive
59tells MH to include a reference to a message/external-body part.
60See 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.
64This directive tells MH to include another message in this one.
65See also \\[mh-edit-mhn]." t)
66
67(autoload 'mh-edit-mhn "mh-mime"
68 "Format the current draft for MIME, expanding any mhn directives.
69Process the current draft with the mhn program, which,
70using directives already inserted in the draft, fills in
71all the MIME components and header fields.
72This step should be done last just before sending the message.
73The mhn program is part of MH version 6.8 or later.
74The \\[mh-revert-mhn-edit] command undoes this command.
75For assistance with creating mhn directives to insert
76various 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.
85Optional 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")
c26cf6c8 91
847b8219
KH
92;;; Site customization (see also mh-utils.el):
93
20f0de75 94(defgroup mh-compose nil
a1b4049d 95 "Mh-e functions for composing messages."
20f0de75
RS
96 :prefix "mh-"
97 :group 'mh)
98
99
847b8219
KH
100(defvar mh-send-prog "send"
101 "Name of the MH send program.
102Some 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.
106This is the case only when `send' is compiled with the BERK option.
107If MH will not allow you to redist a previously redist'd msg, set to nil.")
108
a1b4049d
BW
109(defvar mh-redist-background nil
110 "If non-nil redist will be done in background like send.
111This allows transaction log to be visible if -watch, -verbose or -snoop are used.")
847b8219 112
c26cf6c8
RS
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
c26cf6c8
RS
122(defvar mh-yank-hooks nil
123 "Obsolete hook for modifying a citation just inserted in the mail buffer.
124Each hook function can find the citation between point and mark.
125And each hook function should leave point and mark around the citation
126text as modified.
127
128This is a normal hook, misnamed for historical reasons.
1838eb6c 129It is semi-obsolete and is only used if `mail-citation-hook' is nil.")
c26cf6c8
RS
130
131(defvar mail-citation-hook nil
132 "*Hook for modifying a citation just inserted in the mail buffer.
133Each hook function can find the citation between point and mark.
134And each hook function should leave point and mark around the citation
135text as modified.
136
137If this hook is entirely empty (nil), the text of the message is inserted
1838eb6c 138with `mh-ins-buf-prefix' prefixed to each line.
c26cf6c8 139
1838eb6c 140See also the variable `mh-yank-from-start-of-msg', which controls how
c26cf6c8
RS
141much of the message passed to the hook.")
142
c26cf6c8
RS
143;;; Personal preferences:
144
a1b4049d
BW
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.
152If nil, this variable is initialized to show the version of mh-e, Emacs, and
153MH the first time a message is composed.")
154
20f0de75 155(defcustom mh-delete-yanked-msg-window nil
c26cf6c8
RS
156 "*Controls window display when a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg].
157If non-nil, yanking the current message into a draft letter deletes any
20f0de75
RS
158windows displaying the message."
159 :type 'boolean
160 :group 'mh-compose)
c26cf6c8 161
20f0de75 162(defcustom mh-yank-from-start-of-msg t
c26cf6c8
RS
163 "*Controls which part of a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg].
164If non-nil, include the entire message. If the symbol `body', then yank the
165message minus the header. If nil, yank only the portion of the message
166following the point. If the show buffer has a region, this variable is
20f0de75 167ignored."
a6639a16
AS
168 :type '(choice (const :tag "Below point" nil)
169 (const :tag "Without header" body)
170 (other :tag "Entire message" t))
20f0de75 171 :group 'mh-compose)
c26cf6c8 172
20f0de75 173(defcustom mh-ins-buf-prefix "> "
847b8219
KH
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
20f0de75
RS
176by \\[mh-insert-letter] or \\[mh-yank-cur-msg]."
177 :type 'string
178 :group 'mh-compose)
847b8219 179
20f0de75 180(defcustom mh-reply-default-reply-to nil
c26cf6c8
RS
181 "*Sets the person or persons to whom a reply will be sent.
182If nil, prompt for recipient. If non-nil, then \\<mh-folder-mode-map>`\\[mh-reply]' will use this
847b8219 183value and it should be one of \"from\", \"to\", \"cc\", or \"all\".
20f0de75
RS
184The 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)
c26cf6c8 189
20f0de75 190(defcustom mh-signature-file-name "~/.signature"
c26cf6c8 191 "*Name of file containing the user's signature.
20f0de75
RS
192Inserted into message by \\<mh-letter-mode-map>\\[mh-insert-signature]."
193 :type 'file
194 :group 'mh-compose)
c26cf6c8 195
20f0de75 196(defcustom mh-forward-subject-format "%s: %s"
c26cf6c8
RS
197 "*Format to generate the Subject: line contents for a forwarded message.
198The two string arguments to the format are the sender of the original
20f0de75
RS
199message and the original subject line."
200 :type 'string
201 :group 'mh-compose)
c26cf6c8
RS
202
203(defvar mh-comp-formfile "components"
204 "Name of file to be used as a skeleton for composing messages.
1838eb6c 205Default is \"components\". If not an absolute file name, the file
c26cf6c8
RS
206is searched for first in the user's MH directory, then in the
207system MH lib directory.")
208
847b8219
KH
209(defvar mh-repl-formfile "replcomps"
210 "Name of file to be used as a skeleton for replying to messages.
1838eb6c 211Default is \"replcomps\". If not an absolute file name, the file
847b8219
KH
212is searched for first in the user's MH directory, then in the
213system MH lib directory.")
214
c3d6278e 215(defvar mh-repl-group-formfile "replgroupcomps"
a1b4049d
BW
216 "Name of file to be used as a skeleton for replying to the sender and all recipients of a message.
217Only used if `mh-nmh-p' is non-nil. Default is \"replgroupcomps\". If not an
218absolute file name, the file is searched for first in the user's MH directory,
219then 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
224The setting of this variable determines whether the MH `show-buffer' is
225displayed with the current message when using `mh-reply' without a prefix
226argument. Set it to nil if you already include the message automatically
227in your draft using
228 repl: -filter repl.filter
229in 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'.
235This is usually less than in other text modes because email messages get
236quoted by some prefix (sometimes many times) when they are replied-to,
237and it's best to avoid quoted lines that span more than 80 columns."
238 :type 'integer
239 :group 'mh-compose)
c3d6278e 240
c26cf6c8
RS
241;;; Hooks:
242
20f0de75
RS
243(defcustom mh-letter-mode-hook nil
244 "Invoked in `mh-letter-mode' on a new letter."
245 :type 'hook
246 :group 'mh-compose)
c26cf6c8 247
20f0de75 248(defcustom mh-compose-letter-function nil
847b8219 249 "Invoked when setting up a letter draft.
20f0de75 250It is passed three arguments: TO recipients, SUBJECT, and CC recipients."
f37489e6 251 :type '(choice (const nil) function)
20f0de75
RS
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)
c26cf6c8 258
c26cf6c8 259(defvar mh-rejected-letter-start
a1b4049d
BW
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 )))
c26cf6c8
RS
270
271(defvar mh-new-draft-cleaned-headers
847b8219 272 "^Date:\\|^Received:\\|^Message-Id:\\|^From:\\|^Sender:\\|^Errors-To:\\|^Delivery-Date:\\|^Return-Path:"
c26cf6c8
RS
273 "Regexp of header lines to remove before offering a message as a new draft.
274Used by the \\<mh-folder-mode-map>`\\[mh-edit-again]' and `\\[mh-extract-rejected-mail]' commands.")
275
847b8219
KH
276(defvar mh-to-field-choices '(("t" . "To:") ("s" . "Subject:") ("c" . "Cc:")
277 ("b" . "Bcc:") ("f" . "Fcc:") ("r" . "From:")
278 ("d" . "Dcc:"))
a1b4049d 279 "Alist of (final-character . field-name) choices for `mh-to-field'.")
c26cf6c8
RS
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.
297This function is an entry point to mh-e, the Emacs front end
847b8219
KH
298to the MH mail system.
299
300See documentation of `\\[mh-send]' for more details on composing mail."
c26cf6c8
RS
301 (interactive)
302 (mh-find-path)
303 (call-interactively 'mh-send))
304
305
283b03f4
KH
306(defvar mh-error-if-no-draft nil) ;raise error over using old draft
307
308
309;;;###autoload
c3d6278e 310(defun mh-smail-batch (&optional to subject other-headers &rest ignored)
283b03f4
KH
311 "Set up a mail composition draft with the MH mail system.
312This function is an entry point to mh-e, the Emacs front end
313to the MH mail system. This function does not prompt the user
314for any header fields, and thus is suitable for use by programs
315that want to create a mail buffer.
a1b4049d
BW
316Users should use `\\[mh-smail]' to compose mail.
317Optional arguments for setting certain fields include TO, SUBJECT, and
318OTHER-HEADERS."
283b03f4
KH
319 (mh-find-path)
320 (let ((mh-error-if-no-draft t))
016fbe59 321 (mh-send (or to "") "" (or subject ""))))
283b03f4 322
a1b4049d
BW
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.
329This is `mail-user-agent' entry point to mh-e.
330
331The optional arguments TO and SUBJECT specify recipients and the
332initial Subject field, respectively.
333
334OTHER-HEADERS is an alist specifying additional
335header fields. Elements look like (HEADER . VALUE) where both
336HEADER and VALUE are strings.
337
338CONTINUE, 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)))))
283b03f4 346
c26cf6c8 347(defun mh-edit-again (msg)
a1b4049d 348 "Clean up a draft or a message MSG previously sent and make it resendable.
847b8219 349Default is the current message.
a1b4049d 350The variable `mh-new-draft-cleaned-headers' specifies the headers to remove.
c26cf6c8
RS
351See 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)
a1b4049d 363 (mh-insert-header-separator)
c26cf6c8 364 (goto-char (point-min))
283b03f4 365 (save-buffer)
c26cf6c8
RS
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)
a1b4049d 371 "Extract message MSG returned by the mail system and make it resendable.
1838eb6c 372Default is the current message. The variable `mh-new-draft-cleaned-headers'
c26cf6c8
RS
373gives the headers to clean out of the original message.
374See 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.")))
a1b4049d 386 (mh-insert-header-separator)
c26cf6c8 387 (goto-char (point-min))
283b03f4 388 (save-buffer)
847b8219
KH
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:")
c26cf6c8
RS
393 nil nil config)))
394
395
396(defun mh-forward (to cc &optional msg-or-seq)
a1b4049d
BW
397 "Forward displayed message to recipients TO and CC.
398If optional prefix argument MSG-OR-SEQ provided, then prompt for the message
399sequence. See also documentation for `\\[mh-send]' function."
c26cf6c8
RS
400 (interactive (list (mh-read-address "To: ")
401 (mh-read-address "Cc: ")
402 (if current-prefix-arg
403 (mh-read-seq-default "Forward" t)
847b8219 404 (mh-get-msg-num t))))
c26cf6c8
RS
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))
a1b4049d
BW
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))
c26cf6c8
RS
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? "))
847b8219
KH
417 (mh-exec-cmd "forw" "-build"
418 mh-current-folder msg-or-seq)
c26cf6c8
RS
419 (prog1
420 (mh-read-draft "" draft-name t)
421 (mh-insert-fields "To:" to "Cc:" cc)
283b03f4 422 (save-buffer)))
c26cf6c8 423 (t
a1b4049d 424 (mh-read-draft "" draft-name nil)))))
847b8219
KH
425 (let (orig-from
426 orig-subject)
41b9a988
RS
427 (save-excursion
428 (set-buffer (get-buffer-create mh-temp-buffer))
429 (erase-buffer)
430 (insert-file-contents fwd-msg-file)
847b8219
KH
431 (setq orig-from (mh-get-header-field "From:"))
432 (setq orig-subject (mh-get-header-field "Subject:")))
c26cf6c8 433 (let ((forw-subject
a1b4049d
BW
434 (mh-forwarded-letter-subject orig-from orig-subject))
435 (mail-header-separator mh-mail-header-separator))
847b8219
KH
436 (mh-insert-fields "Subject:" forw-subject)
437 (goto-char (point-min))
41b9a988
RS
438 (if (re-search-forward "^------- Forwarded Message" nil t)
439 (forward-line -1)
a1b4049d 440 (re-search-forward mail-header-separator)
41b9a988 441 (forward-line 1))
847b8219
KH
442 (delete-other-windows)
443 (if (numberp msg-or-seq)
444 (mh-add-msgs-to-seq msg-or-seq 'forwarded t)
c26cf6c8 445 (mh-add-msgs-to-seq (mh-seq-to-msgs msg-or-seq) 'forwarded t))
847b8219
KH
446 (mh-compose-and-send-mail draft "" folder msg-or-seq
447 to forw-subject cc
448 mh-note-forw "Forwarded:"
449 config)))))
c26cf6c8
RS
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.
468This function is an entry point to mh-e, the Emacs front end
847b8219
KH
469to the MH mail system.
470
471See documentation of `\\[mh-send]' for more details on composing mail."
c26cf6c8
RS
472 (interactive)
473 (mh-find-path)
474 (call-interactively 'mh-send-other-window))
475
476
477(defun mh-redistribute (to cc &optional msg)
a1b4049d
BW
478 "Redistribute displayed message to recipients TO and CC.
479Use optional argument MSG to redistribute another message.
c26cf6c8 480Depending on how your copy of MH was compiled, you may need to change the
1838eb6c 481setting of the variable `mh-redist-full-contents'. See its documentation."
c26cf6c8
RS
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...")
a1b4049d
BW
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))))
c26cf6c8
RS
514 (mh-annotate-msg msg folder mh-note-dist
515 "-component" "Resent:"
516 "-text" (format "\"%s %s\"" to cc))
a1b4049d
BW
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)))
c26cf6c8
RS
528 (kill-buffer draft)
529 (message "Redistributing...done"))))
530
531
847b8219
KH
532(defun mh-reply (message &optional includep)
533 "Reply to MESSAGE (default: current message).
c26cf6c8 534If optional prefix argument INCLUDEP provided, then include the message
1838eb6c 535in the reply using filter `mhl.reply' in your MH directory.
c26cf6c8
RS
536Prompts for type of addresses to reply to:
537 from sender only,
538 to sender and primary recipients,
539 cc/all sender and all recipients.
847b8219
KH
540If the file named by `mh-repl-formfile' exists, it is used as a skeleton
541for the reply. See also documentation for `\\[mh-send]' function."
c26cf6c8
RS
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"))
c3d6278e 545 (let* ((reply-to (or mh-reply-default-reply-to
c26cf6c8
RS
546 (completing-read "Reply to whom: "
547 '(("from") ("to") ("cc") ("all"))
548 nil
549 t)))
c3d6278e
KH
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))))
c26cf6c8
RS
559 (message "Composing a reply...")
560 (mh-exec-cmd "repl" "-build" "-noquery" "-nodraftfolder"
c3d6278e
KH
561 (if form-file
562 (list "-form" form-file))
847b8219 563 mh-current-folder message
c26cf6c8
RS
564 (cond ((or (equal reply-to "from") (equal reply-to ""))
565 '("-nocc" "all"))
566 ((equal reply-to "to")
567 '("-cc" "to"))
c3d6278e
KH
568 (group-reply (if mh-nmh-p
569 '("-group" "-nocc" "me")
570 '("-cc" "all" "-nocc" "me"))))
c26cf6c8
RS
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)
283b03f4 577 (save-buffer)
c26cf6c8 578
847b8219
KH
579 (let ((to (mh-get-header-field "To:"))
580 (subject (mh-get-header-field "Subject:"))
581 (cc (mh-get-header-field "Cc:")))
c26cf6c8
RS
582 (goto-char (point-min))
583 (mh-goto-header-end 1)
584 (or includep
a1b4049d 585 (not mh-reply-show-message-p)
c26cf6c8 586 (mh-in-show-buffer (show-buffer)
847b8219
KH
587 (mh-display-msg message folder)))
588 (mh-add-msgs-to-seq message 'answered t)
c26cf6c8 589 (message "Composing a reply...done")
847b8219 590 (mh-compose-and-send-mail draft "" folder message to subject cc
c26cf6c8
RS
591 mh-note-repl "Replied:" config))))))
592
593
594(defun mh-send (to cc subject)
595 "Compose and send a letter.
a1b4049d 596
847b8219
KH
597Do not call this function from outside mh-e; use \\[mh-smail] instead.
598
a1b4049d
BW
599The file named by `mh-comp-formfile' will be used as the form.
600The letter is composed in `mh-letter-mode'; see its documentation for more
601details.
602If `mh-compose-letter-function' is defined, it is called on the draft and
603passed three arguments: TO, CC, and SUBJECT."
c26cf6c8
RS
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.
a1b4049d
BW
615
616Do not call this function from outside mh-e; use \\[mh-smail-other-window]
617instead.
618
619The file named by `mh-comp-formfile' will be used as the form.
620The letter is composed in `mh-letter-mode'; see its documentation for more
621details.
622If `mh-compose-letter-function' is defined, it is called on the draft and
623passed three arguments: TO, CC, and SUBJECT."
c26cf6c8
RS
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)
847b8219
KH
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.
c26cf6c8
RS
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)
fe20aba8
GM
651 ((file-exists-p
652 (setq components
f7c4478f
SM
653 (expand-file-name mh-comp-formfile
654 ;; What is this mh-etc ?? -sm
655 (and (boundp 'mh-etc) mh-etc))))
fe20aba8 656 components)
c26cf6c8
RS
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.
a1b4049d 672 ;; INITIAL-CONTENTS is filename that is read into an empty buffer, or NIL
c26cf6c8
RS
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))
283b03f4
KH
705 (if (y-or-n-p
706 (format "A draft exists. Use for %s? " use))
707 (if mh-error-if-no-draft
60370d40 708 (error "A prior draft exists"))
283b03f4 709 t)))
c26cf6c8
RS
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)
a1b4049d 749 (insert " " (or value "")))
c26cf6c8
RS
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.
a1b4049d
BW
760 (cond ((mh-goto-header-field field)
761 (mh-header-field-end)
762 t)
763 ((mh-goto-header-end 0)
764 nil)))
847b8219
KH
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.
a1b4049d 784 ;; Returns T if found, NIL if not.
847b8219
KH
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
c26cf6c8
RS
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.
9303c8db 795 (if (re-search-forward "^-*$" nil nil)
c26cf6c8
RS
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
847b8219 808(defvar mh-sent-from-folder nil) ;Folder of msg assoc with this letter.
c26cf6c8 809
847b8219 810(defvar mh-sent-from-msg nil) ;Number of msg assoc with this letter.
c26cf6c8 811
847b8219 812(defvar mh-send-args nil) ;Extra args to pass to "send" command.
c26cf6c8 813
847b8219 814(defvar mh-annotate-char nil) ;Character to use to annotate mh-sent-from-msg.
c26cf6c8 815
847b8219 816(defvar mh-annotate-field nil) ;Field name for message annotation.
c26cf6c8
RS
817
818(put 'mh-letter-mode 'mode-class 'special)
819
820;;;###autoload
f7c4478f 821(define-derived-mode mh-letter-mode text-mode "MH-Letter"
c26cf6c8 822 "Mode for composing letters in mh-e.\\<mh-letter-mode-map>
a1b4049d 823
847b8219
KH
824When you have finished composing, type \\[mh-send-letter] to send the message
825using the MH mail handling system.
c26cf6c8 826
a1b4049d
BW
827If MH MIME directives are added manually, you must first run \\[mh-edit-mhn]
828before sending the message. MIME directives that are added by mh-e commands
829such as \\[mh-mhn-compose-insertion] are processed automatically when the
830message is sent.
c26cf6c8 831
a1b4049d
BW
832Options that control this mode can be changed with
833\\[customize-group]; specify the \"mh-compose\" group.
c26cf6c8 834
a1b4049d
BW
835When a message is composed, the hooks `text-mode-hook' and
836`mh-letter-mode-hook' are run.
c26cf6c8 837
a1b4049d 838\\{mh-letter-mode-map}"
c26cf6c8 839
c26cf6c8 840 (or mh-user-path (mh-find-path))
c26cf6c8
RS
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)
a1b4049d
BW
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)
c26cf6c8 898 ;; if text-mode-hook turned on auto-fill, tune it for messages
f7c4478f
SM
899 (when auto-fill-function
900 (make-local-variable 'auto-fill-function)
901 (setq auto-fill-function 'mh-auto-fill-for-letter)))
c26cf6c8
RS
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.
c26cf6c8 907 (if (mh-in-header-p)
9303c8db
KH
908 (let ((fill-prefix "\t"))
909 (do-auto-fill))
910 (do-auto-fill)))
c26cf6c8
RS
911
912
a1b4049d
BW
913(defun mh-insert-header-separator ()
914 ;; Inserts `mh-mail-header-separator', if absent.
c26cf6c8 915 (save-excursion
a1b4049d
BW
916 (goto-char (point-min))
917 (rfc822-goto-eoh)
918 (if (looking-at "$")
919 (insert mh-mail-header-separator))))
c26cf6c8
RS
920
921(defun mh-to-field ()
922 "Move point to the end of a specified header field.
923The field is indicated by the previous keystroke (the last keystroke
1838eb6c 924of the command) according to the list in the variable `mh-to-field-choices'.
c26cf6c8
RS
925Create the field if it does not exist. Set the mark to point before moving."
926 (interactive)
927 (expand-abbrev)
847b8219
KH
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))))
c26cf6c8
RS
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.
953Prompt 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"
847b8219 958 (or (and mh-default-folder-for-message-function
c26cf6c8
RS
959 (save-excursion
960 (goto-char (point-min))
847b8219 961 (funcall mh-default-folder-for-message-function)))
c26cf6c8
RS
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 ()
1838eb6c 974 "Insert the file named by `mh-signature-file-name' at point."
c26cf6c8
RS
975 (interactive)
976 (insert-file-contents mh-signature-file-name)
2450bd29 977 (force-mode-line-update))
c26cf6c8
RS
978
979
980(defun mh-check-whom ()
847b8219 981 "Verify recipients of the current letter, showing expansion of any aliases."
c26cf6c8 982 (interactive)
847b8219 983 (let ((file-name buffer-file-name))
c26cf6c8
RS
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
a1b4049d
BW
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
c26cf6c8
RS
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)
847b8219 1046 mh-compose-letter-function)
c26cf6c8 1047 ;; run-hooks will not pass arguments.
847b8219 1048 (let ((value mh-compose-letter-function))
c26cf6c8
RS
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.
a1b4049d
BW
1058If optional prefix argument ARG is provided, monitor delivery.
1059Run `mh-before-send-letter-hook' before actually doing anything.
1060Run `\\[mh-edit-mhn]' if variable `mh-mhn-compose-insert-p' is set."
c26cf6c8
RS
1061 (interactive "P")
1062 (run-hooks 'mh-before-send-letter-hook)
a1b4049d
BW
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))
c26cf6c8
RS
1067 (save-buffer)
1068 (message "Sending...")
1069 (let ((draft-buffer (current-buffer))
847b8219 1070 (file-name buffer-file-name)
1838eb6c
RS
1071 (config mh-previous-window-config)
1072 (coding-system-for-write
a1b4049d
BW
1073 (if (and (local-variable-p 'buffer-file-coding-system
1074 (current-buffer)) ;XEmacs needs two args
03d9b139
RS
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))))
1838eb6c 1079 buffer-file-coding-system
a1b4049d
BW
1080 (or (and (boundp 'sendmail-coding-system) sendmail-coding-system)
1081 (and (boundp 'default-buffer-file-coding-system )
1082 default-buffer-file-coding-system)
1838eb6c 1083 'iso-latin-1))))
c26cf6c8
RS
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\""
847b8219
KH
1101 (mh-get-header-field "To:")
1102 (mh-get-header-field "Cc:"))))
c26cf6c8
RS
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
847b8219
KH
1114(defun mh-insert-letter (folder message verbatim)
1115 "Insert a message into the current letter.
1838eb6c
RS
1116Removes the message's headers using `mh-invisible-headers'. Prefixes
1117each non-blank line with `mh-ins-buf-prefix'. Prompts for FOLDER and
847b8219
KH
1118MESSAGE. If prefix argument VERBATIM provided, do not indent and do
1119not delete headers. Leaves the mark before the letter and point after it."
c26cf6c8 1120 (interactive
847b8219
KH
1121 (list (mh-prompt-for-folder "Message from" mh-sent-from-folder nil)
1122 (read-input (format "Message number%s: "
c26cf6c8
RS
1123 (if mh-sent-from-msg
1124 (format " [%d]" mh-sent-from-msg)
847b8219 1125 "")))
c26cf6c8
RS
1126 current-prefix-arg))
1127 (save-restriction
1128 (narrow-to-region (point) (point))
1129 (let ((start (point-min)))
847b8219 1130 (if (equal message "") (setq message (int-to-string mh-sent-from-msg)))
c26cf6c8 1131 (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear"
847b8219 1132 (expand-file-name message
c26cf6c8 1133 (mh-expand-file-name folder)))
847b8219 1134 (cond ((not verbatim)
c26cf6c8
RS
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.
1142Prefix 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
1144only the region will be inserted. Otherwise, the entire message will
1145be inserted if `mh-yank-from-start-of-msg' is non-nil. If this variable
1146is nil, the portion of the message following the point will be yanked.
1147If `mh-delete-yanked-msg-window' is non-nil, any window displaying the
1148yanked 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)
847b8219
KH
1158 mark-active ;Emacs 19
1159 (mark)) ;Emacs 18
c26cf6c8
RS
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)
847b8219
KH
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")))
c26cf6c8
RS
1181
1182
1183(defun mh-insert-prefix-string (mh-ins-string)
847b8219 1184 ;; Run mail-citation-hook to insert a prefix string before each line
c26cf6c8 1185 ;; in the buffer. Generality for supercite users.
847b8219
KH
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))
a1b4049d
BW
1194 (let ((zmacs-regions nil)) ;so "(mark)" works in XEmacs
1195 (while (< (point) (mark))
1196 (insert mh-ins-string)
1197 (forward-line 1))))))
c26cf6c8
RS
1198
1199
1200(defun mh-fully-kill-draft ()
1201 "Kill the draft message file and the draft message buffer.
1202Use \\[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))
847b8219
KH
1206 (if (file-exists-p buffer-file-name)
1207 (delete-file buffer-file-name))
c26cf6c8
RS
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
847b8219 1215
a1b4049d
BW
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.
1231In addition, insert newline and quoting characters before text after point.
1232This 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))))
847b8219 1244
847b8219 1245
a1b4049d
BW
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)))
60370d40
PJ
1333
1334;;; mh-comp.el ends here