mh-comp.el 42.1 KB
Newer Older
Bill Wohler's avatar
Bill Wohler committed
1
;;; mh-comp.el --- MH-E functions for composing and sending messages
Richard M. Stallman's avatar
Richard M. Stallman committed
2

Bill Wohler's avatar
Bill Wohler committed
3
;; Copyright (C) 1993, 1995, 1997,
4
;;  2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
Stefan Monnier's avatar
Stefan Monnier committed
5

Bill Wohler's avatar
Bill Wohler committed
6
;; Author: Bill Wohler <wohler@newt.com>
Gerd Moellmann's avatar
Gerd Moellmann committed
7
;; Maintainer: Bill Wohler <wohler@newt.com>
Stefan Monnier's avatar
Stefan Monnier committed
8
;; Keywords: mail
Bill Wohler's avatar
Bill Wohler committed
9
;; See: mh-e.el
Richard M. Stallman's avatar
Richard M. Stallman committed
10

11
;; This file is part of GNU Emacs.
Richard M. Stallman's avatar
Richard M. Stallman committed
12

Karl Heuer's avatar
Karl Heuer committed
13
;; GNU Emacs is free software; you can redistribute it and/or modify
Richard M. Stallman's avatar
Richard M. Stallman committed
14 15 16 17
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

Karl Heuer's avatar
Karl Heuer committed
18
;; GNU Emacs is distributed in the hope that it will be useful,
Richard M. Stallman's avatar
Richard M. Stallman committed
19 20 21 22 23
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
Erik Naggum's avatar
Erik Naggum committed
24
;; along with GNU Emacs; see the file COPYING.  If not, write to the
Lute Kamstra's avatar
Lute Kamstra committed
25 26
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
Richard M. Stallman's avatar
Richard M. Stallman committed
27 28 29

;;; Commentary:

Bill Wohler's avatar
Bill Wohler committed
30 31 32 33
;; This file includes the functions in the MH-Folder maps that get us
;; into MH-Letter mode, as well the functions in the MH-Letter mode
;; that are used to send the mail. Other that those, functions that
;; are needed in mh-letter.el should be found there.
Richard M. Stallman's avatar
Richard M. Stallman committed
34

Karl Heuer's avatar
Karl Heuer committed
35 36
;;; Change Log:

Richard M. Stallman's avatar
Richard M. Stallman committed
37 38
;;; Code:

39
(require 'mh-e)
Bill Wohler's avatar
Bill Wohler committed
40 41
(require 'mh-gnus)                      ;needed because mh-gnus.el not compiled
(require 'mh-scan)
42

Bill Wohler's avatar
Bill Wohler committed
43
(require 'sendmail)
Bill Wohler's avatar
Bill Wohler committed
44

Bill Wohler's avatar
Bill Wohler committed
45 46
(autoload 'easy-menu-add "easymenu")
(autoload 'mml-insert-tag "mml")
Richard M. Stallman's avatar
Richard M. Stallman committed
47

Bill Wohler's avatar
Bill Wohler committed
48 49


Bill Wohler's avatar
Bill Wohler committed
50
;;; Site Customization
Karl Heuer's avatar
Karl Heuer committed
51 52 53 54 55

(defvar mh-send-prog "send"
  "Name of the MH send program.
Some sites need to change this because of a name conflict.")

Bill Wohler's avatar
Bill Wohler committed
56 57
(defvar mh-redist-background nil
  "If non-nil redist will be done in background like send.
58 59
This allows transaction log to be visible if -watch, -verbose or
-snoop are used.")
Karl Heuer's avatar
Karl Heuer committed
60

Bill Wohler's avatar
Bill Wohler committed
61 62


Bill Wohler's avatar
Bill Wohler committed
63
;;; Variables
Richard M. Stallman's avatar
Richard M. Stallman committed
64 65 66

(defvar mh-comp-formfile "components"
  "Name of file to be used as a skeleton for composing messages.
67 68 69 70 71

Default is \"components\".

If not an absolute file name, the file is searched for first in the
user's MH directory, then in the system MH lib directory.")
Richard M. Stallman's avatar
Richard M. Stallman committed
72

Karl Heuer's avatar
Karl Heuer committed
73 74
(defvar mh-repl-formfile "replcomps"
  "Name of file to be used as a skeleton for replying to messages.
75 76 77 78 79

Default is \"replcomps\".

If not an absolute file name, the file is searched for first in the
user's MH directory, then in the system MH lib directory.")
Karl Heuer's avatar
Karl Heuer committed
80

Karl Heuer's avatar
Karl Heuer committed
81
(defvar mh-repl-group-formfile "replgroupcomps"
Bill Wohler's avatar
Bill Wohler committed
82
  "Name of file to be used as a skeleton for replying to messages.
83

Bill Wohler's avatar
Bill Wohler committed
84
Default is \"replgroupcomps\".
85 86 87 88 89

This file is used to form replies to the sender and all recipients of
a message. Only used if `(mh-variant-p 'nmh)' is non-nil.
If not an absolute file name, the file is searched for first in the
user's MH directory, then in the system MH lib directory.")
Bill Wohler's avatar
Bill Wohler committed
90

Richard M. Stallman's avatar
Richard M. Stallman committed
91
(defvar mh-rejected-letter-start
Bill Wohler's avatar
Bill Wohler committed
92
  (format "^%s$"
Bill Wohler's avatar
Bill Wohler committed
93 94
          (regexp-opt
           '("Content-Type: message/rfc822" ;MIME MDN
Bill Wohler's avatar
Bill Wohler committed
95
             "------ This is a copy of the message, including all the headers. ------";from exim
Bill Wohler's avatar
Bill Wohler committed
96
             "--- Below this line is a copy of the message."; from qmail
Bill Wohler's avatar
Bill Wohler committed
97 98 99 100 101 102 103 104 105
             "   ----- Unsent message follows -----" ;from sendmail V5
             " --------Unsent Message below:" ; from sendmail at BU
             "   ----- Original message follows -----" ;from sendmail V8
             "------- Unsent Draft"     ;from MH itself
             "----------  Original Message  ----------" ;from zmailer
             "  --- The unsent message follows ---" ;from AIX mail system
             "    Your message follows:" ;from MMDF-II
             "Content-Description: Returned Content" ;1993 KJ sendmail
             ))))
Richard M. Stallman's avatar
Richard M. Stallman committed
106 107

(defvar mh-new-draft-cleaned-headers
Karl Heuer's avatar
Karl Heuer committed
108
  "^Date:\\|^Received:\\|^Message-Id:\\|^From:\\|^Sender:\\|^Errors-To:\\|^Delivery-Date:\\|^Return-Path:"
109 110
  "Regexp of header lines to remove before offering a message as a new draft\\<mh-folder-mode-map>.
Used by the \\[mh-edit-again] and \\[mh-extract-rejected-mail] commands.")
Richard M. Stallman's avatar
Richard M. Stallman committed
111 112

(defvar mh-letter-mode-syntax-table nil
Bill Wohler's avatar
Bill Wohler committed
113
  "Syntax table used by MH-E while in MH-Letter mode.")
Richard M. Stallman's avatar
Richard M. Stallman committed
114 115 116

(if mh-letter-mode-syntax-table
    ()
Bill Wohler's avatar
Bill Wohler committed
117 118 119
  (setq mh-letter-mode-syntax-table
        (make-syntax-table text-mode-syntax-table))
  (modify-syntax-entry ?% "." mh-letter-mode-syntax-table))
Richard M. Stallman's avatar
Richard M. Stallman committed
120

Bill Wohler's avatar
Bill Wohler committed
121 122 123 124 125 126 127 128
(defvar mh-send-args nil
  "Extra args to pass to \"send\" command.")

(defvar mh-annotate-char nil
  "Character to use to annotate `mh-sent-from-msg'.")

(defvar mh-annotate-field nil
  "Field name for message annotation.")
Richard M. Stallman's avatar
Richard M. Stallman committed
129

Bill Wohler's avatar
Bill Wohler committed
130
(defvar mh-insert-auto-fields-done-local nil
Bill Wohler's avatar
Bill Wohler committed
131
  "Buffer-local variable set when `mh-insert-auto-fields' called successfully.")
Bill Wohler's avatar
Bill Wohler committed
132 133
(make-variable-buffer-local 'mh-insert-auto-fields-done-local)

Bill Wohler's avatar
Bill Wohler committed
134 135 136 137


;;; MH-E Entry Points

Richard M. Stallman's avatar
Richard M. Stallman committed
138 139
;;;###autoload
(defun mh-smail ()
140
  "Compose a message with the MH mail system.
Bill Wohler's avatar
Bill Wohler committed
141
See `mh-send' for more details on composing mail."
Richard M. Stallman's avatar
Richard M. Stallman committed
142 143 144 145
  (interactive)
  (mh-find-path)
  (call-interactively 'mh-send))

146 147 148 149 150 151 152 153
;;;###autoload
(defun mh-smail-other-window ()
  "Compose a message with the MH mail system in other window.
See `mh-send' for more details on composing mail."
  (interactive)
  (mh-find-path)
  (call-interactively 'mh-send-other-window))

Bill Wohler's avatar
Bill Wohler committed
154 155 156 157 158 159 160 161 162 163 164 165
(defun mh-send-other-window (to cc subject)
  "Compose a message in another window.

See `mh-send' for more information and a description of how the
TO, CC, and SUBJECT arguments are used."
  (interactive (list
                (mh-interactive-read-address "To: ")
                (mh-interactive-read-address "Cc: ")
                (mh-interactive-read-string "Subject: ")))
  (let ((pop-up-windows t))
    (mh-send-sub to cc subject (current-window-configuration))))

Bill Wohler's avatar
Bill Wohler committed
166
(defvar mh-error-if-no-draft nil)       ;raise error over using old draft
Karl Heuer's avatar
Karl Heuer committed
167 168

;;;###autoload
Karl Heuer's avatar
Karl Heuer committed
169
(defun mh-smail-batch (&optional to subject other-headers &rest ignored)
170 171
  "Compose a message with the MH mail system.

172 173 174
This function does not prompt the user for any header fields, and
thus is suitable for use by programs that want to create a mail
buffer. Users should use \\[mh-smail] to compose mail.
Bill Wohler's avatar
Bill Wohler committed
175

176
Optional arguments for setting certain fields include TO,
177 178 179 180
SUBJECT, and OTHER-HEADERS. Additional arguments are IGNORED.

This function remains for Emacs 21 compatibility. New
applications should use `mh-user-agent-compose'."
Karl Heuer's avatar
Karl Heuer committed
181 182
  (mh-find-path)
  (let ((mh-error-if-no-draft t))
183
    (mh-send (or to "") "" (or subject ""))))
Karl Heuer's avatar
Karl Heuer committed
184

185 186 187 188 189
;;;###autoload
(define-mail-user-agent 'mh-e-user-agent
  'mh-user-agent-compose 'mh-send-letter 'mh-fully-kill-draft
  'mh-before-send-letter-hook)

Bill Wohler's avatar
Bill Wohler committed
190 191
;;;###autoload
(defun mh-user-agent-compose (&optional to subject other-headers continue
Bill Wohler's avatar
Bill Wohler committed
192 193
                                        switch-function yank-action
                                        send-actions)
Bill Wohler's avatar
Bill Wohler committed
194
  "Set up mail composition draft with the MH mail system.
195 196 197 198
This is the `mail-user-agent' entry point to MH-E. This function
conforms to the contract specified by `define-mail-user-agent'
which means that this function should accept the same arguments
as `compose-mail'.
Bill Wohler's avatar
Bill Wohler committed
199 200 201 202

The optional arguments TO and SUBJECT specify recipients and the
initial Subject field, respectively.

203 204 205
OTHER-HEADERS is an alist specifying additional header fields.
Elements look like (HEADER . VALUE) where both HEADER and VALUE
are strings.
Bill Wohler's avatar
Bill Wohler committed
206

207 208
CONTINUE, SWITCH-FUNCTION, YANK-ACTION and SEND-ACTIONS are
ignored."
Bill Wohler's avatar
Bill Wohler committed
209 210 211 212 213
  (mh-find-path)
  (let ((mh-error-if-no-draft t))
    (mh-send to "" subject)
    (while other-headers
      (mh-insert-fields (concat (car (car other-headers)) ":")
Bill Wohler's avatar
Bill Wohler committed
214
                        (cdr (car other-headers)))
Bill Wohler's avatar
Bill Wohler committed
215
      (setq other-headers (cdr other-headers)))))
Karl Heuer's avatar
Karl Heuer committed
216

Bill Wohler's avatar
Bill Wohler committed
217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327
;; Shush compiler.
(eval-when-compile (mh-do-in-xemacs (defvar sendmail-coding-system)))

;;;###autoload
(defun mh-send-letter (&optional arg)
  "Save draft and send message.

When you are all through editing a message, you send it with this
command. You can give a prefix argument ARG to monitor the first stage
of the delivery\; this output can be found in a buffer called \"*MH-E
Mail Delivery*\".

The hook `mh-before-send-letter-hook' is run at the beginning of
this command. For example, if you want to check your spelling in
your message before sending, add the function `ispell-message'.

In case the MH \"send\" program is installed under a different name,
use `mh-send-prog' to tell MH-E the name."
  (interactive "P")
  (run-hooks 'mh-before-send-letter-hook)
  (if (and (mh-insert-auto-fields t)
           mh-auto-fields-prompt-flag
           (goto-char (point-min)))
      (if (not (y-or-n-p "Auto fields inserted, send? "))
          (error "Send aborted")))
  (cond ((mh-mh-directive-present-p)
         (mh-mh-to-mime))
        ((or (mh-mml-tag-present-p) (not (mh-ascii-buffer-p)))
         (mh-mml-to-mime)))
  (save-buffer)
  (message "Sending...")
  (let ((draft-buffer (current-buffer))
        (file-name buffer-file-name)
        (config mh-previous-window-config)
        (coding-system-for-write
         (if (and (local-variable-p 'buffer-file-coding-system
                                    (current-buffer)) ;XEmacs needs two args
                  ;; We're not sure why, but buffer-file-coding-system
                  ;; tends to get set to undecided-unix.
                  (not (memq buffer-file-coding-system
                             '(undecided undecided-unix undecided-dos))))
             buffer-file-coding-system
           (or (and (boundp 'sendmail-coding-system) sendmail-coding-system)
               (and (boundp 'default-buffer-file-coding-system )
                    default-buffer-file-coding-system)
               'iso-latin-1))))
    ;; Adding a Message-ID field looks good, makes it easier to search for
    ;; message in your +outbox, and best of all doesn't break threading for
    ;; the recipient if you reply to a message in your +outbox.
    (setq mh-send-args (concat "-msgid " mh-send-args))
    ;; The default BCC encapsulation will make a MIME message unreadable.
    ;; With nmh use the -mime arg to prevent this.
    (if (and (mh-variant-p 'nmh)
             (mh-goto-header-field "Bcc:")
             (mh-goto-header-field "Content-Type:"))
        (setq mh-send-args (concat "-mime " mh-send-args)))
    (cond (arg
           (pop-to-buffer mh-mail-delivery-buffer)
           (erase-buffer)
           (mh-exec-cmd-output mh-send-prog t "-watch" "-nopush"
                               "-nodraftfolder" mh-send-args file-name)
           (goto-char (point-max))      ; show the interesting part
           (recenter -1)
           (set-buffer draft-buffer))   ; for annotation below
          (t
           (mh-exec-cmd-daemon mh-send-prog nil "-nodraftfolder" "-noverbose"
                               mh-send-args file-name)))
    (if mh-annotate-char
        (mh-annotate-msg mh-sent-from-msg
                         mh-sent-from-folder
                         mh-annotate-char
                         "-component" mh-annotate-field
                         "-text" (format "\"%s %s\""
                                         (mh-get-header-field "To:")
                                         (mh-get-header-field "Cc:"))))

    (cond ((or (not arg)
               (y-or-n-p "Kill draft buffer? "))
           (kill-buffer draft-buffer)
           (if config
               (set-window-configuration config))))
    (if arg
        (message "Sending...done")
      (message "Sending...backgrounded"))))

;;;###autoload
(defun mh-fully-kill-draft ()
  "Quit editing and delete draft message.

If for some reason you are not happy with the draft, you can use
this command to kill the draft buffer and delete the draft
message. Use the command \\[kill-buffer] if you don't want to
delete the draft message."
  (interactive)
  (if (y-or-n-p "Kill draft message? ")
      (let ((config mh-previous-window-config))
        (if (file-exists-p buffer-file-name)
            (delete-file buffer-file-name))
        (set-buffer-modified-p nil)
        (kill-buffer (buffer-name))
        (message "")
        (if config
            (set-window-configuration config)))
    (error "Message not killed")))



;;; MH-Folder Commands

;; Alphabetical.

Bill Wohler's avatar
Bill Wohler committed
328
;;;###mh-autoload
329 330 331
(defun mh-edit-again (message)
  "Edit a MESSAGE to send it again.

332 333 334 335 336 337 338 339
If you don't complete a draft for one reason or another, and if
the draft buffer is no longer available, you can pick your draft
up again with this command. If you don't use a draft folder, your
last \"draft\" file will be used. If you use draft folders,
you'll need to visit the draft folder with \"\\[mh-visit-folder]
drafts <RET>\", use \\[mh-next-undeleted-msg] to move to the
appropriate message, and then use \\[mh-edit-again] to prepare
the message for editing.
340

341 342
This command can also be used to take messages that were sent to
you and to send them to more people.
343

344 345 346
Don't use this command to re-edit a message from a Mailer-Daemon
who complained that your mail wasn't posted for some reason or
another (see `mh-extract-rejected-mail').
347 348

The default message is the current message.
Bill Wohler's avatar
Bill Wohler committed
349 350

See also `mh-send'."
Richard M. Stallman's avatar
Richard M. Stallman committed
351 352
  (interactive (list (mh-get-msg-num t)))
  (let* ((from-folder mh-current-folder)
Bill Wohler's avatar
Bill Wohler committed
353 354 355
         (config (current-window-configuration))
         (draft
          (cond ((and mh-draft-folder (equal from-folder mh-draft-folder))
356 357 358
                 (pop-to-buffer (find-file-noselect (mh-msg-filename message))
                                t)
                 (rename-buffer (format "draft-%d" message))
Bill Wohler's avatar
Bill Wohler committed
359 360 361 362 363 364 365
                 ;; Make buffer writable...
                 (setq buffer-read-only nil)
                 ;; If buffer was being used to display the message reinsert
                 ;; from file...
                 (when (eq major-mode 'mh-show-mode)
                   (erase-buffer)
                   (insert-file-contents buffer-file-name))
Bill Wohler's avatar
Bill Wohler committed
366 367
                 (buffer-name))
                (t
368
                 (mh-read-draft "clean-up" (mh-msg-filename message) nil)))))
Richard M. Stallman's avatar
Richard M. Stallman committed
369
    (mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil)
Bill Wohler's avatar
Bill Wohler committed
370
    (mh-insert-header-separator)
Richard M. Stallman's avatar
Richard M. Stallman committed
371
    (goto-char (point-min))
Karl Heuer's avatar
Karl Heuer committed
372
    (save-buffer)
Richard M. Stallman's avatar
Richard M. Stallman committed
373
    (mh-compose-and-send-mail draft "" from-folder nil nil nil nil nil nil
Bill Wohler's avatar
Bill Wohler committed
374
                              config)
Bill Wohler's avatar
Bill Wohler committed
375 376
    (mh-letter-mode-message)
    (mh-letter-adjust-point)))
Richard M. Stallman's avatar
Richard M. Stallman committed
377

Bill Wohler's avatar
Bill Wohler committed
378
;;;###mh-autoload
379 380 381
(defun mh-extract-rejected-mail (message)
  "Edit a MESSAGE that was returned by the mail system.

382 383 384 385
This command prepares the message for editing by removing the
Mailer-Daemon envelope and unneeded header fields. Fix whatever
addressing problem you had, and send the message again with
\\[mh-send-letter].
386 387

The default message is the current message.
Bill Wohler's avatar
Bill Wohler committed
388 389

See also `mh-send'."
Richard M. Stallman's avatar
Richard M. Stallman committed
390 391
  (interactive (list (mh-get-msg-num t)))
  (let ((from-folder mh-current-folder)
Bill Wohler's avatar
Bill Wohler committed
392
        (config (current-window-configuration))
393
        (draft (mh-read-draft "extraction" (mh-msg-filename message) nil)))
Richard M. Stallman's avatar
Richard M. Stallman committed
394 395
    (goto-char (point-min))
    (cond ((re-search-forward mh-rejected-letter-start nil t)
Bill Wohler's avatar
Bill Wohler committed
396 397 398 399
           (skip-chars-forward " \t\n")
           (delete-region (point-min) (point))
           (mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil))
          (t
Bill Wohler's avatar
Bill Wohler committed
400
           (message "Does not appear to be a rejected letter")))
Bill Wohler's avatar
Bill Wohler committed
401
    (mh-insert-header-separator)
Richard M. Stallman's avatar
Richard M. Stallman committed
402
    (goto-char (point-min))
Karl Heuer's avatar
Karl Heuer committed
403
    (save-buffer)
404
    (mh-compose-and-send-mail draft "" from-folder message
Bill Wohler's avatar
Bill Wohler committed
405 406 407 408
                              (mh-get-header-field "To:")
                              (mh-get-header-field "From:")
                              (mh-get-header-field "Cc:")
                              nil nil config)
Bill Wohler's avatar
Bill Wohler committed
409
    (mh-letter-mode-message)))
Richard M. Stallman's avatar
Richard M. Stallman committed
410

Bill Wohler's avatar
Bill Wohler committed
411
;;;###mh-autoload
Bill Wohler's avatar
Bill Wohler committed
412
(defun mh-forward (to cc &optional range)
413
  "Forward message.
Bill Wohler's avatar
Bill Wohler committed
414

415 416 417
You are prompted for the TO and CC recipients. You are given a
draft to edit that looks like it would if you had run the MH
command \"forw\". You can then add some text.
Bill Wohler's avatar
Bill Wohler committed
418

419 420 421 422
You can forward several messages by using a RANGE. All of the
messages in the range are inserted into your draft. Check the
documentation of `mh-interactive-range' to see how RANGE is read
in interactive use.
423

424 425 426 427
The hook `mh-forward-hook' is called on the draft.

See also `mh-compose-forward-as-mime-flag',
`mh-forward-subject-format', and `mh-send'."
Bill Wohler's avatar
Bill Wohler committed
428 429 430
  (interactive (list (mh-interactive-read-address "To: ")
                     (mh-interactive-read-address "Cc: ")
                     (mh-interactive-range "Forward")))
Richard M. Stallman's avatar
Richard M. Stallman committed
431
  (let* ((folder mh-current-folder)
Bill Wohler's avatar
Bill Wohler committed
432
         (msgs (mh-range-to-msg-list range))
Bill Wohler's avatar
Bill Wohler committed
433 434 435 436 437
         (config (current-window-configuration))
         (fwd-msg-file (mh-msg-filename (car msgs) folder))
         ;; forw always leaves file in "draft" since it doesn't have -draft
         (draft-name (expand-file-name "draft" mh-user-path))
         (draft (cond ((or (not (file-exists-p draft-name))
438
                           (y-or-n-p "The file draft exists; discard it? "))
Bill Wohler's avatar
Bill Wohler committed
439 440 441 442
                       (mh-exec-cmd "forw" "-build"
                                    (if (and (mh-variant-p 'nmh)
                                             mh-compose-forward-as-mime-flag)
                                        "-mime")
Bill Wohler's avatar
Bill Wohler committed
443 444
                                    mh-current-folder
                                    (mh-coalesce-msg-list msgs))
Bill Wohler's avatar
Bill Wohler committed
445 446 447 448 449 450
                       (prog1
                           (mh-read-draft "" draft-name t)
                         (mh-insert-fields "To:" to "Cc:" cc)
                         (save-buffer)))
                      (t
                       (mh-read-draft "" draft-name nil)))))
Karl Heuer's avatar
Karl Heuer committed
451
    (let (orig-from
Bill Wohler's avatar
Bill Wohler committed
452
          orig-subject)
453
      (save-excursion
Bill Wohler's avatar
Bill Wohler committed
454 455 456 457 458
        (set-buffer (get-buffer-create mh-temp-buffer))
        (erase-buffer)
        (insert-file-contents fwd-msg-file)
        (setq orig-from (mh-get-header-field "From:"))
        (setq orig-subject (mh-get-header-field "Subject:")))
Richard M. Stallman's avatar
Richard M. Stallman committed
459
      (let ((forw-subject
Bill Wohler's avatar
Bill Wohler committed
460
             (mh-forwarded-letter-subject orig-from orig-subject)))
Bill Wohler's avatar
Bill Wohler committed
461 462
        (mh-insert-fields "Subject:" forw-subject)
        (goto-char (point-min))
463 464
        ;; If using MML, translate MH-style directive
        (if (equal mh-compose-insertion 'mml)
Bill Wohler's avatar
Bill Wohler committed
465
            (save-excursion
Bill Wohler's avatar
Bill Wohler committed
466
              (goto-char (mh-mail-header-end))
Bill Wohler's avatar
Bill Wohler committed
467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485
              (while
                  (re-search-forward
                   "^#forw \\[\\([^]]+\\)\\] \\(+\\S-+\\) \\(.*\\)$"
                   (point-max) t)
                (let ((description (if (equal (match-string 1)
                                              "forwarded messages")
                                       "forwarded message %d"
                                     (match-string 1)))
                      (msgs (split-string (match-string 3)))
                      (i 0))
                  (beginning-of-line)
                  (delete-region (point) (progn (forward-line 1) (point)))
                  (dolist (msg msgs)
                    (setq i (1+ i))
                    (mh-mml-forward-message (format description i)
                                            folder msg))))))
        ;; Postition just before forwarded message
        (if (re-search-forward "^------- Forwarded Message" nil t)
            (forward-line -1)
Bill Wohler's avatar
Bill Wohler committed
486
          (goto-char (mh-mail-header-end))
Bill Wohler's avatar
Bill Wohler committed
487 488 489
          (forward-line 1))
        (delete-other-windows)
        (mh-add-msgs-to-seq msgs 'forwarded t)
Bill Wohler's avatar
Bill Wohler committed
490
        (mh-compose-and-send-mail draft "" folder msgs
Bill Wohler's avatar
Bill Wohler committed
491 492 493
                                  to forw-subject cc
                                  mh-note-forw "Forwarded:"
                                  config)
Bill Wohler's avatar
Bill Wohler committed
494
        (mh-letter-mode-message)
Bill Wohler's avatar
Bill Wohler committed
495 496
        (mh-letter-adjust-point)
        (run-hooks 'mh-forward-hook)))))
Richard M. Stallman's avatar
Richard M. Stallman committed
497 498

(defun mh-forwarded-letter-subject (from subject)
Bill Wohler's avatar
Bill Wohler committed
499 500
  "Return a Subject suitable for a forwarded message.
Original message has headers FROM and SUBJECT."
Richard M. Stallman's avatar
Richard M. Stallman committed
501
  (let ((addr-start (string-match "<" from))
Bill Wohler's avatar
Bill Wohler committed
502
        (comment (string-match "(" from)))
Richard M. Stallman's avatar
Richard M. Stallman committed
503
    (cond ((and addr-start (> addr-start 0))
Bill Wohler's avatar
Bill Wohler committed
504 505 506 507 508
           ;; Full Name <luser@host>
           (setq from (substring from 0 (1- addr-start))))
          (comment
           ;; luser@host (Full Name)
           (setq from (substring from (1+ comment) (1- (length from)))))))
Richard M. Stallman's avatar
Richard M. Stallman committed
509 510
  (format mh-forward-subject-format from subject))

511 512 513
;;;###mh-autoload
(defun mh-redistribute (to cc &optional message)
  "Redistribute a message.
Karl Heuer's avatar
Karl Heuer committed
514

515 516 517 518 519 520
This command is similar in function to forwarding mail, but it
does not allow you to edit the message, nor does it add your name
to the \"From\" header field. It appears to the recipient as if
the message had come from the original sender. When you run this
command, you are prompted for the TO and CC recipients. The
default MESSAGE is the current message.
Richard M. Stallman's avatar
Richard M. Stallman committed
521

522
Also investigate the command \\[mh-edit-again] for another way to
523
redistribute messages.
524 525

See also `mh-redist-full-contents-flag'."
Richard M. Stallman's avatar
Richard M. Stallman committed
526
  (interactive (list (mh-read-address "Redist-To: ")
Bill Wohler's avatar
Bill Wohler committed
527 528
                     (mh-read-address "Redist-Cc: ")
                     (mh-get-msg-num t)))
529 530
  (or message
      (setq message (mh-get-msg-num t)))
Richard M. Stallman's avatar
Richard M. Stallman committed
531 532
  (save-window-excursion
    (let ((folder mh-current-folder)
Bill Wohler's avatar
Bill Wohler committed
533
          (draft (mh-read-draft "redistribution"
534 535
                                (if mh-redist-full-contents-flag
                                    (mh-msg-filename message)
Bill Wohler's avatar
Bill Wohler committed
536 537
                                  nil)
                                nil)))
Richard M. Stallman's avatar
Richard M. Stallman committed
538 539 540
      (mh-goto-header-end 0)
      (insert "Resent-To: " to "\n")
      (if (not (equal cc "")) (insert "Resent-cc: " cc "\n"))
Bill Wohler's avatar
Bill Wohler committed
541 542 543 544
      (mh-clean-msg-header
       (point-min)
       "^Message-Id:\\|^Received:\\|^Return-Path:\\|^Sender:\\|^Date:\\|^From:"
       nil)
Richard M. Stallman's avatar
Richard M. Stallman committed
545 546
      (save-buffer)
      (message "Redistributing...")
Bill Wohler's avatar
Bill Wohler committed
547 548
      (let ((env "mhdist=1"))
        ;; Setup environment...
549 550 551 552 553
        (setq env (concat env " mhaltmsg="
                          (if mh-redist-full-contents-flag
                              buffer-file-name
                            (mh-msg-filename message folder))))
        (unless mh-redist-full-contents-flag
Bill Wohler's avatar
Bill Wohler committed
554 555 556 557 558 559
          (setq env (concat env " mhannotate=1")))
        ;; Redistribute...
        (if mh-redist-background
            (mh-exec-cmd-env-daemon env mh-send-prog nil buffer-file-name)
          (mh-exec-cmd-error env mh-send-prog "-push" buffer-file-name))
        ;; Annotate...
560
        (mh-annotate-msg message folder mh-note-dist
Bill Wohler's avatar
Bill Wohler committed
561 562
                         "-component" "Resent:"
                         "-text" (format "\"%s %s\"" to cc)))
Richard M. Stallman's avatar
Richard M. Stallman committed
563 564 565
      (kill-buffer draft)
      (message "Redistributing...done"))))

Bill Wohler's avatar
Bill Wohler committed
566
;;;###mh-autoload
Bill Wohler's avatar
Bill Wohler committed
567
(defun mh-reply (message &optional reply-to includep)
568
  "Reply to a MESSAGE.
Bill Wohler's avatar
Bill Wohler committed
569

570 571 572
When you reply to a message, you are first prompted with \"Reply
to whom?\" (unless the optional argument REPLY-TO is provided).
You have several choices here.
573 574 575

     Response     Reply Goes To

576 577
     from         The person who sent the message.  This is the
                  default, so <RET> is sufficient.
578 579 580 581 582 583 584

     to           Replies to the sender, plus all recipients in the
                  \"To:\" header field.

     all
     cc           Forms a reply to the sender, plus all recipients.

585 586 587 588 589
Depending on your answer, \"repl\" is given a different argument
to form your reply. Specifically, a choice of \"from\" or none at
all runs \"repl -nocc all\", and a choice of \"to\" runs \"repl
-cc to\". Finally, either \"cc\" or \"all\" runs \"repl -cc all
-nocc me\".
590

591 592
Two windows are then created. One window contains the message to
which you are replying in an MH-Show buffer. Your draft, in
593
MH-Letter mode (see `mh-letter-mode'), is in the other window.
594

595 596 597
If you supply a prefix argument INCLUDEP, the message you are
replying to is inserted in your reply after having first been run
through \"mhl\" with the format file \"mhl.reply\".
598

599 600 601
Alternatively, you can customize the option `mh-yank-behavior'
and choose one of its \"Automatically\" variants to do the same
thing. If you do so, the prefix argument has no effect.
602

603 604
Another way to include the message automatically in your draft is
to use \"repl: -filter repl.filter\" in your MH profile.
605

606 607
If you wish to customize the header or other parts of the reply
draft, please see \"repl\" and \"mh-format\".
608

609 610
See also `mh-reply-show-message-flag',
`mh-reply-default-reply-to', and `mh-send'."
Bill Wohler's avatar
Bill Wohler committed
611 612 613 614 615
  (interactive (list
                (mh-get-msg-num t)
                (let ((minibuffer-help-form
                       "from => Sender only\nto => Sender and primary recipients\ncc or all => Sender and all recipients"))
                  (or mh-reply-default-reply-to
616
                      (completing-read "Reply to whom (default from): "
Bill Wohler's avatar
Bill Wohler committed
617 618 619 620 621 622 623 624
                                       '(("from") ("to") ("cc") ("all"))
                                       nil
                                       t)))
                current-prefix-arg))
  (let* ((folder mh-current-folder)
         (show-buffer mh-show-buffer)
         (config (current-window-configuration))
         (group-reply (or (equal reply-to "cc") (equal reply-to "all")))
Bill Wohler's avatar
Bill Wohler committed
625
         (form-file (cond ((and (mh-variant-p 'nmh 'mu-mh) group-reply
Bill Wohler's avatar
Bill Wohler committed
626 627 628 629 630 631 632 633 634 635 636 637 638
                                (stringp mh-repl-group-formfile))
                           mh-repl-group-formfile)
                          ((stringp mh-repl-formfile) mh-repl-formfile)
                          (t nil))))
    (message "Composing a reply...")
    (mh-exec-cmd "repl" "-build" "-noquery" "-nodraftfolder"
                 (if form-file
                     (list "-form" form-file))
                 mh-current-folder message
                 (cond ((or (equal reply-to "from") (equal reply-to ""))
                        '("-nocc" "all"))
                       ((equal reply-to "to")
                        '("-cc" "to"))
Bill Wohler's avatar
Bill Wohler committed
639
                       (group-reply (if (mh-variant-p 'nmh 'mu-mh)
Bill Wohler's avatar
Bill Wohler committed
640 641
                                        '("-group" "-nocc" "me")
                                      '("-cc" "all" "-nocc" "me"))))
642 643
                 (cond ((or (eq mh-yank-behavior 'autosupercite)
                            (eq mh-yank-behavior 'autoattrib))
Bill Wohler's avatar
Bill Wohler committed
644 645 646
                        '("-noformat"))
                       (includep '("-filter" "mhl.reply"))
                       (t '())))
Bill Wohler's avatar
Bill Wohler committed
647 648 649 650 651
    (let ((draft (mh-read-draft "reply"
                                (expand-file-name "reply" mh-user-path)
                                t)))
      (delete-other-windows)
      (save-buffer)
652

Bill Wohler's avatar
Bill Wohler committed
653 654 655 656 657 658 659 660 661 662 663 664 665
      (let ((to (mh-get-header-field "To:"))
            (subject (mh-get-header-field "Subject:"))
            (cc (mh-get-header-field "Cc:")))
        (goto-char (point-min))
        (mh-goto-header-end 1)
        (or includep
            (not mh-reply-show-message-flag)
            (mh-in-show-buffer (show-buffer)
              (mh-display-msg message folder)))
        (mh-add-msgs-to-seq message 'answered t)
        (message "Composing a reply...done")
        (mh-compose-and-send-mail draft "" folder message to subject cc
                                  mh-note-repl "Replied:" config))
666 667
      (when (and (or (eq 'autosupercite mh-yank-behavior)
                     (eq 'autoattrib mh-yank-behavior))
Bill Wohler's avatar
Bill Wohler committed
668 669 670 671
                 (eq (mh-show-buffer-message-number) mh-sent-from-msg))
        (undo-boundary)
        (mh-yank-cur-msg))
      (mh-letter-mode-message))))
Richard M. Stallman's avatar
Richard M. Stallman committed
672

Bill Wohler's avatar
Bill Wohler committed
673
;;;###mh-autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
674
(defun mh-send (to cc subject)
675 676
  "Compose a message.

677 678
Your letter appears in an Emacs buffer whose mode is
MH-Letter (see `mh-letter-mode').
679

680 681 682 683
The arguments TO, CC, and SUBJECT can be used to prefill the
draft fields or suppress the prompts if `mh-compose-prompt-flag'
is on. They are also passed to the function set in the option
`mh-compose-letter-function'.
684 685 686

See also `mh-insert-x-mailer-flag' and `mh-letter-mode-hook'.

687 688 689
Outside of an MH-Folder buffer (`mh-folder-mode'), you must call
either \\[mh-smail] or \\[mh-smail-other-window] to compose a new
message."
Richard M. Stallman's avatar
Richard M. Stallman committed
690
  (interactive (list
Bill Wohler's avatar
Bill Wohler committed
691 692 693
                (mh-interactive-read-address "To: ")
                (mh-interactive-read-address "Cc: ")
                (mh-interactive-read-string "Subject: ")))
Richard M. Stallman's avatar
Richard M. Stallman committed
694 695 696 697
  (let ((config (current-window-configuration)))
    (delete-other-windows)
    (mh-send-sub to cc subject config)))

Bill Wohler's avatar
Bill Wohler committed
698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715


;;; Support Routines

(defun mh-interactive-read-address (prompt)
  "Read an address.
If `mh-compose-prompt-flag' is non-nil, then read an address with
PROMPT.
Otherwise return the empty string."
  (if mh-compose-prompt-flag (mh-read-address prompt) ""))

(defun mh-interactive-read-string (prompt)
  "Read a string.
If `mh-compose-prompt-flag' is non-nil, then read a string with
PROMPT.
Otherwise return the empty string."
  (if mh-compose-prompt-flag (read-string prompt) ""))

Bill Wohler's avatar
Bill Wohler committed
716
;;;###mh-autoload
Bill Wohler's avatar
Bill Wohler committed
717 718
(defun mh-show-buffer-message-number (&optional buffer)
  "Message number of displayed message in corresponding show buffer.
719

Bill Wohler's avatar
Bill Wohler committed
720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741
Return nil if show buffer not displayed.
If in `mh-letter-mode', don't display the message number being replied
to, but rather the message number of the show buffer associated with
our originating folder buffer.
Optional argument BUFFER can be used to specify the buffer."
  (save-excursion
    (if buffer
        (set-buffer buffer))
    (cond ((eq major-mode 'mh-show-mode)
           (let ((number-start (mh-search-from-end ?/ buffer-file-name)))
             (string-to-number (substring buffer-file-name
                                          (1+ number-start)))))
          ((and (eq major-mode 'mh-folder-mode)
                mh-show-buffer
                (get-buffer mh-show-buffer))
           (mh-show-buffer-message-number mh-show-buffer))
          ((and (eq major-mode 'mh-letter-mode)
                mh-sent-from-folder
                (get-buffer mh-sent-from-folder))
           (mh-show-buffer-message-number mh-sent-from-folder))
          (t
           nil))))
Richard M. Stallman's avatar
Richard M. Stallman committed
742 743

(defun mh-send-sub (to cc subject config)
Bill Wohler's avatar
Bill Wohler committed
744 745 746
  "Do the real work of composing and sending a letter.
Expects the TO, CC, and SUBJECT fields as arguments.
CONFIG is the window configuration before sending mail."
Richard M. Stallman's avatar
Richard M. Stallman committed
747
  (let ((folder mh-current-folder)
Bill Wohler's avatar
Bill Wohler committed
748
        (msg-num (mh-get-msg-num nil)))
Richard M. Stallman's avatar
Richard M. Stallman committed
749 750
    (message "Composing a message...")
    (let ((draft (mh-read-draft
Bill Wohler's avatar
Bill Wohler committed
751 752 753 754 755 756 757 758 759 760 761 762
                  "message"
                  (let (components)
                    (cond
                     ((file-exists-p
                       (setq components
                             (expand-file-name mh-comp-formfile mh-user-path)))
                      components)
                     ((file-exists-p
                       (setq components
                             (expand-file-name mh-comp-formfile mh-lib)))
                      components)
                     (t
763 764
                      (error "Can't find %s in %s or %s"
                             mh-comp-formfile mh-user-path mh-lib))))
Bill Wohler's avatar
Bill Wohler committed
765
                  nil)))
Richard M. Stallman's avatar
Richard M. Stallman committed
766 767 768
      (mh-insert-fields "To:" to "Subject:" subject "Cc:" cc)
      (goto-char (point-max))
      (mh-compose-and-send-mail draft "" folder msg-num
Bill Wohler's avatar
Bill Wohler committed
769 770
                                to subject cc
                                nil nil config)
Bill Wohler's avatar
Bill Wohler committed
771 772
      (mh-letter-mode-message)
      (mh-letter-adjust-point))))
Richard M. Stallman's avatar
Richard M. Stallman committed
773 774

(defun mh-read-draft (use initial-contents delete-contents-file)
Bill Wohler's avatar
Bill Wohler committed
775
  "Read draft file into a draft buffer and make that buffer the current one.
776 777 778

USE is a message used for prompting about the intended use of the
message.
Bill Wohler's avatar
Bill Wohler committed
779
INITIAL-CONTENTS is filename that is read into an empty buffer, or nil
780
if buffer should not be modified. Delete the initial-contents file if
Bill Wohler's avatar
Bill Wohler committed
781 782
DELETE-CONTENTS-FILE flag is set.
Returns the draft folder's name.
783 784 785
If the draft folder facility is enabled in ~/.mh_profile, a new buffer
is used each time and saved in the draft folder. The draft file can
then be reused."
Richard M. Stallman's avatar
Richard M. Stallman committed
786
  (cond (mh-draft-folder
Bill Wohler's avatar
Bill Wohler committed
787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809
         (let ((orig-default-dir default-directory)
               (draft-file-name (mh-new-draft-name)))
           (pop-to-buffer (generate-new-buffer
                           (format "draft-%s"
                                   (file-name-nondirectory draft-file-name))))
           (condition-case ()
               (insert-file-contents draft-file-name t)
             (file-error))
           (setq default-directory orig-default-dir)))
        (t
         (let ((draft-name (expand-file-name "draft" mh-user-path)))
           (pop-to-buffer "draft")      ; Create if necessary
           (if (buffer-modified-p)
               (if (y-or-n-p "Draft has been modified; kill anyway? ")
                   (set-buffer-modified-p nil)
                 (error "Draft preserved")))
           (setq buffer-file-name draft-name)
           (clear-visited-file-modtime)
           (unlock-buffer)
           (cond ((and (file-exists-p draft-name)
                       (not (equal draft-name initial-contents)))
                  (insert-file-contents draft-name)
                  (delete-file draft-name))))))
Richard M. Stallman's avatar
Richard M. Stallman committed
810
  (cond ((and initial-contents
Bill Wohler's avatar
Bill Wohler committed
811 812 813 814 815 816 817 818 819
              (or (zerop (buffer-size))
                  (if (y-or-n-p
                       (format "A draft exists.  Use for %s? " use))
                      (if mh-error-if-no-draft
                          (error "A prior draft exists"))
                    t)))
         (erase-buffer)
         (insert-file-contents initial-contents)
         (if delete-contents-file (delete-file initial-contents))))
Richard M. Stallman's avatar
Richard M. Stallman committed
820 821
  (auto-save-mode 1)
  (if mh-draft-folder
Bill Wohler's avatar
Bill Wohler committed
822
      (save-buffer))                    ; Do not reuse draft name
Richard M. Stallman's avatar
Richard M. Stallman committed
823 824 825
  (buffer-name))

(defun mh-new-draft-name ()
Bill Wohler's avatar
Bill Wohler committed
826
  "Return the pathname of folder for draft messages."
Richard M. Stallman's avatar
Richard M. Stallman committed
827 828 829 830 831
  (save-excursion
    (mh-exec-cmd-quiet t "mhpath" mh-draft-folder "new")
    (buffer-substring (point-min) (1- (point-max)))))

(defun mh-insert-fields (&rest name-values)
Bill Wohler's avatar
Bill Wohler committed
832 833 834
  "Insert the NAME-VALUES pairs in the current buffer.
If the field exists, append the value to it.
Do not insert any pairs whose value is the empty string."
Richard M. Stallman's avatar
Richard M. Stallman committed
835 836 837
  (let ((case-fold-search t))
    (while name-values
      (let ((field-name (car name-values))
Bill Wohler's avatar
Bill Wohler committed
838
            (value (car (cdr name-values))))
Bill Wohler's avatar
Bill Wohler committed
839 840
        (if (not (string-match "^.*:$" field-name))
            (setq field-name (concat field-name ":")))
841 842
        (cond ((or (null value)
                   (equal value ""))
Bill Wohler's avatar
Bill Wohler committed
843 844 845 846 847 848
               nil)
              ((mh-position-on-field field-name)
               (insert " " (or value "")))
              (t
               (insert field-name " " value "\n")))
        (setq name-values (cdr (cdr name-values)))))))
Richard M. Stallman's avatar
Richard M. Stallman committed
849

Bill Wohler's avatar
Bill Wohler committed
850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868
(defun mh-compose-and-send-mail (draft send-args
                                       sent-from-folder sent-from-msg
                                       to subject cc
                                       annotate-char annotate-field
                                       config)
  "Edit and compose a draft message in buffer DRAFT and send or save it.
SEND-ARGS is the argument passed to the send command.
SENT-FROM-FOLDER is buffer containing scan listing of current folder,
or nil if none exists.
SENT-FROM-MSG is the message number or sequence name or nil.
The TO, SUBJECT, and CC fields are passed to the
`mh-compose-letter-function'.
If ANNOTATE-CHAR is non-null, it is used to notate the scan listing of
the message. In that case, the ANNOTATE-FIELD is used to build a
string for `mh-annotate-msg'.
CONFIG is the window configuration to restore after sending the
letter."
  (pop-to-buffer draft)
  (mh-letter-mode)
Karl Heuer's avatar
Karl Heuer committed
869

Bill Wohler's avatar
Bill Wohler committed
870 871 872 873
  ;; Insert identity.
  (mh-insert-identity mh-identity-default t)
  (mh-identity-make-menu)
  (mh-identity-add-menu)
Richard M. Stallman's avatar
Richard M. Stallman committed
874

Bill Wohler's avatar
Bill Wohler committed
875 876 877
  ;; Insert extra fields.
  (mh-insert-x-mailer)
  (mh-insert-x-face)
Richard M. Stallman's avatar
Richard M. Stallman committed
878

Bill Wohler's avatar
Bill Wohler committed
879
  (mh-letter-hide-all-skipped-fields)
Bill Wohler's avatar
Bill Wohler committed
880

Bill Wohler's avatar
Bill Wohler committed
881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899
  (setq mh-sent-from-folder sent-from-folder)
  (setq mh-sent-from-msg sent-from-msg)
  (setq mh-send-args send-args)
  (setq mh-annotate-char annotate-char)
  (setq mh-annotate-field annotate-field)
  (setq mh-previous-window-config config)
  (setq mode-line-buffer-identification (list "    {%b}"))
  (mh-logo-display)
  (mh-make-local-hook 'kill-buffer-hook)
  (add-hook 'kill-buffer-hook 'mh-tidy-draft-buffer nil t)
  (if (and (boundp 'mh-compose-letter-function)
           mh-compose-letter-function)
      ;; run-hooks will not pass arguments.
      (let ((value mh-compose-letter-function))
        (if (and (listp value) (not (eq (car value) 'lambda)))
            (while value
              (funcall (car value) to subject cc)
              (setq value (cdr value)))
          (funcall mh-compose-letter-function to subject cc)))))
Bill Wohler's avatar
Bill Wohler committed
900

Bill Wohler's avatar
Bill Wohler committed
901
(defun mh-insert-x-mailer ()
Bill Wohler's avatar
Bill Wohler committed
902 903
  "Append an X-Mailer field to the header.
The versions of MH-E, Emacs, and MH are shown."
Bill Wohler's avatar
Bill Wohler committed
904
  ;; Lazily initialize mh-x-mailer-string.
Bill Wohler's avatar
Bill Wohler committed
905
  (when (and mh-insert-x-mailer-flag (null mh-x-mailer-string))
Bill Wohler's avatar
Bill Wohler committed
906 907 908 909 910 911 912 913 914 915
    (setq mh-x-mailer-string
          (format "MH-E %s; %s; %sEmacs %s"
                  mh-version mh-variant-in-use
                  (if mh-xemacs-flag "X" "GNU ")
                  (cond ((not mh-xemacs-flag) emacs-version)
                        ((string-match "[0-9.]*\\( +\([ a-z]+[0-9]+\)\\)?"
                                       emacs-version)
                         (match-string 0 emacs-version))
                        (t (format "%s.%s" emacs-major-version
                                   emacs-minor-version))))))
Bill Wohler's avatar
Bill Wohler committed
916 917
  ;; Insert X-Mailer, but only if it doesn't already exist.
  (save-excursion
Bill Wohler's avatar
Bill Wohler committed
918 919
    (when (and mh-insert-x-mailer-flag
               (null (mh-goto-header-field "X-Mailer")))
Bill Wohler's avatar
Bill Wohler committed
920
      (mh-insert-fields "X-Mailer:" mh-x-mailer-string))))
Bill Wohler's avatar
Bill Wohler committed
921

Bill Wohler's avatar
Bill Wohler committed
922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976
(defun mh-insert-x-face ()
  "Append X-Face, Face or X-Image-URL field to header.
If the field already exists, this function does nothing."
  (when (and (file-exists-p mh-x-face-file)
             (file-readable-p mh-x-face-file))
    (save-excursion
      (unless (or (mh-position-on-field "X-Face")
                  (mh-position-on-field "Face")
                  (mh-position-on-field "X-Image-URL"))
        (save-excursion
          (goto-char (+ (point) (cadr (insert-file-contents mh-x-face-file))))
          (if (not (looking-at "^"))
              (insert "\n")))
        (unless (looking-at "\\(X-Face\\|Face\\|X-Image-URL\\): ")
          (insert "X-Face: "))))))

(defun mh-tidy-draft-buffer ()
  "Run when a draft buffer is destroyed."
  (let ((buffer (get-buffer mh-recipients-buffer)))
    (if buffer
        (kill-buffer buffer))))

(defun mh-letter-mode-message ()
  "Display a help message for users of `mh-letter-mode'.
This should be the last function called when composing the draft."
  (message "%s" (substitute-command-keys
                 (concat "Type \\[mh-send-letter] to send message, "
                         "\\[mh-help] for help"))))

(defun mh-letter-adjust-point ()
  "Move cursor to first header field if are using the no prompt mode."
  (unless mh-compose-prompt-flag
    (goto-char (point-max))
    (mh-letter-next-header-field)))

(defun mh-annotate-msg (msg buffer note &rest args)
  "Mark MSG in BUFFER with character NOTE and annotate message with ARGS.
MSG can be a message number, a list of message numbers, or a
sequence."
  (apply 'mh-exec-cmd "anno" buffer
         (if (listp msg) (append msg args) (cons msg args)))
  (save-excursion
    (cond ((get-buffer buffer)          ; Buffer may be deleted
           (set-buffer buffer)
           (mh-iterate-on-range nil msg
             (mh-notate nil note
                        (+ mh-cmd-note mh-scan-field-destination-offset)))))))

(defun mh-insert-header-separator ()
  "Insert `mh-mail-header-separator', if absent."
  (save-excursion
    (goto-char (point-min))
    (rfc822-goto-eoh)
    (if (looking-at "$")
        (insert mh-mail-header-separator))))
Bill Wohler's avatar
Bill Wohler committed
977

Bill Wohler's avatar
Bill Wohler committed
978 979
;;;###mh-autoload
(defun mh-insert-auto-fields (&optional non-interactive)
980
  "Insert custom fields if recipient is found in `mh-auto-fields-list'.
Bill Wohler's avatar
Bill Wohler committed
981

982 983 984
Sets buffer-local `mh-insert-auto-fields-done-local' if header
fields were added. If NON-INTERACTIVE is non-nil, perform actions
quietly and only if `mh-insert-auto-fields-done-local' is nil.
985 986 987

An `identity' entry is skipped if one was already entered
manually.
Bill Wohler's avatar
Bill Wohler committed
988 989

Return t if fields added; otherwise return nil."
Bill Wohler's avatar
Bill Wohler committed
990
  (interactive)
Bill Wohler's avatar
Bill Wohler committed
991 992
  (when (or (not non-interactive)
            (not mh-insert-auto-fields-done-local))
Bill Wohler's avatar
Bill Wohler committed
993
    (save-excursion
Bill Wohler's avatar
Bill Wohler committed
994 995 996 997
      (when (and (or (mh-goto-header-field "To:")
                     (mh-goto-header-field "cc:")))
        (let ((list mh-auto-fields-list)
              (fields-inserted nil))
Bill Wohler's avatar
Bill Wohler committed
998 999 1000 1001 1002
          (while list
            (let ((regexp (nth 0 (car list)))
                  (entries (nth 1 (car list))))
              (when (mh-regexp-in-field-p regexp "To:" "cc:")
                (setq mh-insert-auto-fields-done-local t)
Bill Wohler's avatar
Bill Wohler committed
1003
                (setq fields-inserted t)
Bill Wohler's avatar
Bill Wohler committed
1004
                (if (not non-interactive)
Bill Wohler's avatar
Bill Wohler committed
1005
                    (message "Fields for %s added" regexp))
Bill Wohler's avatar
Bill Wohler committed
1006 1007 1008 1009 1010
                (let ((entry-list entries))
                  (while entry-list
                    (let ((field (caar entry-list))
                          (value (cdar entry-list)))
                      (cond
Bill Wohler's avatar
Bill Wohler committed
1011
                       ((equal ":identity" field)
Bill Wohler's avatar
Bill Wohler committed
1012 1013
                        (when
                            ;;(and (not mh-identity-local)
1014
                            ;; Bug 1204506.  But do we need to be able
Bill Wohler's avatar
Bill Wohler committed
1015 1016 1017 1018
                            ;; to set an identity manually that won't be
                            ;; overridden by mh-insert-auto-fields?
                            (assoc value mh-identity-list)
                          ;;)
Bill Wohler's avatar
Bill Wohler committed
1019 1020 1021 1022 1023
                          (mh-insert-identity value)))
                       (t
                        (mh-modify-header-field field value
                                                (equal field "From")))))
                    (setq entry-list (cdr entry-list))))))
Bill Wohler's avatar
Bill Wohler committed
1024 1025
            (setq list (cdr list)))
          fields-inserted)))))
Bill Wohler's avatar
Bill Wohler committed
1026 1027 1028

(defun mh-modify-header-field (field value &optional overwrite-flag)
  "To header FIELD add VALUE.
1029 1030
If OVERWRITE-FLAG is non-nil then the old value, if present, is
discarded."
Bill Wohler's avatar
Bill Wohler committed
1031 1032 1033
  (cond ((and overwrite-flag
              (mh-goto-header-field (concat field ":")))
         (insert " " value)
1034
         (delete-region (point) (mh-line-end-position)))
Bill Wohler's avatar
Bill Wohler committed
1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045
        ((and (not overwrite-flag)
              (mh-regexp-in-field-p (concat "\\b" value "\\b") field))
         ;; Already there, do nothing.
         )
        ((and (not overwrite-flag)
              (mh-goto-header-field (concat field ":")))
         (insert " " value ","))
        (t
         (mh-goto-header-end 0)
         (insert field ": " value "\n"))))

Bill Wohler's avatar
Bill Wohler committed
1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059
(defun mh-regexp-in-field-p (regexp &rest fields)
  "Non-nil means REGEXP was found in FIELDS."
  (save-excursion
    (let ((search-result nil)
          (field))
      (while fields
        (setq field (car fields))
        (if (and (mh-goto-header-field field)
                 (re-search-forward
                  regexp (save-excursion (mh-header-field-end)(point)) t))
            (setq fields nil
                  search-result t)
          (setq fields (cdr fields))))
      search-result)))
Bill Wohler's avatar
Bill Wohler committed
1060 1061 1062

(defun mh-ascii-buffer-p ()
  "Check if current buffer is entirely composed of ASCII.