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

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

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

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

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

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

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

;;; Commentary:

Bill Wohler's avatar
Bill Wohler committed
30
;; Internal support for MH-E package.
Richard M. Stallman's avatar
Richard M. Stallman committed
31

Karl Heuer's avatar
Karl Heuer committed
32 33
;;; Change Log:

Richard M. Stallman's avatar
Richard M. Stallman committed
34 35
;;; Code:

Bill Wohler's avatar
Bill Wohler committed
36 37
(eval-when-compile (require 'mh-acros))
(mh-require-cl)
Bill Wohler's avatar
Bill Wohler committed
38 39 40
(require 'mh-e)
(require 'gnus-util)
(require 'easymenu)
Bill Wohler's avatar
Bill Wohler committed
41
(require 'mh-gnus)
Bill Wohler's avatar
Bill Wohler committed
42 43
(eval-when (compile load eval)
  (ignore-errors (require 'mailabbrev)))
Bill Wohler's avatar
Bill Wohler committed
44 45 46 47 48 49

;; Shush the byte-compiler
(defvar adaptive-fill-first-line-regexp)
(defvar font-lock-defaults)
(defvar mark-active)
(defvar sendmail-coding-system)
Bill Wohler's avatar
Bill Wohler committed
50 51
(defvar mh-identity-list)
(defvar mh-identity-default)
Bill Wohler's avatar
Bill Wohler committed
52
(defvar mh-mml-mode-default)
Bill Wohler's avatar
Bill Wohler committed
53
(defvar mh-identity-menu)
Bill Wohler's avatar
Bill Wohler committed
54

Bill Wohler's avatar
Bill Wohler committed
55
;;; Autoloads
Bill Wohler's avatar
Bill Wohler committed
56
(autoload 'mail-mode-fill-paragraph "sendmail")
Bill Wohler's avatar
Bill Wohler committed
57 58 59 60 61
(autoload 'mm-handle-displayed-p "mm-decode")

(autoload 'sc-cite-original "sc"
  "Workhorse citing function which performs the initial citation.
This is callable from the various mail and news readers' reply
Bill Wohler's avatar
Bill Wohler committed
62
function according to the agreed upon standard.  See `sc-describe'
Bill Wohler's avatar
Bill Wohler committed
63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81
for more details.  `sc-cite-original' does not do any yanking of the
original message but it does require a few things:

     1) The reply buffer is the current buffer.

     2) The original message has been yanked and inserted into the
        reply buffer.

     3) Verbose mail headers from the original message have been
        inserted into the reply buffer directly before the text of the
        original message.

     4) Point is at the beginning of the verbose headers.

     5) Mark is at the end of the body of text to be cited.

For Emacs 19's, the region need not be active (and typically isn't
when this function is called.  Also, the hook `sc-pre-hook' is run
before, and `sc-post-hook' is run after the guts of this function.")
Richard M. Stallman's avatar
Richard M. Stallman committed
82

Karl Heuer's avatar
Karl Heuer committed
83 84 85 86 87 88 89 90 91 92 93
;;; Site customization (see also mh-utils.el):

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

(defvar mh-redist-full-contents nil
  "Non-nil if the `dist' command needs whole letter for redistribution.
This is the case only when `send' is compiled with the BERK option.
If MH will not allow you to redist a previously redist'd msg, set to nil.")

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

Bill Wohler's avatar
Bill Wohler committed
99 100 101 102
;;; Scan Line Formats

(defvar mh-note-repl ?-
  "Messages that have been replied to are marked by this character.")
Richard M. Stallman's avatar
Richard M. Stallman committed
103

Bill Wohler's avatar
Bill Wohler committed
104 105
(defvar mh-note-forw ?F
  "Messages that have been forwarded are marked by this character.")
Richard M. Stallman's avatar
Richard M. Stallman committed
106

Bill Wohler's avatar
Bill Wohler committed
107 108
(defvar mh-note-dist ?R
  "Messages that have been redistributed are marked by this character.")
Richard M. Stallman's avatar
Richard M. Stallman committed
109 110 111 112 113 114 115 116

(defvar mh-yank-hooks nil
  "Obsolete hook for modifying a citation just inserted in the mail buffer.
Each hook function can find the citation between point and mark.
And each hook function should leave point and mark around the citation
text as modified.

This is a normal hook, misnamed for historical reasons.
Richard M. Stallman's avatar
Richard M. Stallman committed
117
It is semi-obsolete and is only used if `mail-citation-hook' is nil.")
Richard M. Stallman's avatar
Richard M. Stallman committed
118 119 120

(defvar mh-comp-formfile "components"
  "Name of file to be used as a skeleton for composing messages.
Richard M. Stallman's avatar
Richard M. Stallman committed
121
Default is \"components\".  If not an absolute file name, the file
Richard M. Stallman's avatar
Richard M. Stallman committed
122 123 124
is searched for first in the user's MH directory, then in the
system MH lib directory.")

Karl Heuer's avatar
Karl Heuer committed
125 126
(defvar mh-repl-formfile "replcomps"
  "Name of file to be used as a skeleton for replying to messages.
Richard M. Stallman's avatar
Richard M. Stallman committed
127
Default is \"replcomps\".  If not an absolute file name, the file
Karl Heuer's avatar
Karl Heuer committed
128 129 130
is searched for first in the user's MH directory, then in the
system MH lib directory.")

Karl Heuer's avatar
Karl Heuer committed
131
(defvar mh-repl-group-formfile "replgroupcomps"
Bill Wohler's avatar
Bill Wohler committed
132 133
  "Name of file to be used as a skeleton for replying to messages.
This file is used to form replies to the sender and all recipients of a
Bill Wohler's avatar
Bill Wohler committed
134 135
message. Only used if `(mh-variant-p 'nmh)' is non-nil.
Default is \"replgroupcomps\".
Bill Wohler's avatar
Bill Wohler committed
136 137
If not an absolute file name, the file is searched for first in the user's MH
directory, then in the system MH lib directory.")
Bill Wohler's avatar
Bill Wohler committed
138

Richard M. Stallman's avatar
Richard M. Stallman committed
139
(defvar mh-rejected-letter-start
Bill Wohler's avatar
Bill Wohler committed
140
  (format "^%s$"
Bill Wohler's avatar
Bill Wohler committed
141 142
          (regexp-opt
           '("Content-Type: message/rfc822" ;MIME MDN
Bill Wohler's avatar
Bill Wohler committed
143 144
             "------ This is a copy of the message, including all the headers. ------";from exim
	     "--- Below this line is a copy of the message."; from qmail
Bill Wohler's avatar
Bill Wohler committed
145 146 147 148 149 150 151 152 153
             "   ----- Unsent message follows -----" ;from sendmail V5
             " --------Unsent Message below:" ; from sendmail at BU
             "   ----- Original message follows -----" ;from sendmail V8
             "------- Unsent Draft"     ;from MH itself
             "----------  Original Message  ----------" ;from zmailer
             "  --- The unsent message follows ---" ;from AIX mail system
             "    Your message follows:" ;from MMDF-II
             "Content-Description: Returned Content" ;1993 KJ sendmail
             ))))
Richard M. Stallman's avatar
Richard M. Stallman committed
154 155

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

Karl Heuer's avatar
Karl Heuer committed
160
(defvar mh-to-field-choices '(("t" . "To:") ("s" . "Subject:") ("c" . "Cc:")
Bill Wohler's avatar
Bill Wohler committed
161 162
                              ("b" . "Bcc:") ("f" . "Fcc:") ("r" . "From:")
                              ("d" . "Dcc:"))
Bill Wohler's avatar
Bill Wohler committed
163
  "Alist of (final-character . field-name) choices for `mh-to-field'.")
Richard M. Stallman's avatar
Richard M. Stallman committed
164 165 166 167 168

(defvar mh-letter-mode-map (copy-keymap text-mode-map)
  "Keymap for composing mail.")

(defvar mh-letter-mode-syntax-table nil
Bill Wohler's avatar
Bill Wohler committed
169
  "Syntax table used by MH-E while in MH-Letter mode.")
Richard M. Stallman's avatar
Richard M. Stallman committed
170 171 172

(if mh-letter-mode-syntax-table
    ()
Bill Wohler's avatar
Bill Wohler committed
173 174 175
  (setq mh-letter-mode-syntax-table
        (make-syntax-table text-mode-syntax-table))
  (modify-syntax-entry ?% "." mh-letter-mode-syntax-table))
Richard M. Stallman's avatar
Richard M. Stallman committed
176

Bill Wohler's avatar
Bill Wohler committed
177 178 179 180 181 182 183 184 185 186 187 188 189 190
(defvar mh-sent-from-folder nil
  "Folder of msg assoc with this letter.")

(defvar mh-sent-from-msg nil
  "Number of msg assoc with this letter.")

(defvar mh-send-args nil
  "Extra args to pass to \"send\" command.")

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

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

Bill Wohler's avatar
Bill Wohler committed
192
(defvar mh-insert-auto-fields-done-local nil
Bill Wohler's avatar
Bill Wohler committed
193
  "Buffer-local variable set when `mh-insert-auto-fields' called successfully.")
Bill Wohler's avatar
Bill Wohler committed
194 195
(make-variable-buffer-local 'mh-insert-auto-fields-done-local)

Richard M. Stallman's avatar
Richard M. Stallman committed
196 197 198
;;;###autoload
(defun mh-smail ()
  "Compose and send mail with the MH mail system.
Bill Wohler's avatar
Bill Wohler committed
199 200
This function is an entry point to MH-E, the Emacs interface to the MH mail
system.
Karl Heuer's avatar
Karl Heuer committed
201

Bill Wohler's avatar
Bill Wohler committed
202
See `mh-send' for more details on composing mail."
Richard M. Stallman's avatar
Richard M. Stallman committed
203 204 205 206
  (interactive)
  (mh-find-path)
  (call-interactively 'mh-send))

Bill Wohler's avatar
Bill Wohler committed
207
(defvar mh-error-if-no-draft nil)       ;raise error over using old draft
Karl Heuer's avatar
Karl Heuer committed
208 209

;;;###autoload
Karl Heuer's avatar
Karl Heuer committed
210
(defun mh-smail-batch (&optional to subject other-headers &rest ignored)
Karl Heuer's avatar
Karl Heuer committed
211
  "Set up a mail composition draft with the MH mail system.
Bill Wohler's avatar
Bill Wohler committed
212 213 214 215 216
This function is an entry point to MH-E, the Emacs interface to the MH mail
system. This function does not prompt the user for any header fields, and thus
is suitable for use by programs that want to create a mail buffer. Users
should use `mh-smail' to compose mail.

Bill Wohler's avatar
Bill Wohler committed
217
Optional arguments for setting certain fields include TO, SUBJECT, and
Bill Wohler's avatar
Bill Wohler committed
218
OTHER-HEADERS. Additional arguments are IGNORED."
Karl Heuer's avatar
Karl Heuer committed
219 220
  (mh-find-path)
  (let ((mh-error-if-no-draft t))
221
    (mh-send (or to "") "" (or subject ""))))
Karl Heuer's avatar
Karl Heuer committed
222

Bill Wohler's avatar
Bill Wohler committed
223 224 225
;; XEmacs needs this:
;;;###autoload
(defun mh-user-agent-compose (&optional to subject other-headers continue
Bill Wohler's avatar
Bill Wohler committed
226 227
                                        switch-function yank-action
                                        send-actions)
Bill Wohler's avatar
Bill Wohler committed
228
  "Set up mail composition draft with the MH mail system.
Bill Wohler's avatar
Bill Wohler committed
229
This is `mail-user-agent' entry point to MH-E.
Bill Wohler's avatar
Bill Wohler committed
230 231 232 233 234 235 236 237 238 239 240 241 242 243

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

OTHER-HEADERS is an alist specifying additional
header fields.  Elements look like (HEADER . VALUE) where both
HEADER and VALUE are strings.

CONTINUE, SWITCH-FUNCTION, YANK-ACTION and SEND-ACTIONS are ignored."
  (mh-find-path)
  (let ((mh-error-if-no-draft t))
    (mh-send to "" subject)
    (while other-headers
      (mh-insert-fields (concat (car (car other-headers)) ":")
Bill Wohler's avatar
Bill Wohler committed
244
                        (cdr (car other-headers)))
Bill Wohler's avatar
Bill Wohler committed
245
      (setq other-headers (cdr other-headers)))))
Karl Heuer's avatar
Karl Heuer committed
246

Bill Wohler's avatar
Bill Wohler committed
247
;;;###mh-autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
248
(defun mh-edit-again (msg)
Bill Wohler's avatar
Bill Wohler committed
249
  "Clean up a draft or a message MSG previously sent and make it resendable.
Karl Heuer's avatar
Karl Heuer committed
250
Default is the current message.
Bill Wohler's avatar
Bill Wohler committed
251
The variable `mh-new-draft-cleaned-headers' specifies the headers to remove.
Bill Wohler's avatar
Bill Wohler committed
252 253

See also `mh-send'."
Richard M. Stallman's avatar
Richard M. Stallman committed
254 255
  (interactive (list (mh-get-msg-num t)))
  (let* ((from-folder mh-current-folder)
Bill Wohler's avatar
Bill Wohler committed
256 257 258 259 260
         (config (current-window-configuration))
         (draft
          (cond ((and mh-draft-folder (equal from-folder mh-draft-folder))
                 (pop-to-buffer (find-file-noselect (mh-msg-filename msg)) t)
                 (rename-buffer (format "draft-%d" msg))
Bill Wohler's avatar
Bill Wohler committed
261 262 263 264 265 266 267
                 ;; Make buffer writable...
                 (setq buffer-read-only nil)
                 ;; If buffer was being used to display the message reinsert
                 ;; from file...
                 (when (eq major-mode 'mh-show-mode)
                   (erase-buffer)
                   (insert-file-contents buffer-file-name))
Bill Wohler's avatar
Bill Wohler committed
268 269 270
                 (buffer-name))
                (t
                 (mh-read-draft "clean-up" (mh-msg-filename msg) nil)))))
Richard M. Stallman's avatar
Richard M. Stallman committed
271
    (mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil)
Bill Wohler's avatar
Bill Wohler committed
272
    (mh-insert-header-separator)
Richard M. Stallman's avatar
Richard M. Stallman committed
273
    (goto-char (point-min))
Karl Heuer's avatar
Karl Heuer committed
274
    (save-buffer)
Richard M. Stallman's avatar
Richard M. Stallman committed
275
    (mh-compose-and-send-mail draft "" from-folder nil nil nil nil nil nil
Bill Wohler's avatar
Bill Wohler committed
276
                              config)
Bill Wohler's avatar
Bill Wohler committed
277 278
    (mh-letter-mode-message)
    (mh-letter-adjust-point)))
Richard M. Stallman's avatar
Richard M. Stallman committed
279

Bill Wohler's avatar
Bill Wohler committed
280
;;;###mh-autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
281
(defun mh-extract-rejected-mail (msg)
Bill Wohler's avatar
Bill Wohler committed
282
  "Extract message MSG returned by the mail system and make it resendable.
Richard M. Stallman's avatar
Richard M. Stallman committed
283
Default is the current message.  The variable `mh-new-draft-cleaned-headers'
Richard M. Stallman's avatar
Richard M. Stallman committed
284
gives the headers to clean out of the original message.
Bill Wohler's avatar
Bill Wohler committed
285 286

See also `mh-send'."
Richard M. Stallman's avatar
Richard M. Stallman committed
287 288
  (interactive (list (mh-get-msg-num t)))
  (let ((from-folder mh-current-folder)
Bill Wohler's avatar
Bill Wohler committed
289 290
        (config (current-window-configuration))
        (draft (mh-read-draft "extraction" (mh-msg-filename msg) nil)))
Richard M. Stallman's avatar
Richard M. Stallman committed
291 292
    (goto-char (point-min))
    (cond ((re-search-forward mh-rejected-letter-start nil t)
Bill Wohler's avatar
Bill Wohler committed
293 294 295 296
           (skip-chars-forward " \t\n")
           (delete-region (point-min) (point))
           (mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil))
          (t
Bill Wohler's avatar
Bill Wohler committed
297
           (message "Does not appear to be a rejected letter")))
Bill Wohler's avatar
Bill Wohler committed
298
    (mh-insert-header-separator)
Richard M. Stallman's avatar
Richard M. Stallman committed
299
    (goto-char (point-min))
Karl Heuer's avatar
Karl Heuer committed
300
    (save-buffer)
Karl Heuer's avatar
Karl Heuer committed
301
    (mh-compose-and-send-mail draft "" from-folder msg
Bill Wohler's avatar
Bill Wohler committed
302 303 304 305
                              (mh-get-header-field "To:")
                              (mh-get-header-field "From:")
                              (mh-get-header-field "Cc:")
                              nil nil config)
Bill Wohler's avatar
Bill Wohler committed
306
    (mh-letter-mode-message)))
Richard M. Stallman's avatar
Richard M. Stallman committed
307

Bill Wohler's avatar
Bill Wohler committed
308
;;;###mh-autoload
Bill Wohler's avatar
Bill Wohler committed
309
(defun mh-forward (to cc &optional range)
Bill Wohler's avatar
Bill Wohler committed
310
  "Forward messages to the recipients TO and CC.
Bill Wohler's avatar
Bill Wohler committed
311
Use optional RANGE argument to specify a message or sequence to forward.
Bill Wohler's avatar
Bill Wohler committed
312
Default is the displayed message.
Bill Wohler's avatar
Bill Wohler committed
313 314 315

Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use.
Bill Wohler's avatar
Bill Wohler committed
316

Bill Wohler's avatar
Bill Wohler committed
317
See also `mh-send'."
Bill Wohler's avatar
Bill Wohler committed
318 319 320
  (interactive (list (mh-interactive-read-address "To: ")
                     (mh-interactive-read-address "Cc: ")
                     (mh-interactive-range "Forward")))
Richard M. Stallman's avatar
Richard M. Stallman committed
321
  (let* ((folder mh-current-folder)
Bill Wohler's avatar
Bill Wohler committed
322
         (msgs (mh-range-to-msg-list range))
Bill Wohler's avatar
Bill Wohler committed
323 324 325 326 327 328
         (config (current-window-configuration))
         (fwd-msg-file (mh-msg-filename (car msgs) folder))
         ;; forw always leaves file in "draft" since it doesn't have -draft
         (draft-name (expand-file-name "draft" mh-user-path))
         (draft (cond ((or (not (file-exists-p draft-name))
                           (y-or-n-p "The file 'draft' exists.  Discard it? "))
Bill Wohler's avatar
Bill Wohler committed
329 330 331 332
                       (mh-exec-cmd "forw" "-build"
                                    (if (and (mh-variant-p 'nmh)
                                             mh-compose-forward-as-mime-flag)
                                        "-mime")
Bill Wohler's avatar
Bill Wohler committed
333 334
                                    mh-current-folder
                                    (mh-coalesce-msg-list msgs))
Bill Wohler's avatar
Bill Wohler committed
335 336 337 338 339 340
                       (prog1
                           (mh-read-draft "" draft-name t)
                         (mh-insert-fields "To:" to "Cc:" cc)
                         (save-buffer)))
                      (t
                       (mh-read-draft "" draft-name nil)))))
Karl Heuer's avatar
Karl Heuer committed
341
    (let (orig-from
Bill Wohler's avatar
Bill Wohler committed
342
          orig-subject)
343
      (save-excursion
Bill Wohler's avatar
Bill Wohler committed
344 345 346 347 348
        (set-buffer (get-buffer-create mh-temp-buffer))
        (erase-buffer)
        (insert-file-contents fwd-msg-file)
        (setq orig-from (mh-get-header-field "From:"))
        (setq orig-subject (mh-get-header-field "Subject:")))
Richard M. Stallman's avatar
Richard M. Stallman committed
349
      (let ((forw-subject
Bill Wohler's avatar
Bill Wohler committed
350
             (mh-forwarded-letter-subject orig-from orig-subject)))
Bill Wohler's avatar
Bill Wohler committed
351 352 353 354 355
        (mh-insert-fields "Subject:" forw-subject)
        (goto-char (point-min))
        ;; If using MML, translate mhn
        (if (equal mh-compose-insertion 'gnus)
            (save-excursion
Bill Wohler's avatar
Bill Wohler committed
356
              (goto-char (mh-mail-header-end))
Bill Wohler's avatar
Bill Wohler committed
357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375
              (while
                  (re-search-forward
                   "^#forw \\[\\([^]]+\\)\\] \\(+\\S-+\\) \\(.*\\)$"
                   (point-max) t)
                (let ((description (if (equal (match-string 1)
                                              "forwarded messages")
                                       "forwarded message %d"
                                     (match-string 1)))
                      (msgs (split-string (match-string 3)))
                      (i 0))
                  (beginning-of-line)
                  (delete-region (point) (progn (forward-line 1) (point)))
                  (dolist (msg msgs)
                    (setq i (1+ i))
                    (mh-mml-forward-message (format description i)
                                            folder msg))))))
        ;; Postition just before forwarded message
        (if (re-search-forward "^------- Forwarded Message" nil t)
            (forward-line -1)
Bill Wohler's avatar
Bill Wohler committed
376
          (goto-char (mh-mail-header-end))
Bill Wohler's avatar
Bill Wohler committed
377 378 379
          (forward-line 1))
        (delete-other-windows)
        (mh-add-msgs-to-seq msgs 'forwarded t)
Bill Wohler's avatar
Bill Wohler committed
380
        (mh-compose-and-send-mail draft "" folder msgs
Bill Wohler's avatar
Bill Wohler committed
381 382 383
                                  to forw-subject cc
                                  mh-note-forw "Forwarded:"
                                  config)
Bill Wohler's avatar
Bill Wohler committed
384
        (mh-letter-mode-message)
Bill Wohler's avatar
Bill Wohler committed
385 386
        (mh-letter-adjust-point)
        (run-hooks 'mh-forward-hook)))))
Richard M. Stallman's avatar
Richard M. Stallman committed
387 388

(defun mh-forwarded-letter-subject (from subject)
Bill Wohler's avatar
Bill Wohler committed
389 390
  "Return a Subject suitable for a forwarded message.
Original message has headers FROM and SUBJECT."
Richard M. Stallman's avatar
Richard M. Stallman committed
391
  (let ((addr-start (string-match "<" from))
Bill Wohler's avatar
Bill Wohler committed
392
        (comment (string-match "(" from)))
Richard M. Stallman's avatar
Richard M. Stallman committed
393
    (cond ((and addr-start (> addr-start 0))
Bill Wohler's avatar
Bill Wohler committed
394 395 396 397 398
           ;; Full Name <luser@host>
           (setq from (substring from 0 (1- addr-start))))
          (comment
           ;; luser@host (Full Name)
           (setq from (substring from (1+ comment) (1- (length from)))))))
Richard M. Stallman's avatar
Richard M. Stallman committed
399 400 401 402 403
  (format mh-forward-subject-format from subject))

;;;###autoload
(defun mh-smail-other-window ()
  "Compose and send mail in other window with the MH mail system.
Bill Wohler's avatar
Bill Wohler committed
404 405
This function is an entry point to MH-E, the Emacs interface to the MH mail
system.
Karl Heuer's avatar
Karl Heuer committed
406

Bill Wohler's avatar
Bill Wohler committed
407
See `mh-send' for more details on composing mail."
Richard M. Stallman's avatar
Richard M. Stallman committed
408 409 410 411
  (interactive)
  (mh-find-path)
  (call-interactively 'mh-send-other-window))

Bill Wohler's avatar
Bill Wohler committed
412
;;;###mh-autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
413
(defun mh-redistribute (to cc &optional msg)
Bill Wohler's avatar
Bill Wohler committed
414 415
  "Redistribute displayed message to recipients TO and CC.
Use optional argument MSG to redistribute another message.
Richard M. Stallman's avatar
Richard M. Stallman committed
416
Depending on how your copy of MH was compiled, you may need to change the
Richard M. Stallman's avatar
Richard M. Stallman committed
417
setting of the variable `mh-redist-full-contents'.  See its documentation."
Richard M. Stallman's avatar
Richard M. Stallman committed
418
  (interactive (list (mh-read-address "Redist-To: ")
Bill Wohler's avatar
Bill Wohler committed
419 420
                     (mh-read-address "Redist-Cc: ")
                     (mh-get-msg-num t)))
Richard M. Stallman's avatar
Richard M. Stallman committed
421 422 423 424
  (or msg
      (setq msg (mh-get-msg-num t)))
  (save-window-excursion
    (let ((folder mh-current-folder)
Bill Wohler's avatar
Bill Wohler committed
425 426 427 428 429
          (draft (mh-read-draft "redistribution"
                                (if mh-redist-full-contents
                                    (mh-msg-filename msg)
                                  nil)
                                nil)))
Richard M. Stallman's avatar
Richard M. Stallman committed
430 431 432
      (mh-goto-header-end 0)
      (insert "Resent-To: " to "\n")
      (if (not (equal cc "")) (insert "Resent-cc: " cc "\n"))
Bill Wohler's avatar
Bill Wohler committed
433 434 435 436
      (mh-clean-msg-header
       (point-min)
       "^Message-Id:\\|^Received:\\|^Return-Path:\\|^Sender:\\|^Date:\\|^From:"
       nil)
Richard M. Stallman's avatar
Richard M. Stallman committed
437 438
      (save-buffer)
      (message "Redistributing...")
Bill Wohler's avatar
Bill Wohler committed
439 440 441 442 443 444 445 446 447 448 449 450 451 452 453
      (let ((env "mhdist=1"))
        ;; Setup environment...
        (setq env (concat env " mhaltmsg=" (if mh-redist-full-contents
                                               buffer-file-name
                                             (mh-msg-filename msg folder))))
        (unless mh-redist-full-contents
          (setq env (concat env " mhannotate=1")))
        ;; Redistribute...
        (if mh-redist-background
            (mh-exec-cmd-env-daemon env mh-send-prog nil buffer-file-name)
          (mh-exec-cmd-error env mh-send-prog "-push" buffer-file-name))
        ;; Annotate...
        (mh-annotate-msg msg folder mh-note-dist
                         "-component" "Resent:"
                         "-text" (format "\"%s %s\"" to cc)))
Richard M. Stallman's avatar
Richard M. Stallman committed
454 455 456
      (kill-buffer draft)
      (message "Redistributing...done"))))

Bill Wohler's avatar
Bill Wohler committed
457 458 459 460 461 462 463 464 465 466 467
(defun mh-show-buffer-message-number (&optional buffer)
  "Message number of displayed message in corresponding show buffer.
Return nil if show buffer not displayed.
If in `mh-letter-mode', don't display the message number being replied to,
but rather the message number of the show buffer associated with our
originating folder buffer.
Optional argument BUFFER can be used to specify the buffer."
  (save-excursion
    (if buffer
        (set-buffer buffer))
    (cond ((eq major-mode 'mh-show-mode)
Bill Wohler's avatar
Bill Wohler committed
468 469 470
           (let ((number-start (mh-search-from-end ?/ buffer-file-name)))
             (car (read-from-string (substring buffer-file-name
                                               (1+ number-start))))))
Bill Wohler's avatar
Bill Wohler committed
471 472 473 474 475 476 477 478 479 480 481
          ((and (eq major-mode 'mh-folder-mode)
                mh-show-buffer
                (get-buffer mh-show-buffer))
           (mh-show-buffer-message-number mh-show-buffer))
          ((and (eq major-mode 'mh-letter-mode)
                mh-sent-from-folder
                (get-buffer mh-sent-from-folder))
           (mh-show-buffer-message-number mh-sent-from-folder))
          (t
           nil))))

Bill Wohler's avatar
Bill Wohler committed
482
;;;###mh-autoload
Bill Wohler's avatar
Bill Wohler committed
483
(defun mh-reply (message &optional reply-to includep)
Bill Wohler's avatar
Bill Wohler committed
484 485
  "Reply to MESSAGE.
Default is the displayed message.
Bill Wohler's avatar
Bill Wohler committed
486 487
If the optional argument REPLY-TO is not given, prompts for type of addresses
to reply to:
Richard M. Stallman's avatar
Richard M. Stallman committed
488 489 490
   from    sender only,
   to      sender and primary recipients,
   cc/all  sender and all recipients.
Bill Wohler's avatar
Bill Wohler committed
491 492
If optional prefix argument INCLUDEP provided, then include the message
in the reply using filter `mhl.reply' in your MH directory.
Bill Wohler's avatar
Bill Wohler committed
493 494 495 496
If the file named by `mh-repl-formfile' exists, it is used as a skeleton for
the reply. If REPLY-TO is cc or all and you're using either the nmh or GNU
mailutils variants and the file names by `mh-repl-group-formfile' exists, it
is used instead.
Bill Wohler's avatar
Bill Wohler committed
497 498

See also `mh-send'."
Bill Wohler's avatar
Bill Wohler committed
499 500 501 502 503
  (interactive (list
                (mh-get-msg-num t)
                (let ((minibuffer-help-form
                       "from => Sender only\nto => Sender and primary recipients\ncc or all => Sender and all recipients"))
                  (or mh-reply-default-reply-to
Bill Wohler's avatar
Bill Wohler committed
504
                      (completing-read "Reply to whom: [from] "
Bill Wohler's avatar
Bill Wohler committed
505 506 507 508 509 510 511 512
                                       '(("from") ("to") ("cc") ("all"))
                                       nil
                                       t)))
                current-prefix-arg))
  (let* ((folder mh-current-folder)
         (show-buffer mh-show-buffer)
         (config (current-window-configuration))
         (group-reply (or (equal reply-to "cc") (equal reply-to "all")))
Bill Wohler's avatar
Bill Wohler committed
513
         (form-file (cond ((and (mh-variant-p 'nmh 'mu-mh) group-reply
Bill Wohler's avatar
Bill Wohler committed
514 515 516 517 518 519 520 521 522 523 524 525 526
                                (stringp mh-repl-group-formfile))
                           mh-repl-group-formfile)
                          ((stringp mh-repl-formfile) mh-repl-formfile)
                          (t nil))))
    (message "Composing a reply...")
    (mh-exec-cmd "repl" "-build" "-noquery" "-nodraftfolder"
                 (if form-file
                     (list "-form" form-file))
                 mh-current-folder message
                 (cond ((or (equal reply-to "from") (equal reply-to ""))
                        '("-nocc" "all"))
                       ((equal reply-to "to")
                        '("-cc" "to"))
Bill Wohler's avatar
Bill Wohler committed
527
                       (group-reply (if (mh-variant-p 'nmh 'mu-mh)
Bill Wohler's avatar
Bill Wohler committed
528 529
                                        '("-group" "-nocc" "me")
                                      '("-cc" "all" "-nocc" "me"))))
Bill Wohler's avatar
Bill Wohler committed
530 531 532 533 534
                 (cond ((or (eq mh-yank-from-start-of-msg 'autosupercite)
                            (eq mh-yank-from-start-of-msg 'autoattrib))
                        '("-noformat"))
                       (includep '("-filter" "mhl.reply"))
                       (t '())))
Bill Wohler's avatar
Bill Wohler committed
535 536 537 538 539
    (let ((draft (mh-read-draft "reply"
                                (expand-file-name "reply" mh-user-path)
                                t)))
      (delete-other-windows)
      (save-buffer)
540

Bill Wohler's avatar
Bill Wohler committed
541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559
      (let ((to (mh-get-header-field "To:"))
            (subject (mh-get-header-field "Subject:"))
            (cc (mh-get-header-field "Cc:")))
        (goto-char (point-min))
        (mh-goto-header-end 1)
        (or includep
            (not mh-reply-show-message-flag)
            (mh-in-show-buffer (show-buffer)
              (mh-display-msg message folder)))
        (mh-add-msgs-to-seq message 'answered t)
        (message "Composing a reply...done")
        (mh-compose-and-send-mail draft "" folder message to subject cc
                                  mh-note-repl "Replied:" config))
      (when (and (or (eq 'autosupercite mh-yank-from-start-of-msg)
                     (eq 'autoattrib mh-yank-from-start-of-msg))
                 (eq (mh-show-buffer-message-number) mh-sent-from-msg))
        (undo-boundary)
        (mh-yank-cur-msg))
      (mh-letter-mode-message))))
Richard M. Stallman's avatar
Richard M. Stallman committed
560

Bill Wohler's avatar
Bill Wohler committed
561
;;;###mh-autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
562 563
(defun mh-send (to cc subject)
  "Compose and send a letter.
Bill Wohler's avatar
Bill Wohler committed
564
Do not call this function from outside MH-E; use \\[mh-smail] instead.
Karl Heuer's avatar
Karl Heuer committed
565

Bill Wohler's avatar
Bill Wohler committed
566 567 568 569 570
The file named by `mh-comp-formfile' will be used as the form.
The letter is composed in `mh-letter-mode'; see its documentation for more
details.
If `mh-compose-letter-function' is defined, it is called on the draft and
passed three arguments: TO, CC, and SUBJECT."
Richard M. Stallman's avatar
Richard M. Stallman committed
571
  (interactive (list
Bill Wohler's avatar
Bill Wohler committed
572 573 574
                (mh-interactive-read-address "To: ")
                (mh-interactive-read-address "Cc: ")
                (mh-interactive-read-string "Subject: ")))
Richard M. Stallman's avatar
Richard M. Stallman committed
575 576 577 578
  (let ((config (current-window-configuration)))
    (delete-other-windows)
    (mh-send-sub to cc subject config)))

Bill Wohler's avatar
Bill Wohler committed
579
;;;###mh-autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
580 581
(defun mh-send-other-window (to cc subject)
  "Compose and send a letter in another window.
Bill Wohler's avatar
Bill Wohler committed
582
Do not call this function from outside MH-E; use \\[mh-smail-other-window]
Bill Wohler's avatar
Bill Wohler committed
583 584 585 586 587 588 589
instead.

The file named by `mh-comp-formfile' will be used as the form.
The letter is composed in `mh-letter-mode'; see its documentation for more
details.
If `mh-compose-letter-function' is defined, it is called on the draft and
passed three arguments: TO, CC, and SUBJECT."
Richard M. Stallman's avatar
Richard M. Stallman committed
590
  (interactive (list
Bill Wohler's avatar
Bill Wohler committed
591 592 593
                (mh-interactive-read-address "To: ")
                (mh-interactive-read-address "Cc: ")
                (mh-interactive-read-string "Subject: ")))
Richard M. Stallman's avatar
Richard M. Stallman committed
594 595 596 597
  (let ((pop-up-windows t))
    (mh-send-sub to cc subject (current-window-configuration))))

(defun mh-send-sub (to cc subject config)
Bill Wohler's avatar
Bill Wohler committed
598 599 600
  "Do the real work of composing and sending a letter.
Expects the TO, CC, and SUBJECT fields as arguments.
CONFIG is the window configuration before sending mail."
Richard M. Stallman's avatar
Richard M. Stallman committed
601
  (let ((folder mh-current-folder)
Bill Wohler's avatar
Bill Wohler committed
602
        (msg-num (mh-get-msg-num nil)))
Richard M. Stallman's avatar
Richard M. Stallman committed
603 604
    (message "Composing a message...")
    (let ((draft (mh-read-draft
Bill Wohler's avatar
Bill Wohler committed
605 606 607 608 609 610 611 612 613 614 615 616 617 618 619
                  "message"
                  (let (components)
                    (cond
                     ((file-exists-p
                       (setq components
                             (expand-file-name mh-comp-formfile mh-user-path)))
                      components)
                     ((file-exists-p
                       (setq components
                             (expand-file-name mh-comp-formfile mh-lib)))
                      components)
                     ((file-exists-p
                       (setq components
                             (expand-file-name mh-comp-formfile
                                               ;; What is this mh-etc ??  -sm
Bill Wohler's avatar
Bill Wohler committed
620 621
                                               ;; This is dead code, so
                                               ;; remove it.
Bill Wohler's avatar
Bill Wohler committed
622
                                        ;(and (boundp 'mh-etc) mh-etc)
Bill Wohler's avatar
Bill Wohler committed
623
                                               )))
Bill Wohler's avatar
Bill Wohler committed
624 625
                      components)
                     (t
626 627
                      (error "Can't find components file \"%s\""
                             components))))
Bill Wohler's avatar
Bill Wohler committed
628
                  nil)))
Richard M. Stallman's avatar
Richard M. Stallman committed
629 630 631
      (mh-insert-fields "To:" to "Subject:" subject "Cc:" cc)
      (goto-char (point-max))
      (mh-compose-and-send-mail draft "" folder msg-num
Bill Wohler's avatar
Bill Wohler committed
632 633
                                to subject cc
                                nil nil config)
Bill Wohler's avatar
Bill Wohler committed
634 635
      (mh-letter-mode-message)
      (mh-letter-adjust-point))))
Richard M. Stallman's avatar
Richard M. Stallman committed
636 637

(defun mh-read-draft (use initial-contents delete-contents-file)
Bill Wohler's avatar
Bill Wohler committed
638 639 640 641 642 643 644 645 646
  "Read draft file into a draft buffer and make that buffer the current one.
USE is a message used for prompting about the intended use of the message.
INITIAL-CONTENTS is filename that is read into an empty buffer, or nil
if buffer should not be modified.  Delete the initial-contents file if
DELETE-CONTENTS-FILE flag is set.
Returns the draft folder's name.
If the draft folder facility is enabled in ~/.mh_profile, a new buffer is
used each time and saved in the draft folder.  The draft file can then be
reused."
Richard M. Stallman's avatar
Richard M. Stallman committed
647
  (cond (mh-draft-folder
Bill Wohler's avatar
Bill Wohler committed
648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670
         (let ((orig-default-dir default-directory)
               (draft-file-name (mh-new-draft-name)))
           (pop-to-buffer (generate-new-buffer
                           (format "draft-%s"
                                   (file-name-nondirectory draft-file-name))))
           (condition-case ()
               (insert-file-contents draft-file-name t)
             (file-error))
           (setq default-directory orig-default-dir)))
        (t
         (let ((draft-name (expand-file-name "draft" mh-user-path)))
           (pop-to-buffer "draft")      ; Create if necessary
           (if (buffer-modified-p)
               (if (y-or-n-p "Draft has been modified; kill anyway? ")
                   (set-buffer-modified-p nil)
                 (error "Draft preserved")))
           (setq buffer-file-name draft-name)
           (clear-visited-file-modtime)
           (unlock-buffer)
           (cond ((and (file-exists-p draft-name)
                       (not (equal draft-name initial-contents)))
                  (insert-file-contents draft-name)
                  (delete-file draft-name))))))
Richard M. Stallman's avatar
Richard M. Stallman committed
671
  (cond ((and initial-contents
Bill Wohler's avatar
Bill Wohler committed
672 673 674 675 676 677 678 679 680
              (or (zerop (buffer-size))
                  (if (y-or-n-p
                       (format "A draft exists.  Use for %s? " use))
                      (if mh-error-if-no-draft
                          (error "A prior draft exists"))
                    t)))
         (erase-buffer)
         (insert-file-contents initial-contents)
         (if delete-contents-file (delete-file initial-contents))))
Richard M. Stallman's avatar
Richard M. Stallman committed
681 682
  (auto-save-mode 1)
  (if mh-draft-folder
Bill Wohler's avatar
Bill Wohler committed
683
      (save-buffer))                    ; Do not reuse draft name
Richard M. Stallman's avatar
Richard M. Stallman committed
684 685 686
  (buffer-name))

(defun mh-new-draft-name ()
Bill Wohler's avatar
Bill Wohler committed
687
  "Return the pathname of folder for draft messages."
Richard M. Stallman's avatar
Richard M. Stallman committed
688 689 690 691 692
  (save-excursion
    (mh-exec-cmd-quiet t "mhpath" mh-draft-folder "new")
    (buffer-substring (point-min) (1- (point-max)))))

(defun mh-annotate-msg (msg buffer note &rest args)
Bill Wohler's avatar
Bill Wohler committed
693 694 695 696
  "Mark MSG in BUFFER with character NOTE and annotate message with ARGS.
MSG can be a message number, a list of message numbers, or a sequence."
  (apply 'mh-exec-cmd "anno" buffer
         (if (listp msg) (append msg args) (cons msg args)))
Richard M. Stallman's avatar
Richard M. Stallman committed
697
  (save-excursion
Bill Wohler's avatar
Bill Wohler committed
698 699
    (cond ((get-buffer buffer)          ; Buffer may be deleted
           (set-buffer buffer)
Bill Wohler's avatar
Bill Wohler committed
700
           (mh-iterate-on-range nil msg
Bill Wohler's avatar
Bill Wohler committed
701
             (mh-notate nil note (1+ mh-cmd-note)))))))
Richard M. Stallman's avatar
Richard M. Stallman committed
702 703

(defun mh-insert-fields (&rest name-values)
Bill Wohler's avatar
Bill Wohler committed
704 705 706
  "Insert the NAME-VALUES pairs in the current buffer.
If the field exists, append the value to it.
Do not insert any pairs whose value is the empty string."
Richard M. Stallman's avatar
Richard M. Stallman committed
707 708 709
  (let ((case-fold-search t))
    (while name-values
      (let ((field-name (car name-values))
Bill Wohler's avatar
Bill Wohler committed
710
            (value (car (cdr name-values))))
Bill Wohler's avatar
Bill Wohler committed
711 712
        (if (not (string-match "^.*:$" field-name))
            (setq field-name (concat field-name ":")))
Bill Wohler's avatar
Bill Wohler committed
713 714 715 716 717 718 719
        (cond ((equal value "")
               nil)
              ((mh-position-on-field field-name)
               (insert " " (or value "")))
              (t
               (insert field-name " " value "\n")))
        (setq name-values (cdr (cdr name-values)))))))
Richard M. Stallman's avatar
Richard M. Stallman committed
720

Bill Wohler's avatar
Bill Wohler committed
721 722 723 724 725
(defun mh-position-on-field (field &optional ignored)
  "Move to the end of the FIELD in the header.
Move to end of entire header if FIELD not found.
Returns non-nil iff FIELD was found.
The optional second arg is for pre-version 4 compatibility and is IGNORED."
Bill Wohler's avatar
Bill Wohler committed
726
  (cond ((mh-goto-header-field field)
Bill Wohler's avatar
Bill Wohler committed
727 728 729 730
         (mh-header-field-end)
         t)
        ((mh-goto-header-end 0)
         nil)))
Karl Heuer's avatar
Karl Heuer committed
731

Bill Wohler's avatar
Bill Wohler committed
732
;;;###mh-autoload
Karl Heuer's avatar
Karl Heuer committed
733
(defun mh-get-header-field (field)
Bill Wohler's avatar
Bill Wohler committed
734 735 736
  "Find and return the body of FIELD in the mail header.
Returns the empty string if the field is not in the header of the
current buffer."
Karl Heuer's avatar
Karl Heuer committed
737 738
  (if (mh-goto-header-field field)
      (progn
Bill Wohler's avatar
Bill Wohler committed
739 740 741 742
        (skip-chars-forward " \t")      ;strip leading white space in body
        (let ((start (point)))
          (mh-header-field-end)
          (buffer-substring-no-properties start (point))))
Karl Heuer's avatar
Karl Heuer committed
743 744
    ""))

Bill Wohler's avatar
Bill Wohler committed
745
(fset 'mh-get-field 'mh-get-header-field) ;MH-E 4 compatibility
Karl Heuer's avatar
Karl Heuer committed
746 747

(defun mh-goto-header-field (field)
Bill Wohler's avatar
Bill Wohler committed
748 749 750
  "Move to FIELD in the message header.
Move to the end of the FIELD name, which should end in a colon.
Returns t if found, nil if not."
Karl Heuer's avatar
Karl Heuer committed
751 752
  (goto-char (point-min))
  (let ((case-fold-search t)
Bill Wohler's avatar
Bill Wohler committed
753 754 755
        (headers-end (save-excursion
                       (mh-goto-header-end 0)
                       (point))))
Karl Heuer's avatar
Karl Heuer committed
756 757
    (re-search-forward (format "^%s" field) headers-end t)))

Richard M. Stallman's avatar
Richard M. Stallman committed
758
(defun mh-goto-header-end (arg)
Bill Wohler's avatar
Bill Wohler committed
759
  "Move the cursor ARG lines after the header."
Karl Heuer's avatar
Karl Heuer committed
760
  (if (re-search-forward "^-*$" nil nil)
Richard M. Stallman's avatar
Richard M. Stallman committed
761 762
      (forward-line arg)))

Bill Wohler's avatar
Bill Wohler committed
763 764 765 766
(defun mh-extract-from-header-value ()
  "Extract From: string from header."
  (save-excursion
    (if (not (mh-goto-header-field "From:"))
Bill Wohler's avatar
Bill Wohler committed
767
        nil
Bill Wohler's avatar
Bill Wohler committed
768 769 770
      (skip-chars-forward " \t")
      (buffer-substring-no-properties
       (point) (progn (mh-header-field-end)(point))))))
Richard M. Stallman's avatar
Richard M. Stallman committed
771 772 773 774 775



;;; Mode for composing and sending a draft message.

Bill Wohler's avatar
Bill Wohler committed
776
(put 'mh-letter-mode 'mode-class 'special)
Richard M. Stallman's avatar
Richard M. Stallman committed
777

Bill Wohler's avatar
Bill Wohler committed
778 779
;;; Menu extracted from mh-menubar.el V1.1 (31 July 2001)
(eval-when-compile (defvar mh-letter-menu nil))
Bill Wohler's avatar
Bill Wohler committed
780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826
(easy-menu-define
  mh-letter-menu mh-letter-mode-map "Menu for MH-E letter mode."
  '("Letter"
    ["Send This Draft"          mh-send-letter t]
    ["Split Current Line"       mh-open-line t]
    ["Check Recipient"          mh-check-whom t]
    ["Yank Current Message"     mh-yank-cur-msg t]
    ["Insert a Message..."      mh-insert-letter t]
    ["Insert Signature"         mh-insert-signature t]
    ("Encrypt/Sign Message"
     ["Sign Message"
      mh-mml-secure-message-sign mh-gnus-pgp-support-flag]
     ["Encrypt Message"
      mh-mml-secure-message-encrypt mh-gnus-pgp-support-flag]
     ["Sign+Encrypt Message"
      mh-mml-secure-message-signencrypt mh-gnus-pgp-support-flag]
     ["Disable Security"
      mh-mml-unsecure-message mh-gnus-pgp-support-flag]
     "--"
     "Security Method"
     ["PGP (MIME)" (setq mh-mml-method-default "pgpmime")
      :style radio
      :selected (equal mh-mml-method-default "pgpmime")]
     ["PGP" (setq mh-mml-method-default "pgp")
      :style radio
      :selected (equal mh-mml-method-default "pgp")]
     ["S/MIME" (setq mh-mml-method-default "smime")
      :style radio
      :selected (equal mh-mml-method-default "smime")]
     "--"
     ["Save Method as Default"
      (customize-save-variable 'mh-mml-method-default mh-mml-method-default) t]
     )
    ["Compose Insertion (MIME)..."      mh-compose-insertion t]
    ["Compose Compressed tar (MIME)..."
     mh-mhn-compose-external-compressed-tar t]
    ["Compose Get File (MIME)..."       mh-mhn-compose-anon-ftp t]
    ["Compose Forward (MIME)..."        mh-compose-forward t]
    ;; The next two will have to be merged. But I also need to make sure the
    ;; user can't mix directives of both types.
    ["Pull in All Compositions (mhn)"
     mh-edit-mhn (mh-mhn-directive-present-p)]
    ["Pull in All Compositions (gnus)"
     mh-mml-to-mime (mh-mml-directive-present-p)]
    ["Revert to Non-MIME Edit (mhn)"
     mh-revert-mhn-edit (equal mh-compose-insertion 'mhn)]
    ["Kill This Draft"          mh-fully-kill-draft t]))
Richard M. Stallman's avatar
Richard M. Stallman committed
827

Bill Wohler's avatar
Bill Wohler committed
828 829 830 831 832 833 834 835 836 837
;;; Help Messages
;;; Group messages logically, more or less.
(defvar mh-letter-mode-help-messages
  '((nil
     "Send letter:          \\[mh-send-letter]"
     "\t\tOpen line:            \\[mh-open-line]\n"
     "Kill letter:          \\[mh-fully-kill-draft]"
     "\t\tInsert:\n"
     "Check recipients:     \\[mh-check-whom]"
     "\t\t  Current message:    \\[mh-yank-cur-msg]\n"
Bill Wohler's avatar
Bill Wohler committed
838 839 840 841 842 843 844
     "\t\t  Attachment:             \\[mh-compose-insertion]\n"
     "\t\t  Message to forward:     \\[mh-compose-forward]\n"
     "                          "
     "Security:"
     "\t\t  Encrypt message:          \\[mh-mml-secure-message-encrypt]"
     "\t\t  Sign+Encrypt message:     \\[mh-mml-secure-message-signencrypt]"
     "\t\t  Sign message:             \\[mh-mml-secure-message-sign]\n"
Bill Wohler's avatar
Bill Wohler committed
845
     "                          "
Bill Wohler's avatar
Bill Wohler committed
846
     "\t\t  Signature:              \\[mh-insert-signature]"))
Bill Wohler's avatar
Bill Wohler committed
847 848 849 850 851 852 853 854 855 856 857
  "Key binding cheat sheet.

This is an associative array which is used to show the most common commands.
The key is a prefix char. The value is one or more strings which are
concatenated together and displayed in the minibuffer if ? is pressed after
the prefix character. The special key nil is used to display the
non-prefixed commands.

The substitutions described in `substitute-command-keys' are performed as
well.")

Bill Wohler's avatar
Bill Wohler committed
858
;;;###mh-autoload
Bill Wohler's avatar
Bill Wohler committed
859 860 861 862 863 864 865 866 867
(defun mh-fill-paragraph-function (arg)
  "Fill paragraph at or after point.
Prefix ARG means justify as well. This function enables `fill-paragraph' to
work better in MH-Letter mode."
  (interactive "P")
  (let ((fill-paragraph-function) (fill-prefix))
    (if (mh-in-header-p)
        (mail-mode-fill-paragraph arg)
      (fill-paragraph arg))))
Richard M. Stallman's avatar
Richard M. Stallman committed
868

Bill Wohler's avatar
Bill Wohler committed
869 870 871 872 873
;; Avoid compiler warnings in XEmacs and Emacs 20
(eval-when-compile
  (defvar tool-bar-mode)
  (defvar tool-bar-map))

Richard M. Stallman's avatar
Richard M. Stallman committed
874
;;;###autoload
875
(define-derived-mode mh-letter-mode text-mode "MH-Letter"
Bill Wohler's avatar
Bill Wohler committed
876
  "Mode for composing letters in MH-E.\\<mh-letter-mode-map>
Bill Wohler's avatar
Bill Wohler committed
877

Karl Heuer's avatar
Karl Heuer committed
878 879
When you have finished composing, type \\[mh-send-letter] to send the message
using the MH mail handling system.
Richard M. Stallman's avatar
Richard M. Stallman committed
880

Bill Wohler's avatar
Bill Wohler committed
881 882 883 884 885 886 887
There are two types of MIME directives used by MH-E: Gnus and MH. The option
`mh-compose-insertion' controls what type of directives are inserted by MH-E
commands. These directives can be converted to MIME body parts by running
\\[mh-edit-mhn] for mhn directives or \\[mh-mml-to-mime] for Gnus directives.
This step is mandatory if these directives are added manually. If the
directives are inserted with MH-E commands such as \\[mh-compose-insertion],
the directives are expanded automatically when the letter is sent.
Richard M. Stallman's avatar
Richard M. Stallman committed
888

Bill Wohler's avatar
Bill Wohler committed
889 890
Options that control this mode can be changed with
\\[customize-group]; specify the \"mh-compose\" group.
Richard M. Stallman's avatar
Richard M. Stallman committed
891

Bill Wohler's avatar
Bill Wohler committed
892 893
When a message is composed, the hooks `text-mode-hook' and
`mh-letter-mode-hook' are run.
Richard M. Stallman's avatar
Richard M. Stallman committed
894

Bill Wohler's avatar
Bill Wohler committed
895
\\{mh-letter-mode-map}"
Bill Wohler's avatar
Bill Wohler committed
896
  (mh-find-path)
Richard M. Stallman's avatar
Richard M. Stallman committed
897 898 899 900 901 902
  (make-local-variable 'mh-send-args)
  (make-local-variable 'mh-annotate-char)
  (make-local-variable 'mh-annotate-field)
  (make-local-variable 'mh-previous-window-config)
  (make-local-variable 'mh-sent-from-folder)
  (make-local-variable 'mh-sent-from-msg)
Bill Wohler's avatar
Bill Wohler committed
903 904 905 906 907 908
  ;; Set the local value of mh-mail-header-separator according to what is
  ;; present in the buffer...
  (set (make-local-variable 'mh-mail-header-separator)
       (save-excursion
         (goto-char (mh-mail-header-end))
         (buffer-substring-no-properties (point) (line-end-position))))
Richard M. Stallman's avatar
Richard M. Stallman committed
909
  (make-local-variable 'mail-header-separator)
Bill Wohler's avatar
Bill Wohler committed
910
  (setq mail-header-separator mh-mail-header-separator) ;override sendmail.el
Bill Wohler's avatar
Bill Wohler committed
911 912
  (make-local-variable 'mh-help-messages)
  (setq mh-help-messages mh-letter-mode-help-messages)
Bill Wohler's avatar
Bill Wohler committed
913 914 915
  (setq buffer-invisibility-spec '((vanish . t) t))
  (set (make-local-variable 'line-move-ignore-invisible) t)

Bill Wohler's avatar
Bill Wohler committed
916 917 918 919 920
  ;; From sendmail.el for proper paragraph fill
  ;; sendmail.el also sets a normal-auto-fill-function (not done here)
  (make-local-variable 'paragraph-separate)
  (make-local-variable 'paragraph-start)
  (make-local-variable 'fill-paragraph-function)
Bill Wohler's avatar
Bill Wohler committed
921
  (setq fill-paragraph-function 'mh-fill-paragraph-function)
Bill Wohler's avatar
Bill Wohler committed
922 923
  (make-local-variable 'adaptive-fill-regexp)
  (setq adaptive-fill-regexp
Bill Wohler's avatar
Bill Wohler committed
924 925
        (concat adaptive-fill-regexp
                "\\|[ \t]*[-[:alnum:]]*>+[ \t]*"))
Bill Wohler's avatar
Bill Wohler committed
926 927
  (make-local-variable 'adaptive-fill-first-line-regexp)
  (setq adaptive-fill-first-line-regexp
Bill Wohler's avatar
Bill Wohler committed
928 929
        (concat adaptive-fill-first-line-regexp
                "\\|[ \t]*[-[:alnum:]]*>+[ \t]*"))
Bill Wohler's avatar
Bill Wohler committed
930 931 932 933 934
  ;; `-- ' precedes the signature.  `-----' appears at the start of the
  ;; lines that delimit forwarded messages.
  ;; Lines containing just >= 3 dashes, perhaps after whitespace,
  ;; are also sometimes used and should be separators.
  (setq paragraph-start (concat (regexp-quote mail-header-separator)
Bill Wohler's avatar
Bill Wohler committed
935 936 937 938
                                "\\|\t*\\([-|#;>* ]\\|(?[0-9]+[.)]\\)+$"
                                "\\|[ \t]*[[:alnum:]]*>+[ \t]*$\\|[ \t]*$\\|"
                                "-- $\\|---+$\\|"
                                page-delimiter))
Bill Wohler's avatar
Bill Wohler committed
939 940 941
  (setq paragraph-separate paragraph-start)
  ;; --- End of code from sendmail.el ---

Bill Wohler's avatar
Bill Wohler committed
942 943
  ;; Enable undo since a show-mode buffer might have been reused.
  (buffer-enable-undo)
Bill Wohler's avatar
Bill Wohler committed
944
  (set (make-local-variable 'tool-bar-map) mh-letter-tool-bar-map)
Bill Wohler's avatar
Bill Wohler committed
945
  (mh-funcall-if-exists mh-toolbar-init :letter)
Bill Wohler's avatar
Bill Wohler committed
946 947
  (make-local-variable 'font-lock-defaults)
  (cond
Bill Wohler's avatar
Bill Wohler committed
948 949 950 951 952 953
   ((or (equal mh-highlight-citation-p 'font-lock)
        (equal mh-highlight-citation-p 'gnus))
    ;; Let's use font-lock even if gnus is used in show-mode.  The reason
    ;; is that gnus uses static text properties which are not appropriate
    ;; for a buffer that will be edited.  So the choice here is either fontify
    ;; the citations and header...
Bill Wohler's avatar
Bill Wohler committed
954
    (setq font-lock-defaults '(mh-letter-font-lock-keywords t)))
Bill Wohler's avatar
Bill Wohler committed
955
   (t
Bill Wohler's avatar
Bill Wohler committed
956
    ;; ...or the header only
Bill Wohler's avatar
Bill Wohler committed
957 958 959
    (setq font-lock-defaults '(mh-show-font-lock-keywords t))))
  (easy-menu-add mh-letter-menu)
  (setq fill-column mh-letter-fill-column)
Bill Wohler's avatar
Bill Wohler committed
960
  ;; If text-mode-hook turned on auto-fill, tune it for messages
961 962 963
  (when auto-fill-function
    (make-local-variable 'auto-fill-function)
    (setq auto-fill-function 'mh-auto-fill-for-letter)))
Richard M. Stallman's avatar
Richard M. Stallman committed
964

Bill Wohler's avatar
Bill Wohler committed
965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988
(defun mh-font-lock-field-data (limit)
  "Find header field region between point and LIMIT."
  (and (< (point) (mh-letter-header-end))
       (< (point) limit)
       (let ((end (min limit (mh-letter-header-end)))
             (point (point))
             data-end data-begin field)
         (end-of-line)
         (setq data-end (if (re-search-forward "^[^ \t]" end t)
                            (match-beginning 0)
                          end))
         (goto-char (1- data-end))
         (if (not (re-search-backward "\\(^[^ \t][^:]*\\):[ \t]*" nil t))
             (setq data-begin (point-min))
           (setq data-begin (match-end 0))
           (setq field (match-string 1)))
         (setq data-begin (max point data-begin))
         (if (and field (mh-letter-skipped-header-field-p field))
             (set-match-data nil)
           (set-match-data (list data-begin data-end data-begin data-end)))
         (goto-char (if (equal point data-end) (1+ data-end) data-end))
         t)))

(defun mh-letter-header-end ()
Bill Wohler's avatar
Bill Wohler committed
989 990 991
  "Find the end of the message header.
This function is to be used only for font locking. It works by searching for
`mh-mail-header-separator' in the buffer."
Bill Wohler's avatar
Bill Wohler committed
992
  (save-excursion
Bill Wohler's avatar
Bill Wohler committed
993 994 995 996 997
    (goto-char (point-min))
    (cond ((equal mh-mail-header-separator "") (point-min))
          ((search-forward (format "\n%s\n" mh-mail-header-separator) nil t)
           (line-beginning-position 0))
          (t (point-min)))))
Bill Wohler's avatar
Bill Wohler committed
998

Richard M. Stallman's avatar
Richard M. Stallman committed
999
(defun mh-auto-fill-for-letter ()
Bill Wohler's avatar
Bill Wohler committed
1000 1001
  "Perform auto-fill for message.
Header is treated specially by inserting a tab before continuation lines."
Richard M. Stallman's avatar
Richard M. Stallman committed
1002
  (if (mh-in-header-p)
Karl Heuer's avatar
Karl Heuer committed
1003
      (let ((fill-prefix "\t"))
Bill Wohler's avatar
Bill Wohler committed
1004
        (do-auto-fill))
Karl Heuer's avatar
Karl Heuer committed
1005
    (do-auto-fill)))
Richard M. Stallman's avatar
Richard M. Stallman committed
1006

Bill Wohler's avatar
Bill Wohler committed
1007
(defun mh-insert-header-separator ()
Bill Wohler's avatar
Bill Wohler committed
1008
  "Insert `mh-mail-header-separator', if absent."
Richard M. Stallman's avatar
Richard M. Stallman committed
1009
  (save-excursion
Bill Wohler's avatar
Bill Wohler committed
1010 1011 1012
    (goto-char (point-min))
    (rfc822-goto-eoh)
    (if (looking-at "$")
Bill Wohler's avatar
Bill Wohler committed
1013
        (insert mh-mail-header-separator))))
Richard M. Stallman's avatar
Richard M. Stallman committed
1014

Bill Wohler's avatar
Bill Wohler committed
1015
;;;###mh-autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
1016 1017 1018
(defun mh-to-field ()
  "Move point to the end of a specified header field.
The field is indicated by the previous keystroke (the last keystroke
Richard M. Stallman's avatar
Richard M. Stallman committed
1019
of the command) according to the list in the variable `mh-to-field-choices'.
Richard M. Stallman's avatar
Richard M. Stallman committed
1020 1021 1022
Create the field if it does not exist.  Set the mark to point before moving."
  (interactive)
  (expand-abbrev)
Karl Heuer's avatar
Karl Heuer committed
1023
  (let ((target (cdr (or (assoc (char-to-string (logior last-input-char ?`))
Bill Wohler's avatar
Bill Wohler committed
1024 1025 1026 1027 1028
                                mh-to-field-choices)
                         ;; also look for a char for version 4 compat
                         (assoc (logior last-input-char ?`)
                                mh-to-field-choices))))
        (case-fold-search t))
Richard M. Stallman's avatar
Richard M. Stallman committed
1029 1030
    (push-mark)
    (cond ((mh-position-on-field target)
Bill Wohler's avatar
Bill Wohler committed
1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044
           (let ((eol (point)))
             (skip-chars-backward " \t")
             (delete-region (point) eol))
           (if (and (not (eq (logior last-input-char ?`) ?s))
                    (save-excursion
                      (backward-char 1)
                      (not (looking-at "[:,]"))))
               (insert ", ")
             (insert " ")))
          (t
           (if (mh-position-on-field "To:")
               (forward-line 1))
           (insert (format "%s \n" target))
           (backward-char 1)))))
Richard M. Stallman's avatar
Richard M. Stallman committed
1045

Bill Wohler's avatar
Bill Wohler committed
1046
;;;###mh-autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
1047 1048 1049 1050 1051 1052
(defun mh-to-fcc (&optional folder)
  "Insert an Fcc: FOLDER field in the current message.
Prompt for the field name with a completion list of the current folders."
  (interactive)
  (or folder
      (setq folder (mh-prompt-for-folder
Bill Wohler's avatar
Bill Wohler committed
1053 1054 1055 1056 1057 1058 1059 1060
                    "Fcc"
                    (or (and mh-default-folder-for-message-function
                             (save-excursion
                               (goto-char (point-min))
                               (funcall
                                mh-default-folder-for-message-function)))
                        "")
                    t)))
Richard M. Stallman's avatar
Richard M. Stallman committed
1061 1062 1063 1064 1065
  (let ((last-input-char ?\C-f))
    (expand-abbrev)
    (save-excursion
      (mh-to-field)
      (insert (if (mh-folder-name-p folder)
Bill Wohler's avatar
Bill Wohler committed
1066 1067
                  (substring folder 1)
                folder)))))
Richard M. Stallman's avatar
Richard M. Stallman committed
1068

Bill Wohler's avatar
Bill Wohler committed
1069 1070 1071 1072 1073 1074 1075 1076 1077 1078
(defun mh-file-is-vcard-p (file)
  "Return t if FILE is a .vcf vcard."
  (let ((case-fold-search t))
    (and (stringp file)
         (file-exists-p file)
         (or (and (not (mh-have-file-command))
                  (not (null (string-match "\.vcf$" file))))
             (and (mh-have-file-command)
                  (string-equal "text/x-vcard" (mh-file-mime-type file)))))))

Bill Wohler's avatar
Bill Wohler committed
1079
;;;###mh-autoload
Bill Wohler's avatar
Bill Wohler committed
1080 1081 1082 1083
(defun mh-insert-signature (&optional file)
  "Insert the signature specified by `mh-signature-file-name' or FILE at point.
A signature separator (`-- ') will be added if the signature block does not
contain one and `mh-signature-separator-flag' is on.
Bill Wohler's avatar
Bill Wohler committed
1084
The value of `mh-letter-insert-signature-hook' is a list of functions to be
Bill Wohler's avatar
Bill Wohler committed
1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131
called, with no arguments, after the signature is inserted.
The signature can also be inserted with `mh-identity-list'."
(interactive)
  (save-excursion
    (insert "\n")
    (let ((mh-signature-file-name (or file mh-signature-file-name))
          (mh-mhn-p (mh-mhn-directive-present-p))
          (mh-mml-p (mh-mml-directive-present-p)))
      (save-restriction
        (narrow-to-region (point) (point))
        (cond
         ((mh-file-is-vcard-p mh-signature-file-name)
          (if (equal mh-compose-insertion 'gnus)
              (insert "<#part type=\"text/x-vcard\" filename=\""
                      mh-signature-file-name
                      "\" disposition=inline description=VCard>\n<#/part>")
            (insert "#text/x-vcard; name=\""
                    (file-name-nondirectory mh-signature-file-name)
                    "\" [VCard] " (expand-file-name mh-signature-file-name))))
         (t
          (cond
           (mh-mhn-p
            (insert "#\n" "Content-Description: Signature\n"))
           (mh-mml-p
            (mml-insert-tag 'part 'type "text/plain" 'disposition "inline"
                            'description "Signature")))
          (cond ((null mh-signature-file-name))
                ((and (stringp mh-signature-file-name)
                      (file-readable-p mh-signature-file-name))
                 (insert-file-contents mh-signature-file-name))
                ((functionp mh-signature-file-name)
                 (funcall mh-signature-file-name)))))
        (save-restriction
          (widen)
          (run-hooks 'mh-letter-insert-signature-hook))
        (goto-char (point-min))
        (when (and (not (mh-file-is-vcard-p mh-signature-file-name))
                   mh-signature-separator-flag
                   (> (point-max) (point-min))
                   (not (mh-signature-separator-p)))
          (cond (mh-mhn-p
                 (forward-line 2))
                (mh-mml-p
                 (forward-line 1)))
          (insert mh-signature-separator))
        (if (not (> (point-max) (point-min)))
            (message "No signature found")))))
1132
  (force-mode-line-update))
Richard M. Stallman's avatar
Richard M. Stallman committed
1133

Bill Wohler's avatar
Bill Wohler committed
1134
;;;###mh-autoload