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