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
)
56 (autoload 'mail-mode-fill-paragraph
"sendmail")
57 (autoload 'mm-handle-displayed-p
"mm-decode")
59 (autoload 'sc-cite-original
"sc"
60 "Workhorse citing function which performs the initial citation.
61 This is callable from the various mail and news readers' reply
62 function according to the agreed upon standard. See `sc-describe'
63 for more details. `sc-cite-original' does not do any yanking of the
64 original message but it does require a few things:
66 1) The reply buffer is the current buffer.
68 2) The original message has been yanked and inserted into the
71 3) Verbose mail headers from the original message have been
72 inserted into the reply buffer directly before the text of the
75 4) Point is at the beginning of the verbose headers.
77 5) Mark is at the end of the body of text to be cited.
79 For Emacs 19's, the region need not be active (and typically isn't
80 when this function is called. Also, the hook `sc-pre-hook' is run
81 before, and `sc-post-hook' is run after the guts of this function.")
83 ;;; Site customization (see also mh-utils.el):
85 (defvar mh-send-prog
"send"
86 "Name of the MH send program.
87 Some sites need to change this because of a name conflict.")
89 (defvar mh-redist-background nil
90 "If non-nil redist will be done in background like send.
91 This allows transaction log to be visible if -watch, -verbose or -snoop are
96 (defvar mh-note-repl ?-
97 "Messages that have been replied to are marked by this character.")
99 (defvar mh-note-forw ?F
100 "Messages that have been forwarded are marked by this character.")
102 (defvar mh-note-dist ?R
103 "Messages that have been redistributed are marked by this character.")
105 (defvar mh-yank-hooks nil
106 "Obsolete hook for modifying a citation just inserted in the mail buffer.
107 Each hook function can find the citation between point and mark.
108 And each hook function should leave point and mark around the citation
111 This is a normal hook, misnamed for historical reasons.
112 It is semi-obsolete and is only used if `mail-citation-hook' is nil.")
114 (defvar mh-comp-formfile
"components"
115 "Name of file to be used as a skeleton for composing messages.
116 Default is \"components\". If not an absolute file name, the file
117 is searched for first in the user's MH directory, then in the
118 system MH lib directory.")
120 (defvar mh-repl-formfile
"replcomps"
121 "Name of file to be used as a skeleton for replying to messages.
122 Default is \"replcomps\". If not an absolute file name, the file
123 is searched for first in the user's MH directory, then in the
124 system MH lib directory.")
126 (defvar mh-repl-group-formfile
"replgroupcomps"
127 "Name of file to be used as a skeleton for replying to messages.
128 This file is used to form replies to the sender and all recipients of a
129 message. Only used if `(mh-variant-p 'nmh)' is non-nil.
130 Default is \"replgroupcomps\".
131 If not an absolute file name, the file is searched for first in the user's MH
132 directory, then in the system MH lib directory.")
134 (defvar mh-rejected-letter-start
137 '("Content-Type: message/rfc822" ;MIME MDN
138 "------ This is a copy of the message, including all the headers. ------";from exim
139 "--- Below this line is a copy of the message."; from qmail
140 " ----- Unsent message follows -----" ;from sendmail V5
141 " --------Unsent Message below:" ; from sendmail at BU
142 " ----- Original message follows -----" ;from sendmail V8
143 "------- Unsent Draft" ;from MH itself
144 "---------- Original Message ----------" ;from zmailer
145 " --- The unsent message follows ---" ;from AIX mail system
146 " Your message follows:" ;from MMDF-II
147 "Content-Description: Returned Content" ;1993 KJ sendmail
150 (defvar mh-new-draft-cleaned-headers
151 "^Date:\\|^Received:\\|^Message-Id:\\|^From:\\|^Sender:\\|^Errors-To:\\|^Delivery-Date:\\|^Return-Path:"
152 "Regexp of header lines to remove before offering a message as a new draft.
153 Used by the \\<mh-folder-mode-map>`\\[mh-edit-again]' and `\\[mh-extract-rejected-mail]' commands.")
155 (defvar mh-to-field-choices
'(("t" .
"To:") ("s" .
"Subject:") ("c" .
"Cc:")
156 ("b" .
"Bcc:") ("f" .
"Fcc:") ("r" .
"From:")
158 "Alist of (final-character . field-name) choices for `mh-to-field'.")
160 (defvar mh-letter-mode-map
(copy-keymap text-mode-map
)
161 "Keymap for composing mail.")
163 (defvar mh-letter-mode-syntax-table nil
164 "Syntax table used by MH-E while in MH-Letter mode.")
166 (if mh-letter-mode-syntax-table
168 (setq mh-letter-mode-syntax-table
169 (make-syntax-table text-mode-syntax-table
))
170 (modify-syntax-entry ?%
"." mh-letter-mode-syntax-table
))
172 (defvar mh-sent-from-folder nil
173 "Folder of msg assoc with this letter.")
175 (defvar mh-sent-from-msg nil
176 "Number of msg assoc with this letter.")
178 (defvar mh-send-args nil
179 "Extra args to pass to \"send\" command.")
181 (defvar mh-annotate-char nil
182 "Character to use to annotate `mh-sent-from-msg'.")
184 (defvar mh-annotate-field nil
185 "Field name for message annotation.")
187 (defvar mh-insert-auto-fields-done-local nil
188 "Buffer-local variable set when `mh-insert-auto-fields' called successfully.")
189 (make-variable-buffer-local 'mh-insert-auto-fields-done-local
)
193 "Compose a message with the MH mail system.
194 See `mh-send' for more details on composing mail."
197 (call-interactively 'mh-send
))
200 (defun mh-smail-other-window ()
201 "Compose a message with the MH mail system in other window.
202 See `mh-send' for more details on composing mail."
205 (call-interactively 'mh-send-other-window
))
207 (defvar mh-error-if-no-draft nil
) ;raise error over using old draft
210 (defun mh-smail-batch (&optional to subject other-headers
&rest ignored
)
211 "Compose a message with the MH mail system.
213 This function does not prompt the user for any header fields, and thus
214 is suitable for use by programs that want to create a mail buffer. Users
215 should use \\[mh-smail] to compose mail.
217 Optional arguments for setting certain fields include TO, SUBJECT, and
218 OTHER-HEADERS. Additional arguments are IGNORED."
220 (let ((mh-error-if-no-draft t
))
221 (mh-send (or to
"") "" (or subject
""))))
223 ;; XEmacs needs this:
225 (defun mh-user-agent-compose (&optional to subject other-headers continue
226 switch-function yank-action
228 "Set up mail composition draft with the MH mail system.
229 This is `mail-user-agent' entry point to MH-E.
231 The optional arguments TO and SUBJECT specify recipients and the
232 initial Subject field, respectively.
234 OTHER-HEADERS is an alist specifying additional
235 header fields. Elements look like (HEADER . VALUE) where both
236 HEADER and VALUE are strings.
238 CONTINUE, SWITCH-FUNCTION, YANK-ACTION and SEND-ACTIONS are ignored."
240 (let ((mh-error-if-no-draft t
))
241 (mh-send to
"" subject
)
243 (mh-insert-fields (concat (car (car other-headers
)) ":")
244 (cdr (car other-headers
)))
245 (setq other-headers
(cdr other-headers
)))))
248 (defun mh-edit-again (message)
249 "Edit a MESSAGE to send it again.
251 If you don't complete a draft for one reason or another, and if the draft
252 buffer is no longer available, you can pick your draft up again with this
253 command. If you don't use a draft folder, your last \"draft\" file will be
254 used. If you use draft folders, you'll need to visit the draft folder with
255 \"\\[mh-visit-folder] drafts <RET>\", use \\[mh-next-undeleted-msg] to move to
256 the appropriate message, and then use \\[mh-edit-again] to prepare the message
259 This command can also be used to take messages that were sent to you and to
260 send them to more people.
262 Don't use this command to re-edit a message from a Mailer-Daemon who
263 complained that your mail wasn't posted for some reason or another (see
264 `mh-extract-rejected-mail').
266 The default message is the current message.
269 (interactive (list (mh-get-msg-num t
)))
270 (let* ((from-folder mh-current-folder
)
271 (config (current-window-configuration))
273 (cond ((and mh-draft-folder
(equal from-folder mh-draft-folder
))
274 (pop-to-buffer (find-file-noselect (mh-msg-filename message
))
276 (rename-buffer (format "draft-%d" message
))
277 ;; Make buffer writable...
278 (setq buffer-read-only nil
)
279 ;; If buffer was being used to display the message reinsert
281 (when (eq major-mode
'mh-show-mode
)
283 (insert-file-contents buffer-file-name
))
286 (mh-read-draft "clean-up" (mh-msg-filename message
) nil
)))))
287 (mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil
)
288 (mh-insert-header-separator)
289 (goto-char (point-min))
291 (mh-compose-and-send-mail draft
"" from-folder nil nil nil nil nil nil
293 (mh-letter-mode-message)
294 (mh-letter-adjust-point)))
297 (defun mh-extract-rejected-mail (message)
298 "Edit a MESSAGE that was returned by the mail system.
300 This command prepares the message for editing by removing the Mailer-Daemon
301 envelope and unneeded header fields. Fix whatever addressing problem you had,
302 and send the message again with \\[mh-send-letter].
304 The default message is the current message.
307 (interactive (list (mh-get-msg-num t
)))
308 (let ((from-folder mh-current-folder
)
309 (config (current-window-configuration))
310 (draft (mh-read-draft "extraction" (mh-msg-filename message
) nil
)))
311 (goto-char (point-min))
312 (cond ((re-search-forward mh-rejected-letter-start nil t
)
313 (skip-chars-forward " \t\n")
314 (delete-region (point-min) (point))
315 (mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil
))
317 (message "Does not appear to be a rejected letter")))
318 (mh-insert-header-separator)
319 (goto-char (point-min))
321 (mh-compose-and-send-mail draft
"" from-folder message
322 (mh-get-header-field "To:")
323 (mh-get-header-field "From:")
324 (mh-get-header-field "Cc:")
326 (mh-letter-mode-message)))
329 (defun mh-forward (to cc
&optional range
)
332 You are prompted for the TO and CC recipients. You are given a draft to edit
333 that looks like it would if you had run the MH command \"forw\". You are given
334 a chance to add some text.
336 You can forward several messages by using a RANGE. All of the messages in the
337 range are inserted into your draft. Check the documentation of
338 `mh-interactive-range' to see how RANGE is read in interactive use.
340 The default message is the current message.
342 See also `mh-compose-forward-as-mime-flag', `mh-forward-subject-format',
344 (interactive (list (mh-interactive-read-address "To: ")
345 (mh-interactive-read-address "Cc: ")
346 (mh-interactive-range "Forward")))
347 (let* ((folder mh-current-folder
)
348 (msgs (mh-range-to-msg-list range
))
349 (config (current-window-configuration))
350 (fwd-msg-file (mh-msg-filename (car msgs
) folder
))
351 ;; forw always leaves file in "draft" since it doesn't have -draft
352 (draft-name (expand-file-name "draft" mh-user-path
))
353 (draft (cond ((or (not (file-exists-p draft-name
))
354 (y-or-n-p "The file 'draft' exists. Discard it? "))
355 (mh-exec-cmd "forw" "-build"
356 (if (and (mh-variant-p 'nmh
)
357 mh-compose-forward-as-mime-flag
)
360 (mh-coalesce-msg-list msgs
))
362 (mh-read-draft "" draft-name t
)
363 (mh-insert-fields "To:" to
"Cc:" cc
)
366 (mh-read-draft "" draft-name nil
)))))
370 (set-buffer (get-buffer-create mh-temp-buffer
))
372 (insert-file-contents fwd-msg-file
)
373 (setq orig-from
(mh-get-header-field "From:"))
374 (setq orig-subject
(mh-get-header-field "Subject:")))
376 (mh-forwarded-letter-subject orig-from orig-subject
)))
377 (mh-insert-fields "Subject:" forw-subject
)
378 (goto-char (point-min))
379 ;; If using MML, translate MH-style directive
380 (if (equal mh-compose-insertion
'mml
)
382 (goto-char (mh-mail-header-end))
385 "^#forw \\[\\([^]]+\\)\\] \\(+\\S-+\\) \\(.*\\)$"
387 (let ((description (if (equal (match-string 1)
388 "forwarded messages")
389 "forwarded message %d"
391 (msgs (split-string (match-string 3)))
394 (delete-region (point) (progn (forward-line 1) (point)))
397 (mh-mml-forward-message (format description i
)
399 ;; Postition just before forwarded message
400 (if (re-search-forward "^------- Forwarded Message" nil t
)
402 (goto-char (mh-mail-header-end))
404 (delete-other-windows)
405 (mh-add-msgs-to-seq msgs
'forwarded t
)
406 (mh-compose-and-send-mail draft
"" folder msgs
408 mh-note-forw
"Forwarded:"
410 (mh-letter-mode-message)
411 (mh-letter-adjust-point)
412 (run-hooks 'mh-forward-hook
)))))
414 (defun mh-forwarded-letter-subject (from subject
)
415 "Return a Subject suitable for a forwarded message.
416 Original message has headers FROM and SUBJECT."
417 (let ((addr-start (string-match "<" from
))
418 (comment (string-match "(" from
)))
419 (cond ((and addr-start
(> addr-start
0))
420 ;; Full Name <luser@host>
421 (setq from
(substring from
0 (1- addr-start
))))
423 ;; luser@host (Full Name)
424 (setq from
(substring from
(1+ comment
) (1- (length from
)))))))
425 (format mh-forward-subject-format from subject
))
428 (defun mh-redistribute (to cc
&optional message
)
429 "Redistribute a message.
431 This command is similar in function to forwarding mail, but it does not allow
432 you to edit the message, nor does it add your name to the \"From\" header
433 field. It appears to the recipient as if the message had come from the
434 original sender. When you run this command, you are prompted for the TO and CC
435 recipients. The default MESSAGE is the current message.
437 Also investigate the \\[mh-edit-again] command for another way to redistribute
440 See also `mh-redist-full-contents-flag'."
441 (interactive (list (mh-read-address "Redist-To: ")
442 (mh-read-address "Redist-Cc: ")
445 (setq message
(mh-get-msg-num t
)))
446 (save-window-excursion
447 (let ((folder mh-current-folder
)
448 (draft (mh-read-draft "redistribution"
449 (if mh-redist-full-contents-flag
450 (mh-msg-filename message
)
453 (mh-goto-header-end 0)
454 (insert "Resent-To: " to
"\n")
455 (if (not (equal cc
"")) (insert "Resent-cc: " cc
"\n"))
458 "^Message-Id:\\|^Received:\\|^Return-Path:\\|^Sender:\\|^Date:\\|^From:"
461 (message "Redistributing...")
462 (let ((env "mhdist=1"))
463 ;; Setup environment...
464 (setq env
(concat env
" mhaltmsg="
465 (if mh-redist-full-contents-flag
467 (mh-msg-filename message folder
))))
468 (unless mh-redist-full-contents-flag
469 (setq env
(concat env
" mhannotate=1")))
471 (if mh-redist-background
472 (mh-exec-cmd-env-daemon env mh-send-prog nil buffer-file-name
)
473 (mh-exec-cmd-error env mh-send-prog
"-push" buffer-file-name
))
475 (mh-annotate-msg message folder mh-note-dist
476 "-component" "Resent:"
477 "-text" (format "\"%s %s\"" to cc
)))
479 (message "Redistributing...done"))))
481 (defun mh-show-buffer-message-number (&optional buffer
)
482 "Message number of displayed message in corresponding show buffer.
483 Return nil if show buffer not displayed.
484 If in `mh-letter-mode', don't display the message number being replied to,
485 but rather the message number of the show buffer associated with our
486 originating folder buffer.
487 Optional argument BUFFER can be used to specify the buffer."
491 (cond ((eq major-mode
'mh-show-mode
)
492 (let ((number-start (mh-search-from-end ?
/ buffer-file-name
)))
493 (car (read-from-string (substring buffer-file-name
494 (1+ number-start
))))))
495 ((and (eq major-mode
'mh-folder-mode
)
497 (get-buffer mh-show-buffer
))
498 (mh-show-buffer-message-number mh-show-buffer
))
499 ((and (eq major-mode
'mh-letter-mode
)
501 (get-buffer mh-sent-from-folder
))
502 (mh-show-buffer-message-number mh-sent-from-folder
))
507 (defun mh-reply (message &optional reply-to includep
)
510 When you reply to a message, you are first prompted with \"Reply to whom?\"
511 \(unless the optional argument REPLY-TO is provided). You have several choices
514 Response Reply Goes To
516 from The person who sent the message. This is the default,
517 so <RET> is sufficient.
519 to Replies to the sender, plus all recipients in the
520 \"To:\" header field.
523 cc Forms a reply to the sender, plus all recipients.
525 Depending on your answer, \"repl\" is given a different argument to form your
526 reply. Specifically, a choice of \"from\" or none at all runs \"repl -nocc
527 all\", and a choice of \"to\" runs \"repl -cc to\". Finally, either \"cc\" or
528 \"all\" runs \"repl -cc all -nocc me\".
530 Two windows are then created. One window contains the message to which you are
531 replying in an MH-Show buffer. Your draft, in MH-Letter mode
532 \(see `mh-letter-mode'), is in the other window.
534 If you supply a prefix argument INCLUDEP, the message you are replying to is
535 inserted in your reply after having first been run through \"mhl\" with the
536 format file \"mhl.reply\".
538 Alternatively, you can customize the option `mh-yank-behavior' and choose one
539 of its \"Automatically\" variants to do the same thing. If you do so, the
540 prefix argument has no effect.
542 Another way to include the message automatically in your draft is to use
543 \"repl: -filter repl.filter\" in your MH profile.
545 If you wish to customize the header or other parts of the reply draft, please
546 see \"repl\" and \"mh-format\".
548 See also `mh-reply-show-message-flag', `mh-reply-default-reply-to', and
552 (let ((minibuffer-help-form
553 "from => Sender only\nto => Sender and primary recipients\ncc or all => Sender and all recipients"))
554 (or mh-reply-default-reply-to
555 (completing-read "Reply to whom: [from] "
556 '(("from") ("to") ("cc") ("all"))
560 (let* ((folder mh-current-folder
)
561 (show-buffer mh-show-buffer
)
562 (config (current-window-configuration))
563 (group-reply (or (equal reply-to
"cc") (equal reply-to
"all")))
564 (form-file (cond ((and (mh-variant-p 'nmh
'mu-mh
) group-reply
565 (stringp mh-repl-group-formfile
))
566 mh-repl-group-formfile
)
567 ((stringp mh-repl-formfile
) mh-repl-formfile
)
569 (message "Composing a reply...")
570 (mh-exec-cmd "repl" "-build" "-noquery" "-nodraftfolder"
572 (list "-form" form-file
))
573 mh-current-folder message
574 (cond ((or (equal reply-to
"from") (equal reply-to
""))
576 ((equal reply-to
"to")
578 (group-reply (if (mh-variant-p 'nmh
'mu-mh
)
579 '("-group" "-nocc" "me")
580 '("-cc" "all" "-nocc" "me"))))
581 (cond ((or (eq mh-yank-behavior
'autosupercite
)
582 (eq mh-yank-behavior
'autoattrib
))
584 (includep '("-filter" "mhl.reply"))
586 (let ((draft (mh-read-draft "reply"
587 (expand-file-name "reply" mh-user-path
)
589 (delete-other-windows)
592 (let ((to (mh-get-header-field "To:"))
593 (subject (mh-get-header-field "Subject:"))
594 (cc (mh-get-header-field "Cc:")))
595 (goto-char (point-min))
596 (mh-goto-header-end 1)
598 (not mh-reply-show-message-flag
)
599 (mh-in-show-buffer (show-buffer)
600 (mh-display-msg message folder
)))
601 (mh-add-msgs-to-seq message
'answered t
)
602 (message "Composing a reply...done")
603 (mh-compose-and-send-mail draft
"" folder message to subject cc
604 mh-note-repl
"Replied:" config
))
605 (when (and (or (eq 'autosupercite mh-yank-behavior
)
606 (eq 'autoattrib mh-yank-behavior
))
607 (eq (mh-show-buffer-message-number) mh-sent-from-msg
))
610 (mh-letter-mode-message))))
613 (defun mh-send (to cc subject
)
616 Your letter appears in an Emacs buffer whose mode is MH-Letter (see
619 The arguments TO, CC, and SUBJECT can be used to prefill the draft fields or
620 suppress the prompts if `mh-compose-prompt-flag' is on. They are also passed
621 to the function set in the option `mh-compose-letter-function'.
623 See also `mh-insert-x-mailer-flag' and `mh-letter-mode-hook'.
625 Outside of an MH-Folder buffer (`mh-folder-mode'), you must call either
626 \\[mh-smail] or \\[mh-smail-other-window] to compose a new message."
628 (mh-interactive-read-address "To: ")
629 (mh-interactive-read-address "Cc: ")
630 (mh-interactive-read-string "Subject: ")))
631 (let ((config (current-window-configuration)))
632 (delete-other-windows)
633 (mh-send-sub to cc subject config
)))
636 (defun mh-send-other-window (to cc subject
)
637 "Compose a message in another window.
639 See `mh-send' for more information and a description of how the TO, CC, and
640 SUBJECT arguments are used."
642 (mh-interactive-read-address "To: ")
643 (mh-interactive-read-address "Cc: ")
644 (mh-interactive-read-string "Subject: ")))
645 (let ((pop-up-windows t
))
646 (mh-send-sub to cc subject
(current-window-configuration))))
648 (defun mh-send-sub (to cc subject config
)
649 "Do the real work of composing and sending a letter.
650 Expects the TO, CC, and SUBJECT fields as arguments.
651 CONFIG is the window configuration before sending mail."
652 (let ((folder mh-current-folder
)
653 (msg-num (mh-get-msg-num nil
)))
654 (message "Composing a message...")
655 (let ((draft (mh-read-draft
661 (expand-file-name mh-comp-formfile mh-user-path
)))
665 (expand-file-name mh-comp-formfile mh-lib
)))
669 (expand-file-name mh-comp-formfile
670 ;; What is this mh-etc ?? -sm
671 ;; This is dead code, so
673 ;(and (boundp 'mh-etc) mh-etc)
677 (error "Can't find components file \"%s\""
680 (mh-insert-fields "To:" to
"Subject:" subject
"Cc:" cc
)
681 (goto-char (point-max))
682 (mh-compose-and-send-mail draft
"" folder msg-num
685 (mh-letter-mode-message)
686 (mh-letter-adjust-point))))
688 (defun mh-read-draft (use initial-contents delete-contents-file
)
689 "Read draft file into a draft buffer and make that buffer the current one.
690 USE is a message used for prompting about the intended use of the message.
691 INITIAL-CONTENTS is filename that is read into an empty buffer, or nil
692 if buffer should not be modified. Delete the initial-contents file if
693 DELETE-CONTENTS-FILE flag is set.
694 Returns the draft folder's name.
695 If the draft folder facility is enabled in ~/.mh_profile, a new buffer is
696 used each time and saved in the draft folder. The draft file can then be
698 (cond (mh-draft-folder
699 (let ((orig-default-dir default-directory
)
700 (draft-file-name (mh-new-draft-name)))
701 (pop-to-buffer (generate-new-buffer
703 (file-name-nondirectory draft-file-name
))))
705 (insert-file-contents draft-file-name t
)
707 (setq default-directory orig-default-dir
)))
709 (let ((draft-name (expand-file-name "draft" mh-user-path
)))
710 (pop-to-buffer "draft") ; Create if necessary
711 (if (buffer-modified-p)
712 (if (y-or-n-p "Draft has been modified; kill anyway? ")
713 (set-buffer-modified-p nil
)
714 (error "Draft preserved")))
715 (setq buffer-file-name draft-name
)
716 (clear-visited-file-modtime)
718 (cond ((and (file-exists-p draft-name
)
719 (not (equal draft-name initial-contents
)))
720 (insert-file-contents draft-name
)
721 (delete-file draft-name
))))))
722 (cond ((and initial-contents
723 (or (zerop (buffer-size))
725 (format "A draft exists. Use for %s? " use
))
726 (if mh-error-if-no-draft
727 (error "A prior draft exists"))
730 (insert-file-contents initial-contents
)
731 (if delete-contents-file
(delete-file initial-contents
))))
734 (save-buffer)) ; Do not reuse draft name
737 (defun mh-new-draft-name ()
738 "Return the pathname of folder for draft messages."
740 (mh-exec-cmd-quiet t
"mhpath" mh-draft-folder
"new")
741 (buffer-substring (point-min) (1- (point-max)))))
743 (defun mh-annotate-msg (msg buffer note
&rest args
)
744 "Mark MSG in BUFFER with character NOTE and annotate message with ARGS.
745 MSG can be a message number, a list of message numbers, or a sequence."
746 (apply 'mh-exec-cmd
"anno" buffer
747 (if (listp msg
) (append msg args
) (cons msg args
)))
749 (cond ((get-buffer buffer
) ; Buffer may be deleted
751 (mh-iterate-on-range nil msg
753 (+ mh-cmd-note mh-scan-field-destination-offset
)))))))
755 (defun mh-insert-fields (&rest name-values
)
756 "Insert the NAME-VALUES pairs in the current buffer.
757 If the field exists, append the value to it.
758 Do not insert any pairs whose value is the empty string."
759 (let ((case-fold-search t
))
761 (let ((field-name (car name-values
))
762 (value (car (cdr name-values
))))
763 (if (not (string-match "^.*:$" field-name
))
764 (setq field-name
(concat field-name
":")))
765 (cond ((equal value
"")
767 ((mh-position-on-field field-name
)
768 (insert " " (or value
"")))
770 (insert field-name
" " value
"\n")))
771 (setq name-values
(cdr (cdr name-values
)))))))
773 (defun mh-position-on-field (field &optional ignored
)
774 "Move to the end of the FIELD in the header.
775 Move to end of entire header if FIELD not found.
776 Returns non-nil iff FIELD was found.
777 The optional second arg is for pre-version 4 compatibility and is IGNORED."
778 (cond ((mh-goto-header-field field
)
779 (mh-header-field-end)
781 ((mh-goto-header-end 0)
785 (defun mh-get-header-field (field)
786 "Find and return the body of FIELD in the mail header.
787 Returns the empty string if the field is not in the header of the
789 (if (mh-goto-header-field field
)
791 (skip-chars-forward " \t") ;strip leading white space in body
792 (let ((start (point)))
793 (mh-header-field-end)
794 (buffer-substring-no-properties start
(point))))
797 (fset 'mh-get-field
'mh-get-header-field
) ;MH-E 4 compatibility
799 (defun mh-goto-header-field (field)
800 "Move to FIELD in the message header.
801 Move to the end of the FIELD name, which should end in a colon.
802 Returns t if found, nil if not."
803 (goto-char (point-min))
804 (let ((case-fold-search t
)
805 (headers-end (save-excursion
806 (mh-goto-header-end 0)
808 (re-search-forward (format "^%s" field
) headers-end t
)))
810 (defun mh-goto-header-end (arg)
811 "Move the cursor ARG lines after the header."
812 (if (re-search-forward "^-*$" nil nil
)
815 (defun mh-extract-from-header-value ()
816 "Extract From: string from header."
818 (if (not (mh-goto-header-field "From:"))
820 (skip-chars-forward " \t")
821 (buffer-substring-no-properties
822 (point) (progn (mh-header-field-end)(point))))))
826 ;;; Mode for composing and sending a draft message.
828 (put 'mh-letter-mode
'mode-class
'special
)
830 ;;; Menu extracted from mh-menubar.el V1.1 (31 July 2001)
831 (eval-when-compile (defvar mh-letter-menu nil
))
833 mh-letter-menu mh-letter-mode-map
"Menu for MH-E letter mode."
835 ["Send This Draft" mh-send-letter t
]
836 ["Split Current Line" mh-open-line t
]
837 ["Check Recipient" mh-check-whom t
]
838 ["Yank Current Message" mh-yank-cur-msg t
]
839 ["Insert a Message..." mh-insert-letter t
]
840 ["Insert Signature" mh-insert-signature t
]
841 ("Encrypt/Sign Message"
843 mh-mml-secure-message-sign mh-pgp-support-flag
]
845 mh-mml-secure-message-encrypt mh-pgp-support-flag
]
846 ["Sign+Encrypt Message"
847 mh-mml-secure-message-signencrypt mh-pgp-support-flag
]
849 mh-mml-unsecure-message mh-pgp-support-flag
]
852 ["PGP (MIME)" (setq mh-mml-method-default
"pgpmime")
854 :selected
(equal mh-mml-method-default
"pgpmime")]
855 ["PGP" (setq mh-mml-method-default
"pgp")
857 :selected
(equal mh-mml-method-default
"pgp")]
858 ["S/MIME" (setq mh-mml-method-default
"smime")
860 :selected
(equal mh-mml-method-default
"smime")]
862 ["Save Method as Default"
863 (customize-save-variable 'mh-mml-method-default mh-mml-method-default
) t
]
865 ["Compose Insertion..." mh-compose-insertion t
]
866 ["Compose Compressed tar (MH)..."
867 mh-mh-compose-external-compressed-tar t
]
868 ["Compose Get File (MH)..." mh-mh-compose-anon-ftp t
]
869 ["Compose Forward..." mh-compose-forward t
]
870 ;; The next two will have to be merged. But I also need to make sure the
871 ;; user can't mix tags of both types.
872 ["Pull in All Compositions (MH)"
873 mh-mh-to-mime
(mh-mh-directive-present-p)]
874 ["Pull in All Compositions (MML)"
875 mh-mml-to-mime
(mh-mml-tag-present-p)]
876 ["Revert to Non-MIME Edit (MH)"
877 mh-mh-to-mime-undo
(equal mh-compose-insertion
'mh
)]
878 ["Kill This Draft" mh-fully-kill-draft t
]))
881 ;;; Group messages logically, more or less.
882 (defvar mh-letter-mode-help-messages
884 "Send letter: \\[mh-send-letter]"
885 "\t\tOpen line: \\[mh-open-line]\n"
886 "Kill letter: \\[mh-fully-kill-draft]"
888 "Check recipients: \\[mh-check-whom]"
889 "\t\t Current message: \\[mh-yank-cur-msg]\n"
890 "\t\t Attachment: \\[mh-compose-insertion]\n"
891 "\t\t Message to forward: \\[mh-compose-forward]\n"
894 "\t\t Encrypt message: \\[mh-mml-secure-message-encrypt]"
895 "\t\t Sign+Encrypt message: \\[mh-mml-secure-message-signencrypt]"
896 "\t\t Sign message: \\[mh-mml-secure-message-sign]\n"
898 "\t\t Signature: \\[mh-insert-signature]"))
899 "Key binding cheat sheet.
901 This is an associative array which is used to show the most common commands.
902 The key is a prefix char. The value is one or more strings which are
903 concatenated together and displayed in the minibuffer if ? is pressed after
904 the prefix character. The special key nil is used to display the
905 non-prefixed commands.
907 The substitutions described in `substitute-command-keys' are performed as
911 (defun mh-fill-paragraph-function (arg)
912 "Fill paragraph at or after point.
913 Prefix ARG means justify as well. This function enables `fill-paragraph' to
914 work better in MH-Letter mode (see `mh-letter-mode')."
916 (let ((fill-paragraph-function) (fill-prefix))
918 (mail-mode-fill-paragraph arg
)
919 (fill-paragraph arg
))))
921 ;; Avoid compiler warnings in XEmacs and Emacs 20
923 (defvar tool-bar-mode
)
924 (defvar tool-bar-map
))
926 (defvar mh-letter-buttons-init-flag nil
)
929 (define-derived-mode mh-letter-mode text-mode
"MH-Letter"
930 "Mode for composing letters in MH-E.\\<mh-letter-mode-map>
932 When you have finished composing, type \\[mh-send-letter] to send the message
933 using the MH mail handling system.
935 There are two types of tags used by MH-E when composing MIME messages: MML and
936 MH. The option `mh-compose-insertion' controls what type of tags are inserted
937 by MH-E commands. These tags can be converted to MIME body parts by running
938 \\[mh-mh-to-mime] for MH-style directives or \\[mh-mml-to-mime] for MML tags.
940 Options that control this mode can be changed with \\[customize-group];
941 specify the \"mh-compose\" group.
943 When a message is composed, the hooks `text-mode-hook' and
944 `mh-letter-mode-hook' are run.
946 \\{mh-letter-mode-map}"
948 (make-local-variable 'mh-send-args
)
949 (make-local-variable 'mh-annotate-char
)
950 (make-local-variable 'mh-annotate-field
)
951 (make-local-variable 'mh-previous-window-config
)
952 (make-local-variable 'mh-sent-from-folder
)
953 (make-local-variable 'mh-sent-from-msg
)
955 (unless mh-letter-buttons-init-flag
956 (mh-tool-bar-letter-buttons-init)
957 (setq mh-letter-buttons-init-flag t
)))
958 ;; Set the local value of mh-mail-header-separator according to what is
959 ;; present in the buffer...
960 (set (make-local-variable 'mh-mail-header-separator
)
962 (goto-char (mh-mail-header-end))
963 (buffer-substring-no-properties (point) (line-end-position))))
964 (make-local-variable 'mail-header-separator
)
965 (setq mail-header-separator mh-mail-header-separator
) ;override sendmail.el
966 (make-local-variable 'mh-help-messages
)
967 (setq mh-help-messages mh-letter-mode-help-messages
)
968 (setq buffer-invisibility-spec
'((vanish . t
) t
))
969 (set (make-local-variable 'line-move-ignore-invisible
) t
)
971 ;; From sendmail.el for proper paragraph fill
972 ;; sendmail.el also sets a normal-auto-fill-function (not done here)
973 (make-local-variable 'paragraph-separate
)
974 (make-local-variable 'paragraph-start
)
975 (make-local-variable 'fill-paragraph-function
)
976 (setq fill-paragraph-function
'mh-fill-paragraph-function
)
977 (make-local-variable 'adaptive-fill-regexp
)
978 (setq adaptive-fill-regexp
979 (concat adaptive-fill-regexp
980 "\\|[ \t]*[-[:alnum:]]*>+[ \t]*"))
981 (make-local-variable 'adaptive-fill-first-line-regexp
)
982 (setq adaptive-fill-first-line-regexp
983 (concat adaptive-fill-first-line-regexp
984 "\\|[ \t]*[-[:alnum:]]*>+[ \t]*"))
985 ;; `-- ' precedes the signature. `-----' appears at the start of the
986 ;; lines that delimit forwarded messages.
987 ;; Lines containing just >= 3 dashes, perhaps after whitespace,
988 ;; are also sometimes used and should be separators.
989 (setq paragraph-start
(concat (regexp-quote mail-header-separator
)
990 "\\|\t*\\([-|#;>* ]\\|(?[0-9]+[.)]\\)+$"
991 "\\|[ \t]*[[:alnum:]]*>+[ \t]*$\\|[ \t]*$\\|"
994 (setq paragraph-separate paragraph-start
)
995 ;; --- End of code from sendmail.el ---
997 ;; Enable undo since a show-mode buffer might have been reused.
999 (set (make-local-variable 'tool-bar-map
) mh-letter-tool-bar-map
)
1000 (mh-funcall-if-exists mh-toolbar-init
:letter
)
1001 (make-local-variable 'font-lock-defaults
)
1003 ((or (equal mh-highlight-citation-p
'font-lock
)
1004 (equal mh-highlight-citation-p
'gnus
))
1005 ;; Let's use font-lock even if gnus is used in show-mode. The reason
1006 ;; is that gnus uses static text properties which are not appropriate
1007 ;; for a buffer that will be edited. So the choice here is either fontify
1008 ;; the citations and header...
1009 (setq font-lock-defaults
'(mh-letter-font-lock-keywords t
)))
1011 ;; ...or the header only
1012 (setq font-lock-defaults
'(mh-show-font-lock-keywords t
))))
1013 (easy-menu-add mh-letter-menu
)
1014 (setq fill-column mh-letter-fill-column
)
1015 ;; If text-mode-hook turned on auto-fill, tune it for messages
1016 (when auto-fill-function
1017 (make-local-variable 'auto-fill-function
)
1018 (setq auto-fill-function
'mh-auto-fill-for-letter
)))
1020 (defun mh-font-lock-field-data (limit)
1021 "Find header field region between point and LIMIT."
1022 (and (< (point) (mh-letter-header-end))
1024 (let ((end (min limit
(mh-letter-header-end)))
1026 data-end data-begin field
)
1028 (setq data-end
(if (re-search-forward "^[^ \t]" end t
)
1031 (goto-char (1- data-end
))
1032 (if (not (re-search-backward "\\(^[^ \t][^:]*\\):[ \t]*" nil t
))
1033 (setq data-begin
(point-min))
1034 (setq data-begin
(match-end 0))
1035 (setq field
(match-string 1)))
1036 (setq data-begin
(max point data-begin
))
1037 (goto-char (if (equal point data-end
) (1+ data-end
) data-end
))
1038 (cond ((and field
(mh-letter-skipped-header-field-p field
))
1039 (set-match-data nil
)
1042 (list data-begin data-end data-begin data-end
))
1045 (defun mh-letter-header-end ()
1046 "Find the end of the message header.
1047 This function is to be used only for font locking. It works by searching for
1048 `mh-mail-header-separator' in the buffer."
1050 (goto-char (point-min))
1051 (cond ((equal mh-mail-header-separator
"") (point-min))
1052 ((search-forward (format "\n%s\n" mh-mail-header-separator
) nil t
)
1053 (line-beginning-position 0))
1056 (defun mh-auto-fill-for-letter ()
1057 "Perform auto-fill for message.
1058 Header is treated specially by inserting a tab before continuation lines."
1059 (if (mh-in-header-p)
1060 (let ((fill-prefix "\t"))
1064 (defun mh-insert-header-separator ()
1065 "Insert `mh-mail-header-separator', if absent."
1067 (goto-char (point-min))
1069 (if (looking-at "$")
1070 (insert mh-mail-header-separator
))))
1073 (defun mh-to-field ()
1074 "Move to specified header field.
1075 The field is indicated by the previous keystroke (the last keystroke
1076 of the command) according to the list in the variable `mh-to-field-choices'.
1077 Create the field if it does not exist. Set the mark to point before moving."
1080 (let ((target (cdr (or (assoc (char-to-string (logior last-input-char ?
`))
1081 mh-to-field-choices
)
1082 ;; also look for a char for version 4 compat
1083 (assoc (logior last-input-char ?
`)
1084 mh-to-field-choices
))))
1085 (case-fold-search t
))
1087 (cond ((mh-position-on-field target
)
1088 (let ((eol (point)))
1089 (skip-chars-backward " \t")
1090 (delete-region (point) eol
))
1091 (if (and (not (eq (logior last-input-char ?
`) ?s
))
1094 (not (looking-at "[:,]"))))
1098 (if (mh-position-on-field "To:")
1100 (insert (format "%s \n" target
))
1101 (backward-char 1)))))
1104 (defun mh-to-fcc (&optional folder
)
1105 "Move to \"Fcc:\" header field.
1106 This command will prompt you for the FOLDER name in which to file a copy of
1110 (setq folder
(mh-prompt-for-folder
1112 (or (and mh-default-folder-for-message-function
1114 (goto-char (point-min))
1116 mh-default-folder-for-message-function
)))
1119 (let ((last-input-char ?\C-f
))
1123 (insert (if (mh-folder-name-p folder
)
1124 (substring folder
1)
1127 (defun mh-file-is-vcard-p (file)
1128 "Return t if FILE is a .vcf vcard."
1129 (let ((case-fold-search t
))
1131 (file-exists-p file
)
1132 (or (and (not (mh-have-file-command))
1133 (not (null (string-match "\.vcf$" file
))))
1134 (and (mh-have-file-command)
1135 (string-equal "text/x-vcard" (mh-file-mime-type file
)))))))
1138 (defun mh-insert-signature (&optional file
)
1139 "Insert signature in message.
1140 This command inserts your signature at the current cursor location.
1142 By default, the text of your signature is taken from the file
1143 \"~/.signature\". You can read from other sources by changing the option
1144 `mh-signature-file-name' or passing in a signature FILE.
1146 A signature separator (\"-- \") will be added if the signature block does not
1147 contain one and `mh-signature-separator-flag' is on.
1149 The value of `mh-letter-insert-signature-hook' is a list of functions to be
1150 called, with no arguments, after the signature is inserted. These functions
1151 may access the actual name of the file or the function used to insert the
1152 signature with `mh-signature-file-name'.
1154 The signature can also be inserted using Identities (see `mh-identity-list')"
1158 (let ((mh-signature-file-name (or file mh-signature-file-name
))
1159 (mh-mh-p (mh-mh-directive-present-p))
1160 (mh-mml-p (mh-mml-tag-present-p)))
1162 (narrow-to-region (point) (point))
1164 ((mh-file-is-vcard-p mh-signature-file-name
)
1165 (if (equal mh-compose-insertion
'mml
)
1166 (insert "<#part type=\"text/x-vcard\" filename=\""
1167 mh-signature-file-name
1168 "\" disposition=inline description=VCard>\n<#/part>")
1169 (insert "#text/x-vcard; name=\""
1170 (file-name-nondirectory mh-signature-file-name
)
1171 "\" [VCard] " (expand-file-name mh-signature-file-name
))))
1175 (insert "#\n" "Content-Description: Signature\n"))
1177 (mml-insert-tag 'part
'type
"text/plain" 'disposition
"inline"
1178 'description
"Signature")))
1179 (cond ((null mh-signature-file-name
))
1180 ((and (stringp mh-signature-file-name
)
1181 (file-readable-p mh-signature-file-name
))
1182 (insert-file-contents mh-signature-file-name
))
1183 ((functionp mh-signature-file-name
)
1184 (funcall mh-signature-file-name
)))))
1187 (run-hooks 'mh-letter-insert-signature-hook
))
1188 (goto-char (point-min))
1189 (when (and (not (mh-file-is-vcard-p mh-signature-file-name
))
1190 mh-signature-separator-flag
1191 (> (point-max) (point-min))
1192 (not (mh-signature-separator-p)))
1197 (insert mh-signature-separator
))
1198 (if (not (> (point-max) (point-min)))
1199 (message "No signature found")))))
1200 (force-mode-line-update))
1203 (defun mh-check-whom ()
1204 "Verify recipients, showing expansion of any aliases.
1205 This command expands aliases so you can check the actual address(es) in the
1206 alias. A new buffer named \"*MH-E Recipients*\" is created with the output of
1209 (let ((file-name buffer-file-name
))
1211 (message "Checking recipients...")
1212 (mh-in-show-buffer (mh-recipients-buffer)
1213 (bury-buffer (current-buffer))
1215 (mh-exec-cmd-output "whom" t file-name
))
1216 (message "Checking recipients...done")))
1218 (defun mh-tidy-draft-buffer ()
1219 "Run when a draft buffer is destroyed."
1220 (let ((buffer (get-buffer mh-recipients-buffer
)))
1222 (kill-buffer buffer
))))
1226 ;;; Routines to compose and send a letter.
1228 (defun mh-insert-x-face ()
1229 "Append X-Face, Face or X-Image-URL field to header.
1230 If the field already exists, this function does nothing."
1231 (when (and (file-exists-p mh-x-face-file
)
1232 (file-readable-p mh-x-face-file
))
1234 (unless (or (mh-position-on-field "X-Face")
1235 (mh-position-on-field "Face")
1236 (mh-position-on-field "X-Image-URL"))
1238 (goto-char (+ (point) (cadr (insert-file-contents mh-x-face-file
))))
1239 (if (not (looking-at "^"))
1241 (unless (looking-at "\\(X-Face\\|Face\\|X-Image-URL\\): ")
1242 (insert "X-Face: "))))))
1244 (defvar mh-x-mailer-string nil
1245 "*String containing the contents of the X-Mailer header field.
1246 If nil, this variable is initialized to show the version of MH-E, Emacs, and
1247 MH the first time a message is composed.")
1249 (defun mh-insert-x-mailer ()
1250 "Append an X-Mailer field to the header.
1251 The versions of MH-E, Emacs, and MH are shown."
1252 ;; Lazily initialize mh-x-mailer-string.
1253 (when (and mh-insert-x-mailer-flag
(null mh-x-mailer-string
))
1254 (setq mh-x-mailer-string
1255 (format "MH-E %s; %s; %sEmacs %s"
1256 mh-version mh-variant-in-use
1257 (if mh-xemacs-flag
"X" "GNU ")
1258 (cond ((not mh-xemacs-flag
) emacs-version
)
1259 ((string-match "[0-9.]*\\( +\([ a-z]+[0-9]+\)\\)?"
1261 (match-string 0 emacs-version
))
1262 (t (format "%s.%s" emacs-major-version
1263 emacs-minor-version
))))))
1264 ;; Insert X-Mailer, but only if it doesn't already exist.
1266 (when (and mh-insert-x-mailer-flag
1267 (null (mh-goto-header-field "X-Mailer")))
1268 (mh-insert-fields "X-Mailer:" mh-x-mailer-string
))))
1270 (defun mh-regexp-in-field-p (regexp &rest fields
)
1271 "Non-nil means REGEXP was found in FIELDS."
1273 (let ((search-result nil
)
1276 (setq field
(car fields
))
1277 (if (and (mh-goto-header-field field
)
1279 regexp
(save-excursion (mh-header-field-end)(point)) t
))
1282 (setq fields
(cdr fields
))))
1286 (defun mh-insert-auto-fields (&optional non-interactive
)
1287 "Insert custom fields if recipient is found in `mh-auto-fields-list'.
1288 Sets buffer-local `mh-insert-auto-fields-done-local' when done and inserted
1289 something. If NON-INTERACTIVE is non-nil, do not be verbose and only
1290 attempt matches if `mh-insert-auto-fields-done-local' is nil.
1292 An `identity' entry is skipped if one was already entered manually.
1294 Return t if fields added; otherwise return nil."
1296 (when (or (not non-interactive
)
1297 (not mh-insert-auto-fields-done-local
))
1299 (when (and (or (mh-goto-header-field "To:")
1300 (mh-goto-header-field "cc:")))
1301 (let ((list mh-auto-fields-list
)
1302 (fields-inserted nil
))
1304 (let ((regexp (nth 0 (car list
)))
1305 (entries (nth 1 (car list
))))
1306 (when (mh-regexp-in-field-p regexp
"To:" "cc:")
1307 (setq mh-insert-auto-fields-done-local t
)
1308 (setq fields-inserted t
)
1309 (if (not non-interactive
)
1310 (message "Fields for %s added" regexp
))
1311 (let ((entry-list entries
))
1313 (let ((field (caar entry-list
))
1314 (value (cdar entry-list
)))
1316 ((equal ":identity" field
)
1317 (when ;;(and (not mh-identity-local)
1318 ;; Bug 1204506. But do we need to be able
1319 ;; to set an identity manually that won't be
1320 ;; overridden by mh-insert-auto-fields?
1321 (assoc value mh-identity-list
)
1323 (mh-insert-identity value
)))
1325 (mh-modify-header-field field value
1326 (equal field
"From")))))
1327 (setq entry-list
(cdr entry-list
))))))
1328 (setq list
(cdr list
)))
1329 fields-inserted
)))))
1331 (defun mh-modify-header-field (field value
&optional overwrite-flag
)
1332 "To header FIELD add VALUE.
1333 If OVERWRITE-FLAG is non-nil then the old value, if present, is discarded."
1334 (cond ((and overwrite-flag
1335 (mh-goto-header-field (concat field
":")))
1337 (delete-region (point) (line-end-position)))
1338 ((and (not overwrite-flag
)
1339 (mh-regexp-in-field-p (concat "\\b" value
"\\b") field
))
1340 ;; Already there, do nothing.
1342 ((and (not overwrite-flag
)
1343 (mh-goto-header-field (concat field
":")))
1344 (insert " " value
","))
1346 (mh-goto-header-end 0)
1347 (insert field
": " value
"\n"))))
1349 (defun mh-compose-and-send-mail (draft send-args
1350 sent-from-folder sent-from-msg
1352 annotate-char annotate-field
1354 "Edit and compose a draft message in buffer DRAFT and send or save it.
1355 SEND-ARGS is the argument passed to the send command.
1356 SENT-FROM-FOLDER is buffer containing scan listing of current folder, or
1358 SENT-FROM-MSG is the message number or sequence name or nil.
1359 The TO, SUBJECT, and CC fields are passed to the
1360 `mh-compose-letter-function'.
1361 If ANNOTATE-CHAR is non-null, it is used to notate the scan listing of the
1362 message. In that case, the ANNOTATE-FIELD is used to build a string
1363 for `mh-annotate-msg'.
1364 CONFIG is the window configuration to restore after sending the letter."
1365 (pop-to-buffer draft
)
1369 (if (and (boundp 'mh-identity-default
)
1371 (not mh-identity-local
))
1372 (mh-insert-identity mh-identity-default
))
1373 (mh-identity-make-menu)
1374 (easy-menu-add mh-identity-menu
)
1376 ;; Insert extra fields.
1377 (mh-insert-x-mailer)
1380 (mh-letter-hide-all-skipped-fields)
1382 (setq mh-sent-from-folder sent-from-folder
)
1383 (setq mh-sent-from-msg sent-from-msg
)
1384 (setq mh-send-args send-args
)
1385 (setq mh-annotate-char annotate-char
)
1386 (setq mh-annotate-field annotate-field
)
1387 (setq mh-previous-window-config config
)
1388 (setq mode-line-buffer-identification
(list " {%b}"))
1390 (mh-make-local-hook 'kill-buffer-hook
)
1391 (add-hook 'kill-buffer-hook
'mh-tidy-draft-buffer nil t
)
1392 (if (and (boundp 'mh-compose-letter-function
)
1393 mh-compose-letter-function
)
1394 ;; run-hooks will not pass arguments.
1395 (let ((value mh-compose-letter-function
))
1396 (if (and (listp value
) (not (eq (car value
) 'lambda
)))
1398 (funcall (car value
) to subject cc
)
1399 (setq value
(cdr value
)))
1400 (funcall mh-compose-letter-function to subject cc
)))))
1402 (defun mh-letter-mode-message ()
1403 "Display a help message for users of `mh-letter-mode'.
1404 This should be the last function called when composing the draft."
1405 (message "%s" (substitute-command-keys
1406 (concat "Type \\[mh-send-letter] to send message, "
1407 "\\[mh-help] for help"))))
1409 (defun mh-ascii-buffer-p ()
1410 "Check if current buffer is entirely composed of ASCII.
1411 The function doesn't work for XEmacs since `find-charset-region' doesn't exist
1413 (loop for charset in
(mh-funcall-if-exists
1414 find-charset-region
(point-min) (point-max))
1415 unless
(eq charset
'ascii
) return nil
1419 (defun mh-send-letter (&optional arg
)
1420 "Save draft and send message.
1421 When you are all through editing a message, you send it with this command. You
1422 can give an argument ARG to monitor the first stage of the delivery\; this
1423 output can be found in a buffer called \"*MH-E Mail Delivery*\".
1425 The value of `mh-before-send-letter-hook' is a list of functions to be called
1426 at the beginning of this command. For example, if you want to check your
1427 spelling in your message before sending, add the `ispell-message' function.
1429 In case the MH \"send\" program is installed under a different name, use
1430 `mh-send-prog' to tell MH-E the name."
1432 (run-hooks 'mh-before-send-letter-hook
)
1433 (if (and (mh-insert-auto-fields t
)
1434 mh-auto-fields-prompt-flag
1435 (goto-char (point-min)))
1436 (if (not (y-or-n-p "Auto fields inserted, send? "))
1437 (error "Send aborted")))
1438 (cond ((mh-mh-directive-present-p)
1440 ((or (mh-mml-tag-present-p) (not (mh-ascii-buffer-p)))
1443 (message "Sending...")
1444 (let ((draft-buffer (current-buffer))
1445 (file-name buffer-file-name
)
1446 (config mh-previous-window-config
)
1447 (coding-system-for-write
1448 (if (and (local-variable-p 'buffer-file-coding-system
1449 (current-buffer)) ;XEmacs needs two args
1450 ;; We're not sure why, but buffer-file-coding-system
1451 ;; tends to get set to undecided-unix.
1452 (not (memq buffer-file-coding-system
1453 '(undecided undecided-unix undecided-dos
))))
1454 buffer-file-coding-system
1455 (or (and (boundp 'sendmail-coding-system
) sendmail-coding-system
)
1456 (and (boundp 'default-buffer-file-coding-system
)
1457 default-buffer-file-coding-system
)
1459 ;; The default BCC encapsulation will make a MIME message unreadable.
1460 ;; With nmh use the -mime arg to prevent this.
1461 (if (and (mh-variant-p 'nmh
)
1462 (mh-goto-header-field "Bcc:")
1463 (mh-goto-header-field "Content-Type:"))
1464 (setq mh-send-args
(format "-mime %s" mh-send-args
)))
1466 (pop-to-buffer mh-mail-delivery-buffer
)
1468 (mh-exec-cmd-output mh-send-prog t
"-watch" "-nopush"
1469 "-nodraftfolder" mh-send-args file-name
)
1470 (goto-char (point-max)) ; show the interesting part
1472 (set-buffer draft-buffer
)) ; for annotation below
1474 (mh-exec-cmd-daemon mh-send-prog nil
"-nodraftfolder" "-noverbose"
1475 mh-send-args file-name
)))
1476 (if mh-annotate-char
1477 (mh-annotate-msg mh-sent-from-msg
1480 "-component" mh-annotate-field
1481 "-text" (format "\"%s %s\""
1482 (mh-get-header-field "To:")
1483 (mh-get-header-field "Cc:"))))
1485 (cond ((or (not arg
)
1486 (y-or-n-p "Kill draft buffer? "))
1487 (kill-buffer draft-buffer
)
1489 (set-window-configuration config
))))
1491 (message "Sending...done")
1492 (message "Sending...backgrounded"))))
1495 (defun mh-insert-letter (folder message verbatim
)
1497 This command prompts you for the FOLDER and MESSAGE number and inserts the
1498 message, indented by `mh-ins-buf-prefix' (\"> \") unless `mh-yank-behavior' is
1499 set to one of the supercite flavors in which case supercite is used to format
1500 the message. Certain undesirable header fields (see
1501 `mh-invisible-header-fields-compiled') are removed before insertion.
1503 If given a prefix argument VERBATIM, the header is left intact, the message is
1504 not indented, and \"> \" is not inserted before each line. This command leaves
1505 the mark before the letter and point after it."
1507 (list (mh-prompt-for-folder "Message from" mh-sent-from-folder nil
)
1508 (read-string (concat "Message number"
1509 (if (numberp mh-sent-from-msg
)
1510 (format " (default %d): " mh-sent-from-msg
)
1512 current-prefix-arg
))
1514 (narrow-to-region (point) (point))
1515 (let ((start (point-min)))
1516 (if (and (equal message
"") (numberp mh-sent-from-msg
))
1517 (setq message
(int-to-string mh-sent-from-msg
)))
1518 (insert-file-contents
1519 (expand-file-name message
(mh-expand-file-name folder
)))
1520 (when (not verbatim
)
1521 (mh-clean-msg-header start mh-invisible-header-fields-compiled nil
)
1522 (goto-char (point-max)) ;Needed for sc-cite-original
1523 (push-mark) ;Needed for sc-cite-original
1524 (goto-char (point-min)) ;Needed for sc-cite-original
1525 (mh-insert-prefix-string mh-ins-buf-prefix
)))))
1527 (defun mh-extract-from-attribution ()
1528 "Extract phrase or comment from From header field."
1530 (if (not (mh-goto-header-field "From: "))
1532 (skip-chars-forward " ")
1534 ((looking-at "\"\\([^\"\n]+\\)\" \\(<.+>\\)")
1535 (format "%s %s " (match-string 1)(match-string 2)))
1536 ((looking-at "\\([^<\n]+<.+>\\)$")
1537 (format "%s " (match-string 1)))
1538 ((looking-at "\\([^ ]+@[^ ]+\\) +(\\(.+\\))$")
1539 (format "%s <%s> " (match-string 2)(match-string 1)))
1540 ((looking-at " *\\(.+\\)$")
1541 (format "%s " (match-string 1)))))))
1544 (defun mh-yank-cur-msg ()
1545 "Insert the current message into the draft buffer.
1547 It is often useful to insert a snippet of text from a letter that someone
1548 mailed to provide some context for your reply. This command does this by
1549 adding an attribution, yanking a portion of text from the message to which
1550 you're replying, and inserting `mh-ins-buf-prefix' (`> ') before each line.
1552 The attribution consists of the sender's name and email address
1553 followed by the content of the `mh-extract-from-attribution-verb'
1556 You can also turn on the `mh-delete-yanked-msg-window-flag' option to delete
1557 the window containing the original message after yanking it to make more room
1558 on your screen for your reply.
1560 You can control how the message to which you are replying is yanked
1561 into your reply using `mh-yank-behavior'.
1563 If this isn't enough, you can gain full control over the appearance of the
1564 included text by setting `mail-citation-hook' to a function that modifies it."
1566 (if (and mh-sent-from-folder
1567 (save-excursion (set-buffer mh-sent-from-folder
) mh-show-buffer
)
1568 (save-excursion (set-buffer mh-sent-from-folder
)
1569 (get-buffer mh-show-buffer
))
1571 (let ((to-point (point))
1572 (to-buffer (current-buffer)))
1573 (set-buffer mh-sent-from-folder
)
1574 (if mh-delete-yanked-msg-window-flag
1575 (delete-windows-on mh-show-buffer
))
1576 (set-buffer mh-show-buffer
) ; Find displayed message
1577 (let* ((from-attr (mh-extract-from-attribution))
1578 (yank-region (mh-mark-active-p nil
))
1580 (cond ((and yank-region
1581 (or (eq 'supercite mh-yank-behavior
)
1582 (eq 'autosupercite mh-yank-behavior
)
1583 (eq t mh-yank-behavior
)))
1584 ;; supercite needs the full header
1586 (buffer-substring (point-min) (mh-mail-header-end))
1588 (buffer-substring (region-beginning) (region-end))))
1590 (buffer-substring (region-beginning) (region-end)))
1591 ((or (eq 'body mh-yank-behavior
)
1592 (eq 'attribution mh-yank-behavior
)
1593 (eq 'autoattrib mh-yank-behavior
))
1596 (goto-char (point-min))
1597 (mh-goto-header-end 1)
1600 ((or (eq 'supercite mh-yank-behavior
)
1601 (eq 'autosupercite mh-yank-behavior
)
1602 (eq t mh-yank-behavior
))
1603 (buffer-substring (point-min) (point-max)))
1605 (buffer-substring (point) (point-max))))))
1606 (set-buffer to-buffer
)
1608 (narrow-to-region to-point to-point
)
1609 (insert (mh-filter-out-non-text mh-ins-str
))
1610 (goto-char (point-max)) ;Needed for sc-cite-original
1611 (push-mark) ;Needed for sc-cite-original
1612 (goto-char (point-min)) ;Needed for sc-cite-original
1613 (mh-insert-prefix-string mh-ins-buf-prefix
)
1614 (when (or (eq 'attribution mh-yank-behavior
)
1615 (eq 'autoattrib mh-yank-behavior
))
1617 (mh-identity-insert-attribution-verb nil
)
1619 ;; If the user has selected a region, he has already "edited" the
1620 ;; text, so leave the cursor at the end of the yanked text. In
1621 ;; either case, leave a mark at the opposite end of the included
1622 ;; text to make it easy to jump or delete to the other end of the
1625 (goto-char (point-max))
1626 (if (null yank-region
)
1627 (mh-exchange-point-and-mark-preserving-active-mark)))))
1628 (error "There is no current message")))
1630 (defun mh-filter-out-non-text (string)
1631 "Return STRING but without adornments such as MIME buttons and smileys."
1633 ;; Insert the string to filter
1635 (goto-char (point-min))
1637 ;; Remove the MIME buttons
1638 (let ((can-move-forward t
)
1640 (while can-move-forward
1641 (cond ((and (not (get-text-property (point) 'mh-data
))
1643 (delete-region (1- (point)) (point))
1644 (setq in-button nil
))
1645 ((get-text-property (point) 'mh-data
)
1646 (delete-region (point)
1647 (save-excursion (forward-line) (point)))
1649 (t (setq can-move-forward
(= (forward-line) 0))))))
1651 ;; Return the contents without properties... This gets rid of emphasis
1653 (buffer-substring-no-properties (point-min) (point-max))))
1655 (defun mh-insert-prefix-string (mh-ins-string)
1656 "Insert prefix string before each line in buffer.
1657 The inserted letter is cited using `sc-cite-original' if `mh-yank-behavior' is
1658 one of 'supercite or 'autosupercite. Otherwise, simply insert MH-INS-STRING
1660 (goto-char (point-min))
1661 (cond ((or (eq mh-yank-behavior
'supercite
)
1662 (eq mh-yank-behavior
'autosupercite
))
1665 (run-hooks 'mail-citation-hook
))
1666 (mh-yank-hooks ;old hook name
1667 (run-hooks 'mh-yank-hooks
))
1669 (or (bolp) (forward-line 1))
1670 (while (< (point) (point-max))
1671 (insert mh-ins-string
)
1673 (goto-char (point-min))))) ;leave point like sc-cite-original
1676 (defun mh-fully-kill-draft ()
1677 "Quit editing and delete draft message.
1678 If for some reason you are not happy with the draft, you can use the this
1679 command to kill the draft buffer and delete the draft message. Use the
1680 \\[kill-buffer] command if you don't want to delete the draft message."
1682 (if (y-or-n-p "Kill draft message? ")
1683 (let ((config mh-previous-window-config
))
1684 (if (file-exists-p buffer-file-name
)
1685 (delete-file buffer-file-name
))
1686 (set-buffer-modified-p nil
)
1687 (kill-buffer (buffer-name))
1690 (set-window-configuration config
)))
1691 (error "Message not killed")))
1693 (defun mh-current-fill-prefix ()
1694 "Return the `fill-prefix' on the current line as a string."
1697 ;; This assumes that the major-mode sets up adaptive-fill-regexp
1698 ;; correctly such as mh-letter-mode or sendmail.el's mail-mode. But
1699 ;; perhaps I should use the variable and simply inserts its value here,
1700 ;; and set it locally in a let scope. --psg
1701 (if (re-search-forward adaptive-fill-regexp nil t
)
1706 (defun mh-open-line ()
1707 "Insert a newline and leave point after it.
1708 This command is similar to the \\[open-line] command in that it inserts a
1709 newline after point. It differs in that it also inserts the right number of
1710 quoting characters and spaces so that the next line begins in the same column
1711 as it was. This is useful when breaking up paragraphs in replies."
1713 (let ((column (current-column))
1714 (prefix (mh-current-fill-prefix)))
1715 (if (> (length prefix
) column
)
1716 (message "Sorry, point seems to be within the line prefix")
1719 (while (> column
(current-column))
1721 (forward-line -
1))))
1723 (mh-do-in-xemacs (defvar mail-abbrevs
))
1725 (defmacro mh-display-completion-list-compat
(word choices
)
1726 "Completes WORD from CHOICES using `display-completion-list'.
1727 Calls `display-completion-list' correctly in older environments.
1728 Versions of Emacs prior to version 22 lacked a COMMON-SUBSTRING argument
1729 which is used to highlight the next possible character you can enter
1730 in the current list of completions."
1731 (if (>= emacs-major-version
22)
1732 `(display-completion-list (all-completions ,word
,choices
) ,word
)
1733 `(display-completion-list (all-completions ,word
,choices
))))
1736 (defun mh-complete-word (word choices begin end
)
1737 "Complete WORD at from CHOICES.
1738 Any match found replaces the text from BEGIN to END."
1739 (let ((completion (try-completion word choices
))
1740 (completions-buffer "*Completions*"))
1741 (cond ((eq completion t
)
1743 (kill-buffer completions-buffer
))
1744 (message "Completed: %s" word
))
1747 (kill-buffer completions-buffer
))
1748 (message "No completion for `%s'" word
))
1749 ((stringp completion
)
1750 (if (equal word completion
)
1751 (with-output-to-temp-buffer completions-buffer
1752 (mh-display-completion-list-compat word choices
))
1754 (kill-buffer completions-buffer
))
1755 (delete-region begin end
)
1756 (insert completion
))))))
1759 (defun mh-beginning-of-word (&optional n
)
1760 "Return position of the N th word backwards."
1761 (unless n
(setq n
1))
1762 (let ((syntax-table (syntax-table)))
1765 (mh-mail-abbrev-make-syntax-table)
1766 (set-syntax-table mail-abbrev-syntax-table
)
1769 (set-syntax-table syntax-table
))))
1771 (defun mh-folder-expand-at-point ()
1772 "Do folder name completion in Fcc header field."
1773 (let* ((end (point))
1774 (beg (mh-beginning-of-word))
1775 (folder (buffer-substring beg end
))
1776 (leading-plus (and (> (length folder
) 0) (equal (aref folder
0) ?
+)))
1777 (last-slash (mh-search-from-end ?
/ folder
))
1778 (prefix (and last-slash
(substring folder
0 last-slash
)))
1779 (choices (mapcar #'(lambda (x)
1780 (list (cond (prefix (format "%s/%s" prefix x
))
1781 (leading-plus (format "+%s" x
))
1783 (mh-folder-completion-function folder nil t
))))
1784 (mh-complete-word folder choices beg end
)))
1786 (defvar mh-letter-complete-function-alist
1787 '((cc . mh-alias-letter-expand-alias
)
1788 (bcc . mh-alias-letter-expand-alias
)
1789 (dcc . mh-alias-letter-expand-alias
)
1790 (fcc . mh-folder-expand-at-point
)
1791 (from . mh-alias-letter-expand-alias
)
1792 (mail-followup-to . mh-alias-letter-expand-alias
)
1793 (reply-to . mh-alias-letter-expand-alias
)
1794 (to . mh-alias-letter-expand-alias
))
1795 "Alist of header fields and completion functions to use.")
1797 (defun mh-letter-complete (arg)
1798 "Perform completion on header field or word preceding point.
1799 If the field contains addresses (for example, \"To:\" or \"Cc:\") or folders
1800 \(for example, \"Fcc:\") then this command will provide alias completion. In
1801 the body of the message, this command runs `mh-letter-complete-function'
1802 instead, which is set to \"'ispell-complete-word\" by default. This command
1803 takes a prefix argument ARG that is passed to the
1804 `mh-letter-complete-function'."
1807 (cond ((not (mh-in-header-p))
1808 (funcall mh-letter-complete-function arg
))
1809 ((setq func
(cdr (assoc (mh-letter-header-field-at-point)
1810 mh-letter-complete-function-alist
)))
1812 (t (funcall mh-letter-complete-function arg
)))))
1814 (defun mh-letter-complete-or-space (arg)
1815 "Perform completion or insert space.
1816 Turn on the `mh-compose-space-does-completion-flag' option to use this command
1817 to perform completion in the header. Otherwise, a space is inserted.
1819 ARG is the number of spaces inserted."
1822 (end-of-prev (save-excursion
1823 (goto-char (mh-beginning-of-word))
1824 (mh-beginning-of-word -
1))))
1825 (cond ((not mh-compose-space-does-completion-flag
)
1826 (self-insert-command arg
))
1827 ((not (mh-in-header-p)) (self-insert-command arg
))
1828 ((> (point) end-of-prev
) (self-insert-command arg
))
1829 ((setq func
(cdr (assoc (mh-letter-header-field-at-point)
1830 mh-letter-complete-function-alist
)))
1832 (t (self-insert-command arg
)))))
1834 (defun mh-letter-confirm-address ()
1835 "Flash alias expansion.
1836 Addresses are separated by a comma\; and when you press the comma, this
1837 command flashes the alias expansion in the minibuffer if
1838 `mh-alias-flash-on-comma' is turned on."
1840 (cond ((not (mh-in-header-p)) (self-insert-command 1))
1841 ((eq (cdr (assoc (mh-letter-header-field-at-point)
1842 mh-letter-complete-function-alist
))
1843 'mh-alias-letter-expand-alias
)
1844 (mh-alias-reload-maybe)
1845 (mh-alias-minibuffer-confirm-address))
1846 (t (self-insert-command 1))))
1848 (defvar mh-letter-header-field-regexp
"^\\([A-Za-z][A-Za-z0-9-]*\\):")
1850 (defun mh-letter-header-field-at-point ()
1851 "Return the header field name at point.
1852 A symbol is returned whose name is the string obtained by downcasing the field
1856 (and (re-search-backward mh-letter-header-field-regexp nil t
)
1857 (intern (downcase (match-string 1))))))
1860 (defun mh-letter-next-header-field-or-indent (arg)
1861 "Move to next field or indent depending on point.
1862 Within the header of the message, this command moves between fields, but skips
1863 those fields listed in `mh-compose-skipped-header-fields'. After the last
1864 field, this command then moves point to the message body before cycling back
1865 to the first field. If point is already past the first line of the message
1866 body, then this command indents by calling `indent-relative' with the given
1867 prefix argument ARG."
1869 (let ((header-end (save-excursion
1870 (goto-char (mh-mail-header-end))
1873 (if (> (point) header-end
)
1874 (indent-relative arg
)
1875 (mh-letter-next-header-field))))
1877 (defun mh-letter-next-header-field ()
1878 "Cycle to the next header field.
1879 If we are at the last header field go to the start of the message body."
1880 (let ((header-end (mh-mail-header-end)))
1881 (cond ((>= (point) header-end
) (goto-char (point-min)))
1884 (re-search-forward mh-letter-header-field-regexp
1885 (line-end-position) t
)
1887 (beginning-of-line))
1889 (cond ((re-search-forward mh-letter-header-field-regexp header-end t
)
1890 (if (mh-letter-skipped-header-field-p (match-string 1))
1891 (mh-letter-next-header-field)
1892 (mh-letter-skip-leading-whitespace-in-header-field)))
1893 (t (goto-char header-end
)
1897 (defun mh-letter-previous-header-field ()
1898 "Cycle to the previous header field.
1899 This command moves backwards between the fields and cycles to the body of the
1900 message after the first field. Unlike the
1901 \\[mh-letter-next-header-field-or-indent] command, it will always take point
1902 to the last field from anywhere in the body."
1904 (let ((header-end (mh-mail-header-end)))
1905 (if (>= (point) header-end
)
1906 (goto-char header-end
)
1907 (mh-header-field-beginning))
1908 (cond ((re-search-backward mh-letter-header-field-regexp nil t
)
1909 (if (mh-letter-skipped-header-field-p (match-string 1))
1910 (mh-letter-previous-header-field)
1911 (goto-char (match-end 0))
1912 (mh-letter-skip-leading-whitespace-in-header-field)))
1913 (t (goto-char header-end
)
1916 (defun mh-letter-skipped-header-field-p (field)
1917 "Check if FIELD is to be skipped."
1918 (let ((field (downcase field
)))
1919 (loop for x in mh-compose-skipped-header-fields
1920 when
(equal (downcase x
) field
) return t
1921 finally return nil
)))
1923 (defun mh-letter-skip-leading-whitespace-in-header-field ()
1924 "Skip leading whitespace in a header field.
1925 If the header field doesn't have at least one space after the colon then a
1926 space character is added."
1927 (let ((need-space t
))
1928 (while (memq (char-after) '(?
\t ?\
))
1930 (setq need-space nil
))
1931 (when need-space
(insert " "))))
1933 (defvar mh-hidden-header-keymap
1934 (let ((map (make-sparse-keymap)))
1936 (define-key map
[mouse-2
] 'mh-letter-toggle-header-field-display-button
))
1938 (define-key map
'(button2)
1939 'mh-letter-toggle-header-field-display-button
))
1942 (defun mh-letter-toggle-header-field-display-button (event)
1943 "Toggle header field display at location of EVENT.
1944 This function does the same thing as `mh-letter-toggle-header-field-display'
1945 except that it is callable from a mouse button."
1947 (mh-do-at-event-location event
1948 (mh-letter-toggle-header-field-display nil
)))
1950 (defun mh-letter-toggle-header-field-display (arg)
1951 "Toggle display of header field at point.
1953 Use this command to display ellipsed header fields. This command is a toggle
1954 so entering it again will hide the field. This command takes a prefix argument
1955 ARG: if negative then the field is hidden, if positive then the field is
1957 (interactive (list nil
))
1958 (when (and (mh-in-header-p)
1961 (re-search-backward mh-letter-header-field-regexp nil t
)))
1962 (let ((buffer-read-only nil
)
1963 (modified-flag (buffer-modified-p))
1967 (setq end
(1- (if (re-search-forward "^[^ \t]" nil t
)
1971 ;; Make it clickable...
1972 (add-text-properties begin end
`(keymap ,mh-hidden-header-keymap
1973 mouse-face highlight
))
1975 (cond ((or (and (not arg
)
1976 (text-property-any begin end
'invisible
'vanish
))
1977 (and (numberp arg
) (>= arg
0))
1978 (and (eq arg
'long
) (> (line-beginning-position 5) end
)))
1979 (remove-text-properties begin end
'(invisible nil
))
1980 (search-forward ":" (line-end-position) t
)
1981 (mh-letter-skip-leading-whitespace-in-header-field))
1982 ;; XXX Redesign to make usable by user. Perhaps use a positive
1983 ;; numeric prefix to make that many lines visible.
1986 (mh-letter-truncate-header-field end
)
1987 (beginning-of-line))
1989 (mh-letter-truncate-header-field end
)
1990 (beginning-of-line)))
1991 (set-buffer-modified-p modified-flag
)))))
1993 (defun mh-letter-truncate-header-field (end)
1994 "Replace text from current line till END with an ellipsis.
1995 If the current line is too long truncate a part of it as well."
1996 (let ((max-len (min (window-width) 62)))
1997 (when (> (+ (current-column) 4) max-len
)
1998 (backward-char (- (+ (current-column) 5) max-len
)))
1999 (when (> end
(point))
2000 (add-text-properties (point) end
'(invisible vanish
)))))
2002 (defun mh-letter-hide-all-skipped-fields ()
2003 "Hide all skipped fields."
2005 (goto-char (point-min))
2007 (narrow-to-region (point) (mh-mail-header-end))
2008 (while (re-search-forward mh-letter-header-field-regexp nil t
)
2009 (if (mh-letter-skipped-header-field-p (match-string 1))
2010 (mh-letter-toggle-header-field-display -
1)
2011 (mh-letter-toggle-header-field-display 'long
))
2012 (beginning-of-line 2)))))
2014 (defun mh-interactive-read-address (prompt)
2016 If `mh-compose-prompt-flag' is non-nil, then read an address with PROMPT.
2017 Otherwise return the empty string."
2018 (if mh-compose-prompt-flag
(mh-read-address prompt
) ""))
2020 (defun mh-interactive-read-string (prompt)
2022 If `mh-compose-prompt-flag' is non-nil, then read a string with PROMPT.
2023 Otherwise return the empty string."
2024 (if mh-compose-prompt-flag
(read-string prompt
) ""))
2026 (defun mh-letter-adjust-point ()
2027 "Move cursor to first header field if are using the no prompt mode."
2028 (unless mh-compose-prompt-flag
2029 (goto-char (point-max))
2030 (mh-letter-next-header-field)))
2032 ;;; Build the letter-mode keymap:
2033 ;;; If this changes, modify mh-letter-mode-help-messages accordingly, above.
2034 (gnus-define-keys mh-letter-mode-map
2035 " " mh-letter-complete-or-space
2036 "," mh-letter-confirm-address
2038 "\C-c\C-\\" mh-fully-kill-draft
;if no C-q
2039 "\C-c\C-^" mh-insert-signature
;if no C-s
2040 "\C-c\C-c" mh-send-letter
2041 "\C-c\C-d" mh-insert-identity
2042 "\C-c\C-e" mh-mh-to-mime
2043 "\C-c\C-f\C-b" mh-to-field
2044 "\C-c\C-f\C-c" mh-to-field
2045 "\C-c\C-f\C-d" mh-to-field
2046 "\C-c\C-f\C-f" mh-to-fcc
2047 "\C-c\C-f\C-r" mh-to-field
2048 "\C-c\C-f\C-s" mh-to-field
2049 "\C-c\C-f\C-t" mh-to-field
2050 "\C-c\C-fb" mh-to-field
2051 "\C-c\C-fc" mh-to-field
2052 "\C-c\C-fd" mh-to-field
2053 "\C-c\C-ff" mh-to-fcc
2054 "\C-c\C-fr" mh-to-field
2055 "\C-c\C-fs" mh-to-field
2056 "\C-c\C-ft" mh-to-field
2057 "\C-c\C-i" mh-insert-letter
2058 "\C-c\C-m\C-e" mh-mml-secure-message-encrypt
2059 "\C-c\C-m\C-f" mh-compose-forward
2060 "\C-c\C-m\C-g" mh-mh-compose-anon-ftp
2061 "\C-c\C-m\C-i" mh-compose-insertion
2062 "\C-c\C-m\C-m" mh-mml-to-mime
2063 "\C-c\C-m\C-n" mh-mml-unsecure-message
2064 "\C-c\C-m\C-s" mh-mml-secure-message-sign
2065 "\C-c\C-m\C-t" mh-mh-compose-external-compressed-tar
2066 "\C-c\C-m\C-u" mh-mh-to-mime-undo
2067 "\C-c\C-m\C-x" mh-mh-compose-external-type
2068 "\C-c\C-mee" mh-mml-secure-message-encrypt
2069 "\C-c\C-mes" mh-mml-secure-message-signencrypt
2070 "\C-c\C-mf" mh-compose-forward
2071 "\C-c\C-mg" mh-mh-compose-anon-ftp
2072 "\C-c\C-mi" mh-compose-insertion
2073 "\C-c\C-mm" mh-mml-to-mime
2074 "\C-c\C-mn" mh-mml-unsecure-message
2075 "\C-c\C-mse" mh-mml-secure-message-signencrypt
2076 "\C-c\C-mss" mh-mml-secure-message-sign
2077 "\C-c\C-mt" mh-mh-compose-external-compressed-tar
2078 "\C-c\C-mu" mh-mh-to-mime-undo
2079 "\C-c\C-mx" mh-mh-compose-external-type
2080 "\C-c\C-o" mh-open-line
2081 "\C-c\C-q" mh-fully-kill-draft
2082 "\C-c\C-s" mh-insert-signature
2083 "\C-c\C-t" mh-letter-toggle-header-field-display
2084 "\C-c\C-w" mh-check-whom
2085 "\C-c\C-y" mh-yank-cur-msg
2086 "\C-c\M-d" mh-insert-auto-fields
2087 "\M-\t" mh-letter-complete
2088 "\t" mh-letter-next-header-field-or-indent
2089 [backtab] mh-letter-previous-header-field)
2091 ;; "C-c /" prefix is used in mh-letter-mode by pgp.el and mailcrypt.el.
2095 ;;; Local Variables:
2096 ;;; indent-tabs-mode: nil
2097 ;;; sentence-end-double-space: nil
2100 ;;; arch-tag: 62865511-e610-4923-b0b5-f45a8ab70a34
2101 ;;; mh-comp.el ends here