1 ;;; mh-comp.el --- MH-E functions for composing messages
3 ;; Copyright (C) 1993, 1995, 1997,
4 ;; 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
6 ;; Author: Bill Wohler <wohler@newt.com>
7 ;; Maintainer: Bill Wohler <wohler@newt.com>
11 ;; This file is part of GNU Emacs.
13 ;; GNU Emacs is free software; you can redistribute it and/or modify
14 ;; it under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation; either version 2, or (at your option)
18 ;; GNU Emacs is distributed in the hope that it will be useful,
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;; GNU General Public License for more details.
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with GNU Emacs; see the file COPYING. If not, write to the
25 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
26 ;; Boston, MA 02110-1301, USA.
30 ;; Internal support for MH-E package.
36 (eval-when-compile (require 'mh-acros))
42 (eval-when (compile load eval)
43 (ignore-errors (require 'mailabbrev)))
45 ;; Shush the byte-compiler
46 (defvar adaptive-fill-first-line-regexp)
47 (defvar font-lock-defaults)
49 (defvar sendmail-coding-system)
50 (defvar mh-identity-list)
51 (defvar mh-identity-default)
52 (defvar mh-mml-mode-default)
53 (defvar mh-identity-menu)
58 (autoload 'mail-mode-fill-paragraph "sendmail")
59 (autoload 'mm-handle-displayed-p "mm-decode")
61 (autoload 'sc-cite-original "sc"
62 "Workhorse citing function which performs the initial citation.
63 This is callable from the various mail and news readers' reply
64 function according to the agreed upon standard. See `sc-describe'
65 for more details. `sc-cite-original' does not do any yanking of the
66 original message but it does require a few things:
68 1) The reply buffer is the current buffer.
70 2) The original message has been yanked and inserted into the
73 3) Verbose mail headers from the original message have been
74 inserted into the reply buffer directly before the text of the
77 4) Point is at the beginning of the verbose headers.
79 5) Mark is at the end of the body of text to be cited.
81 For Emacs 19's, the region need not be active (and typically isn't
82 when this function is called. Also, the hook `sc-pre-hook' is run
83 before, and `sc-post-hook' is run after the guts of this function.")
87 ;;; Site customization (see also mh-utils.el):
89 (defvar mh-send-prog "send"
90 "Name of the MH send program.
91 Some sites need to change this because of a name conflict.")
93 (defvar mh-redist-background nil
94 "If non-nil redist will be done in background like send.
95 This allows transaction log to be visible if -watch, -verbose or
100 ;;; Scan Line Formats
102 (defvar mh-note-repl ?-
103 "Messages that have been replied to are marked by this character.")
105 (defvar mh-note-forw ?F
106 "Messages that have been forwarded are marked by this character.")
108 (defvar mh-note-dist ?R
109 "Messages that have been redistributed are marked by this character.")
111 (defvar mh-yank-hooks nil
112 "Obsolete hook for modifying a citation just inserted in the mail buffer.
114 Each hook function can find the citation between point and mark.
115 And each hook function should leave point and mark around the
116 citation text as modified.
118 This is a normal hook, misnamed for historical reasons. It is
119 semi-obsolete and is only used if `mail-citation-hook' is nil.")
121 (defvar mh-comp-formfile "components"
122 "Name of file to be used as a skeleton for composing messages.
124 Default is \"components\".
126 If not an absolute file name, the file is searched for first in the
127 user's MH directory, then in the system MH lib directory.")
129 (defvar mh-repl-formfile "replcomps"
130 "Name of file to be used as a skeleton for replying to messages.
132 Default is \"replcomps\".
134 If not an absolute file name, the file is searched for first in the
135 user's MH directory, then in the system MH lib directory.")
137 (defvar mh-repl-group-formfile "replgroupcomps"
138 "Name of file to be used as a skeleton for replying to messages.
140 Default is \"replgroupcomps\".
142 This file is used to form replies to the sender and all recipients of
143 a message. Only used if `(mh-variant-p 'nmh)' is non-nil.
144 If not an absolute file name, the file is searched for first in the
145 user's MH directory, then in the system MH lib directory.")
147 (defvar mh-rejected-letter-start
150 '("Content-Type: message/rfc822" ;MIME MDN
151 "------ This is a copy of the message, including all the headers. ------";from exim
152 "--- Below this line is a copy of the message."; from qmail
153 " ----- Unsent message follows -----" ;from sendmail V5
154 " --------Unsent Message below:" ; from sendmail at BU
155 " ----- Original message follows -----" ;from sendmail V8
156 "------- Unsent Draft" ;from MH itself
157 "---------- Original Message ----------" ;from zmailer
158 " --- The unsent message follows ---" ;from AIX mail system
159 " Your message follows:" ;from MMDF-II
160 "Content-Description: Returned Content" ;1993 KJ sendmail
163 (defvar mh-new-draft-cleaned-headers
164 "^Date:\\|^Received:\\|^Message-Id:\\|^From:\\|^Sender:\\|^Errors-To:\\|^Delivery-Date:\\|^Return-Path:"
165 "Regexp of header lines to remove before offering a message as a new draft.
166 Used by the \\<mh-folder-mode-map>`\\[mh-edit-again]' and `\\[mh-extract-rejected-mail]' commands.")
168 (defvar mh-to-field-choices '(("t" . "To:") ("s" . "Subject:") ("c" . "Cc:")
169 ("b" . "Bcc:") ("f" . "Fcc:") ("r" . "From:")
171 "Alist of (final-character . field-name) choices for `mh-to-field'.")
173 (defvar mh-letter-mode-map (copy-keymap text-mode-map)
174 "Keymap for composing mail.")
176 (defvar mh-letter-mode-syntax-table nil
177 "Syntax table used by MH-E while in MH-Letter mode.")
179 (if mh-letter-mode-syntax-table
181 (setq mh-letter-mode-syntax-table
182 (make-syntax-table text-mode-syntax-table))
183 (modify-syntax-entry ?% "." mh-letter-mode-syntax-table))
185 (defvar mh-sent-from-folder nil
186 "Folder of msg assoc with this letter.")
188 (defvar mh-sent-from-msg nil
189 "Number of msg assoc with this letter.")
191 (defvar mh-send-args nil
192 "Extra args to pass to \"send\" command.")
194 (defvar mh-annotate-char nil
195 "Character to use to annotate `mh-sent-from-msg'.")
197 (defvar mh-annotate-field nil
198 "Field name for message annotation.")
200 (defvar mh-insert-auto-fields-done-local nil
201 "Buffer-local variable set when `mh-insert-auto-fields' called successfully.")
202 (make-variable-buffer-local 'mh-insert-auto-fields-done-local)
206 "Compose a message with the MH mail system.
207 See `mh-send' for more details on composing mail."
210 (call-interactively 'mh-send))
213 (defun mh-smail-other-window ()
214 "Compose a message with the MH mail system in other window.
215 See `mh-send' for more details on composing mail."
218 (call-interactively 'mh-send-other-window))
220 (defvar mh-error-if-no-draft nil) ;raise error over using old draft
223 (defun mh-smail-batch (&optional to subject other-headers &rest ignored)
224 "Compose a message with the MH mail system.
226 This function does not prompt the user for any header fields, and
227 thus is suitable for use by programs that want to create a mail
228 buffer. Users should use \\[mh-smail] to compose mail.
230 Optional arguments for setting certain fields include TO,
231 SUBJECT, and OTHER-HEADERS. Additional arguments are IGNORED."
233 (let ((mh-error-if-no-draft t))
234 (mh-send (or to "") "" (or subject ""))))
236 ;; XEmacs needs this:
238 (defun mh-user-agent-compose (&optional to subject other-headers continue
239 switch-function yank-action
241 "Set up mail composition draft with the MH mail system.
242 This is `mail-user-agent' entry point to MH-E.
244 The optional arguments TO and SUBJECT specify recipients and the
245 initial Subject field, respectively.
247 OTHER-HEADERS is an alist specifying additional header fields.
248 Elements look like (HEADER . VALUE) where both HEADER and VALUE
251 CONTINUE, SWITCH-FUNCTION, YANK-ACTION and SEND-ACTIONS are
254 (let ((mh-error-if-no-draft t))
255 (mh-send to "" subject)
257 (mh-insert-fields (concat (car (car other-headers)) ":")
258 (cdr (car other-headers)))
259 (setq other-headers (cdr other-headers)))))
262 (defun mh-edit-again (message)
263 "Edit a MESSAGE to send it again.
265 If you don't complete a draft for one reason or another, and if
266 the draft buffer is no longer available, you can pick your draft
267 up again with this command. If you don't use a draft folder, your
268 last \"draft\" file will be used. If you use draft folders,
269 you'll need to visit the draft folder with \"\\[mh-visit-folder]
270 drafts <RET>\", use \\[mh-next-undeleted-msg] to move to the
271 appropriate message, and then use \\[mh-edit-again] to prepare
272 the message for editing.
274 This command can also be used to take messages that were sent to
275 you and to send them to more people.
277 Don't use this command to re-edit a message from a Mailer-Daemon
278 who complained that your mail wasn't posted for some reason or
279 another (see `mh-extract-rejected-mail').
281 The default message is the current message.
284 (interactive (list (mh-get-msg-num t)))
285 (let* ((from-folder mh-current-folder)
286 (config (current-window-configuration))
288 (cond ((and mh-draft-folder (equal from-folder mh-draft-folder))
289 (pop-to-buffer (find-file-noselect (mh-msg-filename message))
291 (rename-buffer (format "draft-%d" message))
292 ;; Make buffer writable...
293 (setq buffer-read-only nil)
294 ;; If buffer was being used to display the message reinsert
296 (when (eq major-mode 'mh-show-mode)
298 (insert-file-contents buffer-file-name))
301 (mh-read-draft "clean-up" (mh-msg-filename message) nil)))))
302 (mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil)
303 (mh-insert-header-separator)
304 (goto-char (point-min))
306 (mh-compose-and-send-mail draft "" from-folder nil nil nil nil nil nil
308 (mh-letter-mode-message)
309 (mh-letter-adjust-point)))
312 (defun mh-extract-rejected-mail (message)
313 "Edit a MESSAGE that was returned by the mail system.
315 This command prepares the message for editing by removing the
316 Mailer-Daemon envelope and unneeded header fields. Fix whatever
317 addressing problem you had, and send the message again with
320 The default message is the current message.
323 (interactive (list (mh-get-msg-num t)))
324 (let ((from-folder mh-current-folder)
325 (config (current-window-configuration))
326 (draft (mh-read-draft "extraction" (mh-msg-filename message) nil)))
327 (goto-char (point-min))
328 (cond ((re-search-forward mh-rejected-letter-start nil t)
329 (skip-chars-forward " \t\n")
330 (delete-region (point-min) (point))
331 (mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil))
333 (message "Does not appear to be a rejected letter")))
334 (mh-insert-header-separator)
335 (goto-char (point-min))
337 (mh-compose-and-send-mail draft "" from-folder message
338 (mh-get-header-field "To:")
339 (mh-get-header-field "From:")
340 (mh-get-header-field "Cc:")
342 (mh-letter-mode-message)))
345 (defun mh-forward (to cc &optional range)
348 You are prompted for the TO and CC recipients. You are given a
349 draft to edit that looks like it would if you had run the MH
350 command \"forw\". You can then add some text.
352 You can forward several messages by using a RANGE. All of the
353 messages in the range are inserted into your draft. Check the
354 documentation of `mh-interactive-range' to see how RANGE is read
357 The hook `mh-forward-hook' is called on the draft.
359 See also `mh-compose-forward-as-mime-flag',
360 `mh-forward-subject-format', and `mh-send'."
361 (interactive (list (mh-interactive-read-address "To: ")
362 (mh-interactive-read-address "Cc: ")
363 (mh-interactive-range "Forward")))
364 (let* ((folder mh-current-folder)
365 (msgs (mh-range-to-msg-list range))
366 (config (current-window-configuration))
367 (fwd-msg-file (mh-msg-filename (car msgs) folder))
368 ;; forw always leaves file in "draft" since it doesn't have -draft
369 (draft-name (expand-file-name "draft" mh-user-path))
370 (draft (cond ((or (not (file-exists-p draft-name))
371 (y-or-n-p "The file 'draft' exists. Discard it? "))
372 (mh-exec-cmd "forw" "-build"
373 (if (and (mh-variant-p 'nmh)
374 mh-compose-forward-as-mime-flag)
377 (mh-coalesce-msg-list msgs))
379 (mh-read-draft "" draft-name t)
380 (mh-insert-fields "To:" to "Cc:" cc)
383 (mh-read-draft "" draft-name nil)))))
387 (set-buffer (get-buffer-create mh-temp-buffer))
389 (insert-file-contents fwd-msg-file)
390 (setq orig-from (mh-get-header-field "From:"))
391 (setq orig-subject (mh-get-header-field "Subject:")))
393 (mh-forwarded-letter-subject orig-from orig-subject)))
394 (mh-insert-fields "Subject:" forw-subject)
395 (goto-char (point-min))
396 ;; If using MML, translate MH-style directive
397 (if (equal mh-compose-insertion 'mml)
399 (goto-char (mh-mail-header-end))
402 "^#forw \\[\\([^]]+\\)\\] \\(+\\S-+\\) \\(.*\\)$"
404 (let ((description (if (equal (match-string 1)
405 "forwarded messages")
406 "forwarded message %d"
408 (msgs (split-string (match-string 3)))
411 (delete-region (point) (progn (forward-line 1) (point)))
414 (mh-mml-forward-message (format description i)
416 ;; Postition just before forwarded message
417 (if (re-search-forward "^------- Forwarded Message" nil t)
419 (goto-char (mh-mail-header-end))
421 (delete-other-windows)
422 (mh-add-msgs-to-seq msgs 'forwarded t)
423 (mh-compose-and-send-mail draft "" folder msgs
425 mh-note-forw "Forwarded:"
427 (mh-letter-mode-message)
428 (mh-letter-adjust-point)
429 (run-hooks 'mh-forward-hook)))))
431 (defun mh-forwarded-letter-subject (from subject)
432 "Return a Subject suitable for a forwarded message.
433 Original message has headers FROM and SUBJECT."
434 (let ((addr-start (string-match "<" from))
435 (comment (string-match "(" from)))
436 (cond ((and addr-start (> addr-start 0))
437 ;; Full Name <luser@host>
438 (setq from (substring from 0 (1- addr-start))))
440 ;; luser@host (Full Name)
441 (setq from (substring from (1+ comment) (1- (length from)))))))
442 (format mh-forward-subject-format from subject))
445 (defun mh-redistribute (to cc &optional message)
446 "Redistribute a message.
448 This command is similar in function to forwarding mail, but it
449 does not allow you to edit the message, nor does it add your name
450 to the \"From\" header field. It appears to the recipient as if
451 the message had come from the original sender. When you run this
452 command, you are prompted for the TO and CC recipients. The
453 default MESSAGE is the current message.
455 Also investigate the \\[mh-edit-again] command for another way to
456 redistribute messages.
458 See also `mh-redist-full-contents-flag'."
459 (interactive (list (mh-read-address "Redist-To: ")
460 (mh-read-address "Redist-Cc: ")
463 (setq message (mh-get-msg-num t)))
464 (save-window-excursion
465 (let ((folder mh-current-folder)
466 (draft (mh-read-draft "redistribution"
467 (if mh-redist-full-contents-flag
468 (mh-msg-filename message)
471 (mh-goto-header-end 0)
472 (insert "Resent-To: " to "\n")
473 (if (not (equal cc "")) (insert "Resent-cc: " cc "\n"))
476 "^Message-Id:\\|^Received:\\|^Return-Path:\\|^Sender:\\|^Date:\\|^From:"
479 (message "Redistributing...")
480 (let ((env "mhdist=1"))
481 ;; Setup environment...
482 (setq env (concat env " mhaltmsg="
483 (if mh-redist-full-contents-flag
485 (mh-msg-filename message folder))))
486 (unless mh-redist-full-contents-flag
487 (setq env (concat env " mhannotate=1")))
489 (if mh-redist-background
490 (mh-exec-cmd-env-daemon env mh-send-prog nil buffer-file-name)
491 (mh-exec-cmd-error env mh-send-prog "-push" buffer-file-name))
493 (mh-annotate-msg message folder mh-note-dist
494 "-component" "Resent:"
495 "-text" (format "\"%s %s\"" to cc)))
497 (message "Redistributing...done"))))
499 (defun mh-show-buffer-message-number (&optional buffer)
500 "Message number of displayed message in corresponding show buffer.
502 Return nil if show buffer not displayed.
503 If in `mh-letter-mode', don't display the message number being replied
504 to, but rather the message number of the show buffer associated with
505 our originating folder buffer.
506 Optional argument BUFFER can be used to specify the buffer."
510 (cond ((eq major-mode 'mh-show-mode)
511 (let ((number-start (mh-search-from-end ?/ buffer-file-name)))
512 (car (read-from-string (substring buffer-file-name
513 (1+ number-start))))))
514 ((and (eq major-mode 'mh-folder-mode)
516 (get-buffer mh-show-buffer))
517 (mh-show-buffer-message-number mh-show-buffer))
518 ((and (eq major-mode 'mh-letter-mode)
520 (get-buffer mh-sent-from-folder))
521 (mh-show-buffer-message-number mh-sent-from-folder))
526 (defun mh-reply (message &optional reply-to includep)
529 When you reply to a message, you are first prompted with \"Reply
530 to whom?\" (unless the optional argument REPLY-TO is provided).
531 You have several choices here.
533 Response Reply Goes To
535 from The person who sent the message. This is the
536 default, so <RET> is sufficient.
538 to Replies to the sender, plus all recipients in the
539 \"To:\" header field.
542 cc Forms a reply to the sender, plus all recipients.
544 Depending on your answer, \"repl\" is given a different argument
545 to form your reply. Specifically, a choice of \"from\" or none at
546 all runs \"repl -nocc all\", and a choice of \"to\" runs \"repl
547 -cc to\". Finally, either \"cc\" or \"all\" runs \"repl -cc all
550 Two windows are then created. One window contains the message to
551 which you are replying in an MH-Show buffer. Your draft, in
552 MH-Letter mode \(see `mh-letter-mode'), is in the other window.
554 If you supply a prefix argument INCLUDEP, the message you are
555 replying to is inserted in your reply after having first been run
556 through \"mhl\" with the format file \"mhl.reply\".
558 Alternatively, you can customize the option `mh-yank-behavior'
559 and choose one of its \"Automatically\" variants to do the same
560 thing. If you do so, the prefix argument has no effect.
562 Another way to include the message automatically in your draft is
563 to use \"repl: -filter repl.filter\" in your MH profile.
565 If you wish to customize the header or other parts of the reply
566 draft, please see \"repl\" and \"mh-format\".
568 See also `mh-reply-show-message-flag',
569 `mh-reply-default-reply-to', and `mh-send'."
572 (let ((minibuffer-help-form
573 "from => Sender only\nto => Sender and primary recipients\ncc or all => Sender and all recipients"))
574 (or mh-reply-default-reply-to
575 (completing-read "Reply to whom: [from] "
576 '(("from") ("to") ("cc") ("all"))
580 (let* ((folder mh-current-folder)
581 (show-buffer mh-show-buffer)
582 (config (current-window-configuration))
583 (group-reply (or (equal reply-to "cc") (equal reply-to "all")))
584 (form-file (cond ((and (mh-variant-p 'nmh 'mu-mh) group-reply
585 (stringp mh-repl-group-formfile))
586 mh-repl-group-formfile)
587 ((stringp mh-repl-formfile) mh-repl-formfile)
589 (message "Composing a reply...")
590 (mh-exec-cmd "repl" "-build" "-noquery" "-nodraftfolder"
592 (list "-form" form-file))
593 mh-current-folder message
594 (cond ((or (equal reply-to "from") (equal reply-to ""))
596 ((equal reply-to "to")
598 (group-reply (if (mh-variant-p 'nmh 'mu-mh)
599 '("-group" "-nocc" "me")
600 '("-cc" "all" "-nocc" "me"))))
601 (cond ((or (eq mh-yank-behavior 'autosupercite)
602 (eq mh-yank-behavior 'autoattrib))
604 (includep '("-filter" "mhl.reply"))
606 (let ((draft (mh-read-draft "reply"
607 (expand-file-name "reply" mh-user-path)
609 (delete-other-windows)
612 (let ((to (mh-get-header-field "To:"))
613 (subject (mh-get-header-field "Subject:"))
614 (cc (mh-get-header-field "Cc:")))
615 (goto-char (point-min))
616 (mh-goto-header-end 1)
618 (not mh-reply-show-message-flag)
619 (mh-in-show-buffer (show-buffer)
620 (mh-display-msg message folder)))
621 (mh-add-msgs-to-seq message 'answered t)
622 (message "Composing a reply...done")
623 (mh-compose-and-send-mail draft "" folder message to subject cc
624 mh-note-repl "Replied:" config))
625 (when (and (or (eq 'autosupercite mh-yank-behavior)
626 (eq 'autoattrib mh-yank-behavior))
627 (eq (mh-show-buffer-message-number) mh-sent-from-msg))
630 (mh-letter-mode-message))))
633 (defun mh-send (to cc subject)
636 Your letter appears in an Emacs buffer whose mode is
637 MH-Letter (see `mh-letter-mode').
639 The arguments TO, CC, and SUBJECT can be used to prefill the
640 draft fields or suppress the prompts if `mh-compose-prompt-flag'
641 is on. They are also passed to the function set in the option
642 `mh-compose-letter-function'.
644 See also `mh-insert-x-mailer-flag' and `mh-letter-mode-hook'.
646 Outside of an MH-Folder buffer (`mh-folder-mode'), you must call
647 either \\[mh-smail] or \\[mh-smail-other-window] to compose a new
650 (mh-interactive-read-address "To: ")
651 (mh-interactive-read-address "Cc: ")
652 (mh-interactive-read-string "Subject: ")))
653 (let ((config (current-window-configuration)))
654 (delete-other-windows)
655 (mh-send-sub to cc subject config)))
658 (defun mh-send-other-window (to cc subject)
659 "Compose a message in another window.
661 See `mh-send' for more information and a description of how the
662 TO, CC, and SUBJECT arguments are used."
664 (mh-interactive-read-address "To: ")
665 (mh-interactive-read-address "Cc: ")
666 (mh-interactive-read-string "Subject: ")))
667 (let ((pop-up-windows t))
668 (mh-send-sub to cc subject (current-window-configuration))))
670 (defun mh-send-sub (to cc subject config)
671 "Do the real work of composing and sending a letter.
672 Expects the TO, CC, and SUBJECT fields as arguments.
673 CONFIG is the window configuration before sending mail."
674 (let ((folder mh-current-folder)
675 (msg-num (mh-get-msg-num nil)))
676 (message "Composing a message...")
677 (let ((draft (mh-read-draft
683 (expand-file-name mh-comp-formfile mh-user-path)))
687 (expand-file-name mh-comp-formfile mh-lib)))
691 (expand-file-name mh-comp-formfile
692 ;; What is this mh-etc ?? -sm
693 ;; This is dead code, so
695 ;(and (boundp 'mh-etc) mh-etc)
699 (error "Can't find components file \"%s\""
702 (mh-insert-fields "To:" to "Subject:" subject "Cc:" cc)
703 (goto-char (point-max))
704 (mh-compose-and-send-mail draft "" folder msg-num
707 (mh-letter-mode-message)
708 (mh-letter-adjust-point))))
710 (defun mh-read-draft (use initial-contents delete-contents-file)
711 "Read draft file into a draft buffer and make that buffer the current one.
713 USE is a message used for prompting about the intended use of the
715 INITIAL-CONTENTS is filename that is read into an empty buffer, or nil
716 if buffer should not be modified. Delete the initial-contents file if
717 DELETE-CONTENTS-FILE flag is set.
718 Returns the draft folder's name.
719 If the draft folder facility is enabled in ~/.mh_profile, a new buffer
720 is used each time and saved in the draft folder. The draft file can
722 (cond (mh-draft-folder
723 (let ((orig-default-dir default-directory)
724 (draft-file-name (mh-new-draft-name)))
725 (pop-to-buffer (generate-new-buffer
727 (file-name-nondirectory draft-file-name))))
729 (insert-file-contents draft-file-name t)
731 (setq default-directory orig-default-dir)))
733 (let ((draft-name (expand-file-name "draft" mh-user-path)))
734 (pop-to-buffer "draft") ; Create if necessary
735 (if (buffer-modified-p)
736 (if (y-or-n-p "Draft has been modified; kill anyway? ")
737 (set-buffer-modified-p nil)
738 (error "Draft preserved")))
739 (setq buffer-file-name draft-name)
740 (clear-visited-file-modtime)
742 (cond ((and (file-exists-p draft-name)
743 (not (equal draft-name initial-contents)))
744 (insert-file-contents draft-name)
745 (delete-file draft-name))))))
746 (cond ((and initial-contents
747 (or (zerop (buffer-size))
749 (format "A draft exists. Use for %s? " use))
750 (if mh-error-if-no-draft
751 (error "A prior draft exists"))
754 (insert-file-contents initial-contents)
755 (if delete-contents-file (delete-file initial-contents))))
758 (save-buffer)) ; Do not reuse draft name
761 (defun mh-new-draft-name ()
762 "Return the pathname of folder for draft messages."
764 (mh-exec-cmd-quiet t "mhpath" mh-draft-folder "new")
765 (buffer-substring (point-min) (1- (point-max)))))
767 (defun mh-annotate-msg (msg buffer note &rest args)
768 "Mark MSG in BUFFER with character NOTE and annotate message with ARGS.
769 MSG can be a message number, a list of message numbers, or a
771 (apply 'mh-exec-cmd "anno" buffer
772 (if (listp msg) (append msg args) (cons msg args)))
774 (cond ((get-buffer buffer) ; Buffer may be deleted
776 (mh-iterate-on-range nil msg
778 (+ mh-cmd-note mh-scan-field-destination-offset)))))))
780 (defun mh-insert-fields (&rest name-values)
781 "Insert the NAME-VALUES pairs in the current buffer.
782 If the field exists, append the value to it.
783 Do not insert any pairs whose value is the empty string."
784 (let ((case-fold-search t))
786 (let ((field-name (car name-values))
787 (value (car (cdr name-values))))
788 (if (not (string-match "^.*:$" field-name))
789 (setq field-name (concat field-name ":")))
790 (cond ((equal value "")
792 ((mh-position-on-field field-name)
793 (insert " " (or value "")))
795 (insert field-name " " value "\n")))
796 (setq name-values (cdr (cdr name-values)))))))
798 (defun mh-position-on-field (field &optional ignored)
799 "Move to the end of the FIELD in the header.
800 Move to end of entire header if FIELD not found.
801 Returns non-nil iff FIELD was found.
802 The optional second arg is for pre-version 4 compatibility and is
804 (cond ((mh-goto-header-field field)
805 (mh-header-field-end)
807 ((mh-goto-header-end 0)
811 (defun mh-get-header-field (field)
812 "Find and return the body of FIELD in the mail header.
813 Returns the empty string if the field is not in the header of the
815 (if (mh-goto-header-field field)
817 (skip-chars-forward " \t") ;strip leading white space in body
818 (let ((start (point)))
819 (mh-header-field-end)
820 (buffer-substring-no-properties start (point))))
823 (fset 'mh-get-field 'mh-get-header-field) ;MH-E 4 compatibility
825 (defun mh-goto-header-field (field)
826 "Move to FIELD in the message header.
827 Move to the end of the FIELD name, which should end in a colon.
828 Returns t if found, nil if not."
829 (goto-char (point-min))
830 (let ((case-fold-search t)
831 (headers-end (save-excursion
832 (mh-goto-header-end 0)
834 (re-search-forward (format "^%s" field) headers-end t)))
836 (defun mh-goto-header-end (arg)
837 "Move the cursor ARG lines after the header."
838 (if (re-search-forward "^-*$" nil nil)
841 (defun mh-extract-from-header-value ()
842 "Extract From: string from header."
844 (if (not (mh-goto-header-field "From:"))
846 (skip-chars-forward " \t")
847 (buffer-substring-no-properties
848 (point) (progn (mh-header-field-end)(point))))))
852 ;;; Mode for composing and sending a draft message.
854 (put 'mh-letter-mode 'mode-class 'special)
856 ;; Menu extracted from mh-menubar.el V1.1 (31 July 2001)
857 (eval-when-compile (defvar mh-letter-menu nil))
859 mh-letter-menu mh-letter-mode-map "Menu for MH-E letter mode."
861 ["Send This Draft" mh-send-letter t]
862 ["Split Current Line" mh-open-line t]
863 ["Check Recipient" mh-check-whom t]
864 ["Yank Current Message" mh-yank-cur-msg t]
865 ["Insert a Message..." mh-insert-letter t]
866 ["Insert Signature" mh-insert-signature t]
867 ("Encrypt/Sign Message"
869 mh-mml-secure-message-sign mh-pgp-support-flag]
871 mh-mml-secure-message-encrypt mh-pgp-support-flag]
872 ["Sign+Encrypt Message"
873 mh-mml-secure-message-signencrypt mh-pgp-support-flag]
875 mh-mml-unsecure-message mh-pgp-support-flag]
878 ["PGP (MIME)" (setq mh-mml-method-default "pgpmime")
880 :selected (equal mh-mml-method-default "pgpmime")]
881 ["PGP" (setq mh-mml-method-default "pgp")
883 :selected (equal mh-mml-method-default "pgp")]
884 ["S/MIME" (setq mh-mml-method-default "smime")
886 :selected (equal mh-mml-method-default "smime")]
888 ["Save Method as Default"
889 (customize-save-variable 'mh-mml-method-default mh-mml-method-default) t]
891 ["Compose Insertion..." mh-compose-insertion t]
892 ["Compose Compressed tar (MH)..."
893 mh-mh-compose-external-compressed-tar t]
894 ["Compose Get File (MH)..." mh-mh-compose-anon-ftp t]
895 ["Compose Forward..." mh-compose-forward t]
896 ;; The next two will have to be merged. But I also need to make sure the
897 ;; user can't mix tags of both types.
898 ["Pull in All Compositions (MH)"
899 mh-mh-to-mime (mh-mh-directive-present-p)]
900 ["Pull in All Compositions (MML)"
901 mh-mml-to-mime (mh-mml-tag-present-p)]
902 ["Revert to Non-MIME Edit (MH)"
903 mh-mh-to-mime-undo (equal mh-compose-insertion 'mh)]
904 ["Kill This Draft" mh-fully-kill-draft t]))
910 ;; Group messages logically, more or less.
911 (defvar mh-letter-mode-help-messages
913 "Send letter: \\[mh-send-letter]"
914 "\t\tOpen line: \\[mh-open-line]\n"
915 "Kill letter: \\[mh-fully-kill-draft]"
917 "Check recipients: \\[mh-check-whom]"
918 "\t\t Current message: \\[mh-yank-cur-msg]\n"
919 "\t\t Attachment: \\[mh-compose-insertion]\n"
920 "\t\t Message to forward: \\[mh-compose-forward]\n"
923 "\t\t Encrypt message: \\[mh-mml-secure-message-encrypt]"
924 "\t\t Sign+Encrypt message: \\[mh-mml-secure-message-signencrypt]"
925 "\t\t Sign message: \\[mh-mml-secure-message-sign]\n"
927 "\t\t Signature: \\[mh-insert-signature]"))
928 "Key binding cheat sheet.
930 This is an associative array which is used to show the most
931 common commands. The key is a prefix char. The value is one or
932 more strings which are concatenated together and displayed in the
933 minibuffer if ? is pressed after the prefix character. The
934 special key nil is used to display the non-prefixed commands.
936 The substitutions described in `substitute-command-keys' are
940 (defun mh-fill-paragraph-function (arg)
941 "Fill paragraph at or after point.
942 Prefix ARG means justify as well. This function enables
943 `fill-paragraph' to work better in MH-Letter mode (see
946 (let ((fill-paragraph-function) (fill-prefix))
948 (mail-mode-fill-paragraph arg)
949 (fill-paragraph arg))))
951 ;; Avoid compiler warnings in XEmacs and Emacs 20
953 (defvar tool-bar-mode)
954 (defvar tool-bar-map))
956 (defvar mh-letter-buttons-init-flag nil)
959 (define-derived-mode mh-letter-mode text-mode "MH-Letter"
960 "Mode for composing letters in MH-E\\<mh-letter-mode-map>.
962 When you have finished composing, type \\[mh-send-letter] to send
963 the message using the MH mail handling system.
965 There are two types of tags used by MH-E when composing MIME
966 messages: MML and MH. The option `mh-compose-insertion' controls
967 what type of tags are inserted by MH-E commands. These tags can
968 be converted to MIME body parts by running \\[mh-mh-to-mime] for
969 MH-style directives or \\[mh-mml-to-mime] for MML tags.
971 Options that control this mode can be changed with
972 \\[customize-group]; specify the \"mh-compose\" group.
974 When a message is composed, the hooks `text-mode-hook' and
975 `mh-letter-mode-hook' are run.
977 \\{mh-letter-mode-map}"
979 (make-local-variable 'mh-send-args)
980 (make-local-variable 'mh-annotate-char)
981 (make-local-variable 'mh-annotate-field)
982 (make-local-variable 'mh-previous-window-config)
983 (make-local-variable 'mh-sent-from-folder)
984 (make-local-variable 'mh-sent-from-msg)
986 (unless mh-letter-buttons-init-flag
987 (mh-tool-bar-letter-buttons-init)
988 (setq mh-letter-buttons-init-flag t)))
989 ;; Set the local value of mh-mail-header-separator according to what is
990 ;; present in the buffer...
991 (set (make-local-variable 'mh-mail-header-separator)
993 (goto-char (mh-mail-header-end))
994 (buffer-substring-no-properties (point) (line-end-position))))
995 (make-local-variable 'mail-header-separator)
996 (setq mail-header-separator mh-mail-header-separator) ;override sendmail.el
997 (make-local-variable 'mh-help-messages)
998 (setq mh-help-messages mh-letter-mode-help-messages)
999 (setq buffer-invisibility-spec '((vanish . t) t))
1000 (set (make-local-variable 'line-move-ignore-invisible) t)
1002 ;; From sendmail.el for proper paragraph fill
1003 ;; sendmail.el also sets a normal-auto-fill-function (not done here)
1004 (make-local-variable 'paragraph-separate)
1005 (make-local-variable 'paragraph-start)
1006 (make-local-variable 'fill-paragraph-function)
1007 (setq fill-paragraph-function 'mh-fill-paragraph-function)
1008 (make-local-variable 'adaptive-fill-regexp)
1009 (setq adaptive-fill-regexp
1010 (concat adaptive-fill-regexp
1011 "\\|[ \t]*[-[:alnum:]]*>+[ \t]*"))
1012 (make-local-variable 'adaptive-fill-first-line-regexp)
1013 (setq adaptive-fill-first-line-regexp
1014 (concat adaptive-fill-first-line-regexp
1015 "\\|[ \t]*[-[:alnum:]]*>+[ \t]*"))
1016 ;; `-- ' precedes the signature. `-----' appears at the start of the
1017 ;; lines that delimit forwarded messages.
1018 ;; Lines containing just >= 3 dashes, perhaps after whitespace,
1019 ;; are also sometimes used and should be separators.
1020 (setq paragraph-start (concat (regexp-quote mail-header-separator)
1021 "\\|\t*\\([-|#;>* ]\\|(?[0-9]+[.)]\\)+$"
1022 "\\|[ \t]*[[:alnum:]]*>+[ \t]*$\\|[ \t]*$\\|"
1025 (setq paragraph-separate paragraph-start)
1026 ;; --- End of code from sendmail.el ---
1028 ;; Enable undo since a show-mode buffer might have been reused.
1029 (buffer-enable-undo)
1030 (set (make-local-variable 'tool-bar-map) mh-letter-tool-bar-map)
1031 (mh-funcall-if-exists mh-tool-bar-init :letter)
1032 (make-local-variable 'font-lock-defaults)
1034 ((or (equal mh-highlight-citation-style 'font-lock)
1035 (equal mh-highlight-citation-style 'gnus))
1036 ;; Let's use font-lock even if gnus is used in show-mode. The reason
1037 ;; is that gnus uses static text properties which are not appropriate
1038 ;; for a buffer that will be edited. So the choice here is either fontify
1039 ;; the citations and header...
1040 (setq font-lock-defaults '(mh-letter-font-lock-keywords t)))
1042 ;; ...or the header only
1043 (setq font-lock-defaults '(mh-show-font-lock-keywords t))))
1044 (easy-menu-add mh-letter-menu)
1045 (setq fill-column mh-letter-fill-column)
1046 ;; If text-mode-hook turned on auto-fill, tune it for messages
1047 (when auto-fill-function
1048 (make-local-variable 'auto-fill-function)
1049 (setq auto-fill-function 'mh-auto-fill-for-letter)))
1051 (defun mh-font-lock-field-data (limit)
1052 "Find header field region between point and LIMIT."
1053 (and (< (point) (mh-letter-header-end))
1055 (let ((end (min limit (mh-letter-header-end)))
1057 data-end data-begin field)
1059 (setq data-end (if (re-search-forward "^[^ \t]" end t)
1062 (goto-char (1- data-end))
1063 (if (not (re-search-backward "\\(^[^ \t][^:]*\\):[ \t]*" nil t))
1064 (setq data-begin (point-min))
1065 (setq data-begin (match-end 0))
1066 (setq field (match-string 1)))
1067 (setq data-begin (max point data-begin))
1068 (goto-char (if (equal point data-end) (1+ data-end) data-end))
1069 (cond ((and field (mh-letter-skipped-header-field-p field))
1070 (set-match-data nil)
1073 (list data-begin data-end data-begin data-end))
1076 (defun mh-letter-header-end ()
1077 "Find the end of the message header.
1078 This function is to be used only for font locking. It works by
1079 searching for `mh-mail-header-separator' in the buffer."
1081 (goto-char (point-min))
1082 (cond ((equal mh-mail-header-separator "") (point-min))
1083 ((search-forward (format "\n%s\n" mh-mail-header-separator) nil t)
1084 (line-beginning-position 0))
1087 (defun mh-auto-fill-for-letter ()
1088 "Perform auto-fill for message.
1089 Header is treated specially by inserting a tab before continuation
1091 (if (mh-in-header-p)
1092 (let ((fill-prefix "\t"))
1096 (defun mh-insert-header-separator ()
1097 "Insert `mh-mail-header-separator', if absent."
1099 (goto-char (point-min))
1101 (if (looking-at "$")
1102 (insert mh-mail-header-separator))))
1105 (defun mh-to-field ()
1106 "Move to specified header field.
1107 The field is indicated by the previous keystroke (the last keystroke
1108 of the command) according to the list in the variable
1109 `mh-to-field-choices'. Create the field if it does not exist. Set the
1110 mark to point before moving."
1113 (let ((target (cdr (or (assoc (char-to-string (logior last-input-char ?`))
1114 mh-to-field-choices)
1115 ;; also look for a char for version 4 compat
1116 (assoc (logior last-input-char ?`)
1117 mh-to-field-choices))))
1118 (case-fold-search t))
1120 (cond ((mh-position-on-field target)
1121 (let ((eol (point)))
1122 (skip-chars-backward " \t")
1123 (delete-region (point) eol))
1124 (if (and (not (eq (logior last-input-char ?`) ?s))
1127 (not (looking-at "[:,]"))))
1131 (if (mh-position-on-field "To:")
1133 (insert (format "%s \n" target))
1134 (backward-char 1)))))
1137 (defun mh-to-fcc (&optional folder)
1138 "Move to \"Fcc:\" header field.
1139 This command will prompt you for the FOLDER name in which to file a
1143 (setq folder (mh-prompt-for-folder
1145 (or (and mh-default-folder-for-message-function
1147 (goto-char (point-min))
1149 mh-default-folder-for-message-function)))
1152 (let ((last-input-char ?\C-f))
1156 (insert (if (mh-folder-name-p folder)
1157 (substring folder 1)
1160 (defun mh-file-is-vcard-p (file)
1161 "Return t if FILE is a .vcf vcard."
1162 (let ((case-fold-search t))
1164 (file-exists-p file)
1165 (or (and (not (mh-have-file-command))
1166 (not (null (string-match "\.vcf$" file))))
1167 (and (mh-have-file-command)
1168 (string-equal "text/x-vcard" (mh-file-mime-type file)))))))
1171 (defun mh-insert-signature (&optional file)
1172 "Insert signature in message.
1174 This command inserts your signature at the current cursor location.
1176 By default, the text of your signature is taken from the file
1177 \"~/.signature\". You can read from other sources by changing the
1178 option `mh-signature-file-name'.
1180 A signature separator (\"-- \") will be added if the signature block
1181 does not contain one and `mh-signature-separator-flag' is on.
1183 The hook `mh-insert-signature-hook' is run after the signature is
1184 inserted. Hook functions may access the actual name of the file or the
1185 function used to insert the signature with `mh-signature-file-name'.
1187 The signature can also be inserted using Identities (see
1188 `mh-identity-list').
1190 In a program, you can pass in a signature FILE."
1194 (let ((mh-signature-file-name (or file mh-signature-file-name))
1195 (mh-mh-p (mh-mh-directive-present-p))
1196 (mh-mml-p (mh-mml-tag-present-p)))
1198 (narrow-to-region (point) (point))
1200 ((mh-file-is-vcard-p mh-signature-file-name)
1201 (if (equal mh-compose-insertion 'mml)
1202 (insert "<#part type=\"text/x-vcard\" filename=\""
1203 mh-signature-file-name
1204 "\" disposition=inline description=VCard>\n<#/part>")
1205 (insert "#text/x-vcard; name=\""
1206 (file-name-nondirectory mh-signature-file-name)
1207 "\" [VCard] " (expand-file-name mh-signature-file-name))))
1211 (insert "#\n" "Content-Description: Signature\n"))
1213 (mml-insert-tag 'part 'type "text/plain" 'disposition "inline"
1214 'description "Signature")))
1215 (cond ((null mh-signature-file-name))
1216 ((and (stringp mh-signature-file-name)
1217 (file-readable-p mh-signature-file-name))
1218 (insert-file-contents mh-signature-file-name))
1219 ((functionp mh-signature-file-name)
1220 (funcall mh-signature-file-name)))))
1223 (run-hooks 'mh-insert-signature-hook))
1224 (goto-char (point-min))
1225 (when (and (not (mh-file-is-vcard-p mh-signature-file-name))
1226 mh-signature-separator-flag
1227 (> (point-max) (point-min))
1228 (not (mh-signature-separator-p)))
1233 (insert mh-signature-separator))
1234 (if (not (> (point-max) (point-min)))
1235 (message "No signature found")))))
1236 (force-mode-line-update))
1239 (defun mh-check-whom ()
1240 "Verify recipients, showing expansion of any aliases.
1242 This command expands aliases so you can check the actual address(es)
1243 in the alias. A new buffer named \"*MH-E Recipients*\" is created with
1244 the output of \"whom\"."
1246 (let ((file-name buffer-file-name))
1248 (message "Checking recipients...")
1249 (mh-in-show-buffer (mh-recipients-buffer)
1250 (bury-buffer (current-buffer))
1252 (mh-exec-cmd-output "whom" t file-name))
1253 (message "Checking recipients...done")))
1255 (defun mh-tidy-draft-buffer ()
1256 "Run when a draft buffer is destroyed."
1257 (let ((buffer (get-buffer mh-recipients-buffer)))
1259 (kill-buffer buffer))))
1263 ;;; Routines to compose and send a letter.
1265 (defun mh-insert-x-face ()
1266 "Append X-Face, Face or X-Image-URL field to header.
1267 If the field already exists, this function does nothing."
1268 (when (and (file-exists-p mh-x-face-file)
1269 (file-readable-p mh-x-face-file))
1271 (unless (or (mh-position-on-field "X-Face")
1272 (mh-position-on-field "Face")
1273 (mh-position-on-field "X-Image-URL"))
1275 (goto-char (+ (point) (cadr (insert-file-contents mh-x-face-file))))
1276 (if (not (looking-at "^"))
1278 (unless (looking-at "\\(X-Face\\|Face\\|X-Image-URL\\): ")
1279 (insert "X-Face: "))))))
1281 (defvar mh-x-mailer-string nil
1282 "*String containing the contents of the X-Mailer header field.
1283 If nil, this variable is initialized to show the version of MH-E,
1284 Emacs, and MH the first time a message is composed.")
1286 (defun mh-insert-x-mailer ()
1287 "Append an X-Mailer field to the header.
1288 The versions of MH-E, Emacs, and MH are shown."
1289 ;; Lazily initialize mh-x-mailer-string.
1290 (when (and mh-insert-x-mailer-flag (null mh-x-mailer-string))
1291 (setq mh-x-mailer-string
1292 (format "MH-E %s; %s; %sEmacs %s"
1293 mh-version mh-variant-in-use
1294 (if mh-xemacs-flag "X" "GNU ")
1295 (cond ((not mh-xemacs-flag) emacs-version)
1296 ((string-match "[0-9.]*\\( +\([ a-z]+[0-9]+\)\\)?"
1298 (match-string 0 emacs-version))
1299 (t (format "%s.%s" emacs-major-version
1300 emacs-minor-version))))))
1301 ;; Insert X-Mailer, but only if it doesn't already exist.
1303 (when (and mh-insert-x-mailer-flag
1304 (null (mh-goto-header-field "X-Mailer")))
1305 (mh-insert-fields "X-Mailer:" mh-x-mailer-string))))
1307 (defun mh-regexp-in-field-p (regexp &rest fields)
1308 "Non-nil means REGEXP was found in FIELDS."
1310 (let ((search-result nil)
1313 (setq field (car fields))
1314 (if (and (mh-goto-header-field field)
1316 regexp (save-excursion (mh-header-field-end)(point)) t))
1319 (setq fields (cdr fields))))
1323 (defun mh-insert-auto-fields (&optional non-interactive)
1324 "Insert custom fields if recipient is found in `mh-auto-fields-list'.
1326 Sets buffer-local `mh-insert-auto-fields-done-local' when done
1327 and inserted something. If NON-INTERACTIVE is non-nil, do not be
1328 verbose and only attempt matches if
1329 `mh-insert-auto-fields-done-local' is nil.
1331 An `identity' entry is skipped if one was already entered
1334 Return t if fields added; otherwise return nil."
1336 (when (or (not non-interactive)
1337 (not mh-insert-auto-fields-done-local))
1339 (when (and (or (mh-goto-header-field "To:")
1340 (mh-goto-header-field "cc:")))
1341 (let ((list mh-auto-fields-list)
1342 (fields-inserted nil))
1344 (let ((regexp (nth 0 (car list)))
1345 (entries (nth 1 (car list))))
1346 (when (mh-regexp-in-field-p regexp "To:" "cc:")
1347 (setq mh-insert-auto-fields-done-local t)
1348 (setq fields-inserted t)
1349 (if (not non-interactive)
1350 (message "Fields for %s added" regexp))
1351 (let ((entry-list entries))
1353 (let ((field (caar entry-list))
1354 (value (cdar entry-list)))
1356 ((equal ":identity" field)
1357 (when ;;(and (not mh-identity-local)
1358 ;; Bug 1204506. But do we need to be able
1359 ;; to set an identity manually that won't be
1360 ;; overridden by mh-insert-auto-fields?
1361 (assoc value mh-identity-list)
1363 (mh-insert-identity value)))
1365 (mh-modify-header-field field value
1366 (equal field "From")))))
1367 (setq entry-list (cdr entry-list))))))
1368 (setq list (cdr list)))
1369 fields-inserted)))))
1371 (defun mh-modify-header-field (field value &optional overwrite-flag)
1372 "To header FIELD add VALUE.
1373 If OVERWRITE-FLAG is non-nil then the old value, if present, is
1375 (cond ((and overwrite-flag
1376 (mh-goto-header-field (concat field ":")))
1378 (delete-region (point) (line-end-position)))
1379 ((and (not overwrite-flag)
1380 (mh-regexp-in-field-p (concat "\\b" value "\\b") field))
1381 ;; Already there, do nothing.
1383 ((and (not overwrite-flag)
1384 (mh-goto-header-field (concat field ":")))
1385 (insert " " value ","))
1387 (mh-goto-header-end 0)
1388 (insert field ": " value "\n"))))
1390 (defun mh-compose-and-send-mail (draft send-args
1391 sent-from-folder sent-from-msg
1393 annotate-char annotate-field
1395 "Edit and compose a draft message in buffer DRAFT and send or save it.
1396 SEND-ARGS is the argument passed to the send command.
1397 SENT-FROM-FOLDER is buffer containing scan listing of current folder,
1398 or nil if none exists.
1399 SENT-FROM-MSG is the message number or sequence name or nil.
1400 The TO, SUBJECT, and CC fields are passed to the
1401 `mh-compose-letter-function'.
1402 If ANNOTATE-CHAR is non-null, it is used to notate the scan listing of
1403 the message. In that case, the ANNOTATE-FIELD is used to build a
1404 string for `mh-annotate-msg'.
1405 CONFIG is the window configuration to restore after sending the
1407 (pop-to-buffer draft)
1411 (if (and (boundp 'mh-identity-default)
1413 (not mh-identity-local))
1414 (mh-insert-identity mh-identity-default))
1415 (mh-identity-make-menu)
1416 (easy-menu-add mh-identity-menu)
1418 ;; Insert extra fields.
1419 (mh-insert-x-mailer)
1422 (mh-letter-hide-all-skipped-fields)
1424 (setq mh-sent-from-folder sent-from-folder)
1425 (setq mh-sent-from-msg sent-from-msg)
1426 (setq mh-send-args send-args)
1427 (setq mh-annotate-char annotate-char)
1428 (setq mh-annotate-field annotate-field)
1429 (setq mh-previous-window-config config)
1430 (setq mode-line-buffer-identification (list " {%b}"))
1432 (mh-make-local-hook 'kill-buffer-hook)
1433 (add-hook 'kill-buffer-hook 'mh-tidy-draft-buffer nil t)
1434 (if (and (boundp 'mh-compose-letter-function)
1435 mh-compose-letter-function)
1436 ;; run-hooks will not pass arguments.
1437 (let ((value mh-compose-letter-function))
1438 (if (and (listp value) (not (eq (car value) 'lambda)))
1440 (funcall (car value) to subject cc)
1441 (setq value (cdr value)))
1442 (funcall mh-compose-letter-function to subject cc)))))
1444 (defun mh-letter-mode-message ()
1445 "Display a help message for users of `mh-letter-mode'.
1446 This should be the last function called when composing the draft."
1447 (message "%s" (substitute-command-keys
1448 (concat "Type \\[mh-send-letter] to send message, "
1449 "\\[mh-help] for help"))))
1451 (defun mh-ascii-buffer-p ()
1452 "Check if current buffer is entirely composed of ASCII.
1453 The function doesn't work for XEmacs since `find-charset-region'
1454 doesn't exist there."
1455 (loop for charset in (mh-funcall-if-exists
1456 find-charset-region (point-min) (point-max))
1457 unless (eq charset 'ascii) return nil
1461 (defun mh-send-letter (&optional arg)
1462 "Save draft and send message.
1464 When you are all through editing a message, you send it with this
1465 command. You can give a prefix argument ARG to monitor the first stage
1466 of the delivery\; this output can be found in a buffer called \"*MH-E
1469 The hook `mh-before-send-letter-hook' is run at the beginning of the
1470 this command. For example, if you want to check your spelling in your
1471 message before sending, add the `ispell-message' function.
1473 In case the MH \"send\" program is installed under a different name,
1474 use `mh-send-prog' to tell MH-E the name."
1476 (run-hooks 'mh-before-send-letter-hook)
1477 (if (and (mh-insert-auto-fields t)
1478 mh-auto-fields-prompt-flag
1479 (goto-char (point-min)))
1480 (if (not (y-or-n-p "Auto fields inserted, send? "))
1481 (error "Send aborted")))
1482 (cond ((mh-mh-directive-present-p)
1484 ((or (mh-mml-tag-present-p) (not (mh-ascii-buffer-p)))
1487 (message "Sending...")
1488 (let ((draft-buffer (current-buffer))
1489 (file-name buffer-file-name)
1490 (config mh-previous-window-config)
1491 (coding-system-for-write
1492 (if (and (local-variable-p 'buffer-file-coding-system
1493 (current-buffer)) ;XEmacs needs two args
1494 ;; We're not sure why, but buffer-file-coding-system
1495 ;; tends to get set to undecided-unix.
1496 (not (memq buffer-file-coding-system
1497 '(undecided undecided-unix undecided-dos))))
1498 buffer-file-coding-system
1499 (or (and (boundp 'sendmail-coding-system) sendmail-coding-system)
1500 (and (boundp 'default-buffer-file-coding-system )
1501 default-buffer-file-coding-system)
1503 ;; The default BCC encapsulation will make a MIME message unreadable.
1504 ;; With nmh use the -mime arg to prevent this.
1505 (if (and (mh-variant-p 'nmh)
1506 (mh-goto-header-field "Bcc:")
1507 (mh-goto-header-field "Content-Type:"))
1508 (setq mh-send-args (format "-mime %s" mh-send-args)))
1510 (pop-to-buffer mh-mail-delivery-buffer)
1512 (mh-exec-cmd-output mh-send-prog t "-watch" "-nopush"
1513 "-nodraftfolder" mh-send-args file-name)
1514 (goto-char (point-max)) ; show the interesting part
1516 (set-buffer draft-buffer)) ; for annotation below
1518 (mh-exec-cmd-daemon mh-send-prog nil "-nodraftfolder" "-noverbose"
1519 mh-send-args file-name)))
1520 (if mh-annotate-char
1521 (mh-annotate-msg mh-sent-from-msg
1524 "-component" mh-annotate-field
1525 "-text" (format "\"%s %s\""
1526 (mh-get-header-field "To:")
1527 (mh-get-header-field "Cc:"))))
1529 (cond ((or (not arg)
1530 (y-or-n-p "Kill draft buffer? "))
1531 (kill-buffer draft-buffer)
1533 (set-window-configuration config))))
1535 (message "Sending...done")
1536 (message "Sending...backgrounded"))))
1539 (defun mh-insert-letter (folder message verbatim)
1542 This command prompts you for the FOLDER and MESSAGE number and inserts
1543 the message, indented by `mh-ins-buf-prefix' (\"> \") unless
1544 `mh-yank-behavior' is set to one of the supercite flavors in which
1545 case supercite is used to format the message. Certain undesirable
1546 header fields (see `mh-invisible-header-fields-compiled') are removed
1549 If given a prefix argument VERBATIM, the header is left intact, the
1550 message is not indented, and \"> \" is not inserted before each line.
1551 This command leaves the mark before the letter and point after it."
1553 (list (mh-prompt-for-folder "Message from" mh-sent-from-folder nil)
1554 (read-string (concat "Message number"
1555 (if (numberp mh-sent-from-msg)
1556 (format " (default %d): " mh-sent-from-msg)
1558 current-prefix-arg))
1560 (narrow-to-region (point) (point))
1561 (let ((start (point-min)))
1562 (if (and (equal message "") (numberp mh-sent-from-msg))
1563 (setq message (int-to-string mh-sent-from-msg)))
1564 (insert-file-contents
1565 (expand-file-name message (mh-expand-file-name folder)))
1566 (when (not verbatim)
1567 (mh-clean-msg-header start mh-invisible-header-fields-compiled nil)
1568 (goto-char (point-max)) ;Needed for sc-cite-original
1569 (push-mark) ;Needed for sc-cite-original
1570 (goto-char (point-min)) ;Needed for sc-cite-original
1571 (mh-insert-prefix-string mh-ins-buf-prefix)))))
1573 (defun mh-extract-from-attribution ()
1574 "Extract phrase or comment from From header field."
1576 (if (not (mh-goto-header-field "From: "))
1578 (skip-chars-forward " ")
1580 ((looking-at "\"\\([^\"\n]+\\)\" \\(<.+>\\)")
1581 (format "%s %s " (match-string 1)(match-string 2)))
1582 ((looking-at "\\([^<\n]+<.+>\\)$")
1583 (format "%s " (match-string 1)))
1584 ((looking-at "\\([^ ]+@[^ ]+\\) +(\\(.+\\))$")
1585 (format "%s <%s> " (match-string 2)(match-string 1)))
1586 ((looking-at " *\\(.+\\)$")
1587 (format "%s " (match-string 1)))))))
1590 (defun mh-yank-cur-msg ()
1591 "Insert the current message into the draft buffer.
1593 It is often useful to insert a snippet of text from a letter that
1594 someone mailed to provide some context for your reply. This
1595 command does this by adding an attribution, yanking a portion of
1596 text from the message to which you're replying, and inserting
1597 `mh-ins-buf-prefix' (`> ') before each line.
1599 The attribution consists of the sender's name and email address
1600 followed by the content of the `mh-extract-from-attribution-verb'
1603 You can also turn on the `mh-delete-yanked-msg-window-flag'
1604 option to delete the window containing the original message after
1605 yanking it to make more room on your screen for your reply.
1607 You can control how the message to which you are replying is
1608 yanked into your reply using `mh-yank-behavior'.
1610 If this isn't enough, you can gain full control over the
1611 appearance of the included text by setting `mail-citation-hook'
1612 to a function that modifies it. For example, if you set this hook
1613 to `trivial-cite' \(which is NOT part of Emacs), set
1614 `mh-yank-behavior' to \"Body and Header\" (see URL
1615 `http://shasta.cs.uiuc.edu/~lrclause/tc.html').
1617 Note that if `mail-citation-hook' is set, `mh-ins-buf-prefix' is
1618 not inserted. If the option `mh-yank-behavior' is set to one of
1619 the supercite flavors, the hook `mail-citation-hook' is ignored
1620 and `mh-ins-buf-prefix' is not inserted."
1622 (if (and mh-sent-from-folder
1623 (save-excursion (set-buffer mh-sent-from-folder) mh-show-buffer)
1624 (save-excursion (set-buffer mh-sent-from-folder)
1625 (get-buffer mh-show-buffer))
1627 (let ((to-point (point))
1628 (to-buffer (current-buffer)))
1629 (set-buffer mh-sent-from-folder)
1630 (if mh-delete-yanked-msg-window-flag
1631 (delete-windows-on mh-show-buffer))
1632 (set-buffer mh-show-buffer) ; Find displayed message
1633 (let* ((from-attr (mh-extract-from-attribution))
1634 (yank-region (mh-mark-active-p nil))
1636 (cond ((and yank-region
1637 (or (eq 'supercite mh-yank-behavior)
1638 (eq 'autosupercite mh-yank-behavior)
1639 (eq t mh-yank-behavior)))
1640 ;; supercite needs the full header
1642 (buffer-substring (point-min) (mh-mail-header-end))
1644 (buffer-substring (region-beginning) (region-end))))
1646 (buffer-substring (region-beginning) (region-end)))
1647 ((or (eq 'body mh-yank-behavior)
1648 (eq 'attribution mh-yank-behavior)
1649 (eq 'autoattrib mh-yank-behavior))
1652 (goto-char (point-min))
1653 (mh-goto-header-end 1)
1656 ((or (eq 'supercite mh-yank-behavior)
1657 (eq 'autosupercite mh-yank-behavior)
1658 (eq t mh-yank-behavior))
1659 (buffer-substring (point-min) (point-max)))
1661 (buffer-substring (point) (point-max))))))
1662 (set-buffer to-buffer)
1664 (narrow-to-region to-point to-point)
1665 (insert (mh-filter-out-non-text mh-ins-str))
1666 (goto-char (point-max)) ;Needed for sc-cite-original
1667 (push-mark) ;Needed for sc-cite-original
1668 (goto-char (point-min)) ;Needed for sc-cite-original
1669 (mh-insert-prefix-string mh-ins-buf-prefix)
1670 (when (or (eq 'attribution mh-yank-behavior)
1671 (eq 'autoattrib mh-yank-behavior))
1673 (mh-identity-insert-attribution-verb nil)
1675 ;; If the user has selected a region, he has already "edited" the
1676 ;; text, so leave the cursor at the end of the yanked text. In
1677 ;; either case, leave a mark at the opposite end of the included
1678 ;; text to make it easy to jump or delete to the other end of the
1681 (goto-char (point-max))
1682 (if (null yank-region)
1683 (mh-exchange-point-and-mark-preserving-active-mark)))))
1684 (error "There is no current message")))
1686 (defun mh-filter-out-non-text (string)
1687 "Return STRING but without adornments such as MIME buttons and smileys."
1689 ;; Insert the string to filter
1691 (goto-char (point-min))
1693 ;; Remove the MIME buttons
1694 (let ((can-move-forward t)
1696 (while can-move-forward
1697 (cond ((and (not (get-text-property (point) 'mh-data))
1699 (delete-region (1- (point)) (point))
1700 (setq in-button nil))
1701 ((get-text-property (point) 'mh-data)
1702 (delete-region (point)
1703 (save-excursion (forward-line) (point)))
1705 (t (setq can-move-forward (= (forward-line) 0))))))
1707 ;; Return the contents without properties... This gets rid of emphasis
1709 (buffer-substring-no-properties (point-min) (point-max))))
1711 (defun mh-insert-prefix-string (mh-ins-string)
1712 "Insert prefix string before each line in buffer.
1713 The inserted letter is cited using `sc-cite-original' if
1714 `mh-yank-behavior' is one of 'supercite or 'autosupercite.
1715 Otherwise, simply insert MH-INS-STRING before each line."
1716 (goto-char (point-min))
1717 (cond ((or (eq mh-yank-behavior 'supercite)
1718 (eq mh-yank-behavior 'autosupercite))
1721 (run-hooks 'mail-citation-hook))
1722 (mh-yank-hooks ;old hook name
1723 (run-hooks 'mh-yank-hooks))
1725 (or (bolp) (forward-line 1))
1726 (while (< (point) (point-max))
1727 (insert mh-ins-string)
1729 (goto-char (point-min))))) ;leave point like sc-cite-original
1732 (defun mh-fully-kill-draft ()
1733 "Quit editing and delete draft message.
1734 If for some reason you are not happy with the draft, you can use
1735 the this command to kill the draft buffer and delete the draft
1736 message. Use the \\[kill-buffer] command if you don't want to
1737 delete the draft message."
1739 (if (y-or-n-p "Kill draft message? ")
1740 (let ((config mh-previous-window-config))
1741 (if (file-exists-p buffer-file-name)
1742 (delete-file buffer-file-name))
1743 (set-buffer-modified-p nil)
1744 (kill-buffer (buffer-name))
1747 (set-window-configuration config)))
1748 (error "Message not killed")))
1750 (defun mh-current-fill-prefix ()
1751 "Return the `fill-prefix' on the current line as a string."
1754 ;; This assumes that the major-mode sets up adaptive-fill-regexp
1755 ;; correctly such as mh-letter-mode or sendmail.el's mail-mode. But
1756 ;; perhaps I should use the variable and simply inserts its value here,
1757 ;; and set it locally in a let scope. --psg
1758 (if (re-search-forward adaptive-fill-regexp nil t)
1763 (defun mh-open-line ()
1764 "Insert a newline and leave point after it.
1766 This command is similar to the \\[open-line] command in that it
1767 inserts a newline after point. It differs in that it also inserts
1768 the right number of quoting characters and spaces so that the
1769 next line begins in the same column as it was. This is useful
1770 when breaking up paragraphs in replies."
1772 (let ((column (current-column))
1773 (prefix (mh-current-fill-prefix)))
1774 (if (> (length prefix) column)
1775 (message "Sorry, point seems to be within the line prefix")
1778 (while (> column (current-column))
1780 (forward-line -1))))
1782 (mh-do-in-xemacs (defvar mail-abbrevs))
1784 (defmacro mh-display-completion-list-compat (word choices)
1785 "Completes WORD from CHOICES using `display-completion-list'.
1786 Calls `display-completion-list' correctly in older environments.
1787 Versions of Emacs prior to version 22 lacked a COMMON-SUBSTRING
1788 argument which is used to highlight the next possible character you
1789 can enter in the current list of completions."
1790 (if (>= emacs-major-version 22)
1791 `(display-completion-list (all-completions ,word ,choices) ,word)
1792 `(display-completion-list (all-completions ,word ,choices))))
1795 (defun mh-complete-word (word choices begin end)
1796 "Complete WORD at from CHOICES.
1797 Any match found replaces the text from BEGIN to END."
1798 (let ((completion (try-completion word choices))
1799 (completions-buffer "*Completions*"))
1800 (cond ((eq completion t)
1802 (kill-buffer completions-buffer))
1803 (message "Completed: %s" word))
1806 (kill-buffer completions-buffer))
1807 (message "No completion for `%s'" word))
1808 ((stringp completion)
1809 (if (equal word completion)
1810 (with-output-to-temp-buffer completions-buffer
1811 (mh-display-completion-list-compat word choices))
1813 (kill-buffer completions-buffer))
1814 (delete-region begin end)
1815 (insert completion))))))
1818 (defun mh-beginning-of-word (&optional n)
1819 "Return position of the N th word backwards."
1820 (unless n (setq n 1))
1821 (let ((syntax-table (syntax-table)))
1824 (mh-mail-abbrev-make-syntax-table)
1825 (set-syntax-table mail-abbrev-syntax-table)
1828 (set-syntax-table syntax-table))))
1830 (defun mh-folder-expand-at-point ()
1831 "Do folder name completion in Fcc header field."
1832 (let* ((end (point))
1833 (beg (mh-beginning-of-word))
1834 (folder (buffer-substring beg end))
1835 (leading-plus (and (> (length folder) 0) (equal (aref folder 0) ?+)))
1836 (last-slash (mh-search-from-end ?/ folder))
1837 (prefix (and last-slash (substring folder 0 last-slash)))
1838 (choices (mapcar #'(lambda (x)
1839 (list (cond (prefix (format "%s/%s" prefix x))
1840 (leading-plus (format "+%s" x))
1842 (mh-folder-completion-function folder nil t))))
1843 (mh-complete-word folder choices beg end)))
1845 (defvar mh-letter-complete-function-alist
1846 '((cc . mh-alias-letter-expand-alias)
1847 (bcc . mh-alias-letter-expand-alias)
1848 (dcc . mh-alias-letter-expand-alias)
1849 (fcc . mh-folder-expand-at-point)
1850 (from . mh-alias-letter-expand-alias)
1851 (mail-followup-to . mh-alias-letter-expand-alias)
1852 (reply-to . mh-alias-letter-expand-alias)
1853 (to . mh-alias-letter-expand-alias))
1854 "Alist of header fields and completion functions to use.")
1856 (defun mh-letter-complete (arg)
1857 "Perform completion on header field or word preceding point.
1858 If the field contains addresses (for example, \"To:\" or \"Cc:\")
1859 or folders \(for example, \"Fcc:\") then this command will
1860 provide alias completion. In the body of the message, this
1861 command runs `mh-letter-complete-function' instead, which is set
1862 to \"'ispell-complete-word\" by default. This command takes a
1863 prefix argument ARG that is passed to the
1864 `mh-letter-complete-function'."
1867 (cond ((not (mh-in-header-p))
1868 (funcall mh-letter-complete-function arg))
1869 ((setq func (cdr (assoc (mh-letter-header-field-at-point)
1870 mh-letter-complete-function-alist)))
1872 (t (funcall mh-letter-complete-function arg)))))
1874 (defun mh-letter-complete-or-space (arg)
1875 "Perform completion or insert space.
1876 Turn on the `mh-compose-space-does-completion-flag' option to use
1877 this command to perform completion in the header. Otherwise, a
1880 ARG is the number of spaces inserted."
1883 (end-of-prev (save-excursion
1884 (goto-char (mh-beginning-of-word))
1885 (mh-beginning-of-word -1))))
1886 (cond ((not mh-compose-space-does-completion-flag)
1887 (self-insert-command arg))
1888 ((not (mh-in-header-p)) (self-insert-command arg))
1889 ((> (point) end-of-prev) (self-insert-command arg))
1890 ((setq func (cdr (assoc (mh-letter-header-field-at-point)
1891 mh-letter-complete-function-alist)))
1893 (t (self-insert-command arg)))))
1895 (defun mh-letter-confirm-address ()
1896 "Flash alias expansion.
1897 Addresses are separated by a comma\; and when you press the
1898 comma, this command flashes the alias expansion in the minibuffer
1899 if `mh-alias-flash-on-comma' is turned on."
1901 (cond ((not (mh-in-header-p)) (self-insert-command 1))
1902 ((eq (cdr (assoc (mh-letter-header-field-at-point)
1903 mh-letter-complete-function-alist))
1904 'mh-alias-letter-expand-alias)
1905 (mh-alias-reload-maybe)
1906 (mh-alias-minibuffer-confirm-address))
1907 (t (self-insert-command 1))))
1909 (defvar mh-letter-header-field-regexp "^\\([A-Za-z][A-Za-z0-9-]*\\):")
1911 (defun mh-letter-header-field-at-point ()
1912 "Return the header field name at point.
1913 A symbol is returned whose name is the string obtained by
1914 downcasing the field name."
1917 (and (re-search-backward mh-letter-header-field-regexp nil t)
1918 (intern (downcase (match-string 1))))))
1921 (defun mh-letter-next-header-field-or-indent (arg)
1922 "Move to next field or indent depending on point.
1923 Within the header of the message, this command moves between
1924 fields, but skips those fields listed in
1925 `mh-compose-skipped-header-fields'. After the last field, this
1926 command then moves point to the message body before cycling back
1927 to the first field. If point is already past the first line of
1928 the message body, then this command indents by calling
1929 `indent-relative' with the given prefix argument ARG."
1931 (let ((header-end (save-excursion
1932 (goto-char (mh-mail-header-end))
1935 (if (> (point) header-end)
1936 (indent-relative arg)
1937 (mh-letter-next-header-field))))
1939 (defun mh-letter-next-header-field ()
1940 "Cycle to the next header field.
1941 If we are at the last header field go to the start of the message
1943 (let ((header-end (mh-mail-header-end)))
1944 (cond ((>= (point) header-end) (goto-char (point-min)))
1947 (re-search-forward mh-letter-header-field-regexp
1948 (line-end-position) t)
1950 (beginning-of-line))
1952 (cond ((re-search-forward mh-letter-header-field-regexp header-end t)
1953 (if (mh-letter-skipped-header-field-p (match-string 1))
1954 (mh-letter-next-header-field)
1955 (mh-letter-skip-leading-whitespace-in-header-field)))
1956 (t (goto-char header-end)
1960 (defun mh-letter-previous-header-field ()
1961 "Cycle to the previous header field.
1962 This command moves backwards between the fields and cycles to the
1963 body of the message after the first field. Unlike the
1964 \\[mh-letter-next-header-field-or-indent] command, it will always
1965 take point to the last field from anywhere in the body."
1967 (let ((header-end (mh-mail-header-end)))
1968 (if (>= (point) header-end)
1969 (goto-char header-end)
1970 (mh-header-field-beginning))
1971 (cond ((re-search-backward mh-letter-header-field-regexp nil t)
1972 (if (mh-letter-skipped-header-field-p (match-string 1))
1973 (mh-letter-previous-header-field)
1974 (goto-char (match-end 0))
1975 (mh-letter-skip-leading-whitespace-in-header-field)))
1976 (t (goto-char header-end)
1979 (defun mh-letter-skipped-header-field-p (field)
1980 "Check if FIELD is to be skipped."
1981 (let ((field (downcase field)))
1982 (loop for x in mh-compose-skipped-header-fields
1983 when (equal (downcase x) field) return t
1984 finally return nil)))
1986 (defun mh-letter-skip-leading-whitespace-in-header-field ()
1987 "Skip leading whitespace in a header field.
1988 If the header field doesn't have at least one space after the
1989 colon then a space character is added."
1990 (let ((need-space t))
1991 (while (memq (char-after) '(?\t ?\ ))
1993 (setq need-space nil))
1994 (when need-space (insert " "))))
1996 (defvar mh-hidden-header-keymap
1997 (let ((map (make-sparse-keymap)))
1999 (define-key map [mouse-2] 'mh-letter-toggle-header-field-display-button))
2001 (define-key map '(button2)
2002 'mh-letter-toggle-header-field-display-button))
2005 (defun mh-letter-toggle-header-field-display-button (event)
2006 "Toggle header field display at location of EVENT.
2007 This function does the same thing as
2008 `mh-letter-toggle-header-field-display' except that it is
2009 callable from a mouse button."
2011 (mh-do-at-event-location event
2012 (mh-letter-toggle-header-field-display nil)))
2014 (defun mh-letter-toggle-header-field-display (arg)
2015 "Toggle display of header field at point.
2017 Use this command to display truncated header fields. This command
2018 is a toggle so entering it again will hide the field. This
2019 command takes a prefix argument ARG: if negative then the field
2020 is hidden, if positive then the field is displayed."
2021 (interactive (list nil))
2022 (when (and (mh-in-header-p)
2025 (re-search-backward mh-letter-header-field-regexp nil t)))
2026 (let ((buffer-read-only nil)
2027 (modified-flag (buffer-modified-p))
2031 (setq end (1- (if (re-search-forward "^[^ \t]" nil t)
2035 ;; Make it clickable...
2036 (add-text-properties begin end `(keymap ,mh-hidden-header-keymap
2037 mouse-face highlight))
2039 (cond ((or (and (not arg)
2040 (text-property-any begin end 'invisible 'vanish))
2041 (and (numberp arg) (>= arg 0))
2042 (and (eq arg 'long) (> (line-beginning-position 5) end)))
2043 (remove-text-properties begin end '(invisible nil))
2044 (search-forward ":" (line-end-position) t)
2045 (mh-letter-skip-leading-whitespace-in-header-field))
2046 ;; XXX Redesign to make usable by user. Perhaps use a positive
2047 ;; numeric prefix to make that many lines visible.
2050 (mh-letter-truncate-header-field end)
2051 (beginning-of-line))
2053 (mh-letter-truncate-header-field end)
2054 (beginning-of-line)))
2055 (set-buffer-modified-p modified-flag)))))
2057 (defun mh-letter-truncate-header-field (end)
2058 "Replace text from current line till END with an ellipsis.
2059 If the current line is too long truncate a part of it as well."
2060 (let ((max-len (min (window-width) 62)))
2061 (when (> (+ (current-column) 4) max-len)
2062 (backward-char (- (+ (current-column) 5) max-len)))
2063 (when (> end (point))
2064 (add-text-properties (point) end '(invisible vanish)))))
2066 (defun mh-letter-hide-all-skipped-fields ()
2067 "Hide all skipped fields."
2069 (goto-char (point-min))
2071 (narrow-to-region (point) (mh-mail-header-end))
2072 (while (re-search-forward mh-letter-header-field-regexp nil t)
2073 (if (mh-letter-skipped-header-field-p (match-string 1))
2074 (mh-letter-toggle-header-field-display -1)
2075 (mh-letter-toggle-header-field-display 'long))
2076 (beginning-of-line 2)))))
2078 (defun mh-interactive-read-address (prompt)
2080 If `mh-compose-prompt-flag' is non-nil, then read an address with
2082 Otherwise return the empty string."
2083 (if mh-compose-prompt-flag (mh-read-address prompt) ""))
2085 (defun mh-interactive-read-string (prompt)
2087 If `mh-compose-prompt-flag' is non-nil, then read a string with
2089 Otherwise return the empty string."
2090 (if mh-compose-prompt-flag (read-string prompt) ""))
2092 (defun mh-letter-adjust-point ()
2093 "Move cursor to first header field if are using the no prompt mode."
2094 (unless mh-compose-prompt-flag
2095 (goto-char (point-max))
2096 (mh-letter-next-header-field)))
2100 ;;; Build mh-letter-mode keymap
2102 ;; If this changes, modify mh-letter-mode-help-messages accordingly, above.
2103 (gnus-define-keys mh-letter-mode-map
2104 " " mh-letter-complete-or-space
2105 "," mh-letter-confirm-address
2107 "\C-c\C-\\" mh-fully-kill-draft ;if no C-q
2108 "\C-c\C-^" mh-insert-signature ;if no C-s
2109 "\C-c\C-c" mh-send-letter
2110 "\C-c\C-d" mh-insert-identity
2111 "\C-c\C-e" mh-mh-to-mime
2112 "\C-c\C-f\C-b" mh-to-field
2113 "\C-c\C-f\C-c" mh-to-field
2114 "\C-c\C-f\C-d" mh-to-field
2115 "\C-c\C-f\C-f" mh-to-fcc
2116 "\C-c\C-f\C-r" mh-to-field
2117 "\C-c\C-f\C-s" mh-to-field
2118 "\C-c\C-f\C-t" mh-to-field
2119 "\C-c\C-fb" mh-to-field
2120 "\C-c\C-fc" mh-to-field
2121 "\C-c\C-fd" mh-to-field
2122 "\C-c\C-ff" mh-to-fcc
2123 "\C-c\C-fr" mh-to-field
2124 "\C-c\C-fs" mh-to-field
2125 "\C-c\C-ft" mh-to-field
2126 "\C-c\C-i" mh-insert-letter
2127 "\C-c\C-m\C-e" mh-mml-secure-message-encrypt
2128 "\C-c\C-m\C-f" mh-compose-forward
2129 "\C-c\C-m\C-g" mh-mh-compose-anon-ftp
2130 "\C-c\C-m\C-i" mh-compose-insertion
2131 "\C-c\C-m\C-m" mh-mml-to-mime
2132 "\C-c\C-m\C-n" mh-mml-unsecure-message
2133 "\C-c\C-m\C-s" mh-mml-secure-message-sign
2134 "\C-c\C-m\C-t" mh-mh-compose-external-compressed-tar
2135 "\C-c\C-m\C-u" mh-mh-to-mime-undo
2136 "\C-c\C-m\C-x" mh-mh-compose-external-type
2137 "\C-c\C-mee" mh-mml-secure-message-encrypt
2138 "\C-c\C-mes" mh-mml-secure-message-signencrypt
2139 "\C-c\C-mf" mh-compose-forward
2140 "\C-c\C-mg" mh-mh-compose-anon-ftp
2141 "\C-c\C-mi" mh-compose-insertion
2142 "\C-c\C-mm" mh-mml-to-mime
2143 "\C-c\C-mn" mh-mml-unsecure-message
2144 "\C-c\C-mse" mh-mml-secure-message-signencrypt
2145 "\C-c\C-mss" mh-mml-secure-message-sign
2146 "\C-c\C-mt" mh-mh-compose-external-compressed-tar
2147 "\C-c\C-mu" mh-mh-to-mime-undo
2148 "\C-c\C-mx" mh-mh-compose-external-type
2149 "\C-c\C-o" mh-open-line
2150 "\C-c\C-q" mh-fully-kill-draft
2151 "\C-c\C-s" mh-insert-signature
2152 "\C-c\C-t" mh-letter-toggle-header-field-display
2153 "\C-c\C-w" mh-check-whom
2154 "\C-c\C-y" mh-yank-cur-msg
2155 "\C-c\M-d" mh-insert-auto-fields
2156 "\M-\t" mh-letter-complete
2157 "\t" mh-letter-next-header-field-or-indent
2158 [backtab] mh-letter-previous-header-field)
2160 ;; "C-c /" prefix is used in mh-letter-mode by pgp.el and mailcrypt.el.
2165 ;; indent-tabs-mode: nil
2166 ;; sentence-end-double-space: nil
2169 ;; arch-tag: 62865511-e610-4923-b0b5-f45a8ab70a34
2170 ;;; mh-comp.el ends here