code.delx.au - gnu-emacs/blob - lisp/mail/mh-comp.el

   1 ;;; mh-comp.el --- MH-E functions for composing messages
   2
   3 ;; Copyright (C) 1993,1995,1997,2000,2001,2002 Free Software Foundation, Inc.
   4
   5 ;; Author: Bill Wohler <wohler@newt.com>
   6 ;; Maintainer: Bill Wohler <wohler@newt.com>
   7 ;; Keywords: mail
   8 ;; See: mh-e.el
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25 ;; Boston, MA 02111-1307, USA.
  26
  27 ;;; Commentary:
  28
  29 ;; Internal support for MH-E package.
  30
  31 ;;; Change Log:
  32
  33 ;; $Id: mh-comp.el,v 1.145 2002/11/29 16:49:43 wohler Exp $
  34
  35 ;;; Code:
  36
  37 (require 'mh-e)
  38 (require 'mh-utils)
  39 (require 'gnus-util)
  40 (require 'easymenu)
  41 (require 'cl)
  42
  43 ;; Shush the byte-compiler
  44 (defvar adaptive-fill-first-line-regexp)
  45 (defvar font-lock-defaults)
  46 (defvar mark-active)
  47 (defvar sendmail-coding-system)
  48 (defvar tool-bar-mode)
  49
  50 ;;; autoloads from mh-mime
  51 (autoload 'mh-press-button "mh-mime")
  52
  53 ;;; autoloads for mh-seq
  54 (autoload 'mh-notate-seq "mh-seq")
  55
  56 (autoload 'mh-compose-insertion "mh-mime"
  57   "Add a MIME directive to insert a file, using mhn or gnus.
  58 If the variable mh-compose-insertion is set to 'mhn, then that will be used.
  59 If it is set to 'gnus, then that will be used instead.")
  60
  61 (autoload 'mh-compose-forward "mh-mime"
  62   "Add a MIME directive to forward a message, using mhn or gnus.
  63 If the variable mh-compose-insertion is set to 'mhn, then that will be used.
  64 If it is set to 'gnus, then that will be used instead.")
  65
  66 (autoload 'mh-mhn-compose-insertion "mh-mime"
  67   "Add a directive to insert a MIME message part from a file.
  68 This is the typical way to insert non-text parts in a message.
  69 See also \\[mh-edit-mhn]." t)
  70
  71 (autoload 'mh-mhn-compose-anon-ftp "mh-mime"
  72   "Add a directive for a MIME anonymous ftp external body part.
  73 This directive tells MH to include a reference to a
  74 message/external-body part retrievable by anonymous FTP.
  75 See also \\[mh-edit-mhn]." t)
  76
  77 (autoload 'mh-mhn-compose-external-compressed-tar "mh-mime"
  78   "Add a directive to include a MIME reference to a compressed tar file.
  79 The file should be available via anonymous ftp.  This directive
  80 tells MH to include a reference to a message/external-body part.
  81 See also \\[mh-edit-mhn]." t)
  82
  83 (autoload 'mh-mhn-compose-forw "mh-mime"
  84   "Add a forw directive to this message, to forward a message with MIME.
  85 This directive tells MH to include another message in this one.
  86 See also \\[mh-edit-mhn]." t)
  87
  88 (autoload 'mh-edit-mhn "mh-mime"
  89   "Format the current draft for MIME, expanding any mhn directives.
  90 Process the current draft with the mhn program, which,
  91 using directives already inserted in the draft, fills in
  92 all the MIME components and header fields.
  93 This step should be done last just before sending the message.
  94 The mhn program is part of MH version 6.8 or later.
  95 The \\[mh-revert-mhn-edit] command undoes this command.
  96 For assistance with creating mhn directives to insert
  97 various types of components in a message, see
  98 \\[mh-mhn-compose-insertion] (generic insertion from a file),
  99 \\[mh-mhn-compose-anon-ftp] (external reference to file via anonymous ftp),
 100 \\[mh-mhn-compose-external-compressed-tar] \
 101 \(reference to compressed tar file via anonymous ftp), and
 102 \\[mh-mhn-compose-forw] (forward message)." t)
 103
 104 (autoload 'mh-revert-mhn-edit "mh-mime"
 105   "Undoes the effect of \\[mh-edit-mhn] by reverting to the backup file.
 106 Optional non-nil argument means don't ask for confirmation." t)
 107
 108 (autoload 'mh-mml-to-mime "mh-mime"
 109   "Compose MIME message from mml directives.")
 110
 111 (autoload 'mh-mml-forward-message "mh-mime"
 112   "Forward a message as attachment.
 113 The function will prompt the user for a description, a folder and message
 114 number.")
 115
 116 (autoload 'mh-mml-attach-file "mh-mime"
 117   "Attach a file to the outgoing MIME message.
 118 The file is not inserted or encoded until you send the message with
 119 `\\[message-send-and-exit]' or `\\[message-send]'.
 120
 121 Message dispostion is \"inline\" is INLINE is non-nil, else the default is
 122 \"attachment\".
 123 FILE is the name of the file to attach.  TYPE is its content-type, a
 124 string of the form \"type/subtype\".  DESCRIPTION is a one-line
 125 description of the attachment.")
 126
 127 (autoload 'mh-mml-secure-message-sign-pgpmime "mh-mime"
 128   "Add MML tag to encrypt/sign the entire message.")
 129
 130 (autoload 'mh-mml-secure-message-encrypt-pgpmime "mh-mime"
 131   "Add MML tag to encrypt and sign the entire message.
 132 If called with a prefix argument, only encrypt (do NOT sign).")
 133
 134 ;;; Other Autoloads.
 135
 136 (autoload 'Info-goto-node "info")
 137 (autoload 'mail-mode-fill-paragraph "sendmail")
 138 (autoload 'mm-handle-displayed-p "mm-decode")
 139
 140 (autoload 'sc-cite-original "sc"
 141   "Workhorse citing function which performs the initial citation.
 142 This is callable from the various mail and news readers' reply
 143 function according to the agreed upon standard.  See `\\[sc-describe]'
 144 for more details.  `sc-cite-original' does not do any yanking of the
 145 original message but it does require a few things:
 146
 147      1) The reply buffer is the current buffer.
 148
 149      2) The original message has been yanked and inserted into the
 150         reply buffer.
 151
 152      3) Verbose mail headers from the original message have been
 153         inserted into the reply buffer directly before the text of the
 154         original message.
 155
 156      4) Point is at the beginning of the verbose headers.
 157
 158      5) Mark is at the end of the body of text to be cited.
 159
 160 For Emacs 19's, the region need not be active (and typically isn't
 161 when this function is called.  Also, the hook `sc-pre-hook' is run
 162 before, and `sc-post-hook' is run after the guts of this function.")
 163
 164 ;;; Site customization (see also mh-utils.el):
 165
 166 (defgroup mh-compose nil
 167   "MH-E functions for composing messages."
 168   :prefix "mh-"
 169   :group 'mh)
 170
 171 (defvar mh-send-prog "send"
 172   "Name of the MH send program.
 173 Some sites need to change this because of a name conflict.")
 174
 175 (defvar mh-redist-full-contents nil
 176   "Non-nil if the `dist' command needs whole letter for redistribution.
 177 This is the case only when `send' is compiled with the BERK option.
 178 If MH will not allow you to redist a previously redist'd msg, set to nil.")
 179
 180 (defvar mh-redist-background nil
 181   "If non-nil redist will be done in background like send.
 182 This allows transaction log to be visible if -watch, -verbose or -snoop are
 183 used.")
 184
 185 (defvar mh-note-repl "-"
 186   "String whose first character is used to notate replied to messages.")
 187
 188 (defvar mh-note-forw "F"
 189   "String whose first character is used to notate forwarded messages.")
 190
 191 (defvar mh-note-dist "R"
 192   "String whose first character is used to notate redistributed messages.")
 193
 194 (defvar mh-yank-hooks nil
 195   "Obsolete hook for modifying a citation just inserted in the mail buffer.
 196 Each hook function can find the citation between point and mark.
 197 And each hook function should leave point and mark around the citation
 198 text as modified.
 199
 200 This is a normal hook, misnamed for historical reasons.
 201 It is semi-obsolete and is only used if `mail-citation-hook' is nil.")
 202
 203 (defvar mail-citation-hook nil
 204   "*Hook for modifying a citation just inserted in the mail buffer.
 205 Each hook function can find the citation between point and mark.
 206 And each hook function should leave point and mark around the citation
 207 text as modified.
 208
 209 If this hook is entirely empty (nil), the text of the message is inserted
 210 with `mh-ins-buf-prefix' prefixed to each line.
 211
 212 See also the variable `mh-yank-from-start-of-msg', which controls how
 213 much of the message passed to the hook.
 214
 215 This hook was historically provided to set up supercite.  You may now leave
 216 this nil and set up supercite by setting the variable
 217 `mh-yank-from-start-of-msg' to 'supercite or, for more automatic insertion,
 218 to 'autosupercite.")
 219
 220 ;;; Personal preferences:
 221
 222 (defcustom mh-compose-insertion (if (locate-library "mml") 'gnus 'mhn)
 223   "Use either 'gnus or 'mhn to insert MIME message directives in messages."
 224   :type '(choice (const :tag "Use gnus" gnus)
 225                  (const :tag "Use mhn"  mhn))
 226   :group 'mh-compose)
 227
 228 (defcustom mh-x-face-file "~/.face"
 229   "*File name containing the encoded X-Face string to insert in outgoing mail.
 230 If nil, or the file does not exist, nothing is added to message headers."
 231   :type 'file
 232   :group 'mh-compose)
 233
 234 (defcustom mh-insert-x-mailer-flag t
 235   "*Non-nil means append an X-Mailer field to the header."
 236   :type 'boolean
 237   :group 'mh-compose)
 238
 239 (defvar mh-x-mailer-string nil
 240   "*String containing the contents of the X-Mailer header field.
 241 If nil, this variable is initialized to show the version of MH-E, Emacs, and
 242 MH the first time a message is composed.")
 243
 244 (defcustom mh-insert-mail-followup-to-flag t
 245   "Non-nil means maybe append a Mail-Followup-To field to the header.
 246 The insertion is done if the To: or Cc: fields matches an entry in
 247 `mh-insert-mail-followup-to-list'."
 248   :type 'boolean
 249   :group 'mh-compose)
 250
 251 (defcustom mh-insert-mail-followup-to-list nil
 252   "Alist of addresses for which a Mail-Followup-To field is inserted.
 253 Each element has the form (REGEXP ADDRESS).
 254 When the REGEXP appears in the To or cc fields of a message, the corresponding
 255 ADDRESS is inserted in a Mail-Followup-To field.
 256
 257 Here's a customization example:
 258
 259   regexp: mh-e-users@lists.s\\\\(ourceforge\\\\|f\\\\).net
 260  address: mh-e-users@lists.sourceforge.net
 261
 262 This corresponds to:
 263
 264   (setq mh-insert-mail-followup-to-list
 265         '((\"mh-e-users@lists.s\\\\(ourceforge\\\\|f\\\\).net\"
 266            \"mh-e-users@lists.sourceforge.net\")))
 267
 268 While it might be tempting to add a descriptive name to the mailing list
 269 address, consider that this field will appear in other people's outgoing
 270 mail in their To: field.  It might be best to keep it simple."
 271   :type '(repeat (list (string :tag "regexp") (string :tag "address")))
 272   :group 'mh-compose)
 273
 274 (defcustom mh-delete-yanked-msg-window-flag nil
 275   "*Non-nil means delete any window displaying the message.
 276 Controls window display when a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg].
 277 If non-nil, yanking the current message into a draft letter deletes any
 278 windows displaying the message."
 279   :type 'boolean
 280   :group 'mh-compose)
 281
 282 (defcustom mh-yank-from-start-of-msg 'attribution
 283   "*Controls which part of a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg].
 284 If t, include the entire message, with full headers.  This is historically
 285 here for use with supercite, but is now deprecated in favor of the setting
 286 `supercite' below.
 287
 288 If the symbol `body', then yank the message minus the header.
 289
 290 If the symbol `supercite', include the entire message, with full headers.
 291 This also causes the invocation of `sc-cite-original' without the setting
 292 of `mail-citation-hook', now deprecated practice.
 293
 294 If the symbol `autosupercite', do as for `supercite' automatically when
 295 show buffer matches the message being replied-to.  When this option is used,
 296 the -noformat switch is passed to the repl program to override a -filter or
 297 -format switch.
 298
 299 If the symbol `attribution', then yank the message minus the header and add
 300 a simple attribution line at the top.
 301
 302 If the symbol `autoattrib', do as for `attribution' automatically when show
 303 buffer matches the message being replied-to.  You can make sure this is
 304 always the case by setting `mh-reply-show-message-flag' to t (which is the
 305 default) and optionally `mh-delete-yanked-msg-window-flag' to t as well such
 306 that the show window is never displayed.  When the `autoattrib' option is
 307 used, the -noformat switch is passed to the repl program to override a
 308 -filter or -format switch.
 309
 310 If nil, yank only the portion of the message following the point.
 311
 312 If the show buffer has a region, this variable is ignored unless its value is
 313 one of `attribution' or `autoattrib' in which case the attribution is added
 314 to the yanked region."
 315   :type '(choice (const :tag "Below point" nil)
 316                  (const :tag "Without header" body)
 317                  (const :tag "Invoke supercite" supercite)
 318                  (const :tag "Invoke supercite, automatically" autosupercite)
 319                  (const :tag "Without header, with attribution" attribution)
 320                  (const :tag "Without header, with attribution, automatically"
 321                         autoattrib)
 322                  (const :tag "Entire message with headers" t))
 323   :group 'mh-compose)
 324
 325 (defcustom mh-extract-from-attribution-verb "wrote:"
 326   "*Verb to use for attribution when a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg]."
 327   :type '(choice (const "wrote:")
 328                  (const "a écrit :")
 329                  (string :tag "Custom string"))
 330   :group 'mh-compose)
 331
 332 (defcustom mh-ins-buf-prefix "> "
 333   "*String to put before each non-blank line of a yanked or inserted message.
 334 \\<mh-letter-mode-map>Used when the message is inserted into an outgoing letter
 335 by \\[mh-insert-letter] or \\[mh-yank-cur-msg]."
 336   :type 'string
 337   :group 'mh-compose)
 338
 339 (defcustom mh-reply-default-reply-to nil
 340   "*Sets the person or persons to whom a reply will be sent.
 341 If nil, prompt for recipient.  If non-nil, then \\<mh-folder-mode-map>`\\[mh-reply]' will use this
 342 value and it should be one of \"from\", \"to\", \"cc\", or \"all\".
 343 The values \"cc\" and \"all\" do the same thing."
 344   :type '(choice (const :tag "Prompt" nil)
 345                  (const "from") (const "to")
 346                  (const "cc") (const "all"))
 347   :group 'mh-compose)
 348
 349 (defcustom mh-signature-file-name "~/.signature"
 350   "*Name of file containing the user's signature.
 351 Inserted into message by \\<mh-letter-mode-map>\\[mh-insert-signature]."
 352   :type 'file
 353   :group 'mh-compose)
 354
 355 (defcustom mh-forward-subject-format "%s: %s"
 356   "*Format to generate the Subject: line contents for a forwarded message.
 357 The two string arguments to the format are the sender of the original
 358 message and the original subject line."
 359   :type 'string
 360   :group 'mh-compose)
 361
 362 (defvar mh-comp-formfile "components"
 363   "Name of file to be used as a skeleton for composing messages.
 364 Default is \"components\".  If not an absolute file name, the file
 365 is searched for first in the user's MH directory, then in the
 366 system MH lib directory.")
 367
 368 (defvar mh-repl-formfile "replcomps"
 369   "Name of file to be used as a skeleton for replying to messages.
 370 Default is \"replcomps\".  If not an absolute file name, the file
 371 is searched for first in the user's MH directory, then in the
 372 system MH lib directory.")
 373
 374 (defvar mh-repl-group-formfile "replgroupcomps"
 375   "Name of file to be used as a skeleton for replying to messages.
 376 This file is used to form replies to the sender and all recipients of a
 377 message. Only used if `mh-nmh-flag' is non-nil. Default is \"replgroupcomps\".
 378 If not an absolute file name, the file is searched for first in the user's MH
 379 directory, then in the system MH lib directory.")
 380
 381 (defcustom mh-reply-show-message-flag t
 382   "*Non-nil means the show buffer is displayed using \\<mh-letter-mode-map>\\[mh-reply].
 383
 384 The setting of this variable determines whether the MH `show-buffer' is
 385 displayed with the current message when using `mh-reply' without a prefix
 386 argument.  Set it to nil if you already include the message automatically
 387 in your draft using
 388  repl: -filter repl.filter
 389 in your ~/.mh_profile file."
 390   :type 'boolean
 391   :group 'mh-compose)
 392
 393 (defcustom mh-letter-fill-column 72
 394   "*Fill column to use in `mh-letter-mode'.
 395 This is usually less than in other text modes because email messages get
 396 quoted by some prefix (sometimes many times) when they are replied to,
 397 and it's best to avoid quoted lines that span more than 80 columns."
 398   :type 'integer
 399   :group 'mh-compose)
 400
 401 ;;; Hooks:
 402
 403 (defcustom mh-letter-mode-hook nil
 404   "Invoked in `mh-letter-mode' on a new letter."
 405   :type 'hook
 406   :group 'mh-compose)
 407
 408 (defcustom mh-compose-letter-function nil
 409   "Invoked when setting up a letter draft.
 410 It is passed three arguments: TO recipients, SUBJECT, and CC recipients."
 411   :type '(choice (const nil) function)
 412   :group 'mh-compose)
 413
 414 (defcustom mh-before-send-letter-hook nil
 415   "Invoked at the beginning of the \\<mh-letter-mode-map>\\[mh-send-letter] command."
 416   :type 'hook
 417   :group 'mh-compose)
 418
 419 (defcustom mh-letter-insert-signature-hook nil
 420   "Invoked at the beginning of the \\<mh-letter-mode-map>\\[mh-insert-signature] command.
 421 Can be used to determine which signature file to use based on message content.
 422 On return, if `mh-signature-file-name' is non-nil that file will be inserted at
 423 the current point in the buffer."
 424   :type 'hook
 425   :group 'mh-compose)
 426
 427 (defvar mh-rejected-letter-start
 428   (format "^%s$"
 429           (regexp-opt
 430            '("Content-Type: message/rfc822"     ;MIME MDN
 431              "   ----- Unsent message follows -----" ;from sendmail V5
 432              " --------Unsent Message below:" ; from sendmail at BU
 433              "   ----- Original message follows -----" ;from sendmail V8
 434              "------- Unsent Draft"             ;from MH itself
 435              "----------  Original Message  ----------" ;from zmailer
 436              "  --- The unsent message follows ---" ;from AIX mail system
 437              "    Your message follows:"        ;from MMDF-II
 438              "Content-Description: Returned Content" ;1993 KJ sendmail
 439              ))))
 440
 441 (defvar mh-new-draft-cleaned-headers
 442   "^Date:\\|^Received:\\|^Message-Id:\\|^From:\\|^Sender:\\|^Errors-To:\\|^Delivery-Date:\\|^Return-Path:"
 443   "Regexp of header lines to remove before offering a message as a new draft.
 444 Used by the \\<mh-folder-mode-map>`\\[mh-edit-again]' and `\\[mh-extract-rejected-mail]' commands.")
 445
 446 (defvar mh-to-field-choices '(("t" . "To:") ("s" . "Subject:") ("c" . "Cc:")
 447                               ("b" . "Bcc:") ("f" . "Fcc:") ("r" . "From:")
 448                               ("d" . "Dcc:"))
 449   "Alist of (final-character . field-name) choices for `mh-to-field'.")
 450
 451 (defvar mh-letter-mode-map (copy-keymap text-mode-map)
 452   "Keymap for composing mail.")
 453
 454 (defvar mh-letter-mode-syntax-table nil
 455   "Syntax table used by MH-E while in MH-Letter mode.")
 456
 457 (if mh-letter-mode-syntax-table
 458     ()
 459     (setq mh-letter-mode-syntax-table
 460           (make-syntax-table text-mode-syntax-table))
 461     (modify-syntax-entry ?% "." mh-letter-mode-syntax-table))
 462
 463 (defvar mh-sent-from-folder nil
 464   "Folder of msg assoc with this letter.")
 465
 466 (defvar mh-sent-from-msg nil
 467   "Number of msg assoc with this letter.")
 468
 469 (defvar mh-send-args nil
 470   "Extra args to pass to \"send\" command.")
 471
 472 (defvar mh-annotate-char nil
 473   "Character to use to annotate `mh-sent-from-msg'.")
 474
 475 (defvar mh-annotate-field nil
 476   "Field name for message annotation.")
 477
 478 ;;;###autoload
 479 (defun mh-smail ()
 480   "Compose and send mail with the MH mail system.
 481 This function is an entry point to MH-E, the Emacs front end
 482 to the MH mail system.
 483
 484 See documentation of `\\[mh-send]' for more details on composing mail."
 485   (interactive)
 486   (mh-find-path)
 487   (call-interactively 'mh-send))
 488
 489 (defvar mh-error-if-no-draft nil)       ;raise error over using old draft
 490
 491 ;;;###autoload
 492 (defun mh-smail-batch (&optional to subject other-headers &rest ignored)
 493   "Set up a mail composition draft with the MH mail system.
 494 This function is an entry point to MH-E, the Emacs front end
 495 to the MH mail system.  This function does not prompt the user
 496 for any header fields, and thus is suitable for use by programs
 497 that want to create a mail buffer.
 498 Users should use `\\[mh-smail]' to compose mail.
 499 Optional arguments for setting certain fields include TO, SUBJECT, and
 500 OTHER-HEADERS. Additional arguments are IGNORED."
 501   (mh-find-path)
 502   (let ((mh-error-if-no-draft t))
 503     (mh-send (or to "") "" (or subject ""))))
 504
 505 ;; XEmacs needs this:
 506 ;;;###autoload
 507 (defun mh-user-agent-compose (&optional to subject other-headers continue
 508                                              switch-function yank-action
 509                                              send-actions)
 510   "Set up mail composition draft with the MH mail system.
 511 This is `mail-user-agent' entry point to MH-E.
 512
 513 The optional arguments TO and SUBJECT specify recipients and the
 514 initial Subject field, respectively.
 515
 516 OTHER-HEADERS is an alist specifying additional
 517 header fields.  Elements look like (HEADER . VALUE) where both
 518 HEADER and VALUE are strings.
 519
 520 CONTINUE, SWITCH-FUNCTION, YANK-ACTION and SEND-ACTIONS are ignored."
 521   (mh-find-path)
 522   (let ((mh-error-if-no-draft t))
 523     (mh-send to "" subject)
 524     (while other-headers
 525       (mh-insert-fields (concat (car (car other-headers)) ":")
 526                        (cdr (car other-headers)))
 527       (setq other-headers (cdr other-headers)))))
 528
 529 (defun mh-edit-again (msg)
 530   "Clean up a draft or a message MSG previously sent and make it resendable.
 531 Default is the current message.
 532 The variable `mh-new-draft-cleaned-headers' specifies the headers to remove.
 533 See also documentation for `\\[mh-send]' function."
 534   (interactive (list (mh-get-msg-num t)))
 535   (let* ((from-folder mh-current-folder)
 536          (config (current-window-configuration))
 537          (draft
 538           (cond ((and mh-draft-folder (equal from-folder mh-draft-folder))
 539                  (pop-to-buffer (find-file-noselect (mh-msg-filename msg)) t)
 540                  (rename-buffer (format "draft-%d" msg))
 541                  ;; Make buffer writable...
 542                  (setq buffer-read-only nil)
 543                  ;; If buffer was being used to display the message reinsert
 544                  ;; from file...
 545                  (when (eq major-mode 'mh-show-mode)
 546                    (erase-buffer)
 547                    (insert-file-contents buffer-file-name))
 548                  (buffer-name))
 549                 (t
 550                  (mh-read-draft "clean-up" (mh-msg-filename msg) nil)))))
 551     (mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil)
 552     (mh-insert-header-separator)
 553     (goto-char (point-min))
 554     (save-buffer)
 555     (mh-compose-and-send-mail draft "" from-folder nil nil nil nil nil nil
 556                               config)
 557     (mh-letter-mode-message)))
 558
 559 (defun mh-extract-rejected-mail (msg)
 560   "Extract message MSG returned by the mail system and make it resendable.
 561 Default is the current message.  The variable `mh-new-draft-cleaned-headers'
 562 gives the headers to clean out of the original message.
 563 See also documentation for `\\[mh-send]' function."
 564   (interactive (list (mh-get-msg-num t)))
 565   (let ((from-folder mh-current-folder)
 566         (config (current-window-configuration))
 567         (draft (mh-read-draft "extraction" (mh-msg-filename msg) nil)))
 568     (goto-char (point-min))
 569     (cond ((re-search-forward mh-rejected-letter-start nil t)
 570            (skip-chars-forward " \t\n")
 571            (delete-region (point-min) (point))
 572            (mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil))
 573           (t
 574            (message "Does not appear to be a rejected letter.")))
 575     (mh-insert-header-separator)
 576     (goto-char (point-min))
 577     (save-buffer)
 578     (mh-compose-and-send-mail draft "" from-folder msg
 579                               (mh-get-header-field "To:")
 580                               (mh-get-header-field "From:")
 581                               (mh-get-header-field "Cc:")
 582                               nil nil config)
 583     (mh-letter-mode-message)))
 584
 585 (defun mh-forward (to cc &optional msg-or-seq)
 586 "Forward one or more messages to the recipients TO and CC.
 587
 588 Use the optional MSG-OR-SEQ to specify a message or sequence to forward.
 589
 590 Default is the displayed message.  If optional prefix argument is given then
 591 prompt for the message sequence.  If variable `transient-mark-mode' is non-nil
 592 and the mark is active, then the selected region is forwarded.
 593 See also documentation for `\\[mh-send]' function."
 594   (interactive (list (mh-read-address "To: ")
 595                      (mh-read-address "Cc: ")
 596                      (cond
 597                       ((mh-mark-active-p t)
 598                        (mh-region-to-sequence (region-beginning) (region-end))
 599                        'region)
 600                       (current-prefix-arg
 601                        (mh-read-seq-default "Forward" t))
 602                       (t
 603                        (mh-get-msg-num t)))))
 604   (let* ((folder mh-current-folder)
 605          (msgs (if (numberp msg-or-seq)
 606                    (list msg-or-seq)
 607                  (mh-seq-to-msgs msg-or-seq)))
 608          (config (current-window-configuration))
 609          (fwd-msg-file (mh-msg-filename (car msgs) folder))
 610          ;; forw always leaves file in "draft" since it doesn't have -draft
 611          (draft-name (expand-file-name "draft" mh-user-path))
 612          (draft (cond ((or (not (file-exists-p draft-name))
 613                            (y-or-n-p "The file 'draft' exists.  Discard it? "))
 614                        (mh-exec-cmd "forw" "-build" (if mh-nmh-flag "-mime")
 615                                     mh-current-folder msgs)
 616                        (prog1
 617                            (mh-read-draft "" draft-name t)
 618                          (mh-insert-fields "To:" to "Cc:" cc)
 619                          (save-buffer)))
 620                       (t
 621                        (mh-read-draft "" draft-name nil)))))
 622     (let (orig-from
 623           orig-subject)
 624       (save-excursion
 625         (set-buffer (get-buffer-create mh-temp-buffer))
 626         (erase-buffer)
 627         (insert-file-contents fwd-msg-file)
 628         (setq orig-from (mh-get-header-field "From:"))
 629         (setq orig-subject (mh-get-header-field "Subject:")))
 630       (let ((forw-subject
 631              (mh-forwarded-letter-subject orig-from orig-subject))
 632             (mail-header-separator mh-mail-header-separator)
 633             (compose))
 634         (mh-insert-fields "Subject:" forw-subject)
 635         (goto-char (point-min))
 636         ;; If using MML, translate mhn
 637         (if (equal mh-compose-insertion 'gnus)
 638             (save-excursion
 639               (setq compose t)
 640               (re-search-forward (format "^\\(%s\\)?$" mail-header-separator))
 641               (while
 642                   (re-search-forward "^#forw \\[\\([^]]+\\)\\] \\(+\\S-+\\) \\(.*\\)$" (point-max) t)
 643                 (let ((description (if (equal (match-string 1) "forwarded messages")
 644                                        "forwarded message %d"
 645                                      (match-string 1)))
 646                       (msgs (split-string (match-string 3)))
 647                       (i 0))
 648                   (beginning-of-line)
 649                   (delete-region (point)(progn (forward-line 1)(point)))
 650                   (dolist (msg msgs)
 651                     (setq i (1+ i))
 652                     (mh-mml-forward-message (format description i) folder msg))))))
 653         ;; Postition just before forwarded message
 654         (if (re-search-forward "^------- Forwarded Message" nil t)
 655             (forward-line -1)
 656           (re-search-forward (format "^\\(%s\\)?$" mail-header-separator))
 657           (forward-line 1))
 658         (delete-other-windows)
 659         (mh-add-msgs-to-seq msgs 'forwarded t)
 660         (mh-compose-and-send-mail draft "" folder msg-or-seq
 661                                   to forw-subject cc
 662                                   mh-note-forw "Forwarded:"
 663                                   config)
 664         (if compose
 665             (setq mh-mml-compose-insert-flag t))
 666         (mh-letter-mode-message)))))
 667
 668 (defun mh-forwarded-letter-subject (from subject)
 669   "Return a Subject suitable for a forwarded message.
 670 Original message has headers FROM and SUBJECT."
 671   (let ((addr-start (string-match "<" from))
 672         (comment (string-match "(" from)))
 673     (cond ((and addr-start (> addr-start 0))
 674            ;; Full Name <luser@host>
 675            (setq from (substring from 0 (1- addr-start))))
 676           (comment
 677            ;; luser@host (Full Name)
 678            (setq from (substring from (1+ comment) (1- (length from)))))))
 679   (format mh-forward-subject-format from subject))
 680
 681 ;;;###autoload
 682 (defun mh-smail-other-window ()
 683   "Compose and send mail in other window with the MH mail system.
 684 This function is an entry point to MH-E, the Emacs front end
 685 to the MH mail system.
 686
 687 See documentation of `\\[mh-send]' for more details on composing mail."
 688   (interactive)
 689   (mh-find-path)
 690   (call-interactively 'mh-send-other-window))
 691
 692 (defun mh-redistribute (to cc &optional msg)
 693   "Redistribute displayed message to recipients TO and CC.
 694 Use optional argument MSG to redistribute another message.
 695 Depending on how your copy of MH was compiled, you may need to change the
 696 setting of the variable `mh-redist-full-contents'.  See its documentation."
 697   (interactive (list (mh-read-address "Redist-To: ")
 698                      (mh-read-address "Redist-Cc: ")
 699                      (mh-get-msg-num t)))
 700   (or msg
 701       (setq msg (mh-get-msg-num t)))
 702   (save-window-excursion
 703     (let ((folder mh-current-folder)
 704           (draft (mh-read-draft "redistribution"
 705                                 (if mh-redist-full-contents
 706                                     (mh-msg-filename msg)
 707                                   nil)
 708                                 nil)))
 709       (mh-goto-header-end 0)
 710       (insert "Resent-To: " to "\n")
 711       (if (not (equal cc "")) (insert "Resent-cc: " cc "\n"))
 712       (mh-clean-msg-header (point-min)
 713                            "^Message-Id:\\|^Received:\\|^Return-Path:\\|^Sender:\\|^Date:\\|^From:"
 714                            nil)
 715       (save-buffer)
 716       (message "Redistributing...")
 717       (if (not mh-redist-background)
 718           (if mh-redist-full-contents
 719               (call-process "/bin/sh" nil 0 nil "-c"
 720                             (format "mhdist=1 mhaltmsg=%s %s -push %s"
 721                                     buffer-file-name
 722                                     (expand-file-name mh-send-prog mh-progs)
 723                                     buffer-file-name))
 724             (call-process "/bin/sh" nil 0 nil "-c"
 725                           (format "mhdist=1 mhaltmsg=%s mhannotate=1 %s -push %s"
 726                                   (mh-msg-filename msg folder)
 727                                   (expand-file-name mh-send-prog mh-progs)
 728                                   buffer-file-name))))
 729       (mh-annotate-msg msg folder mh-note-dist
 730                        "-component" "Resent:"
 731                        "-text" (format "\"%s %s\"" to cc))
 732       (if mh-redist-background
 733           (mh-exec-cmd-daemon "/bin/sh" "-c"
 734                               (format "mhdist=1 mhaltmsg=%s %s %s %s"
 735                                       (if mh-redist-full-contents
 736                                           buffer-file-name
 737                                         (mh-msg-filename msg folder))
 738                                       (if mh-redist-full-contents
 739                                           ""
 740                                         "mhannotate=1")
 741                                       (mh-expand-file-name "send" mh-progs)
 742                                       buffer-file-name)))
 743       (kill-buffer draft)
 744       (message "Redistributing...done"))))
 745
 746 (defun mh-show-buffer-message-number (&optional buffer)
 747   "Message number of displayed message in corresponding show buffer.
 748 Return nil if show buffer not displayed.
 749 If in `mh-letter-mode', don't display the message number being replied to,
 750 but rather the message number of the show buffer associated with our
 751 originating folder buffer.
 752 Optional argument BUFFER can be used to specify the buffer."
 753   (save-excursion
 754     (if buffer
 755         (set-buffer buffer))
 756     (cond ((eq major-mode 'mh-show-mode)
 757            (let ((number-start (search "/" buffer-file-name :from-end t)))
 758              (car (read-from-string (subseq buffer-file-name
 759                                             (1+ number-start))))))
 760           ((and (eq major-mode 'mh-folder-mode)
 761                 mh-show-buffer
 762                 (get-buffer mh-show-buffer))
 763            (mh-show-buffer-message-number mh-show-buffer))
 764           ((and (eq major-mode 'mh-letter-mode)
 765                 mh-sent-from-folder
 766                 (get-buffer mh-sent-from-folder))
 767            (mh-show-buffer-message-number mh-sent-from-folder))
 768           (t
 769            nil))))
 770
 771 (defun mh-reply (message &optional reply-to includep)
 772   "Reply to MESSAGE (default: current message).
 773 If the optional argument REPLY-TO is not given, prompts for type of addresses
 774 to reply to:
 775    from    sender only,
 776    to      sender and primary recipients,
 777    cc/all  sender and all recipients.
 778 If optional prefix argument INCLUDEP provided, then include the message
 779 in the reply using filter `mhl.reply' in your MH directory.
 780 If the file named by `mh-repl-formfile' exists, it is used as a skeleton
 781 for the reply.  See also documentation for `\\[mh-send]' function."
 782   (interactive (list
 783                 (mh-get-msg-num t)
 784                 (let ((minibuffer-help-form
 785                        "from => Sender only\nto => Sender and primary recipients\ncc or all => Sender and all recipients"))
 786                   (or mh-reply-default-reply-to
 787                       (completing-read "Reply to whom? (from, to, all) [from]: "
 788                                        '(("from") ("to") ("cc") ("all"))
 789                                        nil
 790                                        t)))
 791                 current-prefix-arg))
 792   (let* ((folder mh-current-folder)
 793          (show-buffer mh-show-buffer)
 794          (config (current-window-configuration))
 795          (group-reply (or (equal reply-to "cc") (equal reply-to "all")))
 796          (form-file (cond ((and mh-nmh-flag group-reply
 797                                 (stringp mh-repl-group-formfile))
 798                            mh-repl-group-formfile)
 799                           ((stringp mh-repl-formfile) mh-repl-formfile)
 800                           (t nil))))
 801     (message "Composing a reply...")
 802     (mh-exec-cmd "repl" "-build" "-noquery" "-nodraftfolder"
 803                  (if form-file
 804                      (list "-form" form-file))
 805                  mh-current-folder message
 806                  (cond ((or (equal reply-to "from") (equal reply-to ""))
 807                         '("-nocc" "all"))
 808                        ((equal reply-to "to")
 809                         '("-cc" "to"))
 810                        (group-reply (if mh-nmh-flag
 811                                         '("-group" "-nocc" "me")
 812                                       '("-cc" "all" "-nocc" "me"))))
 813                  (cond ((or (eq mh-yank-from-start-of-msg 'autosupercite)
 814                             (eq mh-yank-from-start-of-msg 'autoattrib))
 815                         '("-noformat"))
 816                        (includep '("-filter" "mhl.reply"))
 817                        (t '())))
 818     (let ((draft (mh-read-draft "reply"
 819                                 (expand-file-name "reply" mh-user-path)
 820                                 t)))
 821       (delete-other-windows)
 822       (save-buffer)
 823
 824       (let ((to (mh-get-header-field "To:"))
 825             (subject (mh-get-header-field "Subject:"))
 826             (cc (mh-get-header-field "Cc:")))
 827         (goto-char (point-min))
 828         (mh-goto-header-end 1)
 829         (or includep
 830             (not mh-reply-show-message-flag)
 831             (mh-in-show-buffer (show-buffer)
 832               (mh-display-msg message folder)))
 833         (mh-add-msgs-to-seq message 'answered t)
 834         (message "Composing a reply...done")
 835         (mh-compose-and-send-mail draft "" folder message to subject cc
 836                                   mh-note-repl "Replied:" config))
 837       (when (and (or (eq 'autosupercite mh-yank-from-start-of-msg)
 838                      (eq 'autoattrib mh-yank-from-start-of-msg))
 839                  (eq (mh-show-buffer-message-number) mh-sent-from-msg))
 840         (undo-boundary)
 841         (mh-yank-cur-msg))
 842       (mh-letter-mode-message))))
 843
 844 (defun mh-send (to cc subject)
 845   "Compose and send a letter.
 846
 847 Do not call this function from outside MH-E; use \\[mh-smail] instead.
 848
 849 The file named by `mh-comp-formfile' will be used as the form.
 850 The letter is composed in `mh-letter-mode'; see its documentation for more
 851 details.
 852 If `mh-compose-letter-function' is defined, it is called on the draft and
 853 passed three arguments: TO, CC, and SUBJECT."
 854   (interactive (list
 855                 (mh-read-address "To: ")
 856                 (mh-read-address "Cc: ")
 857                 (read-string "Subject: ")))
 858   (let ((config (current-window-configuration)))
 859     (delete-other-windows)
 860     (mh-send-sub to cc subject config)))
 861
 862 (defun mh-send-other-window (to cc subject)
 863   "Compose and send a letter in another window.
 864
 865 Do not call this function from outside MH-E; use \\[mh-smail-other-window]
 866 instead.
 867
 868 The file named by `mh-comp-formfile' will be used as the form.
 869 The letter is composed in `mh-letter-mode'; see its documentation for more
 870 details.
 871 If `mh-compose-letter-function' is defined, it is called on the draft and
 872 passed three arguments: TO, CC, and SUBJECT."
 873   (interactive (list
 874                 (mh-read-address "To: ")
 875                 (mh-read-address "Cc: ")
 876                 (read-string "Subject: ")))
 877   (let ((pop-up-windows t))
 878     (mh-send-sub to cc subject (current-window-configuration))))
 879
 880 (defun mh-send-sub (to cc subject config)
 881   "Do the real work of composing and sending a letter.
 882 Expects the TO, CC, and SUBJECT fields as arguments.
 883 CONFIG is the window configuration before sending mail."
 884   (let ((folder mh-current-folder)
 885         (msg-num (mh-get-msg-num nil)))
 886     (message "Composing a message...")
 887     (let ((draft (mh-read-draft
 888                   "message"
 889                   (let (components)
 890                     (cond
 891                      ((file-exists-p
 892                        (setq components
 893                              (expand-file-name mh-comp-formfile mh-user-path)))
 894                       components)
 895                      ((file-exists-p
 896                        (setq components
 897                              (expand-file-name mh-comp-formfile mh-lib)))
 898                       components)
 899                      ((file-exists-p
 900                        (setq components
 901                              (expand-file-name mh-comp-formfile
 902                                                ;; What is this mh-etc ??  -sm
 903                                                ;; This is dead code, so
 904                                                ;; remove it.
 905                                                ;(and (boundp 'mh-etc) mh-etc)
 906                                                )))
 907                       components)
 908                      (t
 909                       (error (format "Can't find components file \"%s\""
 910                                      components)))))
 911                   nil)))
 912       (mh-insert-fields "To:" to "Subject:" subject "Cc:" cc)
 913       (goto-char (point-max))
 914       (mh-compose-and-send-mail draft "" folder msg-num
 915                                 to subject cc
 916                                 nil nil config)
 917       (mh-letter-mode-message))))
 918
 919 (defun mh-read-draft (use initial-contents delete-contents-file)
 920   "Read draft file into a draft buffer and make that buffer the current one.
 921 USE is a message used for prompting about the intended use of the message.
 922 INITIAL-CONTENTS is filename that is read into an empty buffer, or nil
 923 if buffer should not be modified.  Delete the initial-contents file if
 924 DELETE-CONTENTS-FILE flag is set.
 925 Returns the draft folder's name.
 926 If the draft folder facility is enabled in ~/.mh_profile, a new buffer is
 927 used each time and saved in the draft folder.  The draft file can then be
 928 reused."
 929   (cond (mh-draft-folder
 930          (let ((orig-default-dir default-directory)
 931                (draft-file-name (mh-new-draft-name)))
 932            (pop-to-buffer (generate-new-buffer
 933                            (format "draft-%s"
 934                                    (file-name-nondirectory draft-file-name))))
 935            (condition-case ()
 936                (insert-file-contents draft-file-name t)
 937              (file-error))
 938            (setq default-directory orig-default-dir)))
 939         (t
 940          (let ((draft-name (expand-file-name "draft" mh-user-path)))
 941            (pop-to-buffer "draft")      ; Create if necessary
 942            (if (buffer-modified-p)
 943                (if (y-or-n-p "Draft has been modified; kill anyway? ")
 944                    (set-buffer-modified-p nil)
 945                    (error "Draft preserved")))
 946            (setq buffer-file-name draft-name)
 947            (clear-visited-file-modtime)
 948            (unlock-buffer)
 949            (cond ((and (file-exists-p draft-name)
 950                        (not (equal draft-name initial-contents)))
 951                   (insert-file-contents draft-name)
 952                   (delete-file draft-name))))))
 953   (cond ((and initial-contents
 954               (or (zerop (buffer-size))
 955                   (if (y-or-n-p
 956                         (format "A draft exists.  Use for %s? " use))
 957                       (if mh-error-if-no-draft
 958                           (error "A prior draft exists"))
 959                     t)))
 960          (erase-buffer)
 961          (insert-file-contents initial-contents)
 962          (if delete-contents-file (delete-file initial-contents))))
 963   (auto-save-mode 1)
 964   (if mh-draft-folder
 965       (save-buffer))                    ; Do not reuse draft name
 966   (buffer-name))
 967
 968 (defun mh-new-draft-name ()
 969   "Return the pathname of folder for draft messages."
 970   (save-excursion
 971     (mh-exec-cmd-quiet t "mhpath" mh-draft-folder "new")
 972     (buffer-substring (point-min) (1- (point-max)))))
 973
 974 (defun mh-annotate-msg (msg buffer note &rest args)
 975   "Mark MSG in BUFFER with character NOTE and annotate message with ARGS."
 976   (apply 'mh-exec-cmd "anno" buffer msg args)
 977   (save-excursion
 978     (cond ((get-buffer buffer)          ; Buffer may be deleted
 979            (set-buffer buffer)
 980            (if (symbolp msg)
 981                (mh-notate-seq msg note (1+ mh-cmd-note))
 982                (mh-notate msg note (1+ mh-cmd-note)))))))
 983
 984 (defun mh-insert-fields (&rest name-values)
 985   "Insert the NAME-VALUES pairs in the current buffer.
 986 If the field exists, append the value to it.
 987 Do not insert any pairs whose value is the empty string."
 988   (let ((case-fold-search t))
 989     (while name-values
 990       (let ((field-name (car name-values))
 991             (value (car (cdr name-values))))
 992         (cond ((equal value "")
 993                nil)
 994               ((mh-position-on-field field-name)
 995                (insert " " (or value "")))
 996               (t
 997                (insert field-name " " value "\n")))
 998         (setq name-values (cdr (cdr name-values)))))))
 999
1000 (defun mh-position-on-field (field &optional ignored)
1001   "Move to the end of the FIELD in the header.
1002 Move to end of entire header if FIELD not found.
1003 Returns non-nil iff FIELD was found.
1004 The optional second arg is for pre-version 4 compatibility and is IGNORED."
1005   (cond ((mh-goto-header-field field)
1006          (mh-header-field-end)
1007          t)
1008         ((mh-goto-header-end 0)
1009          nil)))
1010
1011 (defun mh-get-header-field (field)
1012   "Find and return the body of FIELD in the mail header.
1013 Returns the empty string if the field is not in the header of the
1014 current buffer."
1015   (if (mh-goto-header-field field)
1016       (progn
1017         (skip-chars-forward " \t")      ;strip leading white space in body
1018         (let ((start (point)))
1019           (mh-header-field-end)
1020           (buffer-substring start (point))))
1021     ""))
1022
1023 (fset 'mh-get-field 'mh-get-header-field) ;MH-E 4 compatibility
1024
1025 (defun mh-goto-header-field (field)
1026   "Move to FIELD in the message header.
1027 Move to the end of the FIELD name, which should end in a colon.
1028 Returns t if found, nil if not."
1029   (goto-char (point-min))
1030   (let ((case-fold-search t)
1031         (headers-end (save-excursion
1032                       (mh-goto-header-end 0)
1033                       (point))))
1034     (re-search-forward (format "^%s" field) headers-end t)))
1035
1036 (defun mh-goto-header-end (arg)
1037   "Move the cursor ARG lines after the header."
1038   (if (re-search-forward "^-*$" nil nil)
1039       (forward-line arg)))
1040
1041
1042 (defun mh-read-address (prompt)
1043   "Read a To: or Cc: address, prompting in the minibuffer with PROMPT.
1044 May someday do completion on aliases."
1045   (read-string prompt))
1046
1047 \f
1048
1049 ;;; Mode for composing and sending a draft message.
1050
1051 (put 'mh-letter-mode 'mode-class 'special)
1052
1053 ;;; Support for emacs21 toolbar using gnus/message.el icons (and code).
1054 (eval-when-compile (defvar tool-bar-map))
1055 (defvar mh-letter-tool-bar-map nil)
1056 (when (and (fboundp 'tool-bar-add-item)
1057            tool-bar-mode)
1058   (setq mh-letter-tool-bar-map
1059     (let ((tool-bar-map (make-sparse-keymap)))
1060       (tool-bar-add-item "mail_send" 'mh-send-letter 'mh-lettertoolbar-send
1061                          :help "Send this letter")
1062       (tool-bar-add-item "attach" 'mh-compose-insertion
1063                          'mh-lettertoolbar-compose
1064                          :help "Insert attachment")
1065       (tool-bar-add-item "spell" 'ispell-message 'mh-lettertoolbar-ispell
1066                          :help "Check spelling")
1067       (tool-bar-add-item-from-menu 'save-buffer "save")
1068       (tool-bar-add-item-from-menu 'undo "undo")
1069       (tool-bar-add-item-from-menu 'kill-region "cut")
1070       (tool-bar-add-item-from-menu 'menu-bar-kill-ring-save "copy")
1071       (tool-bar-add-item "close" 'mh-fully-kill-draft  'mh-lettertoolbar-kill
1072                          :help "Kill this draft")
1073       (tool-bar-add-item "preferences" (lambda ()
1074                                          (interactive)
1075                                          (customize-group "mh-compose"))
1076                          'mh-lettertoolbar-customize
1077                          :help "MH-E composition preferences")
1078       (tool-bar-add-item "help" (lambda ()
1079                                   (interactive)
1080                                   (Info-goto-node "(mh-e)Draft Editing"))
1081                          'mh-lettertoolbar-help :help "Help")
1082       tool-bar-map)))
1083
1084 ;;; Menu extracted from mh-menubar.el V1.1 (31 July 2001)
1085 (eval-when-compile (defvar mh-letter-menu nil))
1086 (cond
1087  ((fboundp 'easy-menu-define)
1088   (easy-menu-define
1089     mh-letter-menu mh-letter-mode-map "Menu for MH-E letter mode."
1090     '("Letter"
1091       ["Send This Draft"          mh-send-letter t]
1092       ["Split Current Line"       mh-open-line t]
1093       ["Check Recipient"          mh-check-whom t]
1094       ["Yank Current Message"     mh-yank-cur-msg t]
1095       ["Insert a Message..."      mh-insert-letter t]
1096       ["Insert Signature"         mh-insert-signature t]
1097       ["GPG Sign message"         mh-mml-secure-message-sign-pgpmime mh-gnus-pgp-support-flag]
1098       ["GPG Encrypt message"      mh-mml-secure-message-encrypt-pgpmime mh-gnus-pgp-support-flag]
1099       ["Compose Insertion (MIME)..."      mh-compose-insertion t]
1100 ;;    ["Compose Compressed tar (MIME)..." mh-mhn-compose-external-compressed-tar t]
1101 ;;    ["Compose Anon FTP (MIME)..."       mh-mhn-compose-anon-ftp t]
1102       ["Compose Forward (MIME)..."        mh-compose-forward t]
1103 ;; The next two will have to be merged.  But I also need to make sure the user
1104 ;; can't mix directives of both types.
1105       ["Pull in All Compositions (mhn)"   mh-edit-mhn mh-mhn-compose-insert-flag]
1106       ["Pull in All Compositions (gnus)"  mh-mml-to-mime mh-mml-compose-insert-flag]
1107       ["Revert to Non-MIME Edit (mhn)"  mh-revert-mhn-edit (equal mh-compose-insertion 'mhn)]
1108       ["Kill This Draft"          mh-fully-kill-draft t]))))
1109
1110 ;;; Help Messages
1111 ;;; Group messages logically, more or less.
1112 (defvar mh-letter-mode-help-messages
1113   '((nil
1114      "Send letter:          \\[mh-send-letter]"
1115      "\t\tOpen line:            \\[mh-open-line]\n"
1116      "Kill letter:          \\[mh-fully-kill-draft]"
1117      "\t\tInsert:\n"
1118      "Check recipients:     \\[mh-check-whom]"
1119      "\t\t  Current message:    \\[mh-yank-cur-msg]\n"
1120      "Encrypt message:      \\[mh-mml-secure-message-encrypt-pgpmime]"
1121      "\t\t  Attachment:         \\[mh-compose-insertion]\n"
1122      "Sign message:         \\[mh-mml-secure-message-sign-pgpmime]"
1123      "\t\t  Message to forward: \\[mh-compose-forward]\n"
1124      "                          "
1125      "\t\t  Signature:          \\[mh-insert-signature]"))
1126   "Key binding cheat sheet.
1127
1128 This is an associative array which is used to show the most common commands.
1129 The key is a prefix char. The value is one or more strings which are
1130 concatenated together and displayed in the minibuffer if ? is pressed after
1131 the prefix character. The special key nil is used to display the
1132 non-prefixed commands.
1133
1134 The substitutions described in `substitute-command-keys' are performed as
1135 well.")
1136
1137
1138 (defun mh-fill-paragraph-function (arg)
1139   "Fill paragraph at or after point.
1140 Prefix ARG means justify as well. This function enables `fill-paragraph' to
1141 work better in MH-Letter mode."
1142   (interactive "P")
1143   (let ((fill-paragraph-function) (fill-prefix))
1144     (if (mh-in-header-p)
1145         (mail-mode-fill-paragraph arg)
1146       (fill-paragraph arg))))
1147
1148 ;;;###autoload
1149 (define-derived-mode mh-letter-mode text-mode "MH-Letter"
1150   "Mode for composing letters in MH-E.\\<mh-letter-mode-map>
1151
1152 When you have finished composing, type \\[mh-send-letter] to send the message
1153 using the MH mail handling system.
1154
1155 If MH MIME directives are added manually, you must first run \\[mh-edit-mhn]
1156 before sending the message. MIME directives that are added by MH-E commands
1157 such as \\[mh-mhn-compose-insertion] are processed automatically when the
1158 message is sent.
1159
1160 Options that control this mode can be changed with
1161 \\[customize-group]; specify the \"mh-compose\" group.
1162
1163 When a message is composed, the hooks `text-mode-hook' and
1164 `mh-letter-mode-hook' are run.
1165
1166 \\{mh-letter-mode-map}"
1167
1168   (or mh-user-path (mh-find-path))
1169   (make-local-variable 'mh-send-args)
1170   (make-local-variable 'mh-annotate-char)
1171   (make-local-variable 'mh-annotate-field)
1172   (make-local-variable 'mh-previous-window-config)
1173   (make-local-variable 'mh-sent-from-folder)
1174   (make-local-variable 'mh-sent-from-msg)
1175   (make-local-variable 'mail-header-separator)
1176   (setq mail-header-separator mh-mail-header-separator) ;override sendmail.el
1177   (make-local-variable 'mh-help-messages)
1178   (setq mh-help-messages mh-letter-mode-help-messages)
1179
1180   ;; From sendmail.el for proper paragraph fill
1181   ;; sendmail.el also sets a normal-auto-fill-function (not done here)
1182   (make-local-variable 'paragraph-separate)
1183   (make-local-variable 'paragraph-start)
1184   (make-local-variable 'fill-paragraph-function)
1185   (setq fill-paragraph-function 'mh-fill-paragraph-function)
1186   (make-local-variable 'adaptive-fill-regexp)
1187   (setq adaptive-fill-regexp
1188         (concat adaptive-fill-regexp
1189                 "\\|[ \t]*[-[:alnum:]]*>+[ \t]*"))
1190   (make-local-variable 'adaptive-fill-first-line-regexp)
1191   (setq adaptive-fill-first-line-regexp
1192         (concat adaptive-fill-first-line-regexp
1193                 "\\|[ \t]*[-[:alnum:]]*>+[ \t]*"))
1194   ;; `-- ' precedes the signature.  `-----' appears at the start of the
1195   ;; lines that delimit forwarded messages.
1196   ;; Lines containing just >= 3 dashes, perhaps after whitespace,
1197   ;; are also sometimes used and should be separators.
1198   (setq paragraph-start (concat (regexp-quote mail-header-separator)
1199                          "\\|\t*\\([-|#;>* ]\\|(?[0-9]+[.)]\\)+$"
1200                          "\\|[ \t]*[[:alnum:]]*>+[ \t]*$\\|[ \t]*$\\|"
1201                          "-- $\\|---+$\\|"
1202                          page-delimiter))
1203   (setq paragraph-separate paragraph-start)
1204   ;; --- End of code from sendmail.el ---
1205
1206   (if (and (boundp 'tool-bar-mode) tool-bar-mode)
1207       (set (make-local-variable 'tool-bar-map) mh-letter-tool-bar-map))
1208   (make-local-variable 'font-lock-defaults)
1209   (cond
1210    ((or (equal mh-highlight-citation-p 'font-lock)
1211         (equal mh-highlight-citation-p 'gnus))
1212     ;; Let's use font-lock even if gnus is used in show-mode.  The reason
1213     ;; is that gnus uses static text properties which are not appropriate
1214     ;; for a buffer that will be edited.  So the choice here is either fontify
1215     ;; the citations and header...
1216     (setq font-lock-defaults '(mh-show-font-lock-keywords-with-cite t)))
1217    (t
1218     ;; ...or the header only
1219     (setq font-lock-defaults '(mh-show-font-lock-keywords t))))
1220   (easy-menu-add mh-letter-menu)
1221   ;; See if a "forw: -mime" message containing a MIME composition.
1222   ;; mode clears local vars, so can't do this in mh-forward.
1223   (save-excursion
1224     (goto-char (point-min))
1225     (when (and (re-search-forward (format "^\\(%s\\)?$" mail-header-separator) nil t)
1226                (= 0 (forward-line 1))
1227                (looking-at "^#forw"))
1228       (require 'mh-mime)    ;Need mh-mhn-compose-insert-flag local var
1229       (setq mh-mhn-compose-insert-flag t)))
1230   (setq fill-column mh-letter-fill-column)
1231   ;; if text-mode-hook turned on auto-fill, tune it for messages
1232   (when auto-fill-function
1233     (make-local-variable 'auto-fill-function)
1234     (setq auto-fill-function 'mh-auto-fill-for-letter)))
1235
1236 (defun mh-auto-fill-for-letter ()
1237   "Perform auto-fill for message.
1238 Header is treated specially by inserting a tab before continuation lines."
1239   (if (mh-in-header-p)
1240       (let ((fill-prefix "\t"))
1241         (do-auto-fill))
1242     (do-auto-fill)))
1243
1244 (defun mh-insert-header-separator ()
1245   "Insert `mh-mail-header-separator', if absent."
1246   (save-excursion
1247     (goto-char (point-min))
1248     (rfc822-goto-eoh)
1249     (if (looking-at "$")
1250         (insert mh-mail-header-separator))))
1251
1252 (defun mh-to-field ()
1253   "Move point to the end of a specified header field.
1254 The field is indicated by the previous keystroke (the last keystroke
1255 of the command) according to the list in the variable `mh-to-field-choices'.
1256 Create the field if it does not exist.  Set the mark to point before moving."
1257   (interactive)
1258   (expand-abbrev)
1259   (let ((target (cdr (or (assoc (char-to-string (logior last-input-char ?`))
1260                                 mh-to-field-choices)
1261                          ;; also look for a char for version 4 compat
1262                          (assoc (logior last-input-char ?`) mh-to-field-choices))))
1263         (case-fold-search t))
1264     (push-mark)
1265     (cond ((mh-position-on-field target)
1266            (let ((eol (point)))
1267              (skip-chars-backward " \t")
1268              (delete-region (point) eol))
1269            (if (and (not (eq (logior last-input-char ?`) ?s))
1270                     (save-excursion
1271                       (backward-char 1)
1272                       (not (looking-at "[:,]"))))
1273                (insert ", ")
1274                (insert " ")))
1275           (t
1276            (if (mh-position-on-field "To:")
1277                (forward-line 1))
1278            (insert (format "%s \n" target))
1279            (backward-char 1)))))
1280
1281 (defun mh-to-fcc (&optional folder)
1282   "Insert an Fcc: FOLDER field in the current message.
1283 Prompt for the field name with a completion list of the current folders."
1284   (interactive)
1285   (or folder
1286       (setq folder (mh-prompt-for-folder
1287                     "Fcc"
1288                     (or (and mh-default-folder-for-message-function
1289                              (save-excursion
1290                                (goto-char (point-min))
1291                                (funcall mh-default-folder-for-message-function)))
1292                         "")
1293                     t)))
1294   (let ((last-input-char ?\C-f))
1295     (expand-abbrev)
1296     (save-excursion
1297       (mh-to-field)
1298       (insert (if (mh-folder-name-p folder)
1299                   (substring folder 1)
1300                 folder)))))
1301
1302 (defun mh-insert-signature ()
1303   "Insert the file named by `mh-signature-file-name' at point.
1304 The value of `mh-letter-insert-signature-hook' is a list of functions to be
1305 called, with no arguments, before the signature is actually inserted."
1306   (interactive)
1307   (let ((mh-signature-file-name mh-signature-file-name))
1308     (run-hooks 'mh-letter-insert-signature-hook)
1309     (if mh-signature-file-name
1310         (insert-file-contents mh-signature-file-name)))
1311   (force-mode-line-update))
1312
1313 (defun mh-check-whom ()
1314   "Verify recipients of the current letter, showing expansion of any aliases."
1315   (interactive)
1316   (let ((file-name buffer-file-name))
1317     (save-buffer)
1318     (message "Checking recipients...")
1319     (mh-in-show-buffer ("*Recipients*")
1320       (bury-buffer (current-buffer))
1321       (erase-buffer)
1322       (mh-exec-cmd-output "whom" t file-name))
1323     (message "Checking recipients...done")))
1324
1325 \f
1326
1327 ;;; Routines to compose and send a letter.
1328
1329 (defun mh-insert-x-face ()
1330   "Append X-Face field to header.
1331 If the field already exists, this function does nothing."
1332   (when (and (file-exists-p mh-x-face-file)
1333              (file-readable-p mh-x-face-file))
1334     (save-excursion
1335       (when (null (mh-position-on-field "X-Face"))
1336         (insert "X-Face: ")
1337         (goto-char (+ (point) (cadr (insert-file-contents mh-x-face-file))))
1338         (if (not (looking-at "^"))
1339             (insert "\n"))))))
1340
1341 (defun mh-insert-x-mailer ()
1342   "Append an X-Mailer field to the header.
1343 The versions of MH-E, Emacs, and MH are shown."
1344
1345   ;; Lazily initialize mh-x-mailer-string.
1346   (when (null mh-x-mailer-string)
1347     (save-window-excursion
1348       (mh-version)
1349       (set-buffer mh-temp-buffer)
1350       (if mh-nmh-flag
1351           (search-forward-regexp "^nmh-\\(\\S +\\)")
1352         (search-forward-regexp "^MH \\(\\S +\\)" nil t))
1353       (let ((x-mailer-mh (buffer-substring (match-beginning 1) (match-end 1))))
1354         (setq mh-x-mailer-string
1355               (format "MH-E %s; %s %s; %s %d.%d"
1356                       mh-version (if mh-nmh-flag "nmh" "MH") x-mailer-mh
1357                       (if mh-xemacs-flag
1358                           "XEmacs"
1359                         "Emacs")
1360                       emacs-major-version emacs-minor-version)))
1361       (kill-buffer mh-temp-buffer)))
1362   ;; Insert X-Mailer, but only if it doesn't already exist.
1363   (save-excursion
1364     (when (null (mh-goto-header-field "X-Mailer"))
1365         (mh-insert-fields "X-Mailer:" mh-x-mailer-string))))
1366
1367 (defun mh-regexp-in-field-p (regexp &rest fields)
1368   "Non-nil means REGEXP was found in FIELDS."
1369   (save-excursion
1370     (let ((search-result nil)
1371           (field))
1372       (while fields
1373         (setq field (car fields))
1374         (if (and (mh-goto-header-field field)
1375                  (re-search-forward
1376                   regexp (save-excursion (mh-header-field-end)(point)) t))
1377             (setq fields nil
1378                   search-result t)
1379           (setq fields (cdr fields))))
1380       search-result)))
1381
1382 (defun mh-insert-mail-followup-to ()
1383   "Insert Mail-Followup-To: if To or Cc match `mh-insert-mail-followup-to-list'."
1384   (save-excursion
1385     (if (and (or (mh-goto-header-field "To:")(mh-goto-header-field "cc:"))
1386              (not (mh-goto-header-field "Mail-Followup-To: ")))
1387         (let ((list mh-insert-mail-followup-to-list))
1388           (while list
1389             (let ((regexp (nth 0 (car list)))
1390                   (entry  (nth 1 (car list))))
1391               (when (mh-regexp-in-field-p regexp "To:" "cc:")
1392                 (if (mh-goto-header-field "Mail-Followup-To: ")
1393                     (insert entry ", ")
1394                   (mh-goto-header-end 0)
1395                   (insert "Mail-Followup-To: " entry "\n")))
1396               (setq list (cdr list))))))))
1397
1398 (defun mh-compose-and-send-mail (draft send-args
1399                                        sent-from-folder sent-from-msg
1400                                        to subject cc
1401                                        annotate-char annotate-field
1402                                        config)
1403   "Edit and compose a draft message in buffer DRAFT and send or save it.
1404 SEND-ARGS is the argument passed to the send command.
1405 SENT-FROM-FOLDER is buffer containing scan listing of current folder, or
1406 nil if none exists.
1407 SENT-FROM-MSG is the message number or sequence name or nil.
1408 The TO, SUBJECT, and CC fields are passed to the
1409 `mh-compose-letter-function'.
1410 If ANNOTATE-CHAR is non-null, it is used to notate the scan listing of the
1411 message.  In that case, the ANNOTATE-FIELD is used to build a string
1412 for `mh-annotate-msg'.
1413 CONFIG is the window configuration to restore after sending the letter."
1414   (pop-to-buffer draft)
1415   (if mh-insert-mail-followup-to-flag (mh-insert-mail-followup-to))
1416   (mh-letter-mode)
1417   (setq mh-sent-from-folder sent-from-folder)
1418   (setq mh-sent-from-msg sent-from-msg)
1419   (setq mh-send-args send-args)
1420   (setq mh-annotate-char annotate-char)
1421   (setq mh-annotate-field annotate-field)
1422   (setq mh-previous-window-config config)
1423   (setq mode-line-buffer-identification (list "{%b}"))
1424   (if (and (boundp 'mh-compose-letter-function)
1425            mh-compose-letter-function)
1426       ;; run-hooks will not pass arguments.
1427       (let ((value mh-compose-letter-function))
1428         (if (and (listp value) (not (eq (car value) 'lambda)))
1429             (while value
1430               (funcall (car value) to subject cc)
1431               (setq value (cdr value)))
1432             (funcall mh-compose-letter-function to subject cc)))))
1433
1434 (defun mh-letter-mode-message ()
1435   "Display a help message for users of `mh-letter-mode'.
1436 This should be the last function called when composing the draft."
1437   (message "%s" (substitute-command-keys
1438                  (concat "Type \\[mh-send-letter] to send message, "
1439                          "\\[mh-help] for help."))))
1440
1441 (defun mh-send-letter (&optional arg)
1442   "Send the draft letter in the current buffer.
1443 If optional prefix argument ARG is provided, monitor delivery.
1444 The value of `mh-before-send-letter-hook' is a list of functions to be called,
1445 with no arguments, before doing anything.
1446 Run `\\[mh-edit-mhn]' if variable `mh-mhn-compose-insert-flag' is set."
1447   (interactive "P")
1448   (run-hooks 'mh-before-send-letter-hook)
1449   (cond
1450    ((and (boundp 'mh-mhn-compose-insert-flag)
1451          mh-mhn-compose-insert-flag)
1452     (mh-edit-mhn))
1453    ((and (boundp 'mh-mml-compose-insert-flag)
1454          mh-mml-compose-insert-flag)
1455     (mh-mml-to-mime)))
1456   (if mh-insert-x-mailer-flag (mh-insert-x-mailer))
1457   (mh-insert-x-face)
1458   (save-buffer)
1459   (message "Sending...")
1460   (let ((draft-buffer (current-buffer))
1461         (file-name buffer-file-name)
1462         (config mh-previous-window-config)
1463         (coding-system-for-write
1464          (if (and (local-variable-p 'buffer-file-coding-system
1465                                     (current-buffer)) ;XEmacs needs two args
1466                   ;; We're not sure why, but buffer-file-coding-system
1467                   ;; tends to get set to undecided-unix.
1468                   (not (memq buffer-file-coding-system
1469                              '(undecided undecided-unix undecided-dos))))
1470              buffer-file-coding-system
1471            (or (and (boundp 'sendmail-coding-system) sendmail-coding-system)
1472                (and (boundp 'default-buffer-file-coding-system )
1473                     default-buffer-file-coding-system)
1474                'iso-latin-1))))
1475     ;; The default BCC encapsulation will make a MIME message unreadable.
1476     ;; With nmh use the -mime arg to prevent this.
1477     (if (and mh-nmh-flag
1478          (mh-goto-header-field "Bcc:")
1479          (mh-goto-header-field "Content-Type:"))
1480         (setq mh-send-args (format "-mime %s" mh-send-args)))
1481     (cond (arg
1482            (pop-to-buffer "MH mail delivery")
1483            (erase-buffer)
1484            (mh-exec-cmd-output mh-send-prog t "-watch" "-nopush"
1485                                "-nodraftfolder" mh-send-args file-name)
1486            (goto-char (point-max))      ; show the interesting part
1487            (recenter -1)
1488            (set-buffer draft-buffer))   ; for annotation below
1489           (t
1490            (mh-exec-cmd-daemon mh-send-prog "-nodraftfolder" "-noverbose"
1491                                mh-send-args file-name)))
1492     (if mh-annotate-char
1493         (mh-annotate-msg mh-sent-from-msg
1494                          mh-sent-from-folder
1495                          mh-annotate-char
1496                          "-component" mh-annotate-field
1497                          "-text" (format "\"%s %s\""
1498                                          (mh-get-header-field "To:")
1499                                          (mh-get-header-field "Cc:"))))
1500
1501     (cond ((or (not arg)
1502                (y-or-n-p "Kill draft buffer? "))
1503            (kill-buffer draft-buffer)
1504            (if config
1505                (set-window-configuration config))))
1506     (if arg
1507         (message "Sending...done")
1508       (message "Sending...backgrounded"))))
1509
1510 (defun mh-insert-letter (folder message verbatim)
1511   "Insert a message into the current letter.
1512 Removes the message's headers using `mh-invisible-headers'.  Prefixes each
1513 non-blank line with `mh-ins-buf-prefix', unless `mh-yank-from-start-of-msg'
1514 is set for supercite and then use it to format the message.
1515 Prompts for FOLDER and MESSAGE.  If prefix argument VERBATIM provided, do
1516 not indent and do not delete headers.  Leaves the mark before the letter
1517 and point after it."
1518   (interactive
1519    (list (mh-prompt-for-folder "Message from" mh-sent-from-folder nil)
1520          (read-input (format "Message number%s: "
1521                              (if mh-sent-from-msg
1522                                  (format " [%d]" mh-sent-from-msg)
1523                                "")))
1524          current-prefix-arg))
1525   (save-restriction
1526     (narrow-to-region (point) (point))
1527     (let ((start (point-min)))
1528       (if (equal message "") (setq message (int-to-string mh-sent-from-msg)))
1529       (insert-file-contents
1530        (expand-file-name message (mh-expand-file-name folder)))
1531       (when (not verbatim)
1532         (mh-clean-msg-header start mh-invisible-headers mh-visible-headers)
1533         (goto-char (point-max))     ;Needed for sc-cite-original
1534         (push-mark)                 ;Needed for sc-cite-original
1535         (goto-char (point-min))     ;Needed for sc-cite-original
1536         (mh-insert-prefix-string mh-ins-buf-prefix)))))
1537
1538 (defun mh-extract-from-attribution ()
1539   "Extract phrase or comment from From header field."
1540   (save-excursion
1541     (if (not (mh-goto-header-field "From: "))
1542         nil
1543       (skip-chars-forward " ")
1544       (cond
1545        ((looking-at "\"\\([^\"\n]+\\)\" \\(<.+>\\)")
1546         (format "%s %s %s" (match-string 1)(match-string 2)
1547                 mh-extract-from-attribution-verb))
1548        ((looking-at "\\([^<\n]+<.+>\\)$")
1549         (format "%s %s" (match-string 1) mh-extract-from-attribution-verb))
1550        ((looking-at "\\([^ ]+@[^ ]+\\) +(\\(.+\\))$")
1551         (format "%s <%s> %s" (match-string 2)(match-string 1)
1552                 mh-extract-from-attribution-verb))
1553        ((looking-at " *\\(.+\\)$")
1554         (format "%s %s" (match-string 1) mh-extract-from-attribution-verb))))))
1555
1556 (defun mh-yank-cur-msg ()
1557   "Insert the current message into the draft buffer.
1558 Prefix each non-blank line in the message with the string in
1559 `mh-ins-buf-prefix'.  If a region is set in the message's buffer, then
1560 only the region will be inserted.  Otherwise, the entire message will
1561 be inserted if `mh-yank-from-start-of-msg' is non-nil.  If this variable
1562 is nil, the portion of the message following the point will be yanked.
1563 If `mh-delete-yanked-msg-window-flag' is non-nil, any window displaying the
1564 yanked message will be deleted."
1565   (interactive)
1566   (if (and mh-sent-from-folder
1567            (save-excursion (set-buffer mh-sent-from-folder) mh-show-buffer)
1568            (save-excursion (set-buffer mh-sent-from-folder)
1569                            (get-buffer mh-show-buffer))
1570            mh-sent-from-msg)
1571       (let ((to-point (point))
1572             (to-buffer (current-buffer)))
1573         (set-buffer mh-sent-from-folder)
1574         (if mh-delete-yanked-msg-window-flag
1575             (delete-windows-on mh-show-buffer))
1576         (set-buffer mh-show-buffer)     ; Find displayed message
1577         (let* ((from-attr (mh-extract-from-attribution))
1578                (yank-region (mh-mark-active-p nil))
1579                (mh-ins-str
1580                 (cond ((and yank-region
1581                             (or (eq 'supercite mh-yank-from-start-of-msg)
1582                                 (eq 'autosupercite mh-yank-from-start-of-msg)
1583                                 (eq t mh-yank-from-start-of-msg)))
1584                        ;; supercite needs the full header
1585                        (concat
1586                         (buffer-substring (point-min) (mail-header-end))
1587                         "\n"
1588                         (buffer-substring (region-beginning) (region-end))))
1589                       (yank-region
1590                        (buffer-substring (region-beginning) (region-end)))
1591                       ((or (eq 'body mh-yank-from-start-of-msg)
1592                            (eq 'attribution
1593                                mh-yank-from-start-of-msg)
1594                            (eq 'autoattrib
1595                                mh-yank-from-start-of-msg))
1596                        (buffer-substring
1597                         (save-excursion
1598                           (goto-char (point-min))
1599                           (mh-goto-header-end 1)
1600                           (point))
1601                         (point-max)))
1602                       ((or (eq 'supercite mh-yank-from-start-of-msg)
1603                            (eq 'autosupercite mh-yank-from-start-of-msg)
1604                            (eq t mh-yank-from-start-of-msg))
1605                        (buffer-substring (point-min) (point-max)))
1606                       (t
1607                        (buffer-substring (point) (point-max))))))
1608           (set-buffer to-buffer)
1609           (save-restriction
1610             (narrow-to-region to-point to-point)
1611             (insert (mh-filter-out-non-text mh-ins-str))
1612             (goto-char (point-max))     ;Needed for sc-cite-original
1613             (push-mark)                 ;Needed for sc-cite-original
1614             (goto-char (point-min))     ;Needed for sc-cite-original
1615             (mh-insert-prefix-string mh-ins-buf-prefix)
1616             (if (or (eq 'attribution mh-yank-from-start-of-msg)
1617                     (eq 'autoattrib mh-yank-from-start-of-msg))
1618                 (insert from-attr "\n\n"))
1619             ;; If the user has selected a region, he has already "edited" the
1620             ;; text, so leave the cursor at the end of the yanked text. In
1621             ;; either case, leave a mark at the opposite end of the included
1622             ;; text to make it easy to jump or delete to the other end of the
1623             ;; text.
1624             (push-mark)
1625             (goto-char (point-max))
1626             (if (null yank-region)
1627                 (mh-exchange-point-and-mark-preserving-active-mark)))))
1628     (error "There is no current message")))
1629
1630 (defun mh-filter-out-non-text (string)
1631   "Return STRING but without adornments such as MIME buttons and smileys."
1632   (with-temp-buffer
1633     ;; Insert the string to filter
1634     (insert string)
1635     (goto-char (point-min))
1636
1637     ;; Remove the MIME buttons
1638     (let ((can-move-forward t)
1639           (in-button nil))
1640       (while can-move-forward
1641         (cond ((and (not (get-text-property (point) 'mh-data))
1642                     in-button)
1643                (delete-region (save-excursion (forward-line -1) (point))
1644                               (point))
1645                (setq in-button nil))
1646               ((get-text-property (point) 'mh-data)
1647                (delete-region (point)
1648                               (save-excursion (forward-line) (point)))
1649                (setq in-button t))
1650               (t (setq can-move-forward (= (forward-line) 0))))))
1651
1652     ;; Return the contents without properties... This gets rid of emphasis
1653     ;; and smileys
1654     (buffer-substring-no-properties (point-min) (point-max))))
1655
1656 (defun mh-insert-prefix-string (mh-ins-string)
1657   "Insert prefix string before each line in buffer.
1658 The inserted letter is cited using `sc-cite-original' if
1659 `mh-yank-from-start-of-msg' is one of 'supercite or 'autosupercite. Otherwise,
1660 simply insert MH-INS-STRING before each line."
1661   (goto-char (point-min))
1662   (cond ((or (eq mh-yank-from-start-of-msg 'supercite)
1663              (eq mh-yank-from-start-of-msg 'autosupercite))
1664          (sc-cite-original))
1665         (mail-citation-hook
1666          (run-hooks 'mail-citation-hook))
1667         (mh-yank-hooks                  ;old hook name
1668          (run-hooks 'mh-yank-hooks))
1669         (t
1670          (or (bolp) (forward-line 1))
1671          (while (< (point) (point-max))
1672            (insert mh-ins-string)
1673            (forward-line 1))
1674          (goto-char (point-min)))))     ;leave point like sc-cite-original
1675
1676 (defun mh-fully-kill-draft ()
1677   "Kill the draft message file and the draft message buffer.
1678 Use \\[kill-buffer] if you don't want to delete the draft message file."
1679   (interactive)
1680   (if (y-or-n-p "Kill draft message? ")
1681       (let ((config mh-previous-window-config))
1682         (if (file-exists-p buffer-file-name)
1683             (delete-file buffer-file-name))
1684         (set-buffer-modified-p nil)
1685         (kill-buffer (buffer-name))
1686         (message "")
1687         (if config
1688             (set-window-configuration config)))
1689     (error "Message not killed")))
1690
1691 (defun mh-current-fill-prefix ()
1692   "Return the `fill-prefix' on the current line as a string."
1693   (save-excursion
1694     (beginning-of-line)
1695     ;; This assumes that the major-mode sets up adaptive-fill-regexp
1696     ;; correctly such as mh-letter-mode or sendmail.el's mail-mode.  But
1697     ;; perhaps I should use the variable and simply inserts its value here,
1698     ;; and set it locally in a let scope.  --psg
1699     (if (re-search-forward adaptive-fill-regexp nil t)
1700         (match-string 0)
1701       "")))
1702
1703 (defun mh-open-line ()
1704   "Insert a newline and leave point after it.
1705 In addition, insert newline and quoting characters before text after point.
1706 This is useful in breaking up paragraphs in replies."
1707   (interactive)
1708   (let ((column (current-column))
1709         (prefix (mh-current-fill-prefix)))
1710     (if (> (length prefix) column)
1711         (message "Sorry, point seems to be within the line prefix")
1712       (newline 2)
1713       (insert prefix)
1714       (while (> column (current-column))
1715         (insert " "))
1716       (forward-line -1))))
1717
1718 ;;; Build the letter-mode keymap:
1719 ;;; If this changes, modify mh-letter-mode-help-messages accordingly, above.
1720 (gnus-define-keys  mh-letter-mode-map
1721   "\C-c?"               mh-help
1722   "\C-c\C-c"            mh-send-letter
1723   "\C-c\C-e"            mh-edit-mhn
1724   "\C-c\C-f\C-b"        mh-to-field
1725   "\C-c\C-f\C-c"        mh-to-field
1726   "\C-c\C-f\C-d"        mh-to-field
1727   "\C-c\C-f\C-f"        mh-to-fcc
1728   "\C-c\C-f\C-r"        mh-to-field
1729   "\C-c\C-f\C-s"        mh-to-field
1730   "\C-c\C-f\C-t"        mh-to-field
1731   "\C-c\C-fb"           mh-to-field
1732   "\C-c\C-fc"           mh-to-field
1733   "\C-c\C-fd"           mh-to-field
1734   "\C-c\C-ff"           mh-to-fcc
1735   "\C-c\C-fr"           mh-to-field
1736   "\C-c\C-fs"           mh-to-field
1737   "\C-c\C-ft"           mh-to-field
1738   "\C-c\C-i"            mh-insert-letter
1739   "\C-c\C-m\C-e"        mh-mml-secure-message-encrypt-pgpmime
1740   "\C-c\C-m\C-f"        mh-compose-forward
1741   "\C-c\C-m\C-i"        mh-compose-insertion
1742   "\C-c\C-m\C-m"        mh-mml-to-mime
1743   "\C-c\C-m\C-s"        mh-mml-secure-message-sign-pgpmime
1744   "\C-c\C-m\C-u"        mh-revert-mhn-edit
1745   "\C-c\C-me"           mh-mml-secure-message-encrypt-pgpmime
1746   "\C-c\C-mf"           mh-compose-forward
1747   "\C-c\C-mi"           mh-compose-insertion
1748   "\C-c\C-mm"           mh-mml-to-mime
1749   "\C-c\C-ms"           mh-mml-secure-message-sign-pgpmime
1750   "\C-c\C-mu"           mh-revert-mhn-edit
1751   "\C-c\C-o"            mh-open-line
1752   "\C-c\C-q"            mh-fully-kill-draft
1753   "\C-c\C-\\"           mh-fully-kill-draft ;if no C-q
1754   "\C-c\C-s"            mh-insert-signature
1755   "\C-c\C-^"            mh-insert-signature ;if no C-s
1756   "\C-c\C-w"            mh-check-whom
1757   "\C-c\C-y"            mh-yank-cur-msg)
1758
1759 ;; "C-c /" prefix is used in mh-letter-mode by pgp.el and mailcrypt.el.
1760
1761 (defun mh-customize ()
1762   "Customize MH-E variables."
1763   (interactive)
1764   (customize-group 'mh))
1765
1766 (provide 'mh-comp)
1767
1768 ;;; Local Variables:
1769 ;;; sentence-end-double-space: nil
1770 ;;; End:
1771
1772 ;;; mh-comp.el ends here