1;;; mh-comp.el --- MH-E functions for composing and sending messages
2
3;; Copyright (C) 1993, 1995, 1997,
4;;  2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
5
6;; Author: Bill Wohler <wohler@newt.com>
7;; Maintainer: Bill Wohler <wohler@newt.com>
8;; Keywords: mail
9;; See: mh-e.el
10
11;; This file is part of GNU Emacs.
12
13;; GNU Emacs is free software; you can redistribute it and/or modify
14;; it under the terms of the GNU General Public License as published by
15;; the Free Software Foundation; either version 2, or (at your option)
16;; any later version.
17
18;; GNU Emacs is distributed in the hope that it will be useful,
19;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
21;; GNU General Public License for more details.
22
23;; You should have received a copy of the GNU General Public License
24;; along with GNU Emacs; see the file COPYING.  If not, write to the
25;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
26;; Boston, MA 02110-1301, USA.
27
28;;; Commentary:
29
30;; This file includes the functions in the MH-Folder maps that get us
31;; into MH-Letter mode, as well the functions in the MH-Letter mode
32;; that are used to send the mail. Other that those, functions that
33;; are needed in mh-letter.el should be found there.
34
35;;; Change Log:
36
37;;; Code:
38
39(require 'mh-e)
40(require 'mh-gnus)                      ;needed because mh-gnus.el not compiled
41(require 'mh-scan)
42
43(require 'sendmail)
44
45(autoload 'easy-menu-add "easymenu")
46(autoload 'mml-insert-tag "mml")
47
48
49
50;;; Site Customization
51
52(defvar mh-send-prog "send"
53  "Name of the MH send program.
54Some sites need to change this because of a name conflict.")
55
56(defvar mh-send-uses-spost-flag nil
57  "Non-nil means \"send\" uses \"spost\" to submit messages.
58
59If the value of \"postproc:\" is \"spost\", you may need to set
60this variable to t to tell MH-E to avoid using features of
61\"post\" that are not supported by \"spost\". You'll know that
62you'll need to do this if sending mail fails with an error of
63\"spost: -msgid unknown\".")
64
65(defvar mh-redist-background nil
66  "If non-nil redist will be done in background like send.
67This allows transaction log to be visible if -watch, -verbose or
68-snoop are used.")
69
70
71
72;;; Variables
73
74(defvar mh-comp-formfile "components"
75  "Name of file to be used as a skeleton for composing messages.
76
77Default is \"components\".
78
79If not an absolute file name, the file is searched for first in the
80user's MH directory, then in the system MH lib directory.")
81
82(defvar mh-repl-formfile "replcomps"
83  "Name of file to be used as a skeleton for replying to messages.
84
85Default is \"replcomps\".
86
87If not an absolute file name, the file is searched for first in the
88user's MH directory, then in the system MH lib directory.")
89
90(defvar mh-repl-group-formfile "replgroupcomps"
91  "Name of file to be used as a skeleton for replying to messages.
92
93Default is \"replgroupcomps\".
94
95This file is used to form replies to the sender and all recipients of
96a message. Only used if `(mh-variant-p 'nmh)' is non-nil.
97If not an absolute file name, the file is searched for first in the
98user's MH directory, then in the system MH lib directory.")
99
100(defvar mh-rejected-letter-start
101  (format "^%s$"
102          (regexp-opt
103           '("Content-Type: message/rfc822" ;MIME MDN
104             "------ This is a copy of the message, including all the headers. ------";from exim
105             "--- Below this line is a copy of the message."; from qmail
106             "   ----- Unsent message follows -----" ;from sendmail V5
107             " --------Unsent Message below:" ; from sendmail at BU
108             "   ----- Original message follows -----" ;from sendmail V8
109             "------- Unsent Draft"     ;from MH itself
110             "----------  Original Message  ----------" ;from zmailer
111             "  --- The unsent message follows ---" ;from AIX mail system
112             "    Your message follows:" ;from MMDF-II
113             "Content-Description: Returned Content" ;1993 KJ sendmail
114             ))))
115
116(defvar mh-new-draft-cleaned-headers
117  "^Date:\\|^Received:\\|^Message-Id:\\|^From:\\|^Sender:\\|^Errors-To:\\|^Delivery-Date:\\|^Return-Path:"
118  "Regexp of header lines to remove before offering a message as a new draft\\<mh-folder-mode-map>.
119Used by the \\[mh-edit-again] and \\[mh-extract-rejected-mail] commands.")
120
121(defvar mh-letter-mode-syntax-table nil
122  "Syntax table used by MH-E while in MH-Letter mode.")
123
124(if mh-letter-mode-syntax-table
125    ()
126  (setq mh-letter-mode-syntax-table
127        (make-syntax-table text-mode-syntax-table))
128  (modify-syntax-entry ?% "." mh-letter-mode-syntax-table))
129
130(defvar mh-send-args ""
131  "Extra args to pass to \"send\" command.")
132
133(defvar mh-annotate-char nil
134  "Character to use to annotate `mh-sent-from-msg'.")
135
136(defvar mh-annotate-field nil
137  "Field name for message annotation.")
138
139(defvar mh-insert-auto-fields-done-local nil
140  "Buffer-local variable set when `mh-insert-auto-fields' called successfully.")
141(make-variable-buffer-local 'mh-insert-auto-fields-done-local)
142
143
144
145;;; MH-E Entry Points
146
147;;;###autoload
148(defun mh-smail ()
149  "Compose a message with the MH mail system.
150See `mh-send' for more details on composing mail."
151  (interactive)
152  (mh-find-path)
153  (call-interactively 'mh-send))
154
155;;;###autoload
156(defun mh-smail-other-window ()
157  "Compose a message with the MH mail system in other window.
158See `mh-send' for more details on composing mail."
159  (interactive)
160  (mh-find-path)
161  (call-interactively 'mh-send-other-window))
162
163(defun mh-send-other-window (to cc subject)
164  "Compose a message in another window.
165
166See `mh-send' for more information and a description of how the
167TO, CC, and SUBJECT arguments are used."
168  (interactive (list
169                (mh-interactive-read-address "To: ")
170                (mh-interactive-read-address "Cc: ")
171                (mh-interactive-read-string "Subject: ")))
172  (let ((pop-up-windows t))
173    (mh-send-sub to cc subject (current-window-configuration))))
174
175(defvar mh-error-if-no-draft nil)       ;raise error over using old draft
176
177;;;###autoload
178(defun mh-smail-batch (&optional to subject other-headers &rest ignored)
179  "Compose a message with the MH mail system.
180
181This function does not prompt the user for any header fields, and
182thus is suitable for use by programs that want to create a mail
183buffer. Users should use \\[mh-smail] to compose mail.
184
185Optional arguments for setting certain fields include TO,
186SUBJECT, and OTHER-HEADERS. Additional arguments are IGNORED.
187
188This function remains for Emacs 21 compatibility. New
189applications should use `mh-user-agent-compose'."
190  (mh-find-path)
191  (let ((mh-error-if-no-draft t))
192    (mh-send (or to "") "" (or subject ""))))
193
194;;;###autoload
195(define-mail-user-agent 'mh-e-user-agent
196  'mh-user-agent-compose 'mh-send-letter 'mh-fully-kill-draft
197  'mh-before-send-letter-hook)
198
199;;;###autoload
200(defun mh-user-agent-compose (&optional to subject other-headers continue
201                                        switch-function yank-action
202                                        send-actions)
203  "Set up mail composition draft with the MH mail system.
204This is the `mail-user-agent' entry point to MH-E. This function
205conforms to the contract specified by `define-mail-user-agent'
206which means that this function should accept the same arguments
207as `compose-mail'.
208
209The optional arguments TO and SUBJECT specify recipients and the
210initial Subject field, respectively.
211
212OTHER-HEADERS is an alist specifying additional header fields.
213Elements look like (HEADER . VALUE) where both HEADER and VALUE
214are strings.
215
216CONTINUE, SWITCH-FUNCTION, YANK-ACTION and SEND-ACTIONS are
217ignored."
218  (mh-find-path)
219  (let ((mh-error-if-no-draft t))
220    (mh-send to "" subject)
221    (while other-headers
222      (mh-insert-fields (concat (car (car other-headers)) ":")
223                        (cdr (car other-headers)))
224      (setq other-headers (cdr other-headers)))))
225
226;; Shush compiler.
227(defvar sendmail-coding-system)         ; XEmacs
228
229;;;###autoload
230(defun mh-send-letter (&optional arg)
231  "Save draft and send message.
232
233When you are all through editing a message, you send it with this
234command. You can give a prefix argument ARG to monitor the first stage
235of the delivery\; this output can be found in a buffer called \"*MH-E
236Mail Delivery*\".
237
238The hook `mh-before-send-letter-hook' is run at the beginning of
239this command. For example, if you want to check your spelling in
240your message before sending, add the function `ispell-message'.
241
242Unless `mh-insert-auto-fields' had previously been called
243manually, the function `mh-insert-auto-fields' is called to
244insert fields based upon the recipients. If fields are added, you
245are given a chance to see and to confirm these fields before the
246message is actually sent. You can do away with this confirmation
247by turning off the option `mh-auto-fields-prompt-flag'.
248
249In case the MH \"send\" program is installed under a different name,
250use `mh-send-prog' to tell MH-E the name."
251  (interactive "P")
252  (run-hooks 'mh-before-send-letter-hook)
253  (if (and (mh-insert-auto-fields t)
254           mh-auto-fields-prompt-flag
255           (goto-char (point-min)))
256      (if (not (y-or-n-p "Auto fields inserted, send? "))
257          (error "Send aborted")))
258  (cond ((mh-mh-directive-present-p)
259         (mh-mh-to-mime))
260        ((or (mh-mml-tag-present-p) (not (mh-ascii-buffer-p)))
261         (mh-mml-to-mime)))
262  (save-buffer)
263  (message "Sending...")
264  (let ((draft-buffer (current-buffer))
265        (file-name buffer-file-name)
266        (config mh-previous-window-config)
267        (coding-system-for-write
268         (if (and (local-variable-p 'buffer-file-coding-system
269                                    (current-buffer)) ;XEmacs needs two args
270                  ;; We're not sure why, but buffer-file-coding-system
271                  ;; tends to get set to undecided-unix.
272                  (not (memq buffer-file-coding-system
273                             '(undecided undecided-unix undecided-dos))))
274             buffer-file-coding-system
275           (or (and (boundp 'sendmail-coding-system) sendmail-coding-system)
276               (and (boundp 'default-buffer-file-coding-system )
277                    default-buffer-file-coding-system)
278               'iso-latin-1))))
279    ;; Older versions of spost do not support -msgid and -mime.
280    (unless mh-send-uses-spost-flag
281      ;; Adding a Message-ID field looks good, makes it easier to search for
282      ;; message in your +outbox, and best of all doesn't break threading for
283      ;; the recipient if you reply to a message in your +outbox.
284      (setq mh-send-args (concat "-msgid " mh-send-args))
285      ;; The default BCC encapsulation will make a MIME message unreadable.
286      ;; With nmh use the -mime arg to prevent this.
287      (if (and (mh-variant-p 'nmh)
288               (mh-goto-header-field "Bcc:")
289               (mh-goto-header-field "Content-Type:"))
290          (setq mh-send-args (concat "-mime " mh-send-args))))
291    (cond (arg
292           (pop-to-buffer mh-mail-delivery-buffer)
293           (erase-buffer)
294           (mh-exec-cmd-output mh-send-prog t "-watch" "-nopush"
295                               "-nodraftfolder" mh-send-args file-name)
296           (goto-char (point-max))      ; show the interesting part
297           (recenter -1)
298           (set-buffer draft-buffer))   ; for annotation below
299          (t
300           (mh-exec-cmd-daemon mh-send-prog nil "-nodraftfolder" "-noverbose"
301                               (split-string mh-send-args) file-name)))
302    (if mh-annotate-char
303        (mh-annotate-msg mh-sent-from-msg
304                         mh-sent-from-folder
305                         mh-annotate-char
306                         "-component" mh-annotate-field
307                         "-text" (format "\"%s %s\""
308                                         (mh-get-header-field "To:")
309                                         (mh-get-header-field "Cc:"))))
310
311    (cond ((or (not arg)
312               (y-or-n-p "Kill draft buffer? "))
313           (kill-buffer draft-buffer)
314           (if config
315               (set-window-configuration config))))
316    (if arg
317        (message "Sending...done")
318      (message "Sending...backgrounded"))))
319
320;;;###autoload
321(defun mh-fully-kill-draft ()
322  "Quit editing and delete draft message.
323
324If for some reason you are not happy with the draft, you can use
325this command to kill the draft buffer and delete the draft
326message. Use the command \\[kill-buffer] if you don't want to
327delete the draft message."
328  (interactive)
329  (if (y-or-n-p "Kill draft message? ")
330      (let ((config mh-previous-window-config))
331        (if (file-exists-p buffer-file-name)
332            (delete-file buffer-file-name))
333        (set-buffer-modified-p nil)
334        (kill-buffer (buffer-name))
335        (message "")
336        (if config
337            (set-window-configuration config)))
338    (error "Message not killed")))
339
340
341
342;;; MH-Folder Commands
343
344;; Alphabetical.
345
346;;;###mh-autoload
347(defun mh-edit-again (message)
348  "Edit a MESSAGE to send it again.
349
350If you don't complete a draft for one reason or another, and if
351the draft buffer is no longer available, you can pick your draft
352up again with this command. If you don't use a draft folder, your
353last \"draft\" file will be used. If you use draft folders,
354you'll need to visit the draft folder with \"\\[mh-visit-folder]
355drafts <RET>\", use \\[mh-next-undeleted-msg] to move to the
356appropriate message, and then use \\[mh-edit-again] to prepare
357the message for editing.
358
359This command can also be used to take messages that were sent to
360you and to send them to more people.
361
362Don't use this command to re-edit a message from a Mailer-Daemon
363who complained that your mail wasn't posted for some reason or
364another (see `mh-extract-rejected-mail').
365
366The default message is the current message.
367
368See also `mh-send'."
369  (interactive (list (mh-get-msg-num t)))
370  (let* ((from-folder mh-current-folder)
371         (config (current-window-configuration))
372         (draft
373          (cond ((and mh-draft-folder (equal from-folder mh-draft-folder))
374                 (pop-to-buffer (find-file-noselect (mh-msg-filename message))
375                                t)
376                 (rename-buffer (format "draft-%d" message))
377                 ;; Make buffer writable...
378                 (setq buffer-read-only nil)
379                 ;; If buffer was being used to display the message reinsert
380                 ;; from file...
381                 (when (eq major-mode 'mh-show-mode)
382                   (erase-buffer)
383                   (insert-file-contents buffer-file-name))
384                 (buffer-name))
385                (t
386                 (mh-read-draft "clean-up" (mh-msg-filename message) nil)))))
387    (mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil)
388    (mh-insert-header-separator)
389    (goto-char (point-min))
390    (save-buffer)
391    (mh-compose-and-send-mail draft "" from-folder nil nil nil nil nil nil
392                              config)
393    (mh-letter-mode-message)
394    (mh-letter-adjust-point)))
395
396;;;###mh-autoload
397(defun mh-extract-rejected-mail (message)
398  "Edit a MESSAGE that was returned by the mail system.
399
400This command prepares the message for editing by removing the
401Mailer-Daemon envelope and unneeded header fields. Fix whatever
402addressing problem you had, and send the message again with
403\\[mh-send-letter].
404
405The default message is the current message.
406
407See also `mh-send'."
408  (interactive (list (mh-get-msg-num t)))
409  (let ((from-folder mh-current-folder)
410        (config (current-window-configuration))
411        (draft (mh-read-draft "extraction" (mh-msg-filename message) nil)))
412    (goto-char (point-min))
413    (cond ((re-search-forward mh-rejected-letter-start nil t)
414           (skip-chars-forward " \t\n")
415           (delete-region (point-min) (point))
416           (mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil))
417          (t
418           (message "Does not appear to be a rejected letter")))
419    (mh-insert-header-separator)
420    (goto-char (point-min))
421    (save-buffer)
422    (mh-compose-and-send-mail draft "" from-folder message
423                              (mh-get-header-field "To:")
424                              (mh-get-header-field "From:")
425                              (mh-get-header-field "Cc:")
426                              nil nil config)
427    (mh-letter-mode-message)))
428
429;;;###mh-autoload
430(defun mh-forward (to cc &optional range)
431  "Forward message.
432
433You are prompted for the TO and CC recipients. You are given a
434draft to edit that looks like it would if you had run the MH
435command \"forw\". You can then add some text.
436
437You can forward several messages by using a RANGE. All of the
438messages in the range are inserted into your draft. Check the
439documentation of `mh-interactive-range' to see how RANGE is read
440in interactive use.
441
442The hook `mh-forward-hook' is called on the draft.
443
444See also `mh-compose-forward-as-mime-flag',
445`mh-forward-subject-format', and `mh-send'."
446  (interactive (list (mh-interactive-read-address "To: ")
447                     (mh-interactive-read-address "Cc: ")
448                     (mh-interactive-range "Forward")))
449  (let* ((folder mh-current-folder)
450         (msgs (mh-range-to-msg-list range))
451         (config (current-window-configuration))
452         (fwd-msg-file (mh-msg-filename (car msgs) folder))
453         ;; forw always leaves file in "draft" since it doesn't have -draft
454         (draft-name (expand-file-name "draft" mh-user-path))
455         (draft (cond ((or (not (file-exists-p draft-name))
456                           (y-or-n-p "The file draft exists; discard it? "))
457                       (mh-exec-cmd "forw" "-build"
458                                    (if (and (mh-variant-p 'nmh)
459                                             mh-compose-forward-as-mime-flag)
460                                        "-mime")
461                                    mh-current-folder
462                                    (mh-coalesce-msg-list msgs))
463                       (prog1
464                           (mh-read-draft "" draft-name t)
465                         (mh-insert-fields "To:" to "Cc:" cc)
466                         (save-buffer)))
467                      (t
468                       (mh-read-draft "" draft-name nil)))))
469    (let (orig-from
470          orig-subject)
471      (save-excursion
472        (set-buffer (get-buffer-create mh-temp-buffer))
473        (erase-buffer)
474        (insert-file-contents fwd-msg-file)
475        (setq orig-from (mh-get-header-field "From:"))
476        (setq orig-subject (mh-get-header-field "Subject:")))
477      (let ((forw-subject
478             (mh-forwarded-letter-subject orig-from orig-subject)))
479        (mh-insert-fields "Subject:" forw-subject)
480        (goto-char (point-min))
481        ;; If using MML, translate MH-style directive
482        (if (equal mh-compose-insertion 'mml)
483            (save-excursion
484              (goto-char (mh-mail-header-end))
485              (while
486                  (re-search-forward
487                   "^#forw \\[\\([^]]+\\)\\] \\(+\\S-+\\) \\(.*\\)$"
488                   (point-max) t)
489                (let ((description (if (equal (match-string 1)
490                                              "forwarded messages")
491                                       "forwarded message %d"
492                                     (match-string 1)))
493                      (msgs (split-string (match-string 3)))
494                      (i 0))
495                  (beginning-of-line)
496                  (delete-region (point) (progn (forward-line 1) (point)))
497                  (dolist (msg msgs)
498                    (setq i (1+ i))
499                    (mh-mml-forward-message (format description i)
500                                            folder msg))))))
501        ;; Postition just before forwarded message
502        (if (re-search-forward "^------- Forwarded Message" nil t)
503            (forward-line -1)
504          (goto-char (mh-mail-header-end))
505          (forward-line 1))
506        (delete-other-windows)
507        (mh-add-msgs-to-seq msgs 'forwarded t)
508        (mh-compose-and-send-mail draft "" folder msgs
509                                  to forw-subject cc
510                                  mh-note-forw "Forwarded:"
511                                  config)
512        (mh-letter-mode-message)
513        (mh-letter-adjust-point)
514        (run-hooks 'mh-forward-hook)))))
515
516(defun mh-forwarded-letter-subject (from subject)
517  "Return a Subject suitable for a forwarded message.
518Original message has headers FROM and SUBJECT."
519  (let ((addr-start (string-match "<" from))
520        (comment (string-match "(" from)))
521    (cond ((and addr-start (> addr-start 0))
522           ;; Full Name <luser@host>
523           (setq from (substring from 0 (1- addr-start))))
524          (comment
525           ;; luser@host (Full Name)
526           (setq from (substring from (1+ comment) (1- (length from)))))))
527  (format mh-forward-subject-format from subject))
528
529;;;###mh-autoload
530(defun mh-redistribute (to cc &optional message)
531  "Redistribute a message.
532
533This command is similar in function to forwarding mail, but it
534does not allow you to edit the message, nor does it add your name
535to the \"From\" header field. It appears to the recipient as if
536the message had come from the original sender. When you run this
537command, you are prompted for the TO and CC recipients. The
538default MESSAGE is the current message.
539
540Also investigate the command \\[mh-edit-again] for another way to
541redistribute messages.
542
543See also `mh-redist-full-contents-flag'."
544  (interactive (list (mh-read-address "Redist-To: ")
545                     (mh-read-address "Redist-Cc: ")
546                     (mh-get-msg-num t)))
547  (or message
548      (setq message (mh-get-msg-num t)))
549  (save-window-excursion
550    (let ((folder mh-current-folder)
551          (draft (mh-read-draft "redistribution"
552                                (if mh-redist-full-contents-flag
553                                    (mh-msg-filename message)
554                                  nil)
555                                nil)))
556      (mh-goto-header-end 0)
557      (insert "Resent-To: " to "\n")
558      (if (not (equal cc "")) (insert "Resent-cc: " cc "\n"))
559      (mh-clean-msg-header
560       (point-min)
561       "^Message-Id:\\|^Received:\\|^Return-Path:\\|^Sender:\\|^Date:\\|^From:"
562       nil)
563      (save-buffer)
564      (message "Redistributing...")
565      (let ((env "mhdist=1"))
566        ;; Setup environment...
567        (setq env (concat env " mhaltmsg="
568                          (if mh-redist-full-contents-flag
569                              buffer-file-name
570                            (mh-msg-filename message folder))))
571        (unless mh-redist-full-contents-flag
572          (setq env (concat env " mhannotate=1")))
573        ;; Redistribute...
574        (if mh-redist-background
575            (mh-exec-cmd-env-daemon env mh-send-prog nil buffer-file-name)
576          (mh-exec-cmd-error env mh-send-prog "-push" buffer-file-name))
577        ;; Annotate...
578        (mh-annotate-msg message folder mh-note-dist
579                         "-component" "Resent:"
580                         "-text" (format "\"%s %s\"" to cc)))
581      (kill-buffer draft)
582      (message "Redistributing...done"))))
583
584;;;###mh-autoload
585(defun mh-reply (message &optional reply-to includep)
586  "Reply to a MESSAGE.
587
588When you reply to a message, you are first prompted with \"Reply
589to whom?\" (unless the optional argument REPLY-TO is provided).
590You have several choices here.
591
592     Response     Reply Goes To
593
594     from         The person who sent the message. This is the
595                  default, so <RET> is sufficient.
596
597     to           Replies to the sender, plus all recipients in the
598                  \"To:\" header field.
599
600     all cc       Forms a reply to the addresses in the
601                  \"Mail-Followup-To:\" header field if one
602                  exists; otherwise forms a reply to the sender,
603                  plus all recipients.
604
605Depending on your answer, \"repl\" is given a different argument
606to form your reply. Specifically, a choice of \"from\" or none at
607all runs \"repl -nocc all\", and a choice of \"to\" runs \"repl
608-cc to\". Finally, either \"cc\" or \"all\" runs \"repl -cc all
609-nocc me\".
610
611Two windows are then created. One window contains the message to
612which you are replying in an MH-Show buffer. Your draft, in
613MH-Letter mode (*note `mh-letter-mode'), is in the other window.
614If the reply draft was not one that you expected, check the
615things that affect the behavior of \"repl\" which include the
616\"repl:\" profile component and the \"replcomps\" and
617\"replgroupcomps\" files.
618
619If you supply a prefix argument INCLUDEP, the message you are
620replying to is inserted in your reply after having first been run
621through \"mhl\" with the format file \"mhl.reply\".
622
623Alternatively, you can customize the option `mh-yank-behavior'
624and choose one of its \"Automatically\" variants to do the same
625thing. If you do so, the prefix argument has no effect.
626
627Another way to include the message automatically in your draft is
628to use \"repl: -filter repl.filter\" in your MH profile.
629
630If you wish to customize the header or other parts of the reply
631draft, please see \"repl\" and \"mh-format\".
632
633See also `mh-reply-show-message-flag',
634`mh-reply-default-reply-to', and `mh-send'."
635  (interactive (list
636                (mh-get-msg-num t)
637                (let ((minibuffer-help-form
638                       "from => Sender only\nto => Sender and primary recipients\ncc or all => Sender and all recipients"))
639                  (or mh-reply-default-reply-to
640                      (completing-read "Reply to whom (default from): "
641                                       '(("from") ("to") ("cc") ("all"))
642                                       nil
643                                       t)))
644                current-prefix-arg))
645  (let* ((folder mh-current-folder)
646         (show-buffer mh-show-buffer)
647         (config (current-window-configuration))
648         (group-reply (or (equal reply-to "cc") (equal reply-to "all")))
649         (form-file (cond ((and (mh-variant-p 'nmh 'mu-mh) group-reply
650                                (stringp mh-repl-group-formfile))
651                           mh-repl-group-formfile)
652                          ((stringp mh-repl-formfile) mh-repl-formfile)
653                          (t nil))))
654    (message "Composing a reply...")
655    (mh-exec-cmd "repl" "-build" "-noquery" "-nodraftfolder"
656                 (if form-file
657                     (list "-form" form-file))
658                 mh-current-folder message
659                 (cond ((or (equal reply-to "from") (equal reply-to ""))
660                        '("-nocc" "all"))
661                       ((equal reply-to "to")
662                        '("-cc" "to"))
663                       (group-reply (if (mh-variant-p 'nmh 'mu-mh)
664                                        '("-group" "-nocc" "me")
665                                      '("-cc" "all" "-nocc" "me"))))
666                 (cond ((or (eq mh-yank-behavior 'autosupercite)
667                            (eq mh-yank-behavior 'autoattrib))
668                        '("-noformat"))
669                       (includep '("-filter" "mhl.reply"))
670                       (t '())))
671    (let ((draft (mh-read-draft "reply"
672                                (expand-file-name "reply" mh-user-path)
673                                t)))
674      (delete-other-windows)
675      (save-buffer)
676
677      (let ((to (mh-get-header-field "To:"))
678            (subject (mh-get-header-field "Subject:"))
679            (cc (mh-get-header-field "Cc:")))
680        (goto-char (point-min))
681        (mh-goto-header-end 1)
682        (or includep
683            (not mh-reply-show-message-flag)
684            (mh-in-show-buffer (show-buffer)
685              (mh-display-msg message folder)))
686        (mh-add-msgs-to-seq message 'answered t)
687        (message "Composing a reply...done")
688        (mh-compose-and-send-mail draft "" folder message to subject cc
689                                  mh-note-repl "Replied:" config))
690      (when (and (or (eq 'autosupercite mh-yank-behavior)
691                     (eq 'autoattrib mh-yank-behavior))
692                 (eq (mh-show-buffer-message-number) mh-sent-from-msg))
693        (undo-boundary)
694        (mh-yank-cur-msg))
695      (mh-letter-mode-message))))
696
697;;;###mh-autoload
698(defun mh-send (to cc subject)
699  "Compose a message.
700
701Your letter appears in an Emacs buffer whose mode is
702MH-Letter (see `mh-letter-mode').
703
704The arguments TO, CC, and SUBJECT can be used to prefill the
705draft fields or suppress the prompts if `mh-compose-prompt-flag'
706is on. They are also passed to the function set in the option
707`mh-compose-letter-function'.
708
709See also `mh-insert-x-mailer-flag' and `mh-letter-mode-hook'.
710
711Outside of an MH-Folder buffer (`mh-folder-mode'), you must call
712either \\[mh-smail] or \\[mh-smail-other-window] to compose a new
713message."
714  (interactive (list
715                (mh-interactive-read-address "To: ")
716                (mh-interactive-read-address "Cc: ")
717                (mh-interactive-read-string "Subject: ")))
718  (let ((config (current-window-configuration)))
719    (delete-other-windows)
720    (mh-send-sub to cc subject config)))
721
722
723
724;;; Support Routines
725
726(defun mh-interactive-read-address (prompt)
727  "Read an address.
728If `mh-compose-prompt-flag' is non-nil, then read an address with
729PROMPT.
730Otherwise return the empty string."
731  (if mh-compose-prompt-flag (mh-read-address prompt) ""))
732
733(defun mh-interactive-read-string (prompt)
734  "Read a string.
735If `mh-compose-prompt-flag' is non-nil, then read a string with
736PROMPT.
737Otherwise return the empty string."
738  (if mh-compose-prompt-flag (read-string prompt) ""))
739
740;;;###mh-autoload
741(defun mh-show-buffer-message-number (&optional buffer)
742  "Message number of displayed message in corresponding show buffer.
743
744Return nil if show buffer not displayed.
745If in `mh-letter-mode', don't display the message number being replied
746to, but rather the message number of the show buffer associated with
747our originating folder buffer.
748Optional argument BUFFER can be used to specify the buffer."
749  (save-excursion
750    (if buffer
751        (set-buffer buffer))
752    (cond ((eq major-mode 'mh-show-mode)
753           (let ((number-start (mh-search-from-end ?/ buffer-file-name)))
754             (string-to-number (substring buffer-file-name
755                                          (1+ number-start)))))
756          ((and (eq major-mode 'mh-folder-mode)
757                mh-show-buffer
758                (get-buffer mh-show-buffer))
759           (mh-show-buffer-message-number mh-show-buffer))
760          ((and (eq major-mode 'mh-letter-mode)
761                mh-sent-from-folder
762                (get-buffer mh-sent-from-folder))
763           (mh-show-buffer-message-number mh-sent-from-folder))
764          (t
765           nil))))
766
767(defun mh-send-sub (to cc subject config)
768  "Do the real work of composing and sending a letter.
769Expects the TO, CC, and SUBJECT fields as arguments.
770CONFIG is the window configuration before sending mail."
771  (let ((folder mh-current-folder)
772        (msg-num (mh-get-msg-num nil)))
773    (message "Composing a message...")
774    (let ((draft (mh-read-draft
775                  "message"
776                  (let (components)
777                    (cond
778                     ((file-exists-p
779                       (setq components
780                             (expand-file-name mh-comp-formfile mh-user-path)))
781                      components)
782                     ((file-exists-p
783                       (setq components
784                             (expand-file-name mh-comp-formfile mh-lib)))
785                      components)
786                     (t
787                      (error "Can't find %s in %s or %s"
788                             mh-comp-formfile mh-user-path mh-lib))))
789                  nil)))
790      (mh-insert-fields "To:" to "Subject:" subject "Cc:" cc)
791      (goto-char (point-max))
792      (mh-compose-and-send-mail draft "" folder msg-num
793                                to subject cc
794                                nil nil config)
795      (mh-letter-mode-message)
796      (mh-letter-adjust-point))))
797
798(defun mh-read-draft (use initial-contents delete-contents-file)
799  "Read draft file into a draft buffer and make that buffer the current one.
800
801USE is a message used for prompting about the intended use of the
802message.
803INITIAL-CONTENTS is filename that is read into an empty buffer, or nil
804if buffer should not be modified. Delete the initial-contents file if
805DELETE-CONTENTS-FILE flag is set.
806Returns the draft folder's name.
807If the draft folder facility is enabled in ~/.mh_profile, a new buffer
808is used each time and saved in the draft folder. The draft file can
809then be reused."
810  (cond (mh-draft-folder
811         (let ((orig-default-dir default-directory)
812               (draft-file-name (mh-new-draft-name)))
813           (pop-to-buffer (generate-new-buffer
814                           (format "draft-%s"
815                                   (file-name-nondirectory draft-file-name))))
816           (condition-case ()
817               (insert-file-contents draft-file-name t)
818             (file-error))
819           (setq default-directory orig-default-dir)))
820        (t
821         (let ((draft-name (expand-file-name "draft" mh-user-path)))
822           (pop-to-buffer "draft")      ; Create if necessary
823           (if (buffer-modified-p)
824               (if (y-or-n-p "Draft has been modified; kill anyway? ")
825                   (set-buffer-modified-p nil)
826                 (error "Draft preserved")))
827           (setq buffer-file-name draft-name)
828           (clear-visited-file-modtime)
829           (unlock-buffer)
830           (cond ((and (file-exists-p draft-name)
831                       (not (equal draft-name initial-contents)))
832                  (insert-file-contents draft-name)
833                  (delete-file draft-name))))))
834  (cond ((and initial-contents
835              (or (zerop (buffer-size))
836                  (if (y-or-n-p
837                       (format "A draft exists.  Use for %s? " use))
838                      (if mh-error-if-no-draft
839                          (error "A prior draft exists"))
840                    t)))
841         (erase-buffer)
842         (insert-file-contents initial-contents)
843         (if delete-contents-file (delete-file initial-contents))))
844  (auto-save-mode 1)
845  (if mh-draft-folder
846      (save-buffer))                    ; Do not reuse draft name
847  (buffer-name))
848
849(defun mh-new-draft-name ()
850  "Return the pathname of folder for draft messages."
851  (save-excursion
852    (mh-exec-cmd-quiet t "mhpath" mh-draft-folder "new")
853    (buffer-substring (point-min) (1- (point-max)))))
854
855(defun mh-insert-fields (&rest name-values)
856  "Insert the NAME-VALUES pairs in the current buffer.
857If the field exists, append the value to it.
858Do not insert any pairs whose value is the empty string."
859  (let ((case-fold-search t))
860    (while name-values
861      (let ((field-name (car name-values))
862            (value (car (cdr name-values))))
863        (if (not (string-match "^.*:$" field-name))
864            (setq field-name (concat field-name ":")))
865        (cond ((or (null value)
866                   (equal value ""))
867               nil)
868              ((mh-position-on-field field-name)
869               (insert " " (or value "")))
870              (t
871               (insert field-name " " value "\n")))
872        (setq name-values (cdr (cdr name-values)))))))
873
874(defun mh-compose-and-send-mail (draft send-args
875                                       sent-from-folder sent-from-msg
876                                       to subject cc
877                                       annotate-char annotate-field
878                                       config)
879  "Edit and compose a draft message in buffer DRAFT and send or save it.
880SEND-ARGS is the argument passed to the send command.
881SENT-FROM-FOLDER is buffer containing scan listing of current folder,
882or nil if none exists.
883SENT-FROM-MSG is the message number or sequence name or nil.
884The TO, SUBJECT, and CC fields are passed to the
885`mh-compose-letter-function'.
886If ANNOTATE-CHAR is non-null, it is used to notate the scan listing of
887the message. In that case, the ANNOTATE-FIELD is used to build a
888string for `mh-annotate-msg'.
889CONFIG is the window configuration to restore after sending the
890letter."
891  (pop-to-buffer draft)
892  (mh-letter-mode)
893
894  ;; Insert identity.
895  (mh-insert-identity mh-identity-default t)
896  (mh-identity-make-menu)
897  (mh-identity-add-menu)
898
899  ;; Insert extra fields.
900  (mh-insert-x-mailer)
901  (mh-insert-x-face)
902
903  (mh-letter-hide-all-skipped-fields)
904
905  (setq mh-sent-from-folder sent-from-folder)
906  (setq mh-sent-from-msg sent-from-msg)
907  (setq mh-send-args send-args)
908  (setq mh-annotate-char annotate-char)
909  (setq mh-annotate-field annotate-field)
910  (setq mh-previous-window-config config)
911  (setq mode-line-buffer-identification (list "    {%b}"))
912  (mh-logo-display)
913  (mh-make-local-hook 'kill-buffer-hook)
914  (add-hook 'kill-buffer-hook 'mh-tidy-draft-buffer nil t)
915  (run-hook-with-args 'mh-compose-letter-function to subject cc))
916
917(defun mh-insert-x-mailer ()
918  "Append an X-Mailer field to the header.
919The versions of MH-E, Emacs, and MH are shown."
920  ;; Lazily initialize mh-x-mailer-string.
921  (when (and mh-insert-x-mailer-flag (null mh-x-mailer-string))
922    (setq mh-x-mailer-string
923          (format "MH-E %s; %s; %sEmacs %s"
924                  mh-version mh-variant-in-use
925                  (if mh-xemacs-flag "X" "GNU ")
926                  (cond ((not mh-xemacs-flag)
927                         (string-match "[0-9]+\\.[0-9]+\\(\\.[0-9]+\\)?"
928                                       emacs-version)
929                         (match-string 0 emacs-version))
930                        ((string-match "[0-9.]*\\( +\([ a-z]+[0-9]+\)\\)?"
931                                       emacs-version)
932                         (match-string 0 emacs-version))
933                        (t (format "%s.%s" emacs-major-version
934                                   emacs-minor-version))))))
935  ;; Insert X-Mailer, but only if it doesn't already exist.
936  (save-excursion
937    (when (and mh-insert-x-mailer-flag
938               (null (mh-goto-header-field "X-Mailer")))
939      (mh-insert-fields "X-Mailer:" mh-x-mailer-string))))
940
941(defun mh-insert-x-face ()
942  "Append X-Face, Face or X-Image-URL field to header.
943If the field already exists, this function does nothing."
944  (when (and (file-exists-p mh-x-face-file)
945             (file-readable-p mh-x-face-file))
946    (save-excursion
947      (unless (or (mh-position-on-field "X-Face")
948                  (mh-position-on-field "Face")
949                  (mh-position-on-field "X-Image-URL"))
950        (save-excursion
951          (goto-char (+ (point) (cadr (insert-file-contents mh-x-face-file))))
952          (if (not (looking-at "^"))
953              (insert "\n")))
954        (unless (looking-at "\\(X-Face\\|Face\\|X-Image-URL\\): ")
955          (insert "X-Face: "))))))
956
957(defun mh-tidy-draft-buffer ()
958  "Run when a draft buffer is destroyed."
959  (let ((buffer (get-buffer mh-recipients-buffer)))
960    (if buffer
961        (kill-buffer buffer))))
962
963(defun mh-letter-mode-message ()
964  "Display a help message for users of `mh-letter-mode'.
965This should be the last function called when composing the draft."
966  (message "%s" (substitute-command-keys
967                 (concat "Type \\[mh-send-letter] to send message, "
968                         "\\[mh-help] for help"))))
969
970(defun mh-letter-adjust-point ()
971  "Move cursor to first header field if are using the no prompt mode."
972  (unless mh-compose-prompt-flag
973    (goto-char (point-max))
974    (mh-letter-next-header-field)))
975
976(defun mh-annotate-msg (msg buffer note &rest args)
977  "Mark MSG in BUFFER with character NOTE and annotate message with ARGS.
978MSG can be a message number, a list of message numbers, or a
979sequence."
980  (apply 'mh-exec-cmd "anno" buffer
981         (if (listp msg) (append msg args) (cons msg args)))
982  (save-excursion
983    (cond ((get-buffer buffer)          ; Buffer may be deleted
984           (set-buffer buffer)
985           (mh-iterate-on-range nil msg
986             (mh-notate nil note
987                        (+ mh-cmd-note mh-scan-field-destination-offset)))))))
988
989(defun mh-insert-header-separator ()
990  "Insert `mh-mail-header-separator', if absent."
991  (save-excursion
992    (goto-char (point-min))
993    (rfc822-goto-eoh)
994    (if (looking-at "$")
995        (insert mh-mail-header-separator))))
996
997;;;###mh-autoload
998(defun mh-insert-auto-fields (&optional non-interactive)
999  "Insert custom fields if recipient is found in `mh-auto-fields-list'.
1000
1001Once the header contains one or more recipients, you may run this
1002command to insert these fields manually. However, if you use this
1003command, the automatic insertion when the message is sent is
1004disabled.
1005
1006In a program, set buffer-local `mh-insert-auto-fields-done-local'
1007if header fields were added. If NON-INTERACTIVE is non-nil,
1008perform actions quietly and only if
1009`mh-insert-auto-fields-done-local' is nil. Return t if fields
1010added; otherwise return nil."
1011  (interactive)
1012  (when (or (not non-interactive)
1013            (not mh-insert-auto-fields-done-local))
1014    (save-excursion
1015      (when (and (or (mh-goto-header-field "To:")
1016                     (mh-goto-header-field "cc:")))
1017        (let ((list mh-auto-fields-list)
1018              (fields-inserted nil))
1019          (while list
1020            (let ((regexp (nth 0 (car list)))
1021                  (entries (nth 1 (car list))))
1022              (when (mh-regexp-in-field-p regexp "To:" "cc:")
1023                (setq mh-insert-auto-fields-done-local t)
1024                (setq fields-inserted t)
1025                (if (not non-interactive)
1026                    (message "Fields for %s added" regexp))
1027                (let ((entry-list entries))
1028                  (while entry-list
1029                    (let ((field (caar entry-list))
1030                          (value (cdar entry-list)))
1031                      (cond
1032                       ((equal ":identity" field)
1033                        (when
1034                            ;;(and (not mh-identity-local)
1035                            ;; Bug 1204506.  But do we need to be able
1036                            ;; to set an identity manually that won't be
1037                            ;; overridden by mh-insert-auto-fields?
1038                            (assoc value mh-identity-list)
1039                          ;;)
1040                          (mh-insert-identity value)))
1041                       (t
1042                        (mh-modify-header-field field value
1043                                                (equal field "From")))))
1044                    (setq entry-list (cdr entry-list))))))
1045            (setq list (cdr list)))
1046          fields-inserted)))))
1047
1048(defun mh-modify-header-field (field value &optional overwrite-flag)
1049  "To header FIELD add VALUE.
1050If OVERWRITE-FLAG is non-nil then the old value, if present, is
1051discarded."
1052  (cond ((and overwrite-flag
1053              (mh-goto-header-field (concat field ":")))
1054         (insert " " value)
1055         (delete-region (point) (mh-line-end-position)))
1056        ((and (not overwrite-flag)
1057              (mh-regexp-in-field-p (concat "\\b" value "\\b") field))
1058         ;; Already there, do nothing.
1059         )
1060        ((and (not overwrite-flag)
1061              (mh-goto-header-field (concat field ":")))
1062         (insert " " value ","))
1063        (t
1064         (mh-goto-header-end 0)
1065         (insert field ": " value "\n"))))
1066
1067(defun mh-regexp-in-field-p (regexp &rest fields)
1068  "Non-nil means REGEXP was found in FIELDS."
1069  (save-excursion
1070    (let ((search-result nil)
1071          (field))
1072      (while fields
1073        (setq field (car fields))
1074        (if (and (mh-goto-header-field field)
1075                 (re-search-forward
1076                  regexp (save-excursion (mh-header-field-end)(point)) t))
1077            (setq fields nil
1078                  search-result t)
1079          (setq fields (cdr fields))))
1080      search-result)))
1081
1082(defun mh-ascii-buffer-p ()
1083  "Check if current buffer is entirely composed of ASCII.
1084The function doesn't work for XEmacs since `find-charset-region'
1085doesn't exist there."
1086  (loop for charset in (mh-funcall-if-exists
1087                        find-charset-region (point-min) (point-max))
1088        unless (eq charset 'ascii) return nil
1089        finally return t))
1090
1091(provide 'mh-comp)
1092
1093;; Local Variables:
1094;; indent-tabs-mode: nil
1095;; sentence-end-double-space: nil
1096;; End:
1097
1098;; arch-tag: 62865511-e610-4923-b0b5-f45a8ab70a34
1099;;; mh-comp.el ends here
1100