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