lisp/mh-e/mh-comp.el

   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 3, 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 \f
  49
  50 ;;; Site Customization
  51
  52 (defvar mh-send-prog "send"
  53   "Name of the MH send program.
  54 Some 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
  59 If the value of \"postproc:\" is \"spost\", you may need to set
  60 this variable to t to tell MH-E to avoid using features of
  61 \"post\" that are not supported by \"spost\". You'll know that
  62 you'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.
  67 This allows transaction log to be visible if -watch, -verbose or
  68 -snoop are used.")
  69
  70 \f
  71
  72 ;;; Variables
  73
  74 (defvar mh-comp-formfile "components"
  75   "Name of file to be used as a skeleton for composing messages.
  76
  77 Default is \"components\".
  78
  79 If not an absolute file name, the file is searched for first in the
  80 user'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
  85 Default is \"replcomps\".
  86
  87 If not an absolute file name, the file is searched for first in the
  88 user'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
  93 Default is \"replgroupcomps\".
  94
  95 This file is used to form replies to the sender and all recipients of
  96 a message. Only used if `(mh-variant-p 'nmh)' is non-nil.
  97 If not an absolute file name, the file is searched for first in the
  98 user'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>.
 119 Used 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 \f
 144
 145 ;;; MH-E Entry Points
 146
 147 ;;;###autoload
 148 (defun mh-smail ()
 149   "Compose a message with the MH mail system.
 150 See `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.
 158 See `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
 166 See `mh-send' for more information and a description of how the
 167 TO, 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
 181 This function does not prompt the user for any header fields, and
 182 thus is suitable for use by programs that want to create a mail
 183 buffer. Users should use \\[mh-smail] to compose mail.
 184
 185 Optional arguments for setting certain fields include TO,
 186 SUBJECT, and OTHER-HEADERS. Additional arguments are IGNORED.
 187
 188 This function remains for Emacs 21 compatibility. New
 189 applications 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.
 204 This is the `mail-user-agent' entry point to MH-E. This function
 205 conforms to the contract specified by `define-mail-user-agent'
 206 which means that this function should accept the same arguments
 207 as `compose-mail'.
 208
 209 The optional arguments TO and SUBJECT specify recipients and the
 210 initial Subject field, respectively.
 211
 212 OTHER-HEADERS is an alist specifying additional header fields.
 213 Elements look like (HEADER . VALUE) where both HEADER and VALUE
 214 are strings.
 215
 216 CONTINUE, SWITCH-FUNCTION, YANK-ACTION and SEND-ACTIONS are
 217 ignored."
 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
 233 When you are all through editing a message, you send it with this
 234 command. You can give a prefix argument ARG to monitor the first stage
 235 of the delivery\; this output can be found in a buffer called \"*MH-E
 236 Mail Delivery*\".
 237
 238 The hook `mh-before-send-letter-hook' is run at the beginning of
 239 this command. For example, if you want to check your spelling in
 240 your message before sending, add the function `ispell-message'.
 241
 242 Unless `mh-insert-auto-fields' had previously been called
 243 manually, the function `mh-insert-auto-fields' is called to
 244 insert fields based upon the recipients. If fields are added, you
 245 are given a chance to see and to confirm these fields before the
 246 message is actually sent. You can do away with this confirmation
 247 by turning off the option `mh-auto-fields-prompt-flag'.
 248
 249 In case the MH \"send\" program is installed under a different name,
 250 use `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
 324 If for some reason you are not happy with the draft, you can use
 325 this command to kill the draft buffer and delete the draft
 326 message. Use the command \\[kill-buffer] if you don't want to
 327 delete 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 \f
 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
 350 If you don't complete a draft for one reason or another, and if
 351 the draft buffer is no longer available, you can pick your draft
 352 up again with this command. If you don't use a draft folder, your
 353 last \"draft\" file will be used. If you use draft folders,
 354 you'll need to visit the draft folder with \"\\[mh-visit-folder]
 355 drafts <RET>\", use \\[mh-next-undeleted-msg] to move to the
 356 appropriate message, and then use \\[mh-edit-again] to prepare
 357 the message for editing.
 358
 359 This command can also be used to take messages that were sent to
 360 you and to send them to more people.
 361
 362 Don't use this command to re-edit a message from a Mailer-Daemon
 363 who complained that your mail wasn't posted for some reason or
 364 another (see `mh-extract-rejected-mail').
 365
 366 The default message is the current message.
 367
 368 See 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
 400 This command prepares the message for editing by removing the
 401 Mailer-Daemon envelope and unneeded header fields. Fix whatever
 402 addressing problem you had, and send the message again with
 403 \\[mh-send-letter].
 404
 405 The default message is the current message.
 406
 407 See 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
 433 You are prompted for the TO and CC recipients. You are given a
 434 draft to edit that looks like it would if you had run the MH
 435 command \"forw\". You can then add some text.
 436
 437 You can forward several messages by using a RANGE. All of the
 438 messages in the range are inserted into your draft. Check the
 439 documentation of `mh-interactive-range' to see how RANGE is read
 440 in interactive use.
 441
 442 The hook `mh-forward-hook' is called on the draft.
 443
 444 See 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                     ;; Was inserted before us, move to end of file to preserve order
 502                     (goto-char (point-max)))))))
 503         ;; Postition just before forwarded message
 504         (if (re-search-forward "^------- Forwarded Message" nil t)
 505             (forward-line -1)
 506           (goto-char (mh-mail-header-end))
 507           (forward-line 1))
 508         (delete-other-windows)
 509         (mh-add-msgs-to-seq msgs 'forwarded t)
 510         (mh-compose-and-send-mail draft "" folder msgs
 511                                   to forw-subject cc
 512                                   mh-note-forw "Forwarded:"
 513                                   config)
 514         (mh-letter-mode-message)
 515         (mh-letter-adjust-point)
 516         (run-hooks 'mh-forward-hook)))))
 517
 518 (defun mh-forwarded-letter-subject (from subject)
 519   "Return a Subject suitable for a forwarded message.
 520 Original message has headers FROM and SUBJECT."
 521   (let ((addr-start (string-match "<" from))
 522         (comment (string-match "(" from)))
 523     (cond ((and addr-start (> addr-start 0))
 524            ;; Full Name <luser@host>
 525            (setq from (substring from 0 (1- addr-start))))
 526           (comment
 527            ;; luser@host (Full Name)
 528            (setq from (substring from (1+ comment) (1- (length from)))))))
 529   (format mh-forward-subject-format from subject))
 530
 531 ;;;###mh-autoload
 532 (defun mh-redistribute (to cc &optional message)
 533   "Redistribute a message.
 534
 535 This command is similar in function to forwarding mail, but it
 536 does not allow you to edit the message, nor does it add your name
 537 to the \"From\" header field. It appears to the recipient as if
 538 the message had come from the original sender. When you run this
 539 command, you are prompted for the TO and CC recipients. The
 540 default MESSAGE is the current message.
 541
 542 Also investigate the command \\[mh-edit-again] for another way to
 543 redistribute messages.
 544
 545 See also `mh-redist-full-contents-flag'."
 546   (interactive (list (mh-read-address "Redist-To: ")
 547                      (mh-read-address "Redist-Cc: ")
 548                      (mh-get-msg-num t)))
 549   (or message
 550       (setq message (mh-get-msg-num t)))
 551   (save-window-excursion
 552     (let ((folder mh-current-folder)
 553           (draft (mh-read-draft "redistribution"
 554                                 (if mh-redist-full-contents-flag
 555                                     (mh-msg-filename message)
 556                                   nil)
 557                                 nil)))
 558       (mh-goto-header-end 0)
 559       (insert "Resent-To: " to "\n")
 560       (if (not (equal cc "")) (insert "Resent-cc: " cc "\n"))
 561       (mh-clean-msg-header
 562        (point-min)
 563        "^Message-Id:\\|^Received:\\|^Return-Path:\\|^Sender:\\|^Date:\\|^From:"
 564        nil)
 565       (save-buffer)
 566       (message "Redistributing...")
 567       (let ((env "mhdist=1"))
 568         ;; Setup environment...
 569         (setq env (concat env " mhaltmsg="
 570                           (if mh-redist-full-contents-flag
 571                               buffer-file-name
 572                             (mh-msg-filename message folder))))
 573         (unless mh-redist-full-contents-flag
 574           (setq env (concat env " mhannotate=1")))
 575         ;; Redistribute...
 576         (if mh-redist-background
 577             (mh-exec-cmd-env-daemon env mh-send-prog nil buffer-file-name)
 578           (mh-exec-cmd-error env mh-send-prog "-push" buffer-file-name))
 579         ;; Annotate...
 580         (mh-annotate-msg message folder mh-note-dist
 581                          "-component" "Resent:"
 582                          "-text" (format "\"%s %s\"" to cc)))
 583       (kill-buffer draft)
 584       (message "Redistributing...done"))))
 585
 586 ;;;###mh-autoload
 587 (defun mh-reply (message &optional reply-to includep)
 588   "Reply to a MESSAGE.
 589
 590 When you reply to a message, you are first prompted with \"Reply
 591 to whom?\" (unless the optional argument REPLY-TO is provided).
 592 You have several choices here.
 593
 594      Response     Reply Goes To
 595
 596      from         The person who sent the message. This is the
 597                   default, so <RET> is sufficient.
 598
 599      to           Replies to the sender, plus all recipients in the
 600                   \"To:\" header field.
 601
 602      all cc       Forms a reply to the addresses in the
 603                   \"Mail-Followup-To:\" header field if one
 604                   exists; otherwise forms a reply to the sender,
 605                   plus all recipients.
 606
 607 Depending on your answer, \"repl\" is given a different argument
 608 to form your reply. Specifically, a choice of \"from\" or none at
 609 all runs \"repl -nocc all\", and a choice of \"to\" runs \"repl
 610 -cc to\". Finally, either \"cc\" or \"all\" runs \"repl -cc all
 611 -nocc me\".
 612
 613 Two windows are then created. One window contains the message to
 614 which you are replying in an MH-Show buffer. Your draft, in
 615 MH-Letter mode (*note `mh-letter-mode'), is in the other window.
 616 If the reply draft was not one that you expected, check the
 617 things that affect the behavior of \"repl\" which include the
 618 \"repl:\" profile component and the \"replcomps\" and
 619 \"replgroupcomps\" files.
 620
 621 If you supply a prefix argument INCLUDEP, the message you are
 622 replying to is inserted in your reply after having first been run
 623 through \"mhl\" with the format file \"mhl.reply\".
 624
 625 Alternatively, you can customize the option `mh-yank-behavior'
 626 and choose one of its \"Automatically\" variants to do the same
 627 thing. If you do so, the prefix argument has no effect.
 628
 629 Another way to include the message automatically in your draft is
 630 to use \"repl: -filter repl.filter\" in your MH profile.
 631
 632 If you wish to customize the header or other parts of the reply
 633 draft, please see \"repl\" and \"mh-format\".
 634
 635 See also `mh-reply-show-message-flag',
 636 `mh-reply-default-reply-to', and `mh-send'."
 637   (interactive (list
 638                 (mh-get-msg-num t)
 639                 (let ((minibuffer-help-form
 640                        "from => Sender only\nto => Sender and primary recipients\ncc or all => Sender and all recipients"))
 641                   (or mh-reply-default-reply-to
 642                       (completing-read "Reply to whom (default from): "
 643                                        '(("from") ("to") ("cc") ("all"))
 644                                        nil
 645                                        t)))
 646                 current-prefix-arg))
 647   (let* ((folder mh-current-folder)
 648          (show-buffer mh-show-buffer)
 649          (config (current-window-configuration))
 650          (group-reply (or (equal reply-to "cc") (equal reply-to "all")))
 651          (form-file (cond ((and (mh-variant-p 'nmh 'mu-mh) group-reply
 652                                 (stringp mh-repl-group-formfile))
 653                            mh-repl-group-formfile)
 654                           ((stringp mh-repl-formfile) mh-repl-formfile)
 655                           (t nil))))
 656     (message "Composing a reply...")
 657     (mh-exec-cmd "repl" "-build" "-noquery" "-nodraftfolder"
 658                  (if form-file
 659                      (list "-form" form-file))
 660                  mh-current-folder message
 661                  (cond ((or (equal reply-to "from") (equal reply-to ""))
 662                         '("-nocc" "all"))
 663                        ((equal reply-to "to")
 664                         '("-cc" "to"))
 665                        (group-reply (if (mh-variant-p 'nmh 'mu-mh)
 666                                         '("-group" "-nocc" "me")
 667                                       '("-cc" "all" "-nocc" "me"))))
 668                  (cond ((or (eq mh-yank-behavior 'autosupercite)
 669                             (eq mh-yank-behavior 'autoattrib))
 670                         '("-noformat"))
 671                        (includep '("-filter" "mhl.reply"))
 672                        (t '())))
 673     (let ((draft (mh-read-draft "reply"
 674                                 (expand-file-name "reply" mh-user-path)
 675                                 t)))
 676       (delete-other-windows)
 677       (save-buffer)
 678
 679       (let ((to (mh-get-header-field "To:"))
 680             (subject (mh-get-header-field "Subject:"))
 681             (cc (mh-get-header-field "Cc:")))
 682         (goto-char (point-min))
 683         (mh-goto-header-end 1)
 684         (or includep
 685             (not mh-reply-show-message-flag)
 686             (mh-in-show-buffer (show-buffer)
 687               (mh-display-msg message folder)))
 688         (mh-add-msgs-to-seq message 'answered t)
 689         (message "Composing a reply...done")
 690         (mh-compose-and-send-mail draft "" folder message to subject cc
 691                                   mh-note-repl "Replied:" config))
 692       (when (and (or (eq 'autosupercite mh-yank-behavior)
 693                      (eq 'autoattrib mh-yank-behavior))
 694                  (eq (mh-show-buffer-message-number) mh-sent-from-msg))
 695         (undo-boundary)
 696         (mh-yank-cur-msg))
 697       (mh-letter-mode-message))))
 698
 699 ;;;###mh-autoload
 700 (defun mh-send (to cc subject)
 701   "Compose a message.
 702
 703 Your letter appears in an Emacs buffer whose mode is
 704 MH-Letter (see `mh-letter-mode').
 705
 706 The arguments TO, CC, and SUBJECT can be used to prefill the
 707 draft fields or suppress the prompts if `mh-compose-prompt-flag'
 708 is on. They are also passed to the function set in the option
 709 `mh-compose-letter-function'.
 710
 711 See also `mh-insert-x-mailer-flag' and `mh-letter-mode-hook'.
 712
 713 Outside of an MH-Folder buffer (`mh-folder-mode'), you must call
 714 either \\[mh-smail] or \\[mh-smail-other-window] to compose a new
 715 message."
 716   (interactive (list
 717                 (mh-interactive-read-address "To: ")
 718                 (mh-interactive-read-address "Cc: ")
 719                 (mh-interactive-read-string "Subject: ")))
 720   (let ((config (current-window-configuration)))
 721     (delete-other-windows)
 722     (mh-send-sub to cc subject config)))
 723
 724 \f
 725
 726 ;;; Support Routines
 727
 728 (defun mh-interactive-read-address (prompt)
 729   "Read an address.
 730 If `mh-compose-prompt-flag' is non-nil, then read an address with
 731 PROMPT.
 732 Otherwise return the empty string."
 733   (if mh-compose-prompt-flag (mh-read-address prompt) ""))
 734
 735 (defun mh-interactive-read-string (prompt)
 736   "Read a string.
 737 If `mh-compose-prompt-flag' is non-nil, then read a string with
 738 PROMPT.
 739 Otherwise return the empty string."
 740   (if mh-compose-prompt-flag (read-string prompt) ""))
 741
 742 ;;;###mh-autoload
 743 (defun mh-show-buffer-message-number (&optional buffer)
 744   "Message number of displayed message in corresponding show buffer.
 745
 746 Return nil if show buffer not displayed.
 747 If in `mh-letter-mode', don't display the message number being replied
 748 to, but rather the message number of the show buffer associated with
 749 our originating folder buffer.
 750 Optional argument BUFFER can be used to specify the buffer."
 751   (save-excursion
 752     (if buffer
 753         (set-buffer buffer))
 754     (cond ((eq major-mode 'mh-show-mode)
 755            (let ((number-start (mh-search-from-end ?/ buffer-file-name)))
 756              (string-to-number (substring buffer-file-name
 757                                           (1+ number-start)))))
 758           ((and (eq major-mode 'mh-folder-mode)
 759                 mh-show-buffer
 760                 (get-buffer mh-show-buffer))
 761            (mh-show-buffer-message-number mh-show-buffer))
 762           ((and (eq major-mode 'mh-letter-mode)
 763                 mh-sent-from-folder
 764                 (get-buffer mh-sent-from-folder))
 765            (mh-show-buffer-message-number mh-sent-from-folder))
 766           (t
 767            nil))))
 768
 769 (defun mh-send-sub (to cc subject config)
 770   "Do the real work of composing and sending a letter.
 771 Expects the TO, CC, and SUBJECT fields as arguments.
 772 CONFIG is the window configuration before sending mail."
 773   (let ((folder mh-current-folder)
 774         (msg-num (mh-get-msg-num nil)))
 775     (message "Composing a message...")
 776     (let ((draft (mh-read-draft
 777                   "message"
 778                   (let (components)
 779                     (cond
 780                      ((file-exists-p
 781                        (setq components
 782                              (expand-file-name mh-comp-formfile mh-user-path)))
 783                       components)
 784                      ((file-exists-p
 785                        (setq components
 786                              (expand-file-name mh-comp-formfile mh-lib)))
 787                       components)
 788                      (t
 789                       (error "Can't find %s in %s or %s"
 790                              mh-comp-formfile mh-user-path mh-lib))))
 791                   nil)))
 792       (mh-insert-fields "To:" to "Subject:" subject "Cc:" cc)
 793       (goto-char (point-max))
 794       (mh-compose-and-send-mail draft "" folder msg-num
 795                                 to subject cc
 796                                 nil nil config)
 797       (mh-letter-mode-message)
 798       (mh-letter-adjust-point))))
 799
 800 (defun mh-read-draft (use initial-contents delete-contents-file)
 801   "Read draft file into a draft buffer and make that buffer the current one.
 802
 803 USE is a message used for prompting about the intended use of the
 804 message.
 805 INITIAL-CONTENTS is filename that is read into an empty buffer, or nil
 806 if buffer should not be modified. Delete the initial-contents file if
 807 DELETE-CONTENTS-FILE flag is set.
 808 Returns the draft folder's name.
 809 If the draft folder facility is enabled in ~/.mh_profile, a new buffer
 810 is used each time and saved in the draft folder. The draft file can
 811 then be reused."
 812   (cond (mh-draft-folder
 813          (let ((orig-default-dir default-directory)
 814                (draft-file-name (mh-new-draft-name)))
 815            (pop-to-buffer (generate-new-buffer
 816                            (format "draft-%s"
 817                                    (file-name-nondirectory draft-file-name))))
 818            (condition-case ()
 819                (insert-file-contents draft-file-name t)
 820              (file-error))
 821            (setq default-directory orig-default-dir)))
 822         (t
 823          (let ((draft-name (expand-file-name "draft" mh-user-path)))
 824            (pop-to-buffer "draft")      ; Create if necessary
 825            (if (buffer-modified-p)
 826                (if (y-or-n-p "Draft has been modified; kill anyway? ")
 827                    (set-buffer-modified-p nil)
 828                  (error "Draft preserved")))
 829            (setq buffer-file-name draft-name)
 830            (clear-visited-file-modtime)
 831            (unlock-buffer)
 832            (cond ((and (file-exists-p draft-name)
 833                        (not (equal draft-name initial-contents)))
 834                   (insert-file-contents draft-name)
 835                   (delete-file draft-name))))))
 836   (cond ((and initial-contents
 837               (or (zerop (buffer-size))
 838                   (if (y-or-n-p
 839                        (format "A draft exists.  Use for %s? " use))
 840                       (if mh-error-if-no-draft
 841                           (error "A prior draft exists"))
 842                     t)))
 843          (erase-buffer)
 844          (insert-file-contents initial-contents)
 845          (if delete-contents-file (delete-file initial-contents))))
 846   (auto-save-mode 1)
 847   (if mh-draft-folder
 848       (save-buffer))                    ; Do not reuse draft name
 849   (buffer-name))
 850
 851 (defun mh-new-draft-name ()
 852   "Return the pathname of folder for draft messages."
 853   (save-excursion
 854     (mh-exec-cmd-quiet t "mhpath" mh-draft-folder "new")
 855     (buffer-substring (point-min) (1- (point-max)))))
 856
 857 (defun mh-insert-fields (&rest name-values)
 858   "Insert the NAME-VALUES pairs in the current buffer.
 859 If the field exists, append the value to it.
 860 Do not insert any pairs whose value is the empty string."
 861   (let ((case-fold-search t))
 862     (while name-values
 863       (let ((field-name (car name-values))
 864             (value (car (cdr name-values))))
 865         (if (not (string-match "^.*:$" field-name))
 866             (setq field-name (concat field-name ":")))
 867         (cond ((or (null value)
 868                    (equal value ""))
 869                nil)
 870               ((mh-position-on-field field-name)
 871                (insert " " (or value "")))
 872               (t
 873                (insert field-name " " value "\n")))
 874         (setq name-values (cdr (cdr name-values)))))))
 875
 876 (defun mh-compose-and-send-mail (draft send-args
 877                                        sent-from-folder sent-from-msg
 878                                        to subject cc
 879                                        annotate-char annotate-field
 880                                        config)
 881   "Edit and compose a draft message in buffer DRAFT and send or save it.
 882 SEND-ARGS is the argument passed to the send command.
 883 SENT-FROM-FOLDER is buffer containing scan listing of current folder,
 884 or nil if none exists.
 885 SENT-FROM-MSG is the message number or sequence name or nil.
 886 The TO, SUBJECT, and CC fields are passed to the
 887 `mh-compose-letter-function'.
 888 If ANNOTATE-CHAR is non-null, it is used to notate the scan listing of
 889 the message. In that case, the ANNOTATE-FIELD is used to build a
 890 string for `mh-annotate-msg'.
 891 CONFIG is the window configuration to restore after sending the
 892 letter."
 893   (pop-to-buffer draft)
 894   (mh-letter-mode)
 895
 896   ;; Insert identity.
 897   (mh-insert-identity mh-identity-default t)
 898   (mh-identity-make-menu)
 899   (mh-identity-add-menu)
 900
 901   ;; Insert extra fields.
 902   (mh-insert-x-mailer)
 903   (mh-insert-x-face)
 904
 905   (mh-letter-hide-all-skipped-fields)
 906
 907   (setq mh-sent-from-folder sent-from-folder)
 908   (setq mh-sent-from-msg sent-from-msg)
 909   (setq mh-send-args send-args)
 910   (setq mh-annotate-char annotate-char)
 911   (setq mh-annotate-field annotate-field)
 912   (setq mh-previous-window-config config)
 913   (setq mode-line-buffer-identification (list "    {%b}"))
 914   (mh-logo-display)
 915   (mh-make-local-hook 'kill-buffer-hook)
 916   (add-hook 'kill-buffer-hook 'mh-tidy-draft-buffer nil t)
 917   (run-hook-with-args 'mh-compose-letter-function to subject cc))
 918
 919 (defun mh-insert-x-mailer ()
 920   "Append an X-Mailer field to the header.
 921 The versions of MH-E, Emacs, and MH are shown."
 922   ;; Lazily initialize mh-x-mailer-string.
 923   (when (and mh-insert-x-mailer-flag (null mh-x-mailer-string))
 924     (setq mh-x-mailer-string
 925           (format "MH-E %s; %s; %sEmacs %s"
 926                   mh-version mh-variant-in-use
 927                   (if mh-xemacs-flag "X" "GNU ")
 928                   (cond ((not mh-xemacs-flag)
 929                          (string-match "[0-9]+\\.[0-9]+\\(\\.[0-9]+\\)?"
 930                                        emacs-version)
 931                          (match-string 0 emacs-version))
 932                         ((string-match "[0-9.]*\\( +\([ a-z]+[0-9]+\)\\)?"
 933                                        emacs-version)
 934                          (match-string 0 emacs-version))
 935                         (t (format "%s.%s" emacs-major-version
 936                                    emacs-minor-version))))))
 937   ;; Insert X-Mailer, but only if it doesn't already exist.
 938   (save-excursion
 939     (when (and mh-insert-x-mailer-flag
 940                (null (mh-goto-header-field "X-Mailer")))
 941       (mh-insert-fields "X-Mailer:" mh-x-mailer-string))))
 942
 943 (defun mh-insert-x-face ()
 944   "Append X-Face, Face or X-Image-URL field to header.
 945 If the field already exists, this function does nothing."
 946   (when (and (file-exists-p mh-x-face-file)
 947              (file-readable-p mh-x-face-file))
 948     (save-excursion
 949       (unless (or (mh-position-on-field "X-Face")
 950                   (mh-position-on-field "Face")
 951                   (mh-position-on-field "X-Image-URL"))
 952         (save-excursion
 953           (goto-char (+ (point) (cadr (insert-file-contents mh-x-face-file))))
 954           (if (not (looking-at "^"))
 955               (insert "\n")))
 956         (unless (looking-at "\\(X-Face\\|Face\\|X-Image-URL\\): ")
 957           (insert "X-Face: "))))))
 958
 959 (defun mh-tidy-draft-buffer ()
 960   "Run when a draft buffer is destroyed."
 961   (let ((buffer (get-buffer mh-recipients-buffer)))
 962     (if buffer
 963         (kill-buffer buffer))))
 964
 965 (defun mh-letter-mode-message ()
 966   "Display a help message for users of `mh-letter-mode'.
 967 This should be the last function called when composing the draft."
 968   (message "%s" (substitute-command-keys
 969                  (concat "Type \\[mh-send-letter] to send message, "
 970                          "\\[mh-help] for help"))))
 971
 972 (defun mh-letter-adjust-point ()
 973   "Move cursor to first header field if are using the no prompt mode."
 974   (unless mh-compose-prompt-flag
 975     (goto-char (point-max))
 976     (mh-letter-next-header-field)))
 977
 978 (defun mh-annotate-msg (msg buffer note &rest args)
 979   "Mark MSG in BUFFER with character NOTE and annotate message with ARGS.
 980 MSG can be a message number, a list of message numbers, or a
 981 sequence."
 982   (apply 'mh-exec-cmd "anno" buffer
 983          (if (listp msg) (append msg args) (cons msg args)))
 984   (save-excursion
 985     (cond ((get-buffer buffer)          ; Buffer may be deleted
 986            (set-buffer buffer)
 987            (mh-iterate-on-range nil msg
 988              (mh-notate nil note
 989                         (+ mh-cmd-note mh-scan-field-destination-offset)))))))
 990
 991 (defun mh-insert-header-separator ()
 992   "Insert `mh-mail-header-separator', if absent."
 993   (save-excursion
 994     (goto-char (point-min))
 995     (rfc822-goto-eoh)
 996     (if (looking-at "$")
 997         (insert mh-mail-header-separator))))
 998
 999 ;;;###mh-autoload
1000 (defun mh-insert-auto-fields (&optional non-interactive)
1001   "Insert custom fields if recipient is found in `mh-auto-fields-list'.
1002
1003 Once the header contains one or more recipients, you may run this
1004 command to insert these fields manually. However, if you use this
1005 command, the automatic insertion when the message is sent is
1006 disabled.
1007
1008 In a program, set buffer-local `mh-insert-auto-fields-done-local'
1009 if header fields were added. If NON-INTERACTIVE is non-nil,
1010 perform actions quietly and only if
1011 `mh-insert-auto-fields-done-local' is nil. Return t if fields
1012 added; otherwise return nil."
1013   (interactive)
1014   (when (or (not non-interactive)
1015             (not mh-insert-auto-fields-done-local))
1016     (save-excursion
1017       (when (and (or (mh-goto-header-field "To:")
1018                      (mh-goto-header-field "cc:")))
1019         (let ((list mh-auto-fields-list)
1020               (fields-inserted nil))
1021           (while list
1022             (let ((regexp (nth 0 (car list)))
1023                   (entries (nth 1 (car list))))
1024               (when (mh-regexp-in-field-p regexp "To:" "cc:")
1025                 (setq mh-insert-auto-fields-done-local t)
1026                 (setq fields-inserted t)
1027                 (if (not non-interactive)
1028                     (message "Fields for %s added" regexp))
1029                 (let ((entry-list entries))
1030                   (while entry-list
1031                     (let ((field (caar entry-list))
1032                           (value (cdar entry-list)))
1033                       (cond
1034                        ((equal ":identity" field)
1035                         (when
1036                             ;;(and (not mh-identity-local)
1037                             ;; Bug 1204506.  But do we need to be able
1038                             ;; to set an identity manually that won't be
1039                             ;; overridden by mh-insert-auto-fields?
1040                             (assoc value mh-identity-list)
1041                           ;;)
1042                           (mh-insert-identity value)))
1043                        (t
1044                         (mh-modify-header-field field value
1045                                                 (equal field "From")))))
1046                     (setq entry-list (cdr entry-list))))))
1047             (setq list (cdr list)))
1048           fields-inserted)))))
1049
1050 (defun mh-modify-header-field (field value &optional overwrite-flag)
1051   "To header FIELD add VALUE.
1052 If OVERWRITE-FLAG is non-nil then the old value, if present, is
1053 discarded."
1054   (cond ((and overwrite-flag
1055               (mh-goto-header-field (concat field ":")))
1056          (insert " " value)
1057          (delete-region (point) (mh-line-end-position)))
1058         ((and (not overwrite-flag)
1059               (mh-regexp-in-field-p (concat "\\b" value "\\b") field))
1060          ;; Already there, do nothing.
1061          )
1062         ((and (not overwrite-flag)
1063               (mh-goto-header-field (concat field ":")))
1064          (insert " " value ","))
1065         (t
1066          (mh-goto-header-end 0)
1067          (insert field ": " value "\n"))))
1068
1069 (defun mh-regexp-in-field-p (regexp &rest fields)
1070   "Non-nil means REGEXP was found in FIELDS."
1071   (save-excursion
1072     (let ((search-result nil)
1073           (field))
1074       (while fields
1075         (setq field (car fields))
1076         (if (and (mh-goto-header-field field)
1077                  (re-search-forward
1078                   regexp (save-excursion (mh-header-field-end)(point)) t))
1079             (setq fields nil
1080                   search-result t)
1081           (setq fields (cdr fields))))
1082       search-result)))
1083
1084 (defun mh-ascii-buffer-p ()
1085   "Check if current buffer is entirely composed of ASCII.
1086 The function doesn't work for XEmacs since `find-charset-region'
1087 doesn't exist there."
1088   (loop for charset in (mh-funcall-if-exists
1089                         find-charset-region (point-min) (point-max))
1090         unless (eq charset 'ascii) return nil
1091         finally return t))
1092
1093 (provide 'mh-comp)
1094
1095 ;; Local Variables:
1096 ;; indent-tabs-mode: nil
1097 ;; sentence-end-double-space: nil
1098 ;; End:
1099
1100 ;; arch-tag: 62865511-e610-4923-b0b5-f45a8ab70a34
1101 ;;; mh-comp.el ends here