6365
|
1 ;;; mh-comp --- mh-e functions for composing messages
|
13385
|
2 ;; Time-stamp: <95/08/19 17:48:59 gildea>
|
6365
|
3
|
30887
|
4 ;; Copyright (C) 1993,1995,1997,2000 Free Software Foundation, Inc.
|
|
5
|
33145
|
6 ;; Maintainer: Bill Wohler <wohler@newt.com>
|
30887
|
7 ;; Keywords: mail
|
|
8 ;; Bug-reports: include `M-x mh-version' output in any correspondence
|
6365
|
9
|
13385
|
10 ;; This file is part of mh-e, part of GNU Emacs.
|
6365
|
11
|
11333
|
12 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
6365
|
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
|
11333
|
17 ;; GNU Emacs is distributed in the hope that it will be useful,
|
6365
|
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
|
14169
|
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.
|
6365
|
26
|
|
27 ;;; Commentary:
|
|
28
|
|
29 ;; Internal support for mh-e package.
|
|
30
|
11332
|
31 ;;; Change Log:
|
|
32
|
33145
|
33 ;; $Id: mh-comp.el,v 1.19 2000/08/16 20:39:14 monnier Exp $
|
11332
|
34
|
6365
|
35 ;;; Code:
|
|
36
|
|
37 (provide 'mh-comp)
|
|
38 (require 'mh-utils)
|
|
39
|
11332
|
40 ;;; Site customization (see also mh-utils.el):
|
|
41
|
17426
|
42 (defgroup mh-compose nil
|
|
43 "Mh-e functions for composing messages"
|
|
44 :prefix "mh-"
|
|
45 :group 'mh)
|
|
46
|
|
47
|
11332
|
48 (defvar mh-send-prog "send"
|
|
49 "Name of the MH send program.
|
|
50 Some sites need to change this because of a name conflict.")
|
|
51
|
|
52 (defvar mh-redist-full-contents nil
|
|
53 "Non-nil if the `dist' command needs whole letter for redistribution.
|
|
54 This is the case only when `send' is compiled with the BERK option.
|
|
55 If MH will not allow you to redist a previously redist'd msg, set to nil.")
|
|
56
|
|
57
|
6365
|
58 (defvar mh-note-repl "-"
|
|
59 "String whose first character is used to notate replied to messages.")
|
|
60
|
|
61 (defvar mh-note-forw "F"
|
|
62 "String whose first character is used to notate forwarded messages.")
|
|
63
|
|
64 (defvar mh-note-dist "R"
|
|
65 "String whose first character is used to notate redistributed messages.")
|
|
66
|
|
67 (defvar mh-yank-hooks nil
|
|
68 "Obsolete hook for modifying a citation just inserted in the mail buffer.
|
|
69 Each hook function can find the citation between point and mark.
|
|
70 And each hook function should leave point and mark around the citation
|
|
71 text as modified.
|
|
72
|
|
73 This is a normal hook, misnamed for historical reasons.
|
19936
|
74 It is semi-obsolete and is only used if `mail-citation-hook' is nil.")
|
6365
|
75
|
|
76 (defvar mail-citation-hook nil
|
|
77 "*Hook for modifying a citation just inserted in the mail buffer.
|
|
78 Each hook function can find the citation between point and mark.
|
|
79 And each hook function should leave point and mark around the citation
|
|
80 text as modified.
|
|
81
|
|
82 If this hook is entirely empty (nil), the text of the message is inserted
|
19936
|
83 with `mh-ins-buf-prefix' prefixed to each line.
|
6365
|
84
|
19936
|
85 See also the variable `mh-yank-from-start-of-msg', which controls how
|
6365
|
86 much of the message passed to the hook.")
|
|
87
|
|
88 ;;; Copied from sendmail.el for Hyperbole
|
|
89 (defvar mail-header-separator "--------"
|
|
90 "*Line used by MH to separate headers from text in messages being composed.")
|
|
91
|
|
92 ;;; Personal preferences:
|
|
93
|
17426
|
94 (defcustom mh-delete-yanked-msg-window nil
|
6365
|
95 "*Controls window display when a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg].
|
|
96 If non-nil, yanking the current message into a draft letter deletes any
|
17426
|
97 windows displaying the message."
|
|
98 :type 'boolean
|
|
99 :group 'mh-compose)
|
6365
|
100
|
17426
|
101 (defcustom mh-yank-from-start-of-msg t
|
6365
|
102 "*Controls which part of a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg].
|
|
103 If non-nil, include the entire message. If the symbol `body', then yank the
|
|
104 message minus the header. If nil, yank only the portion of the message
|
|
105 following the point. If the show buffer has a region, this variable is
|
17426
|
106 ignored."
|
22590
|
107 :type '(choice (const :tag "Below point" nil)
|
|
108 (const :tag "Without header" body)
|
|
109 (other :tag "Entire message" t))
|
17426
|
110 :group 'mh-compose)
|
6365
|
111
|
17426
|
112 (defcustom mh-ins-buf-prefix "> "
|
11332
|
113 "*String to put before each non-blank line of a yanked or inserted message.
|
|
114 \\<mh-letter-mode-map>Used when the message is inserted into an outgoing letter
|
17426
|
115 by \\[mh-insert-letter] or \\[mh-yank-cur-msg]."
|
|
116 :type 'string
|
|
117 :group 'mh-compose)
|
11332
|
118
|
17426
|
119 (defcustom mh-reply-default-reply-to nil
|
6365
|
120 "*Sets the person or persons to whom a reply will be sent.
|
|
121 If nil, prompt for recipient. If non-nil, then \\<mh-folder-mode-map>`\\[mh-reply]' will use this
|
11332
|
122 value and it should be one of \"from\", \"to\", \"cc\", or \"all\".
|
17426
|
123 The values \"cc\" and \"all\" do the same thing."
|
|
124 :type '(choice (const :tag "Prompt" nil)
|
|
125 (const "from") (const "to")
|
|
126 (const "cc") (const "all"))
|
|
127 :group 'mh-compose)
|
6365
|
128
|
17426
|
129 (defcustom mh-signature-file-name "~/.signature"
|
6365
|
130 "*Name of file containing the user's signature.
|
17426
|
131 Inserted into message by \\<mh-letter-mode-map>\\[mh-insert-signature]."
|
|
132 :type 'file
|
|
133 :group 'mh-compose)
|
6365
|
134
|
17426
|
135 (defcustom mh-forward-subject-format "%s: %s"
|
6365
|
136 "*Format to generate the Subject: line contents for a forwarded message.
|
|
137 The two string arguments to the format are the sender of the original
|
17426
|
138 message and the original subject line."
|
|
139 :type 'string
|
|
140 :group 'mh-compose)
|
6365
|
141
|
|
142 (defvar mh-comp-formfile "components"
|
|
143 "Name of file to be used as a skeleton for composing messages.
|
19936
|
144 Default is \"components\". If not an absolute file name, the file
|
6365
|
145 is searched for first in the user's MH directory, then in the
|
|
146 system MH lib directory.")
|
|
147
|
11332
|
148 (defvar mh-repl-formfile "replcomps"
|
|
149 "Name of file to be used as a skeleton for replying to messages.
|
19936
|
150 Default is \"replcomps\". If not an absolute file name, the file
|
11332
|
151 is searched for first in the user's MH directory, then in the
|
|
152 system MH lib directory.")
|
|
153
|
24421
|
154 (defvar mh-repl-group-formfile "replgroupcomps"
|
|
155 "Name of file to be used as a skeleton for replying to the sender
|
|
156 and all recipients of a messages. Only used if mh-nmh-p is non-nil.
|
|
157 Default is \"replgroupcomps\". If not an absolute file name, the file
|
|
158 is searched for first in the user's MH directory, then in the system
|
|
159 MH lib directory.")
|
|
160
|
6365
|
161 ;;; Hooks:
|
|
162
|
17426
|
163 (defcustom mh-letter-mode-hook nil
|
|
164 "Invoked in `mh-letter-mode' on a new letter."
|
|
165 :type 'hook
|
|
166 :group 'mh-compose)
|
6365
|
167
|
17426
|
168 (defcustom mh-compose-letter-function nil
|
11332
|
169 "Invoked when setting up a letter draft.
|
17426
|
170 It is passed three arguments: TO recipients, SUBJECT, and CC recipients."
|
|
171 :type 'function
|
|
172 :group 'mh-compose)
|
6365
|
173
|
17426
|
174 (defcustom mh-before-send-letter-hook nil
|
|
175 "Invoked at the beginning of the \\<mh-letter-mode-map>\\[mh-send-letter] command."
|
|
176 :type 'hook
|
|
177 :group 'mh-compose)
|
6365
|
178
|
|
179
|
|
180 (defvar mh-rejected-letter-start
|
11332
|
181 (concat "^ ----- Unsent message follows -----$" ;from sendmail V5
|
|
182 "\\|^ ----- Original message follows -----$" ;from sendmail V8
|
|
183 "\\|^------- Unsent Draft$" ;from MH itself
|
6365
|
184 "\\|^---------- Original Message ----------$" ;from zmailer
|
11332
|
185 "\\|^ --- The unsent message follows ---$" ;from AIX mail system
|
|
186 "\\|^ Your message follows:$" ;from MMDF-II
|
|
187 "\\|^Content-Description: Returned Content$" ;1993 KJ sendmail
|
|
188 )
|
6365
|
189 "Regexp specifying the beginning of the wrapper around a returned letter.
|
|
190 This wrapper is generated by the mail system when rejecting a letter.")
|
|
191
|
|
192 (defvar mh-new-draft-cleaned-headers
|
11332
|
193 "^Date:\\|^Received:\\|^Message-Id:\\|^From:\\|^Sender:\\|^Errors-To:\\|^Delivery-Date:\\|^Return-Path:"
|
6365
|
194 "Regexp of header lines to remove before offering a message as a new draft.
|
|
195 Used by the \\<mh-folder-mode-map>`\\[mh-edit-again]' and `\\[mh-extract-rejected-mail]' commands.")
|
|
196
|
11332
|
197 (defvar mh-to-field-choices '(("t" . "To:") ("s" . "Subject:") ("c" . "Cc:")
|
|
198 ("b" . "Bcc:") ("f" . "Fcc:") ("r" . "From:")
|
|
199 ("d" . "Dcc:"))
|
6365
|
200 "Alist of (final-character . field-name) choices for mh-to-field.")
|
|
201
|
|
202 (defvar mh-letter-mode-map (copy-keymap text-mode-map)
|
|
203 "Keymap for composing mail.")
|
|
204
|
|
205 (defvar mh-letter-mode-syntax-table nil
|
|
206 "Syntax table used by mh-e while in MH-Letter mode.")
|
|
207
|
|
208 (if mh-letter-mode-syntax-table
|
|
209 ()
|
|
210 (setq mh-letter-mode-syntax-table
|
|
211 (make-syntax-table text-mode-syntax-table))
|
|
212 (modify-syntax-entry ?% "." mh-letter-mode-syntax-table))
|
|
213
|
|
214
|
|
215 ;;;###autoload
|
|
216 (defun mh-smail ()
|
|
217 "Compose and send mail with the MH mail system.
|
|
218 This function is an entry point to mh-e, the Emacs front end
|
11332
|
219 to the MH mail system.
|
|
220
|
|
221 See documentation of `\\[mh-send]' for more details on composing mail."
|
6365
|
222 (interactive)
|
|
223 (mh-find-path)
|
|
224 (call-interactively 'mh-send))
|
|
225
|
|
226
|
13385
|
227 (defvar mh-error-if-no-draft nil) ;raise error over using old draft
|
|
228
|
|
229
|
|
230 ;;;###autoload
|
24421
|
231 (defun mh-smail-batch (&optional to subject other-headers &rest ignored)
|
13385
|
232 "Set up a mail composition draft with the MH mail system.
|
|
233 This function is an entry point to mh-e, the Emacs front end
|
|
234 to the MH mail system. This function does not prompt the user
|
|
235 for any header fields, and thus is suitable for use by programs
|
|
236 that want to create a mail buffer.
|
|
237 Users should use `\\[mh-smail]' to compose mail."
|
|
238 (mh-find-path)
|
|
239 (let ((mh-error-if-no-draft t))
|
26393
|
240 (mh-send (or to "") "" (or subject ""))))
|
13385
|
241
|
|
242
|
6365
|
243 (defun mh-edit-again (msg)
|
|
244 "Clean-up a draft or a message previously sent and make it resendable.
|
11332
|
245 Default is the current message.
|
6365
|
246 The variable mh-new-draft-cleaned-headers specifies the headers to remove.
|
|
247 See also documentation for `\\[mh-send]' function."
|
|
248 (interactive (list (mh-get-msg-num t)))
|
|
249 (let* ((from-folder mh-current-folder)
|
|
250 (config (current-window-configuration))
|
|
251 (draft
|
|
252 (cond ((and mh-draft-folder (equal from-folder mh-draft-folder))
|
|
253 (pop-to-buffer (find-file-noselect (mh-msg-filename msg)) t)
|
|
254 (rename-buffer (format "draft-%d" msg))
|
|
255 (buffer-name))
|
|
256 (t
|
|
257 (mh-read-draft "clean-up" (mh-msg-filename msg) nil)))))
|
|
258 (mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil)
|
|
259 (goto-char (point-min))
|
13385
|
260 (save-buffer)
|
6365
|
261 (mh-compose-and-send-mail draft "" from-folder nil nil nil nil nil nil
|
|
262 config)))
|
|
263
|
|
264
|
|
265 (defun mh-extract-rejected-mail (msg)
|
|
266 "Extract a letter returned by the mail system and make it resendable.
|
19936
|
267 Default is the current message. The variable `mh-new-draft-cleaned-headers'
|
6365
|
268 gives the headers to clean out of the original message.
|
|
269 See also documentation for `\\[mh-send]' function."
|
|
270 (interactive (list (mh-get-msg-num t)))
|
|
271 (let ((from-folder mh-current-folder)
|
|
272 (config (current-window-configuration))
|
|
273 (draft (mh-read-draft "extraction" (mh-msg-filename msg) nil)))
|
|
274 (goto-char (point-min))
|
|
275 (cond ((re-search-forward mh-rejected-letter-start nil t)
|
|
276 (skip-chars-forward " \t\n")
|
|
277 (delete-region (point-min) (point))
|
|
278 (mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil))
|
|
279 (t
|
|
280 (message "Does not appear to be a rejected letter.")))
|
|
281 (goto-char (point-min))
|
13385
|
282 (save-buffer)
|
11332
|
283 (mh-compose-and-send-mail draft "" from-folder msg
|
|
284 (mh-get-header-field "To:")
|
|
285 (mh-get-header-field "From:")
|
|
286 (mh-get-header-field "Cc:")
|
6365
|
287 nil nil config)))
|
|
288
|
|
289
|
|
290 (defun mh-forward (to cc &optional msg-or-seq)
|
|
291 "Forward a message or message sequence. Defaults to displayed message.
|
|
292 If optional prefix argument provided, then prompt for the message sequence.
|
|
293 See also documentation for `\\[mh-send]' function."
|
|
294 (interactive (list (mh-read-address "To: ")
|
|
295 (mh-read-address "Cc: ")
|
|
296 (if current-prefix-arg
|
|
297 (mh-read-seq-default "Forward" t)
|
11332
|
298 (mh-get-msg-num t))))
|
6365
|
299 (or msg-or-seq
|
|
300 (setq msg-or-seq (mh-get-msg-num t)))
|
|
301 (let* ((folder mh-current-folder)
|
|
302 (config (current-window-configuration))
|
|
303 ;; forw always leaves file in "draft" since it doesn't have -draft
|
|
304 (draft-name (expand-file-name "draft" mh-user-path))
|
|
305 (draft (cond ((or (not (file-exists-p draft-name))
|
|
306 (y-or-n-p "The file 'draft' exists. Discard it? "))
|
11332
|
307 (mh-exec-cmd "forw" "-build"
|
|
308 mh-current-folder msg-or-seq)
|
6365
|
309 (prog1
|
|
310 (mh-read-draft "" draft-name t)
|
|
311 (mh-insert-fields "To:" to "Cc:" cc)
|
13385
|
312 (save-buffer)))
|
6365
|
313 (t
|
25535
|
314 (mh-read-draft "" draft-name nil))))
|
|
315 (fwd-msg-file (mh-msg-filename (if (numberp msg-or-seq)
|
|
316 msg-or-seq
|
|
317 (car (mh-seq-to-msgs msg-or-seq)))
|
|
318 folder)))
|
11332
|
319 (let (orig-from
|
|
320 orig-subject)
|
25535
|
321 (save-excursion
|
|
322 (set-buffer (get-buffer-create mh-temp-buffer))
|
|
323 (erase-buffer)
|
|
324 (insert-file-contents fwd-msg-file)
|
11332
|
325 (setq orig-from (mh-get-header-field "From:"))
|
|
326 (setq orig-subject (mh-get-header-field "Subject:")))
|
6365
|
327 (let ((forw-subject
|
|
328 (mh-forwarded-letter-subject orig-from orig-subject)))
|
11332
|
329 (mh-insert-fields "Subject:" forw-subject)
|
|
330 (goto-char (point-min))
|
25535
|
331 (if (re-search-forward "^------- Forwarded Message" nil t)
|
|
332 (forward-line -1)
|
|
333 (re-search-forward "^--------")
|
|
334 (forward-line 1))
|
11332
|
335 (delete-other-windows)
|
|
336 (if (numberp msg-or-seq)
|
|
337 (mh-add-msgs-to-seq msg-or-seq 'forwarded t)
|
6365
|
338 (mh-add-msgs-to-seq (mh-seq-to-msgs msg-or-seq) 'forwarded t))
|
11332
|
339 (mh-compose-and-send-mail draft "" folder msg-or-seq
|
|
340 to forw-subject cc
|
|
341 mh-note-forw "Forwarded:"
|
|
342 config)))))
|
6365
|
343
|
|
344 (defun mh-forwarded-letter-subject (from subject)
|
|
345 ;; Return a Subject suitable for a forwarded message.
|
|
346 ;; Original message has headers FROM and SUBJECT.
|
|
347 (let ((addr-start (string-match "<" from))
|
|
348 (comment (string-match "(" from)))
|
|
349 (cond ((and addr-start (> addr-start 0))
|
|
350 ;; Full Name <luser@host>
|
|
351 (setq from (substring from 0 (1- addr-start))))
|
|
352 (comment
|
|
353 ;; luser@host (Full Name)
|
|
354 (setq from (substring from (1+ comment) (1- (length from)))))))
|
|
355 (format mh-forward-subject-format from subject))
|
|
356
|
|
357
|
|
358 ;;;###autoload
|
|
359 (defun mh-smail-other-window ()
|
|
360 "Compose and send mail in other window with the MH mail system.
|
|
361 This function is an entry point to mh-e, the Emacs front end
|
11332
|
362 to the MH mail system.
|
|
363
|
|
364 See documentation of `\\[mh-send]' for more details on composing mail."
|
6365
|
365 (interactive)
|
|
366 (mh-find-path)
|
|
367 (call-interactively 'mh-send-other-window))
|
|
368
|
|
369
|
|
370 (defun mh-redistribute (to cc &optional msg)
|
|
371 "Redistribute a letter.
|
|
372 Depending on how your copy of MH was compiled, you may need to change the
|
19936
|
373 setting of the variable `mh-redist-full-contents'. See its documentation."
|
6365
|
374 (interactive (list (mh-read-address "Redist-To: ")
|
|
375 (mh-read-address "Redist-Cc: ")
|
|
376 (mh-get-msg-num t)))
|
|
377 (or msg
|
|
378 (setq msg (mh-get-msg-num t)))
|
|
379 (save-window-excursion
|
|
380 (let ((folder mh-current-folder)
|
|
381 (draft (mh-read-draft "redistribution"
|
|
382 (if mh-redist-full-contents
|
|
383 (mh-msg-filename msg)
|
|
384 nil)
|
|
385 nil)))
|
|
386 (mh-goto-header-end 0)
|
|
387 (insert "Resent-To: " to "\n")
|
|
388 (if (not (equal cc "")) (insert "Resent-cc: " cc "\n"))
|
|
389 (mh-clean-msg-header (point-min)
|
|
390 "^Message-Id:\\|^Received:\\|^Return-Path:\\|^Sender:\\|^Date:\\|^From:"
|
|
391 nil)
|
|
392 (save-buffer)
|
|
393 (message "Redistributing...")
|
|
394 (if mh-redist-full-contents
|
|
395 (call-process "/bin/sh" nil 0 nil "-c"
|
|
396 (format "mhdist=1 mhaltmsg=%s %s -push %s"
|
11332
|
397 buffer-file-name
|
6365
|
398 (expand-file-name mh-send-prog mh-progs)
|
11332
|
399 buffer-file-name))
|
6365
|
400 (call-process "/bin/sh" nil 0 nil "-c"
|
|
401 (format "mhdist=1 mhaltmsg=%s mhannotate=1 %s -push %s"
|
|
402 (mh-msg-filename msg folder)
|
|
403 (expand-file-name mh-send-prog mh-progs)
|
11332
|
404 buffer-file-name)))
|
6365
|
405 (mh-annotate-msg msg folder mh-note-dist
|
|
406 "-component" "Resent:"
|
|
407 "-text" (format "\"%s %s\"" to cc))
|
|
408 (kill-buffer draft)
|
|
409 (message "Redistributing...done"))))
|
|
410
|
|
411
|
11332
|
412 (defun mh-reply (message &optional includep)
|
|
413 "Reply to MESSAGE (default: current message).
|
6365
|
414 If optional prefix argument INCLUDEP provided, then include the message
|
19936
|
415 in the reply using filter `mhl.reply' in your MH directory.
|
6365
|
416 Prompts for type of addresses to reply to:
|
|
417 from sender only,
|
|
418 to sender and primary recipients,
|
|
419 cc/all sender and all recipients.
|
11332
|
420 If the file named by `mh-repl-formfile' exists, it is used as a skeleton
|
|
421 for the reply. See also documentation for `\\[mh-send]' function."
|
6365
|
422 (interactive (list (mh-get-msg-num t) current-prefix-arg))
|
|
423 (let ((minibuffer-help-form
|
|
424 "from => Sender only\nto => Sender and primary recipients\ncc or all => Sender and all recipients"))
|
24421
|
425 (let* ((reply-to (or mh-reply-default-reply-to
|
6365
|
426 (completing-read "Reply to whom: "
|
|
427 '(("from") ("to") ("cc") ("all"))
|
|
428 nil
|
|
429 t)))
|
24421
|
430 (folder mh-current-folder)
|
|
431 (show-buffer mh-show-buffer)
|
|
432 (config (current-window-configuration))
|
|
433 (group-reply (or (equal reply-to "cc") (equal reply-to "all")))
|
|
434 (form-file (cond ((and mh-nmh-p group-reply
|
|
435 (stringp mh-repl-group-formfile))
|
|
436 mh-repl-group-formfile)
|
|
437 ((stringp mh-repl-formfile) mh-repl-formfile)
|
|
438 (t nil))))
|
6365
|
439 (message "Composing a reply...")
|
|
440 (mh-exec-cmd "repl" "-build" "-noquery" "-nodraftfolder"
|
24421
|
441 (if form-file
|
|
442 (list "-form" form-file))
|
11332
|
443 mh-current-folder message
|
6365
|
444 (cond ((or (equal reply-to "from") (equal reply-to ""))
|
|
445 '("-nocc" "all"))
|
|
446 ((equal reply-to "to")
|
|
447 '("-cc" "to"))
|
24421
|
448 (group-reply (if mh-nmh-p
|
|
449 '("-group" "-nocc" "me")
|
|
450 '("-cc" "all" "-nocc" "me"))))
|
6365
|
451 (if includep
|
|
452 '("-filter" "mhl.reply")))
|
|
453 (let ((draft (mh-read-draft "reply"
|
|
454 (expand-file-name "reply" mh-user-path)
|
|
455 t)))
|
|
456 (delete-other-windows)
|
13385
|
457 (save-buffer)
|
6365
|
458
|
11332
|
459 (let ((to (mh-get-header-field "To:"))
|
|
460 (subject (mh-get-header-field "Subject:"))
|
|
461 (cc (mh-get-header-field "Cc:")))
|
6365
|
462 (goto-char (point-min))
|
|
463 (mh-goto-header-end 1)
|
|
464 (or includep
|
|
465 (mh-in-show-buffer (show-buffer)
|
11332
|
466 (mh-display-msg message folder)))
|
|
467 (mh-add-msgs-to-seq message 'answered t)
|
6365
|
468 (message "Composing a reply...done")
|
11332
|
469 (mh-compose-and-send-mail draft "" folder message to subject cc
|
6365
|
470 mh-note-repl "Replied:" config))))))
|
|
471
|
|
472
|
|
473 (defun mh-send (to cc subject)
|
|
474 "Compose and send a letter.
|
|
475 The file named by `mh-comp-formfile' will be used as the form.
|
11332
|
476 Do not call this function from outside mh-e; use \\[mh-smail] instead.
|
|
477
|
6365
|
478 The letter is composed in mh-letter-mode; see its documentation for more
|
|
479 details. If `mh-compose-letter-function' is defined, it is called on the
|
19936
|
480 draft and passed three arguments: TO, SUBJECT, and CC."
|
6365
|
481 (interactive (list
|
|
482 (mh-read-address "To: ")
|
|
483 (mh-read-address "Cc: ")
|
|
484 (read-string "Subject: ")))
|
|
485 (let ((config (current-window-configuration)))
|
|
486 (delete-other-windows)
|
|
487 (mh-send-sub to cc subject config)))
|
|
488
|
|
489
|
|
490 (defun mh-send-other-window (to cc subject)
|
|
491 "Compose and send a letter in another window.
|
|
492 Do not call this function from outside mh-e;
|
|
493 use \\[mh-smail-other-window] instead.
|
|
494 See also documentation for `\\[mh-send]' function."
|
|
495 (interactive (list
|
|
496 (mh-read-address "To: ")
|
|
497 (mh-read-address "Cc: ")
|
|
498 (read-string "Subject: ")))
|
|
499 (let ((pop-up-windows t))
|
|
500 (mh-send-sub to cc subject (current-window-configuration))))
|
|
501
|
|
502
|
|
503 (defun mh-send-sub (to cc subject config)
|
11332
|
504 ;; Do the real work of composing and sending a letter.
|
|
505 ;; Expects the TO, CC, and SUBJECT fields as arguments.
|
|
506 ;; CONFIG is the window configuration before sending mail.
|
6365
|
507 (let ((folder mh-current-folder)
|
|
508 (msg-num (mh-get-msg-num nil)))
|
|
509 (message "Composing a message...")
|
|
510 (let ((draft (mh-read-draft
|
|
511 "message"
|
|
512 (let (components)
|
|
513 (cond
|
|
514 ((file-exists-p
|
|
515 (setq components
|
|
516 (expand-file-name mh-comp-formfile mh-user-path)))
|
|
517 components)
|
|
518 ((file-exists-p
|
|
519 (setq components
|
|
520 (expand-file-name mh-comp-formfile mh-lib)))
|
|
521 components)
|
28739
|
522 ((file-exists-p
|
|
523 (setq components
|
29420
|
524 (expand-file-name mh-comp-formfile
|
|
525 ;; What is this mh-etc ?? -sm
|
|
526 (and (boundp 'mh-etc) mh-etc))))
|
28739
|
527 components)
|
6365
|
528 (t
|
|
529 (error (format "Can't find components file \"%s\""
|
|
530 components)))))
|
|
531 nil)))
|
|
532 (mh-insert-fields "To:" to "Subject:" subject "Cc:" cc)
|
|
533 (goto-char (point-max))
|
|
534 (message "Composing a message...done")
|
|
535 (mh-compose-and-send-mail draft "" folder msg-num
|
|
536 to subject cc
|
|
537 nil nil config))))
|
|
538
|
|
539
|
|
540 (defun mh-read-draft (use initial-contents delete-contents-file)
|
|
541 ;; Read draft file into a draft buffer and make that buffer the current one.
|
|
542 ;; USE is a message used for prompting about the intended use of the message.
|
|
543 ;; INITIAL-CONTENTS is filename that is read into an empty buffer, or NIL
|
|
544 ;; if buffer should not be modified. Delete the initial-contents file if
|
|
545 ;; DELETE-CONTENTS-FILE flag is set.
|
|
546 ;; Returns the draft folder's name.
|
|
547 ;; If the draft folder facility is enabled in ~/.mh_profile, a new buffer is
|
|
548 ;; used each time and saved in the draft folder. The draft file can then be
|
|
549 ;; reused.
|
|
550 (cond (mh-draft-folder
|
|
551 (let ((orig-default-dir default-directory)
|
|
552 (draft-file-name (mh-new-draft-name)))
|
|
553 (pop-to-buffer (generate-new-buffer
|
|
554 (format "draft-%s"
|
|
555 (file-name-nondirectory draft-file-name))))
|
|
556 (condition-case ()
|
|
557 (insert-file-contents draft-file-name t)
|
|
558 (file-error))
|
|
559 (setq default-directory orig-default-dir)))
|
|
560 (t
|
|
561 (let ((draft-name (expand-file-name "draft" mh-user-path)))
|
|
562 (pop-to-buffer "draft") ; Create if necessary
|
|
563 (if (buffer-modified-p)
|
|
564 (if (y-or-n-p "Draft has been modified; kill anyway? ")
|
|
565 (set-buffer-modified-p nil)
|
|
566 (error "Draft preserved")))
|
|
567 (setq buffer-file-name draft-name)
|
|
568 (clear-visited-file-modtime)
|
|
569 (unlock-buffer)
|
|
570 (cond ((and (file-exists-p draft-name)
|
|
571 (not (equal draft-name initial-contents)))
|
|
572 (insert-file-contents draft-name)
|
|
573 (delete-file draft-name))))))
|
|
574 (cond ((and initial-contents
|
|
575 (or (zerop (buffer-size))
|
13385
|
576 (if (y-or-n-p
|
|
577 (format "A draft exists. Use for %s? " use))
|
|
578 (if mh-error-if-no-draft
|
|
579 (error "A prior draft exists."))
|
|
580 t)))
|
6365
|
581 (erase-buffer)
|
|
582 (insert-file-contents initial-contents)
|
|
583 (if delete-contents-file (delete-file initial-contents))))
|
|
584 (auto-save-mode 1)
|
|
585 (if mh-draft-folder
|
|
586 (save-buffer)) ; Do not reuse draft name
|
|
587 (buffer-name))
|
|
588
|
|
589
|
|
590 (defun mh-new-draft-name ()
|
|
591 ;; Returns the pathname of folder for draft messages.
|
|
592 (save-excursion
|
|
593 (mh-exec-cmd-quiet t "mhpath" mh-draft-folder "new")
|
|
594 (buffer-substring (point-min) (1- (point-max)))))
|
|
595
|
|
596
|
|
597 (defun mh-annotate-msg (msg buffer note &rest args)
|
|
598 ;; Mark the MESSAGE in BUFFER listing with the character NOTE and annotate
|
|
599 ;; the saved message with ARGS.
|
|
600 (apply 'mh-exec-cmd "anno" buffer msg args)
|
|
601 (save-excursion
|
|
602 (cond ((get-buffer buffer) ; Buffer may be deleted
|
|
603 (set-buffer buffer)
|
|
604 (if (symbolp msg)
|
|
605 (mh-notate-seq msg note (1+ mh-cmd-note))
|
|
606 (mh-notate msg note (1+ mh-cmd-note)))))))
|
|
607
|
|
608
|
|
609 (defun mh-insert-fields (&rest name-values)
|
|
610 ;; Insert the NAME-VALUE pairs in the current buffer.
|
|
611 ;; If field NAME exists, append VALUE to it.
|
|
612 ;; Do not insert any pairs whose value is the empty string.
|
|
613 (let ((case-fold-search t))
|
|
614 (while name-values
|
|
615 (let ((field-name (car name-values))
|
|
616 (value (car (cdr name-values))))
|
|
617 (cond ((equal value "")
|
|
618 nil)
|
|
619 ((mh-position-on-field field-name)
|
|
620 (insert " " value))
|
|
621 (t
|
|
622 (insert field-name " " value "\n")))
|
|
623 (setq name-values (cdr (cdr name-values)))))))
|
|
624
|
|
625
|
|
626 (defun mh-position-on-field (field &optional ignore)
|
|
627 ;; Move to the end of the FIELD in the header.
|
|
628 ;; Move to end of entire header if FIELD not found.
|
|
629 ;; Returns non-nil iff FIELD was found.
|
|
630 ;; The optional second arg is for pre-version 4 compatibility.
|
11332
|
631 (if (mh-goto-header-field field)
|
|
632 (progn
|
|
633 (mh-header-field-end)
|
|
634 t)))
|
|
635
|
|
636
|
|
637 (defun mh-get-header-field (field)
|
|
638 ;; Find and return the body of FIELD in the mail header.
|
|
639 ;; Returns the empty string if the field is not in the header of the
|
|
640 ;; current buffer.
|
|
641 (if (mh-goto-header-field field)
|
|
642 (progn
|
|
643 (skip-chars-forward " \t") ;strip leading white space in body
|
|
644 (let ((start (point)))
|
|
645 (mh-header-field-end)
|
|
646 (buffer-substring start (point))))
|
|
647 ""))
|
|
648
|
|
649 (fset 'mh-get-field 'mh-get-header-field) ;mh-e 4 compatibility
|
6365
|
650
|
11332
|
651 (defun mh-goto-header-field (field)
|
|
652 ;; Move to FIELD in the message header.
|
|
653 ;; Move to the end of the FIELD name, which should end in a colon.
|
|
654 ;; Returns T if found, NIL if not.
|
|
655 (goto-char (point-min))
|
|
656 (let ((case-fold-search t)
|
|
657 (headers-end (save-excursion
|
|
658 (mh-goto-header-end 0)
|
|
659 (point))))
|
|
660 (re-search-forward (format "^%s" field) headers-end t)))
|
|
661
|
|
662 (defun mh-header-field-end ()
|
|
663 ;; Move to the end of the current header field.
|
|
664 ;; Handles RFC 822 continuation lines.
|
|
665 (forward-line 1)
|
|
666 (while (looking-at "^[ \t]")
|
|
667 (forward-line 1))
|
|
668 (backward-char 1)) ;to end of previous line
|
|
669
|
6365
|
670
|
|
671 (defun mh-goto-header-end (arg)
|
|
672 ;; Find the end of the message header in the current buffer and position
|
|
673 ;; the cursor at the ARG'th newline after the header.
|
11507
|
674 (if (re-search-forward "^-*$" nil nil)
|
6365
|
675 (forward-line arg)))
|
|
676
|
|
677
|
|
678 (defun mh-read-address (prompt)
|
|
679 ;; Read a To: or Cc: address, prompting in the minibuffer with PROMPT.
|
|
680 ;; May someday do completion on aliases.
|
|
681 (read-string prompt))
|
|
682
|
|
683
|
|
684
|
|
685 ;;; Mode for composing and sending a draft message.
|
|
686
|
11332
|
687 (defvar mh-sent-from-folder nil) ;Folder of msg assoc with this letter.
|
6365
|
688
|
11332
|
689 (defvar mh-sent-from-msg nil) ;Number of msg assoc with this letter.
|
6365
|
690
|
11332
|
691 (defvar mh-send-args nil) ;Extra args to pass to "send" command.
|
6365
|
692
|
11332
|
693 (defvar mh-annotate-char nil) ;Character to use to annotate mh-sent-from-msg.
|
6365
|
694
|
11332
|
695 (defvar mh-annotate-field nil) ;Field name for message annotation.
|
6365
|
696
|
|
697 (put 'mh-letter-mode 'mode-class 'special)
|
|
698
|
|
699 ;;;###autoload
|
29420
|
700 (define-derived-mode mh-letter-mode text-mode "MH-Letter"
|
6365
|
701 "Mode for composing letters in mh-e.\\<mh-letter-mode-map>
|
11332
|
702 When you have finished composing, type \\[mh-send-letter] to send the message
|
|
703 using the MH mail handling system.
|
|
704 See the documentation for \\[mh-edit-mhn] for information on composing MIME
|
|
705 messages.
|
6365
|
706
|
|
707 \\{mh-letter-mode-map}
|
|
708
|
|
709 Variables controlling this mode (defaults in parentheses):
|
|
710
|
|
711 mh-delete-yanked-msg-window (nil)
|
|
712 If non-nil, \\[mh-yank-cur-msg] will delete any windows displaying
|
|
713 the yanked message.
|
|
714
|
|
715 mh-yank-from-start-of-msg (t)
|
|
716 If non-nil, \\[mh-yank-cur-msg] will include the entire message.
|
|
717 If `body', just yank the body (no header).
|
|
718 If nil, only the portion of the message following the point will be yanked.
|
|
719 If there is a region, this variable is ignored.
|
|
720
|
11332
|
721 mh-ins-buf-prefix (\"> \")
|
|
722 String to insert before each non-blank line of a message as it is
|
|
723 inserted in a draft letter.
|
|
724
|
6365
|
725 mh-signature-file-name (\"~/.signature\")
|
|
726 File to be inserted into message by \\[mh-insert-signature].
|
|
727
|
19936
|
728 This command runs the normal hooks `text-mode-hook' and `mh-letter-mode-hook'."
|
6365
|
729 (or mh-user-path (mh-find-path))
|
|
730 (make-local-variable 'paragraph-start)
|
11332
|
731 (setq paragraph-start (concat "^[ \t]*[-_][-_][-_]+$\\|" paragraph-start))
|
6365
|
732 (make-local-variable 'paragraph-separate)
|
|
733 (setq paragraph-separate
|
11332
|
734 (concat "^[ \t]*[-_][-_][-_]+$\\|" paragraph-separate))
|
6365
|
735 (make-local-variable 'mh-send-args)
|
|
736 (make-local-variable 'mh-annotate-char)
|
|
737 (make-local-variable 'mh-annotate-field)
|
|
738 (make-local-variable 'mh-previous-window-config)
|
|
739 (make-local-variable 'mh-sent-from-folder)
|
|
740 (make-local-variable 'mh-sent-from-msg)
|
|
741 (make-local-variable 'mail-header-separator)
|
|
742 (setq mail-header-separator "--------") ;for Hyperbole
|
|
743 ;; if text-mode-hook turned on auto-fill, tune it for messages
|
29420
|
744 (when auto-fill-function
|
|
745 (make-local-variable 'auto-fill-function)
|
|
746 (setq auto-fill-function 'mh-auto-fill-for-letter)))
|
6365
|
747
|
|
748
|
|
749 (defun mh-auto-fill-for-letter ()
|
|
750 ;; Auto-fill in letters treats the header specially by inserting a tab
|
|
751 ;; before continuation line.
|
|
752 (if (mh-in-header-p)
|
11507
|
753 (let ((fill-prefix "\t"))
|
|
754 (do-auto-fill))
|
|
755 (do-auto-fill)))
|
6365
|
756
|
|
757
|
|
758 (defun mh-in-header-p ()
|
|
759 ;; Return non-nil if the point is in the header of a draft message.
|
|
760 (save-excursion
|
|
761 (let ((cur-point (point)))
|
|
762 (goto-char (point-min))
|
|
763 (re-search-forward "^-*$" nil t)
|
|
764 (< cur-point (point)))))
|
|
765
|
|
766
|
|
767 (defun mh-to-field ()
|
|
768 "Move point to the end of a specified header field.
|
|
769 The field is indicated by the previous keystroke (the last keystroke
|
19936
|
770 of the command) according to the list in the variable `mh-to-field-choices'.
|
6365
|
771 Create the field if it does not exist. Set the mark to point before moving."
|
|
772 (interactive)
|
|
773 (expand-abbrev)
|
11332
|
774 (let ((target (cdr (or (assoc (char-to-string (logior last-input-char ?`))
|
|
775 mh-to-field-choices)
|
|
776 ;; also look for a char for version 4 compat
|
|
777 (assoc (logior last-input-char ?`) mh-to-field-choices))))
|
6365
|
778 (case-fold-search t))
|
|
779 (push-mark)
|
|
780 (cond ((mh-position-on-field target)
|
|
781 (let ((eol (point)))
|
|
782 (skip-chars-backward " \t")
|
|
783 (delete-region (point) eol))
|
|
784 (if (and (not (eq (logior last-input-char ?`) ?s))
|
|
785 (save-excursion
|
|
786 (backward-char 1)
|
|
787 (not (looking-at "[:,]"))))
|
|
788 (insert ", ")
|
|
789 (insert " ")))
|
|
790 (t
|
|
791 (if (mh-position-on-field "To:")
|
|
792 (forward-line 1))
|
|
793 (insert (format "%s \n" target))
|
|
794 (backward-char 1)))))
|
|
795
|
|
796
|
|
797 (defun mh-to-fcc (&optional folder)
|
|
798 "Insert an Fcc: FOLDER field in the current message.
|
|
799 Prompt for the field name with a completion list of the current folders."
|
|
800 (interactive)
|
|
801 (or folder
|
|
802 (setq folder (mh-prompt-for-folder
|
|
803 "Fcc"
|
11332
|
804 (or (and mh-default-folder-for-message-function
|
6365
|
805 (save-excursion
|
|
806 (goto-char (point-min))
|
11332
|
807 (funcall mh-default-folder-for-message-function)))
|
6365
|
808 "")
|
|
809 t)))
|
|
810 (let ((last-input-char ?\C-f))
|
|
811 (expand-abbrev)
|
|
812 (save-excursion
|
|
813 (mh-to-field)
|
|
814 (insert (if (mh-folder-name-p folder)
|
|
815 (substring folder 1)
|
|
816 folder)))))
|
|
817
|
|
818
|
|
819 (defun mh-insert-signature ()
|
19936
|
820 "Insert the file named by `mh-signature-file-name' at point."
|
6365
|
821 (interactive)
|
|
822 (insert-file-contents mh-signature-file-name)
|
11578
|
823 (force-mode-line-update))
|
6365
|
824
|
|
825
|
|
826 (defun mh-check-whom ()
|
11332
|
827 "Verify recipients of the current letter, showing expansion of any aliases."
|
6365
|
828 (interactive)
|
11332
|
829 (let ((file-name buffer-file-name))
|
6365
|
830 (save-buffer)
|
|
831 (message "Checking recipients...")
|
|
832 (mh-in-show-buffer ("*Recipients*")
|
|
833 (bury-buffer (current-buffer))
|
|
834 (erase-buffer)
|
|
835 (mh-exec-cmd-output "whom" t file-name))
|
|
836 (message "Checking recipients...done")))
|
|
837
|
|
838
|
|
839
|
|
840 ;;; Routines to compose and send a letter.
|
|
841
|
|
842 (defun mh-compose-and-send-mail (draft send-args
|
|
843 sent-from-folder sent-from-msg
|
|
844 to subject cc
|
|
845 annotate-char annotate-field
|
|
846 config)
|
|
847 ;; Edit and compose a draft message in buffer DRAFT and send or save it.
|
|
848 ;; SENT-FROM-FOLDER is buffer containing scan listing of current folder, or
|
|
849 ;; nil if none exists.
|
|
850 ;; SENT-FROM-MSG is the message number or sequence name or nil.
|
|
851 ;; SEND-ARGS is an optional argument passed to the send command.
|
|
852 ;; The TO, SUBJECT, and CC fields are passed to the
|
|
853 ;; mh-compose-letter-function.
|
|
854 ;; If ANNOTATE-CHAR is non-null, it is used to notate the scan listing of the
|
|
855 ;; message. In that case, the ANNOTATE-FIELD is used to build a string
|
|
856 ;; for mh-annotate-msg.
|
|
857 ;; CONFIG is the window configuration to restore after sending the letter.
|
|
858 (pop-to-buffer draft)
|
|
859 (mh-letter-mode)
|
|
860 (setq mh-sent-from-folder sent-from-folder)
|
|
861 (setq mh-sent-from-msg sent-from-msg)
|
|
862 (setq mh-send-args send-args)
|
|
863 (setq mh-annotate-char annotate-char)
|
|
864 (setq mh-annotate-field annotate-field)
|
|
865 (setq mh-previous-window-config config)
|
|
866 (setq mode-line-buffer-identification (list "{%b}"))
|
|
867 (if (and (boundp 'mh-compose-letter-function)
|
11332
|
868 mh-compose-letter-function)
|
6365
|
869 ;; run-hooks will not pass arguments.
|
11332
|
870 (let ((value mh-compose-letter-function))
|
6365
|
871 (if (and (listp value) (not (eq (car value) 'lambda)))
|
|
872 (while value
|
|
873 (funcall (car value) to subject cc)
|
|
874 (setq value (cdr value)))
|
|
875 (funcall mh-compose-letter-function to subject cc)))))
|
|
876
|
|
877
|
|
878 (defun mh-send-letter (&optional arg)
|
|
879 "Send the draft letter in the current buffer.
|
|
880 If optional prefix argument is provided, monitor delivery.
|
19936
|
881 Run `mh-before-send-letter-hook' before actually doing anything."
|
6365
|
882 (interactive "P")
|
|
883 (run-hooks 'mh-before-send-letter-hook)
|
|
884 (save-buffer)
|
|
885 (message "Sending...")
|
|
886 (let ((draft-buffer (current-buffer))
|
11332
|
887 (file-name buffer-file-name)
|
19936
|
888 (config mh-previous-window-config)
|
|
889 (coding-system-for-write
|
19952
|
890 (if (and (local-variable-p 'buffer-file-coding-system)
|
|
891 ;; We're not sure why, but buffer-file-coding-system
|
|
892 ;; tends to get set to undecided-unix.
|
|
893 (not (memq buffer-file-coding-system
|
|
894 '(undecided undecided-unix undecided-dos))))
|
19936
|
895 buffer-file-coding-system
|
|
896 (or sendmail-coding-system
|
|
897 default-buffer-file-coding-system
|
|
898 'iso-latin-1))))
|
6365
|
899 (cond (arg
|
|
900 (pop-to-buffer "MH mail delivery")
|
|
901 (erase-buffer)
|
|
902 (mh-exec-cmd-output mh-send-prog t "-watch" "-nopush"
|
|
903 "-nodraftfolder" mh-send-args file-name)
|
|
904 (goto-char (point-max)) ; show the interesting part
|
|
905 (recenter -1)
|
|
906 (set-buffer draft-buffer)) ; for annotation below
|
|
907 (t
|
|
908 (mh-exec-cmd-daemon mh-send-prog "-nodraftfolder" "-noverbose"
|
|
909 mh-send-args file-name)))
|
|
910 (if mh-annotate-char
|
|
911 (mh-annotate-msg mh-sent-from-msg
|
|
912 mh-sent-from-folder
|
|
913 mh-annotate-char
|
|
914 "-component" mh-annotate-field
|
|
915 "-text" (format "\"%s %s\""
|
11332
|
916 (mh-get-header-field "To:")
|
|
917 (mh-get-header-field "Cc:"))))
|
6365
|
918
|
|
919 (cond ((or (not arg)
|
|
920 (y-or-n-p "Kill draft buffer? "))
|
|
921 (kill-buffer draft-buffer)
|
|
922 (if config
|
|
923 (set-window-configuration config))))
|
|
924 (if arg
|
|
925 (message "Sending...done")
|
|
926 (message "Sending...backgrounded"))))
|
|
927
|
|
928
|
11332
|
929 (defun mh-insert-letter (folder message verbatim)
|
|
930 "Insert a message into the current letter.
|
19936
|
931 Removes the message's headers using `mh-invisible-headers'. Prefixes
|
|
932 each non-blank line with `mh-ins-buf-prefix'. Prompts for FOLDER and
|
11332
|
933 MESSAGE. If prefix argument VERBATIM provided, do not indent and do
|
|
934 not delete headers. Leaves the mark before the letter and point after it."
|
6365
|
935 (interactive
|
11332
|
936 (list (mh-prompt-for-folder "Message from" mh-sent-from-folder nil)
|
|
937 (read-input (format "Message number%s: "
|
6365
|
938 (if mh-sent-from-msg
|
|
939 (format " [%d]" mh-sent-from-msg)
|
11332
|
940 "")))
|
6365
|
941 current-prefix-arg))
|
|
942 (save-restriction
|
|
943 (narrow-to-region (point) (point))
|
|
944 (let ((start (point-min)))
|
11332
|
945 (if (equal message "") (setq message (int-to-string mh-sent-from-msg)))
|
6365
|
946 (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear"
|
11332
|
947 (expand-file-name message
|
6365
|
948 (mh-expand-file-name folder)))
|
11332
|
949 (cond ((not verbatim)
|
6365
|
950 (mh-clean-msg-header start mh-invisible-headers mh-visible-headers)
|
|
951 (set-mark start) ; since mh-clean-msg-header moves it
|
|
952 (mh-insert-prefix-string mh-ins-buf-prefix))))))
|
|
953
|
|
954
|
|
955 (defun mh-yank-cur-msg ()
|
|
956 "Insert the current message into the draft buffer.
|
|
957 Prefix each non-blank line in the message with the string in
|
|
958 `mh-ins-buf-prefix'. If a region is set in the message's buffer, then
|
|
959 only the region will be inserted. Otherwise, the entire message will
|
|
960 be inserted if `mh-yank-from-start-of-msg' is non-nil. If this variable
|
|
961 is nil, the portion of the message following the point will be yanked.
|
|
962 If `mh-delete-yanked-msg-window' is non-nil, any window displaying the
|
|
963 yanked message will be deleted."
|
|
964 (interactive)
|
|
965 (if (and mh-sent-from-folder mh-sent-from-msg)
|
|
966 (let ((to-point (point))
|
|
967 (to-buffer (current-buffer)))
|
|
968 (set-buffer mh-sent-from-folder)
|
|
969 (if mh-delete-yanked-msg-window
|
|
970 (delete-windows-on mh-show-buffer))
|
|
971 (set-buffer mh-show-buffer) ; Find displayed message
|
|
972 (let ((mh-ins-str (cond ((if (boundp 'mark-active)
|
11332
|
973 mark-active ;Emacs 19
|
|
974 (mark)) ;Emacs 18
|
6365
|
975 (buffer-substring (region-beginning)
|
|
976 (region-end)))
|
|
977 ((eq 'body mh-yank-from-start-of-msg)
|
|
978 (buffer-substring
|
|
979 (save-excursion
|
|
980 (goto-char (point-min))
|
|
981 (mh-goto-header-end 1)
|
|
982 (point))
|
|
983 (point-max)))
|
|
984 (mh-yank-from-start-of-msg
|
|
985 (buffer-substring (point-min) (point-max)))
|
|
986 (t
|
|
987 (buffer-substring (point) (point-max))))))
|
|
988 (set-buffer to-buffer)
|
11332
|
989 (save-restriction
|
|
990 (narrow-to-region to-point to-point)
|
|
991 (push-mark)
|
|
992 (insert mh-ins-str)
|
|
993 (mh-insert-prefix-string mh-ins-buf-prefix)
|
|
994 (insert "\n"))))
|
|
995 (error "There is no current message")))
|
6365
|
996
|
|
997
|
|
998 (defun mh-insert-prefix-string (mh-ins-string)
|
11332
|
999 ;; Run mail-citation-hook to insert a prefix string before each line
|
6365
|
1000 ;; in the buffer. Generality for supercite users.
|
11332
|
1001 (set-mark (point-max))
|
|
1002 (goto-char (point-min))
|
|
1003 (cond (mail-citation-hook
|
|
1004 (run-hooks 'mail-citation-hook))
|
|
1005 (mh-yank-hooks ;old hook name
|
|
1006 (run-hooks 'mh-yank-hooks))
|
|
1007 (t
|
|
1008 (or (bolp) (forward-line 1))
|
30887
|
1009 (while (< (point) (mark))
|
|
1010 (insert mh-ins-string)
|
|
1011 (forward-line 1)))))
|
6365
|
1012
|
|
1013
|
|
1014 (defun mh-fully-kill-draft ()
|
|
1015 "Kill the draft message file and the draft message buffer.
|
|
1016 Use \\[kill-buffer] if you don't want to delete the draft message file."
|
|
1017 (interactive)
|
|
1018 (if (y-or-n-p "Kill draft message? ")
|
|
1019 (let ((config mh-previous-window-config))
|
11332
|
1020 (if (file-exists-p buffer-file-name)
|
|
1021 (delete-file buffer-file-name))
|
6365
|
1022 (set-buffer-modified-p nil)
|
|
1023 (kill-buffer (buffer-name))
|
|
1024 (message "")
|
|
1025 (if config
|
|
1026 (set-window-configuration config)))
|
|
1027 (error "Message not killed")))
|
|
1028
|
11332
|
1029
|
6365
|
1030 ;;; Build the letter-mode keymap:
|
|
1031
|
|
1032 (define-key mh-letter-mode-map "\C-c\C-f\C-b" 'mh-to-field)
|
|
1033 (define-key mh-letter-mode-map "\C-c\C-f\C-c" 'mh-to-field)
|
11332
|
1034 (define-key mh-letter-mode-map "\C-c\C-f\C-d" 'mh-to-field)
|
6365
|
1035 (define-key mh-letter-mode-map "\C-c\C-f\C-f" 'mh-to-fcc)
|
11332
|
1036 (define-key mh-letter-mode-map "\C-c\C-f\C-r" 'mh-to-field)
|
6365
|
1037 (define-key mh-letter-mode-map "\C-c\C-f\C-s" 'mh-to-field)
|
|
1038 (define-key mh-letter-mode-map "\C-c\C-f\C-t" 'mh-to-field)
|
|
1039 (define-key mh-letter-mode-map "\C-c\C-fb" 'mh-to-field)
|
|
1040 (define-key mh-letter-mode-map "\C-c\C-fc" 'mh-to-field)
|
11332
|
1041 (define-key mh-letter-mode-map "\C-c\C-fd" 'mh-to-field)
|
6365
|
1042 (define-key mh-letter-mode-map "\C-c\C-ff" 'mh-to-fcc)
|
11332
|
1043 (define-key mh-letter-mode-map "\C-c\C-fr" 'mh-to-field)
|
6365
|
1044 (define-key mh-letter-mode-map "\C-c\C-fs" 'mh-to-field)
|
|
1045 (define-key mh-letter-mode-map "\C-c\C-ft" 'mh-to-field)
|
11332
|
1046 (define-key mh-letter-mode-map "\C-c\C-i" 'mh-insert-letter)
|
6365
|
1047 (define-key mh-letter-mode-map "\C-c\C-q" 'mh-fully-kill-draft)
|
11332
|
1048 (define-key mh-letter-mode-map "\C-c\C-\\" 'mh-fully-kill-draft) ;if no C-q
|
|
1049 (define-key mh-letter-mode-map "\C-c\C-s" 'mh-insert-signature)
|
|
1050 (define-key mh-letter-mode-map "\C-c\C-^" 'mh-insert-signature) ;if no C-s
|
6365
|
1051 (define-key mh-letter-mode-map "\C-c\C-w" 'mh-check-whom)
|
|
1052 (define-key mh-letter-mode-map "\C-c\C-y" 'mh-yank-cur-msg)
|
|
1053 (define-key mh-letter-mode-map "\C-c\C-c" 'mh-send-letter)
|
|
1054 (define-key mh-letter-mode-map "\C-c\C-m\C-f" 'mh-mhn-compose-forw)
|
|
1055 (define-key mh-letter-mode-map "\C-c\C-m\C-e" 'mh-mhn-compose-anon-ftp)
|
|
1056 (define-key mh-letter-mode-map "\C-c\C-m\C-t" 'mh-mhn-compose-external-compressed-tar)
|
|
1057 (define-key mh-letter-mode-map "\C-c\C-m\C-i" 'mh-mhn-compose-insertion)
|
|
1058 (define-key mh-letter-mode-map "\C-c\C-e" 'mh-edit-mhn)
|
|
1059 (define-key mh-letter-mode-map "\C-c\C-m\C-u" 'mh-revert-mhn-edit)
|
|
1060
|
13385
|
1061 ;; "C-c /" prefix is used in mh-letter-mode by pgp.el
|
6365
|
1062
|
|
1063 ;;; autoloads from mh-mime
|
|
1064
|
|
1065 (autoload 'mh-mhn-compose-insertion "mh-mime"
|
11507
|
1066 "Add a directive to insert a MIME message part from a file.
|
11332
|
1067 This is the typical way to insert non-text parts in a message.
|
|
1068 See also \\[mh-edit-mhn]." t)
|
|
1069
|
6365
|
1070 (autoload 'mh-mhn-compose-anon-ftp "mh-mime"
|
11507
|
1071 "Add a directive for a MIME anonymous ftp external body part.
|
11332
|
1072 This directive tells MH to include a reference to a
|
|
1073 message/external-body part retrievable by anonymous FTP.
|
|
1074 See also \\[mh-edit-mhn]." t)
|
|
1075
|
6365
|
1076 (autoload 'mh-mhn-compose-external-compressed-tar "mh-mime"
|
11507
|
1077 "Add a directive to include a MIME reference to a compressed tar file.
|
11332
|
1078 The file should be available via anonymous ftp. This directive
|
|
1079 tells MH to include a reference to a message/external-body part.
|
|
1080 See also \\[mh-edit-mhn]." t)
|
|
1081
|
6365
|
1082 (autoload 'mh-mhn-compose-forw "mh-mime"
|
11507
|
1083 "Add a forw directive to this message, to forward a message with MIME.
|
11332
|
1084 This directive tells MH to include another message in this one.
|
|
1085 See also \\[mh-edit-mhn]." t)
|
|
1086
|
6365
|
1087 (autoload 'mh-edit-mhn "mh-mime"
|
11332
|
1088 "Format the current draft for MIME, expanding any mhn directives.
|
|
1089 Process the current draft with the mhn program, which,
|
|
1090 using directives already inserted in the draft, fills in
|
6365
|
1091 all the MIME components and header fields.
|
|
1092 This step should be done last just before sending the message.
|
|
1093 The mhn program is part of MH version 6.8 or later.
|
19936
|
1094 The \\[mh-revert-mhn-edit] command undoes this command.
|
11332
|
1095 For assistance with creating mhn directives to insert
|
6365
|
1096 various types of components in a message, see
|
|
1097 \\[mh-mhn-compose-insertion] (generic insertion from a file),
|
|
1098 \\[mh-mhn-compose-anon-ftp] (external reference to file via anonymous ftp),
|
|
1099 \\[mh-mhn-compose-external-compressed-tar] \
|
|
1100 \(reference to compressed tar file via anonymous ftp), and
|
|
1101 \\[mh-mhn-compose-forw] (forward message)." t)
|
|
1102
|
|
1103 (autoload 'mh-revert-mhn-edit "mh-mime"
|
11332
|
1104 "Undoes the effect of \\[mh-edit-mhn] by reverting to the backup file.
|
|
1105 Optional non-nil argument means don't ask for confirmation." t)
|