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