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