;;; mh-comp.el --- MH-E functions for composing messages
-;; Copyright (C) 1993, 95, 1997,
-;; 2000, 01, 02, 2003 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1995, 1997,
+;; 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;; Code:
+(eval-when-compile (require 'mh-acros))
+(mh-require-cl)
(require 'mh-e)
(require 'gnus-util)
(require 'easymenu)
-(require 'cl)
+(require 'mh-gnus)
(eval-when (compile load eval)
(ignore-errors (require 'mailabbrev)))
(defvar sendmail-coding-system)
(defvar mh-identity-list)
(defvar mh-identity-default)
+(defvar mh-mml-mode-default)
(defvar mh-identity-menu)
;;; Autoloads
-(autoload 'Info-goto-node "info")
(autoload 'mail-mode-fill-paragraph "sendmail")
(autoload 'mm-handle-displayed-p "mm-decode")
(autoload 'sc-cite-original "sc"
"Workhorse citing function which performs the initial citation.
This is callable from the various mail and news readers' reply
-function according to the agreed upon standard. See `\\[sc-describe]'
+function according to the agreed upon standard. See `sc-describe'
for more details. `sc-cite-original' does not do any yanking of the
original message but it does require a few things:
This allows transaction log to be visible if -watch, -verbose or -snoop are
used.")
-(defvar mh-note-repl "-"
- "String whose first character is used to notate replied to messages.")
+;;; Scan Line Formats
-(defvar mh-note-forw "F"
- "String whose first character is used to notate forwarded messages.")
+(defvar mh-note-repl ?-
+ "Messages that have been replied to are marked by this character.")
-(defvar mh-note-dist "R"
- "String whose first character is used to notate redistributed messages.")
+(defvar mh-note-forw ?F
+ "Messages that have been forwarded are marked by this character.")
+
+(defvar mh-note-dist ?R
+ "Messages that have been redistributed are marked by this character.")
(defvar mh-yank-hooks nil
"Obsolete hook for modifying a citation just inserted in the mail buffer.
This is a normal hook, misnamed for historical reasons.
It is semi-obsolete and is only used if `mail-citation-hook' is nil.")
-(defvar mail-citation-hook nil
- "*Hook for modifying a citation just inserted in the mail buffer.
-Each hook function can find the citation between point and mark.
-And each hook function should leave point and mark around the citation
-text as modified.
-
-If this hook is entirely empty (nil), the text of the message is inserted
-with `mh-ins-buf-prefix' prefixed to each line.
-
-See also the variable `mh-yank-from-start-of-msg', which controls how
-much of the message passed to the hook.
-
-This hook was historically provided to set up supercite. You may now leave
-this nil and set up supercite by setting the variable
-`mh-yank-from-start-of-msg' to 'supercite or, for more automatic insertion,
-to 'autosupercite.")
-
(defvar mh-comp-formfile "components"
"Name of file to be used as a skeleton for composing messages.
Default is \"components\". If not an absolute file name, the file
(defvar mh-repl-group-formfile "replgroupcomps"
"Name of file to be used as a skeleton for replying to messages.
This file is used to form replies to the sender and all recipients of a
-message. Only used if `mh-nmh-flag' is non-nil. Default is \"replgroupcomps\".
+message. Only used if `(mh-variant-p 'nmh)' is non-nil.
+Default is \"replgroupcomps\".
If not an absolute file name, the file is searched for first in the user's MH
directory, then in the system MH lib directory.")
(format "^%s$"
(regexp-opt
'("Content-Type: message/rfc822" ;MIME MDN
+ "------ This is a copy of the message, including all the headers. ------";from exim
+ "--- Below this line is a copy of the message."; from qmail
" ----- Unsent message follows -----" ;from sendmail V5
" --------Unsent Message below:" ; from sendmail at BU
" ----- Original message follows -----" ;from sendmail V8
(defvar mh-annotate-field nil
"Field name for message annotation.")
+(defvar mh-insert-auto-fields-done-local nil
+ "Buffer-local variable set when `mh-insert-auto-fields' called successfully.")
+(make-variable-buffer-local 'mh-insert-auto-fields-done-local)
+
;;;###autoload
(defun mh-smail ()
"Compose and send mail with the MH mail system.
-This function is an entry point to MH-E, the Emacs front end
-to the MH mail system.
+This function is an entry point to MH-E, the Emacs interface to the MH mail
+system.
-See documentation of `\\[mh-send]' for more details on composing mail."
+See `mh-send' for more details on composing mail."
(interactive)
(mh-find-path)
(call-interactively 'mh-send))
;;;###autoload
(defun mh-smail-batch (&optional to subject other-headers &rest ignored)
"Set up a mail composition draft with the MH mail system.
-This function is an entry point to MH-E, the Emacs front end
-to the MH mail system. This function does not prompt the user
-for any header fields, and thus is suitable for use by programs
-that want to create a mail buffer.
-Users should use `\\[mh-smail]' to compose mail.
+This function is an entry point to MH-E, the Emacs interface to the MH mail
+system. This function does not prompt the user for any header fields, and thus
+is suitable for use by programs that want to create a mail buffer. Users
+should use `mh-smail' to compose mail.
+
Optional arguments for setting certain fields include TO, SUBJECT, and
OTHER-HEADERS. Additional arguments are IGNORED."
(mh-find-path)
"Clean up a draft or a message MSG previously sent and make it resendable.
Default is the current message.
The variable `mh-new-draft-cleaned-headers' specifies the headers to remove.
-See also documentation for `\\[mh-send]' function."
+
+See also `mh-send'."
(interactive (list (mh-get-msg-num t)))
(let* ((from-folder mh-current-folder)
(config (current-window-configuration))
(save-buffer)
(mh-compose-and-send-mail draft "" from-folder nil nil nil nil nil nil
config)
- (mh-letter-mode-message)))
+ (mh-letter-mode-message)
+ (mh-letter-adjust-point)))
;;;###mh-autoload
(defun mh-extract-rejected-mail (msg)
"Extract message MSG returned by the mail system and make it resendable.
Default is the current message. The variable `mh-new-draft-cleaned-headers'
gives the headers to clean out of the original message.
-See also documentation for `\\[mh-send]' function."
+
+See also `mh-send'."
(interactive (list (mh-get-msg-num t)))
(let ((from-folder mh-current-folder)
(config (current-window-configuration))
(delete-region (point-min) (point))
(mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil))
(t
- (message "Does not appear to be a rejected letter.")))
+ (message "Does not appear to be a rejected letter")))
(mh-insert-header-separator)
(goto-char (point-min))
(save-buffer)
(mh-letter-mode-message)))
;;;###mh-autoload
-(defun mh-forward (to cc &optional msg-or-seq)
+(defun mh-forward (to cc &optional range)
"Forward messages to the recipients TO and CC.
-Use optional MSG-OR-SEQ argument to specify a message or sequence to forward.
+Use optional RANGE argument to specify a message or sequence to forward.
Default is the displayed message.
-If optional prefix argument is provided, then prompt for the message sequence.
-If variable `transient-mark-mode' is non-nil and the mark is active, then the
-selected region is forwarded.
-In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a
-region in a cons cell, or a sequence.
-
-See also documentation for `\\[mh-send]' function."
- (interactive (list (mh-read-address "To: ")
- (mh-read-address "Cc: ")
- (mh-interactive-msg-or-seq "Forward")))
+
+Check the documentation of `mh-interactive-range' to see how RANGE is read in
+interactive use.
+
+See also `mh-send'."
+ (interactive (list (mh-interactive-read-address "To: ")
+ (mh-interactive-read-address "Cc: ")
+ (mh-interactive-range "Forward")))
(let* ((folder mh-current-folder)
- (msgs (mh-msg-or-seq-to-msg-list msg-or-seq))
+ (msgs (mh-range-to-msg-list range))
(config (current-window-configuration))
(fwd-msg-file (mh-msg-filename (car msgs) folder))
;; forw always leaves file in "draft" since it doesn't have -draft
(draft-name (expand-file-name "draft" mh-user-path))
(draft (cond ((or (not (file-exists-p draft-name))
(y-or-n-p "The file 'draft' exists. Discard it? "))
- (mh-exec-cmd "forw" "-build" (if mh-nmh-flag "-mime")
+ (mh-exec-cmd "forw" "-build"
+ (if (and (mh-variant-p 'nmh)
+ mh-compose-forward-as-mime-flag)
+ "-mime")
mh-current-folder
(mh-coalesce-msg-list msgs))
(prog1
;; If using MML, translate mhn
(if (equal mh-compose-insertion 'gnus)
(save-excursion
- (re-search-forward (format "^\\(%s\\)?$"
- mh-mail-header-separator))
+ (goto-char (mh-mail-header-end))
(while
(re-search-forward
"^#forw \\[\\([^]]+\\)\\] \\(+\\S-+\\) \\(.*\\)$"
;; Postition just before forwarded message
(if (re-search-forward "^------- Forwarded Message" nil t)
(forward-line -1)
- (re-search-forward (format "^\\(%s\\)?$" mh-mail-header-separator))
+ (goto-char (mh-mail-header-end))
(forward-line 1))
(delete-other-windows)
(mh-add-msgs-to-seq msgs 'forwarded t)
to forw-subject cc
mh-note-forw "Forwarded:"
config)
- (mh-letter-mode-message)))))
+ (mh-letter-mode-message)
+ (mh-letter-adjust-point)
+ (run-hooks 'mh-forward-hook)))))
(defun mh-forwarded-letter-subject (from subject)
"Return a Subject suitable for a forwarded message.
;;;###autoload
(defun mh-smail-other-window ()
"Compose and send mail in other window with the MH mail system.
-This function is an entry point to MH-E, the Emacs front end
-to the MH mail system.
+This function is an entry point to MH-E, the Emacs interface to the MH mail
+system.
-See documentation of `\\[mh-send]' for more details on composing mail."
+See `mh-send' for more details on composing mail."
(interactive)
(mh-find-path)
(call-interactively 'mh-send-other-window))
cc/all sender and all recipients.
If optional prefix argument INCLUDEP provided, then include the message
in the reply using filter `mhl.reply' in your MH directory.
-If the file named by `mh-repl-formfile' exists, it is used as a skeleton
-for the reply. See also documentation for `\\[mh-send]' function."
+If the file named by `mh-repl-formfile' exists, it is used as a skeleton for
+the reply. If REPLY-TO is cc or all and you're using either the nmh or GNU
+mailutils variants and the file names by `mh-repl-group-formfile' exists, it
+is used instead.
+
+See also `mh-send'."
(interactive (list
(mh-get-msg-num t)
(let ((minibuffer-help-form
"from => Sender only\nto => Sender and primary recipients\ncc or all => Sender and all recipients"))
(or mh-reply-default-reply-to
- (completing-read "Reply to whom? (from, to, all) [from]: "
+ (completing-read "Reply to whom: [from] "
'(("from") ("to") ("cc") ("all"))
nil
t)))
(show-buffer mh-show-buffer)
(config (current-window-configuration))
(group-reply (or (equal reply-to "cc") (equal reply-to "all")))
- (form-file (cond ((and mh-nmh-flag group-reply
+ (form-file (cond ((and (mh-variant-p 'nmh 'mu-mh) group-reply
(stringp mh-repl-group-formfile))
mh-repl-group-formfile)
((stringp mh-repl-formfile) mh-repl-formfile)
'("-nocc" "all"))
((equal reply-to "to")
'("-cc" "to"))
- (group-reply (if mh-nmh-flag
+ (group-reply (if (mh-variant-p 'nmh 'mu-mh)
'("-group" "-nocc" "me")
'("-cc" "all" "-nocc" "me"))))
(cond ((or (eq mh-yank-from-start-of-msg 'autosupercite)
;;;###mh-autoload
(defun mh-send (to cc subject)
"Compose and send a letter.
-
Do not call this function from outside MH-E; use \\[mh-smail] instead.
The file named by `mh-comp-formfile' will be used as the form.
If `mh-compose-letter-function' is defined, it is called on the draft and
passed three arguments: TO, CC, and SUBJECT."
(interactive (list
- (mh-read-address "To: ")
- (mh-read-address "Cc: ")
- (read-string "Subject: ")))
+ (mh-interactive-read-address "To: ")
+ (mh-interactive-read-address "Cc: ")
+ (mh-interactive-read-string "Subject: ")))
(let ((config (current-window-configuration)))
(delete-other-windows)
(mh-send-sub to cc subject config)))
;;;###mh-autoload
(defun mh-send-other-window (to cc subject)
"Compose and send a letter in another window.
-
Do not call this function from outside MH-E; use \\[mh-smail-other-window]
instead.
If `mh-compose-letter-function' is defined, it is called on the draft and
passed three arguments: TO, CC, and SUBJECT."
(interactive (list
- (mh-read-address "To: ")
- (mh-read-address "Cc: ")
- (read-string "Subject: ")))
+ (mh-interactive-read-address "To: ")
+ (mh-interactive-read-address "Cc: ")
+ (mh-interactive-read-string "Subject: ")))
(let ((pop-up-windows t))
(mh-send-sub to cc subject (current-window-configuration))))
)))
components)
(t
- (error (format "Can't find components file \"%s\""
- components)))))
+ (error "Can't find components file \"%s\""
+ components))))
nil)))
(mh-insert-fields "To:" to "Subject:" subject "Cc:" cc)
(goto-char (point-max))
(mh-compose-and-send-mail draft "" folder msg-num
to subject cc
nil nil config)
- (mh-letter-mode-message))))
+ (mh-letter-mode-message)
+ (mh-letter-adjust-point))))
(defun mh-read-draft (use initial-contents delete-contents-file)
"Read draft file into a draft buffer and make that buffer the current one.
(save-excursion
(cond ((get-buffer buffer) ; Buffer may be deleted
(set-buffer buffer)
- (mh-iterate-on-msg-or-seq nil msg
+ (mh-iterate-on-range nil msg
(mh-notate nil note (1+ mh-cmd-note)))))))
(defun mh-insert-fields (&rest name-values)
(while name-values
(let ((field-name (car name-values))
(value (car (cdr name-values))))
+ (if (not (string-match "^.*:$" field-name))
+ (setq field-name (concat field-name ":")))
(cond ((equal value "")
nil)
((mh-position-on-field field-name)
((mh-goto-header-end 0)
nil)))
+;;;###mh-autoload
(defun mh-get-header-field (field)
"Find and return the body of FIELD in the mail header.
Returns the empty string if the field is not in the header of the
;;; Menu extracted from mh-menubar.el V1.1 (31 July 2001)
(eval-when-compile (defvar mh-letter-menu nil))
-(cond
- ((fboundp 'easy-menu-define)
- (easy-menu-define
- mh-letter-menu mh-letter-mode-map "Menu for MH-E letter mode."
- '("Letter"
- ["Send This Draft" mh-send-letter t]
- ["Split Current Line" mh-open-line t]
- ["Check Recipient" mh-check-whom t]
- ["Yank Current Message" mh-yank-cur-msg t]
- ["Insert a Message..." mh-insert-letter t]
- ["Insert Signature" mh-insert-signature t]
- ["GPG Sign message"
- mh-mml-secure-message-sign-pgpmime mh-gnus-pgp-support-flag]
- ["GPG Encrypt message"
- mh-mml-secure-message-encrypt-pgpmime mh-gnus-pgp-support-flag]
- ["Compose Insertion (MIME)..." mh-compose-insertion t]
- ;; ["Compose Compressed tar (MIME)..."
- ;;mh-mhn-compose-external-compressed-tar t]
- ;; ["Compose Anon FTP (MIME)..." mh-mhn-compose-anon-ftp t]
- ["Compose Forward (MIME)..." mh-compose-forward t]
- ;; The next two will have to be merged. But I also need to make sure the
- ;; user can't mix directives of both types.
- ["Pull in All Compositions (mhn)"
- mh-edit-mhn (mh-mhn-directive-present-p)]
- ["Pull in All Compositions (gnus)"
- mh-mml-to-mime (mh-mml-directive-present-p)]
- ["Revert to Non-MIME Edit (mhn)"
- mh-revert-mhn-edit (equal mh-compose-insertion 'mhn)]
- ["Kill This Draft" mh-fully-kill-draft t]))))
+(easy-menu-define
+ mh-letter-menu mh-letter-mode-map "Menu for MH-E letter mode."
+ '("Letter"
+ ["Send This Draft" mh-send-letter t]
+ ["Split Current Line" mh-open-line t]
+ ["Check Recipient" mh-check-whom t]
+ ["Yank Current Message" mh-yank-cur-msg t]
+ ["Insert a Message..." mh-insert-letter t]
+ ["Insert Signature" mh-insert-signature t]
+ ("Encrypt/Sign Message"
+ ["Sign Message"
+ mh-mml-secure-message-sign mh-gnus-pgp-support-flag]
+ ["Encrypt Message"
+ mh-mml-secure-message-encrypt mh-gnus-pgp-support-flag]
+ ["Sign+Encrypt Message"
+ mh-mml-secure-message-signencrypt mh-gnus-pgp-support-flag]
+ ["Disable Security"
+ mh-mml-unsecure-message mh-gnus-pgp-support-flag]
+ "--"
+ "Security Method"
+ ["PGP (MIME)" (setq mh-mml-method-default "pgpmime")
+ :style radio
+ :selected (equal mh-mml-method-default "pgpmime")]
+ ["PGP" (setq mh-mml-method-default "pgp")
+ :style radio
+ :selected (equal mh-mml-method-default "pgp")]
+ ["S/MIME" (setq mh-mml-method-default "smime")
+ :style radio
+ :selected (equal mh-mml-method-default "smime")]
+ "--"
+ ["Save Method as Default"
+ (customize-save-variable 'mh-mml-method-default mh-mml-method-default) t]
+ )
+ ["Compose Insertion (MIME)..." mh-compose-insertion t]
+ ["Compose Compressed tar (MIME)..."
+ mh-mhn-compose-external-compressed-tar t]
+ ["Compose Get File (MIME)..." mh-mhn-compose-anon-ftp t]
+ ["Compose Forward (MIME)..." mh-compose-forward t]
+ ;; The next two will have to be merged. But I also need to make sure the
+ ;; user can't mix directives of both types.
+ ["Pull in All Compositions (mhn)"
+ mh-edit-mhn (mh-mhn-directive-present-p)]
+ ["Pull in All Compositions (gnus)"
+ mh-mml-to-mime (mh-mml-directive-present-p)]
+ ["Revert to Non-MIME Edit (mhn)"
+ mh-revert-mhn-edit (equal mh-compose-insertion 'mhn)]
+ ["Kill This Draft" mh-fully-kill-draft t]))
;;; Help Messages
;;; Group messages logically, more or less.
"\t\tInsert:\n"
"Check recipients: \\[mh-check-whom]"
"\t\t Current message: \\[mh-yank-cur-msg]\n"
- "Encrypt message: \\[mh-mml-secure-message-encrypt-pgpmime]"
- "\t\t Attachment: \\[mh-compose-insertion]\n"
- "Sign message: \\[mh-mml-secure-message-sign-pgpmime]"
- "\t\t Message to forward: \\[mh-compose-forward]\n"
+ "\t\t Attachment: \\[mh-compose-insertion]\n"
+ "\t\t Message to forward: \\[mh-compose-forward]\n"
" "
- "\t\t Signature: \\[mh-insert-signature]"))
+ "Security:"
+ "\t\t Encrypt message: \\[mh-mml-secure-message-encrypt]"
+ "\t\t Sign+Encrypt message: \\[mh-mml-secure-message-signencrypt]"
+ "\t\t Sign message: \\[mh-mml-secure-message-sign]\n"
+ " "
+ "\t\t Signature: \\[mh-insert-signature]"))
"Key binding cheat sheet.
This is an associative array which is used to show the most common commands.
`mh-letter-mode-hook' are run.
\\{mh-letter-mode-map}"
-
- (or mh-user-path (mh-find-path))
+ (mh-find-path)
(make-local-variable 'mh-send-args)
(make-local-variable 'mh-annotate-char)
(make-local-variable 'mh-annotate-field)
(make-local-variable 'mh-previous-window-config)
(make-local-variable 'mh-sent-from-folder)
(make-local-variable 'mh-sent-from-msg)
+ ;; Set the local value of mh-mail-header-separator according to what is
+ ;; present in the buffer...
+ (set (make-local-variable 'mh-mail-header-separator)
+ (save-excursion
+ (goto-char (mh-mail-header-end))
+ (buffer-substring-no-properties (point) (line-end-position))))
(make-local-variable 'mail-header-separator)
(setq mail-header-separator mh-mail-header-separator) ;override sendmail.el
(make-local-variable 'mh-help-messages)
(setq mh-help-messages mh-letter-mode-help-messages)
+ (setq buffer-invisibility-spec '((vanish . t) t))
+ (set (make-local-variable 'line-move-ignore-invisible) t)
;; From sendmail.el for proper paragraph fill
;; sendmail.el also sets a normal-auto-fill-function (not done here)
;; Enable undo since a show-mode buffer might have been reused.
(buffer-enable-undo)
- (if (and (boundp 'tool-bar-mode) tool-bar-mode)
- (set (make-local-variable 'tool-bar-map) mh-letter-tool-bar-map))
+ (set (make-local-variable 'tool-bar-map) mh-letter-tool-bar-map)
(mh-funcall-if-exists mh-toolbar-init :letter)
(make-local-variable 'font-lock-defaults)
(cond
;; is that gnus uses static text properties which are not appropriate
;; for a buffer that will be edited. So the choice here is either fontify
;; the citations and header...
- (setq font-lock-defaults '(mh-show-font-lock-keywords-with-cite t)))
+ (setq font-lock-defaults '(mh-letter-font-lock-keywords t)))
(t
;; ...or the header only
(setq font-lock-defaults '(mh-show-font-lock-keywords t))))
(make-local-variable 'auto-fill-function)
(setq auto-fill-function 'mh-auto-fill-for-letter)))
+(defun mh-font-lock-field-data (limit)
+ "Find header field region between point and LIMIT."
+ (and (< (point) (mh-letter-header-end))
+ (< (point) limit)
+ (let ((end (min limit (mh-letter-header-end)))
+ (point (point))
+ data-end data-begin field)
+ (end-of-line)
+ (setq data-end (if (re-search-forward "^[^ \t]" end t)
+ (match-beginning 0)
+ end))
+ (goto-char (1- data-end))
+ (if (not (re-search-backward "\\(^[^ \t][^:]*\\):[ \t]*" nil t))
+ (setq data-begin (point-min))
+ (setq data-begin (match-end 0))
+ (setq field (match-string 1)))
+ (setq data-begin (max point data-begin))
+ (goto-char (if (equal point data-end) (1+ data-end) data-end))
+ (cond ((and field (mh-letter-skipped-header-field-p field))
+ (set-match-data nil)
+ nil)
+ (t (set-match-data
+ (list data-begin data-end data-begin data-end))
+ t)))))
+
+(defun mh-letter-header-end ()
+ "Find the end of the message header.
+This function is to be used only for font locking. It works by searching for
+`mh-mail-header-separator' in the buffer."
+ (save-excursion
+ (goto-char (point-min))
+ (cond ((equal mh-mail-header-separator "") (point-min))
+ ((search-forward (format "\n%s\n" mh-mail-header-separator) nil t)
+ (line-beginning-position 0))
+ (t (point-min)))))
+
(defun mh-auto-fill-for-letter ()
"Perform auto-fill for message.
Header is treated specially by inserting a tab before continuation lines."
(substring folder 1)
folder)))))
+(defun mh-file-is-vcard-p (file)
+ "Return t if FILE is a .vcf vcard."
+ (let ((case-fold-search t))
+ (and (stringp file)
+ (file-exists-p file)
+ (or (and (not (mh-have-file-command))
+ (not (null (string-match "\.vcf$" file))))
+ (and (mh-have-file-command)
+ (string-equal "text/x-vcard" (mh-file-mime-type file)))))))
+
;;;###mh-autoload
-(defun mh-insert-signature ()
- "Insert the file named by `mh-signature-file-name' at point.
+(defun mh-insert-signature (&optional file)
+ "Insert the signature specified by `mh-signature-file-name' or FILE at point.
+A signature separator (`-- ') will be added if the signature block does not
+contain one and `mh-signature-separator-flag' is on.
The value of `mh-letter-insert-signature-hook' is a list of functions to be
-called, with no arguments, before the signature is actually inserted."
- (interactive)
- (let ((mh-signature-file-name mh-signature-file-name))
- (run-hooks 'mh-letter-insert-signature-hook)
- (if mh-signature-file-name
- (insert-file-contents mh-signature-file-name)))
+called, with no arguments, after the signature is inserted.
+The signature can also be inserted with `mh-identity-list'."
+(interactive)
+ (save-excursion
+ (insert "\n")
+ (let ((mh-signature-file-name (or file mh-signature-file-name))
+ (mh-mhn-p (mh-mhn-directive-present-p))
+ (mh-mml-p (mh-mml-directive-present-p)))
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (cond
+ ((mh-file-is-vcard-p mh-signature-file-name)
+ (if (equal mh-compose-insertion 'gnus)
+ (insert "<#part type=\"text/x-vcard\" filename=\""
+ mh-signature-file-name
+ "\" disposition=inline description=VCard>\n<#/part>")
+ (insert "#text/x-vcard; name=\""
+ (file-name-nondirectory mh-signature-file-name)
+ "\" [VCard] " (expand-file-name mh-signature-file-name))))
+ (t
+ (cond
+ (mh-mhn-p
+ (insert "#\n" "Content-Description: Signature\n"))
+ (mh-mml-p
+ (mml-insert-tag 'part 'type "text/plain" 'disposition "inline"
+ 'description "Signature")))
+ (cond ((null mh-signature-file-name))
+ ((and (stringp mh-signature-file-name)
+ (file-readable-p mh-signature-file-name))
+ (insert-file-contents mh-signature-file-name))
+ ((functionp mh-signature-file-name)
+ (funcall mh-signature-file-name)))))
+ (save-restriction
+ (widen)
+ (run-hooks 'mh-letter-insert-signature-hook))
+ (goto-char (point-min))
+ (when (and (not (mh-file-is-vcard-p mh-signature-file-name))
+ mh-signature-separator-flag
+ (> (point-max) (point-min))
+ (not (mh-signature-separator-p)))
+ (cond (mh-mhn-p
+ (forward-line 2))
+ (mh-mml-p
+ (forward-line 1)))
+ (insert mh-signature-separator))
+ (if (not (> (point-max) (point-min)))
+ (message "No signature found")))))
(force-mode-line-update))
;;;###mh-autoload
(defun mh-insert-x-mailer ()
"Append an X-Mailer field to the header.
The versions of MH-E, Emacs, and MH are shown."
-
;; Lazily initialize mh-x-mailer-string.
- (when (null mh-x-mailer-string)
- (save-window-excursion
- ;; User would be confused if version info buffer disappeared magically,
- ;; so don't delete buffer if it already existed.
- (let ((info-buffer-exists-p (get-buffer mh-info-buffer)))
- (mh-version)
- (set-buffer mh-info-buffer)
- (if mh-nmh-flag
- (search-forward-regexp "^nmh-\\(\\S +\\)")
- (search-forward-regexp "^MH \\(\\S +\\)" nil t))
- (let ((x-mailer-mh (buffer-substring (match-beginning 1)
- (match-end 1))))
- (setq mh-x-mailer-string
- (format "MH-E %s; %s %s; %sEmacs %s"
- mh-version (if mh-nmh-flag "nmh" "MH") x-mailer-mh
- (if mh-xemacs-flag "X" "GNU ")
- (cond ((not mh-xemacs-flag) emacs-version)
- ((string-match "[0-9.]*\\( +\([ a-z]+[0-9]+\)\\)?"
- emacs-version)
- (match-string 0 emacs-version))
- (t (format "%s.%s"
- emacs-major-version
- emacs-minor-version))))))
- (if (not info-buffer-exists-p)
- (kill-buffer mh-info-buffer)))))
+ (when (and mh-insert-x-mailer-flag (null mh-x-mailer-string))
+ (setq mh-x-mailer-string
+ (format "MH-E %s; %s; %sEmacs %s"
+ mh-version mh-variant-in-use
+ (if mh-xemacs-flag "X" "GNU ")
+ (cond ((not mh-xemacs-flag) emacs-version)
+ ((string-match "[0-9.]*\\( +\([ a-z]+[0-9]+\)\\)?"
+ emacs-version)
+ (match-string 0 emacs-version))
+ (t (format "%s.%s" emacs-major-version
+ emacs-minor-version))))))
;; Insert X-Mailer, but only if it doesn't already exist.
(save-excursion
- (when (null (mh-goto-header-field "X-Mailer"))
+ (when (and mh-insert-x-mailer-flag
+ (null (mh-goto-header-field "X-Mailer")))
(mh-insert-fields "X-Mailer:" mh-x-mailer-string))))
(defun mh-regexp-in-field-p (regexp &rest fields)
(setq fields (cdr fields))))
search-result)))
-(defun mh-insert-auto-fields ()
- "Insert custom fields if To or Cc match `mh-auto-fields-list'."
- (save-excursion
- (when (and (or (mh-goto-header-field "To:")(mh-goto-header-field "cc:")))
- (let ((list mh-auto-fields-list))
- (while list
- (let ((regexp (nth 0 (car list)))
- (entries (nth 1 (car list))))
- (when (mh-regexp-in-field-p regexp "To:" "cc:")
- (let ((entry-list entries))
- (while entry-list
- (let ((field (caar entry-list))
- (value (cdar entry-list)))
- (cond
- ((equal "identity" field)
- (when (assoc value mh-identity-list)
- (mh-insert-identity value)))
- (t
- (mh-modify-header-field field value
- (equal field "From")))))
- (setq entry-list (cdr entry-list))))))
- (setq list (cdr list)))))))
+;;;###mh-autoload
+(defun mh-insert-auto-fields (&optional non-interactive)
+ "Insert custom fields if To or Cc match `mh-auto-fields-list'.
+Sets buffer-local `mh-insert-auto-fields-done-local' when done and inserted
+something. If NON-INTERACTIVE is non-nil, do not be verbose and only
+attempt matches if `mh-insert-auto-fields-done-local' is nil.
+
+An `identity' entry is skipped if one was already entered manually.
+
+Return t if fields added; otherwise return nil."
+ (interactive)
+ (when (or (not non-interactive)
+ (not mh-insert-auto-fields-done-local))
+ (save-excursion
+ (when (and (or (mh-goto-header-field "To:")
+ (mh-goto-header-field "cc:")))
+ (let ((list mh-auto-fields-list)
+ (fields-inserted nil))
+ (while list
+ (let ((regexp (nth 0 (car list)))
+ (entries (nth 1 (car list))))
+ (when (mh-regexp-in-field-p regexp "To:" "cc:")
+ (setq mh-insert-auto-fields-done-local t)
+ (setq fields-inserted t)
+ (if (not non-interactive)
+ (message "Fields for %s added" regexp))
+ (let ((entry-list entries))
+ (while entry-list
+ (let ((field (caar entry-list))
+ (value (cdar entry-list)))
+ (cond
+ ((equal ":identity" field)
+ (when ;;(and (not mh-identity-local)
+ ;; Bug 1204506. But do we need to be able
+ ;; to set an identity manually that won't be
+ ;; overridden by mh-insert-auto-fields?
+ (assoc value mh-identity-list)
+ ;;)
+ (mh-insert-identity value)))
+ (t
+ (mh-modify-header-field field value
+ (equal field "From")))))
+ (setq entry-list (cdr entry-list))))))
+ (setq list (cdr list)))
+ fields-inserted)))))
(defun mh-modify-header-field (field value &optional overwrite-flag)
"To header FIELD add VALUE.
If OVERWRITE-FLAG is non-nil then the old value, if present, is discarded."
- (cond ((mh-goto-header-field (concat field ":"))
- (insert value)
- (if overwrite-flag
- (delete-region (point) (line-end-position))
- (insert ", ")))
- (t (mh-goto-header-end 0)
- (insert field ": " value "\n"))))
+ (cond ((and overwrite-flag
+ (mh-goto-header-field (concat field ":")))
+ (insert " " value)
+ (delete-region (point) (line-end-position)))
+ ((and (not overwrite-flag)
+ (mh-regexp-in-field-p (concat "\\b" value "\\b") field))
+ ;; Already there, do nothing.
+ )
+ ((and (not overwrite-flag)
+ (mh-goto-header-field (concat field ":")))
+ (insert " " value ","))
+ (t
+ (mh-goto-header-end 0)
+ (insert field ": " value "\n"))))
(defun mh-compose-and-send-mail (draft send-args
sent-from-folder sent-from-msg
for `mh-annotate-msg'.
CONFIG is the window configuration to restore after sending the letter."
(pop-to-buffer draft)
- (mh-insert-auto-fields)
(mh-letter-mode)
- ;; mh-identity support
+ ;; Insert identity.
(if (and (boundp 'mh-identity-default)
mh-identity-default
(not mh-identity-local))
(mh-insert-identity mh-identity-default))
- (when (and (boundp 'mh-identity-list)
- mh-identity-list)
- (mh-identity-make-menu)
- (easy-menu-add mh-identity-menu))
+ (mh-identity-make-menu)
+ (easy-menu-add mh-identity-menu)
+
+ ;; Insert extra fields.
+ (mh-insert-x-mailer)
+ (mh-insert-x-face)
+
+ (mh-letter-hide-all-skipped-fields)
(setq mh-sent-from-folder sent-from-folder)
(setq mh-sent-from-msg sent-from-msg)
This should be the last function called when composing the draft."
(message "%s" (substitute-command-keys
(concat "Type \\[mh-send-letter] to send message, "
- "\\[mh-help] for help."))))
+ "\\[mh-help] for help"))))
+
+(defun mh-ascii-buffer-p ()
+ "Check if current buffer is entirely composed of ASCII.
+The function doesn't work for XEmacs since `find-charset-region' doesn't exist
+there."
+ (loop for charset in (mh-funcall-if-exists
+ find-charset-region (point-min) (point-max))
+ unless (eq charset 'ascii) return nil
+ finally return t))
;;;###mh-autoload
(defun mh-send-letter (&optional arg)
The value of `mh-before-send-letter-hook' is a list of functions to be called,
with no arguments, before doing anything.
Run `\\[mh-edit-mhn]' if mhn directives are present; otherwise
-run `\\[mh-mml-to-mime]' if mml directives are present.
-Insert X-Mailer field if variable `mh-insert-x-mailer-flag' is set.
-Insert X-Face field if the file specified by `mh-x-face-file' exists."
+run `\\[mh-mml-to-mime]' if mml directives are present."
(interactive "P")
(run-hooks 'mh-before-send-letter-hook)
+ (if (and (mh-insert-auto-fields t)
+ mh-auto-fields-prompt-flag
+ (goto-char (point-min)))
+ (if (not (y-or-n-p "Auto fields inserted, send? "))
+ (error "Send aborted")))
(cond ((mh-mhn-directive-present-p)
(mh-edit-mhn))
- ((mh-mml-directive-present-p)
+ ((or (mh-mml-directive-present-p) (not (mh-ascii-buffer-p)))
(mh-mml-to-mime)))
- (if mh-insert-x-mailer-flag (mh-insert-x-mailer))
- (mh-insert-x-face)
(save-buffer)
(message "Sending...")
(let ((draft-buffer (current-buffer))
'iso-latin-1))))
;; The default BCC encapsulation will make a MIME message unreadable.
;; With nmh use the -mime arg to prevent this.
- (if (and mh-nmh-flag
+ (if (and (mh-variant-p 'nmh)
(mh-goto-header-field "Bcc:")
(mh-goto-header-field "Content-Type:"))
(setq mh-send-args (format "-mime %s" mh-send-args)))
;;;###mh-autoload
(defun mh-insert-letter (folder message verbatim)
"Insert a message into the current letter.
-Removes the header fields according to the variable `mh-invisible-headers'.
+Removes the header fields according to the variable
+`mh-invisible-header-fields-compiled'.
Prefixes each non-blank line with `mh-ins-buf-prefix', unless
`mh-yank-from-start-of-msg' is set for supercite in which case supercite is
used to format the message.
and point after it."
(interactive
(list (mh-prompt-for-folder "Message from" mh-sent-from-folder nil)
- (read-input (format "Message number%s: "
+ (read-input (concat "Message number"
(if (numberp mh-sent-from-msg)
- (format " [%d]" mh-sent-from-msg)
- "")))
+ (format " (default %d): " mh-sent-from-msg)
+ ": ")))
current-prefix-arg))
(save-restriction
(narrow-to-region (point) (point))
(let ((start (point-min)))
- (if (equal message "") (setq message (int-to-string mh-sent-from-msg)))
+ (if (and (equal message "") (numberp mh-sent-from-msg))
+ (setq message (int-to-string mh-sent-from-msg)))
(insert-file-contents
(expand-file-name message (mh-expand-file-name folder)))
(when (not verbatim)
- (mh-clean-msg-header start mh-invisible-headers mh-visible-headers)
+ (mh-clean-msg-header start mh-invisible-header-fields-compiled nil)
(goto-char (point-max)) ;Needed for sc-cite-original
(push-mark) ;Needed for sc-cite-original
(goto-char (point-min)) ;Needed for sc-cite-original
(skip-chars-forward " ")
(cond
((looking-at "\"\\([^\"\n]+\\)\" \\(<.+>\\)")
- (format "%s %s %s" (match-string 1)(match-string 2)
- mh-extract-from-attribution-verb))
+ (format "%s %s " (match-string 1)(match-string 2)))
((looking-at "\\([^<\n]+<.+>\\)$")
- (format "%s %s" (match-string 1) mh-extract-from-attribution-verb))
+ (format "%s " (match-string 1)))
((looking-at "\\([^ ]+@[^ ]+\\) +(\\(.+\\))$")
- (format "%s <%s> %s" (match-string 2)(match-string 1)
- mh-extract-from-attribution-verb))
+ (format "%s <%s> " (match-string 2)(match-string 1)))
((looking-at " *\\(.+\\)$")
- (format "%s %s" (match-string 1) mh-extract-from-attribution-verb))))))
+ (format "%s " (match-string 1)))))))
;;;###mh-autoload
(defun mh-yank-cur-msg ()
(push-mark) ;Needed for sc-cite-original
(goto-char (point-min)) ;Needed for sc-cite-original
(mh-insert-prefix-string mh-ins-buf-prefix)
- (if (or (eq 'attribution mh-yank-from-start-of-msg)
- (eq 'autoattrib mh-yank-from-start-of-msg))
- (insert from-attr "\n\n"))
+ (when (or (eq 'attribution mh-yank-from-start-of-msg)
+ (eq 'autoattrib mh-yank-from-start-of-msg))
+ (insert from-attr)
+ (mh-identity-insert-attribution-verb nil)
+ (insert "\n\n"))
;; If the user has selected a region, he has already "edited" the
;; text, so leave the cursor at the end of the yanked text. In
;; either case, leave a mark at the opposite end of the included
(mh-do-in-xemacs (defvar mail-abbrevs))
+;;;###mh-autoload
+(defun mh-complete-word (word choices begin end)
+ "Complete WORD at from CHOICES.
+Any match found replaces the text from BEGIN to END."
+ (let ((completion (try-completion word choices))
+ (completions-buffer "*Completions*"))
+ (cond ((eq completion t)
+ (ignore-errors
+ (kill-buffer completions-buffer))
+ (message "Completed: %s" word))
+ ((null completion)
+ (ignore-errors
+ (kill-buffer completions-buffer))
+ (message "No completion for `%s'" word))
+ ((stringp completion)
+ (if (equal word completion)
+ (with-output-to-temp-buffer completions-buffer
+ (display-completion-list (all-completions word choices)))
+ (ignore-errors
+ (kill-buffer completions-buffer))
+ (delete-region begin end)
+ (insert completion))))))
+
+;;;###mh-autoload
+(defun mh-beginning-of-word (&optional n)
+ "Return position of the N th word backwards."
+ (unless n (setq n 1))
+ (let ((syntax-table (syntax-table)))
+ (unwind-protect
+ (save-excursion
+ (mh-mail-abbrev-make-syntax-table)
+ (set-syntax-table mail-abbrev-syntax-table)
+ (backward-word n)
+ (point))
+ (set-syntax-table syntax-table))))
+
(defun mh-folder-expand-at-point ()
"Do folder name completion in Fcc header field."
(let* ((end (point))
- (syntax-table (syntax-table))
- (beg (unwind-protect
- (save-excursion
- (mh-funcall-if-exists mail-abbrev-make-syntax-table)
- (set-syntax-table mail-abbrev-syntax-table)
- (backward-word 1)
- (point))
- (set-syntax-table syntax-table)))
+ (beg (mh-beginning-of-word))
(folder (buffer-substring beg end))
(leading-plus (and (> (length folder) 0) (equal (aref folder 0) ?+)))
(last-slash (mh-search-from-end ?/ folder))
(prefix (and last-slash (substring folder 0 last-slash)))
- (mail-abbrevs
- (mapcar #'(lambda (x)
- (list (cond (prefix (format "%s/%s" prefix x))
- (leading-plus (format "+%s" x))
- (t x))))
- (mh-folder-completion-function folder nil t))))
- (if (fboundp 'mail-abbrev-complete-alias)
- (mh-funcall-if-exists mail-abbrev-complete-alias)
- (error "Fcc completion not supported in your version of Emacs"))))
+ (choices (mapcar #'(lambda (x)
+ (list (cond (prefix (format "%s/%s" prefix x))
+ (leading-plus (format "+%s" x))
+ (t x))))
+ (mh-folder-completion-function folder nil t))))
+ (mh-complete-word folder choices beg end)))
+
+(defvar mh-letter-complete-function-alist
+ '((cc . mh-alias-letter-expand-alias)
+ (bcc . mh-alias-letter-expand-alias)
+ (dcc . mh-alias-letter-expand-alias)
+ (fcc . mh-folder-expand-at-point)
+ (from . mh-alias-letter-expand-alias)
+ (mail-followup-to . mh-alias-letter-expand-alias)
+ (reply-to . mh-alias-letter-expand-alias)
+ (to . mh-alias-letter-expand-alias))
+ "Alist of header fields and completion functions to use.")
-;;;###mh-autoload
(defun mh-letter-complete (arg)
"Perform completion on header field or word preceding point.
-Alias completion is done within the mail header on selected fields and
-by the function designated by `mh-letter-complete-function' elsewhere,
-passing the prefix ARG if any."
+If the field contains addresses (for example, `To:' or `Cc:') or folders (for
+example, `Fcc:') then this function will provide alias completion. Elsewhere,
+this function runs `mh-letter-complete-function' instead and passes the prefix
+ARG, if present."
(interactive "P")
- (let ((case-fold-search t))
- (cond
- ((and (mh-in-header-p)
- (save-excursion
- (mh-header-field-beginning)
- (looking-at "^fcc:")))
- (mh-folder-expand-at-point))
- ((and (mh-in-header-p)
- (save-excursion
- (mh-header-field-beginning)
- (looking-at "^.*\\(to\\|cc\\|from\\):")))
- (mh-alias-letter-expand-alias))
- (t
- (funcall mh-letter-complete-function arg)))))
+ (let ((func nil))
+ (cond ((not (mh-in-header-p))
+ (funcall mh-letter-complete-function arg))
+ ((setq func (cdr (assoc (mh-letter-header-field-at-point)
+ mh-letter-complete-function-alist)))
+ (funcall func))
+ (t (funcall mh-letter-complete-function arg)))))
+
+(defun mh-letter-complete-or-space (arg)
+ "Perform completion or insert space.
+If `mh-compose-space-does-completion-flag' is nil (the default) a space is
+inserted.
+
+Otherwise, if point is in the message header and the preceding character is
+not whitespace then do completion. Otherwise insert a space character.
+
+ARG is the number of spaces inserted."
+ (interactive "p")
+ (let ((func nil)
+ (end-of-prev (save-excursion
+ (goto-char (mh-beginning-of-word))
+ (mh-beginning-of-word -1))))
+ (cond ((not mh-compose-space-does-completion-flag)
+ (self-insert-command arg))
+ ((not (mh-in-header-p)) (self-insert-command arg))
+ ((> (point) end-of-prev) (self-insert-command arg))
+ ((setq func (cdr (assoc (mh-letter-header-field-at-point)
+ mh-letter-complete-function-alist)))
+ (funcall func))
+ (t (self-insert-command arg)))))
+
+(defun mh-letter-confirm-address ()
+ "Flash alias expansion if `mh-alias-flash-on-comma' is non-nil."
+ (interactive)
+ (cond ((not (mh-in-header-p)) (self-insert-command 1))
+ ((eq (cdr (assoc (mh-letter-header-field-at-point)
+ mh-letter-complete-function-alist))
+ 'mh-alias-letter-expand-alias)
+ (mh-alias-reload-maybe)
+ (mh-alias-minibuffer-confirm-address))
+ (t (self-insert-command 1))))
+
+(defvar mh-letter-header-field-regexp "^\\([A-Za-z][A-Za-z0-9-]*\\):")
+
+(defun mh-letter-header-field-at-point ()
+ "Return the header field name at point.
+A symbol is returned whose name is the string obtained by downcasing the field
+name."
+ (save-excursion
+ (end-of-line)
+ (and (re-search-backward mh-letter-header-field-regexp nil t)
+ (intern (downcase (match-string 1))))))
+
+;;;###mh-autoload
+(defun mh-letter-next-header-field-or-indent (arg)
+ "Move to next field or indent depending on point.
+In the message header, go to the next field. Elsewhere call
+`indent-relative' as usual with optional prefix ARG."
+ (interactive "P")
+ (let ((header-end (save-excursion
+ (goto-char (mh-mail-header-end))
+ (forward-line)
+ (point))))
+ (if (> (point) header-end)
+ (indent-relative arg)
+ (mh-letter-next-header-field))))
+
+(defun mh-letter-next-header-field ()
+ "Cycle to the next header field.
+If we are at the last header field go to the start of the message body."
+ (let ((header-end (mh-mail-header-end)))
+ (cond ((>= (point) header-end) (goto-char (point-min)))
+ ((< (point) (progn
+ (beginning-of-line)
+ (re-search-forward mh-letter-header-field-regexp
+ (line-end-position) t)
+ (point)))
+ (beginning-of-line))
+ (t (end-of-line)))
+ (cond ((re-search-forward mh-letter-header-field-regexp header-end t)
+ (if (mh-letter-skipped-header-field-p (match-string 1))
+ (mh-letter-next-header-field)
+ (mh-letter-skip-leading-whitespace-in-header-field)))
+ (t (goto-char header-end)
+ (forward-line)))))
+
+;;;###mh-autoload
+(defun mh-letter-previous-header-field ()
+ "Cycle to the previous header field.
+If we are at the first header field go to the start of the message body."
+ (interactive)
+ (let ((header-end (mh-mail-header-end)))
+ (if (>= (point) header-end)
+ (goto-char header-end)
+ (mh-header-field-beginning))
+ (cond ((re-search-backward mh-letter-header-field-regexp nil t)
+ (if (mh-letter-skipped-header-field-p (match-string 1))
+ (mh-letter-previous-header-field)
+ (goto-char (match-end 0))
+ (mh-letter-skip-leading-whitespace-in-header-field)))
+ (t (goto-char header-end)
+ (forward-line)))))
+
+(defun mh-letter-skipped-header-field-p (field)
+ "Check if FIELD is to be skipped."
+ (let ((field (downcase field)))
+ (loop for x in mh-compose-skipped-header-fields
+ when (equal (downcase x) field) return t
+ finally return nil)))
+
+(defun mh-letter-skip-leading-whitespace-in-header-field ()
+ "Skip leading whitespace in a header field.
+If the header field doesn't have at least one space after the colon then a
+space character is added."
+ (let ((need-space t))
+ (while (memq (char-after) '(?\t ?\ ))
+ (forward-char)
+ (setq need-space nil))
+ (when need-space (insert " "))))
+
+(defvar mh-hidden-header-keymap
+ (let ((map (make-sparse-keymap)))
+ (mh-do-in-gnu-emacs
+ (define-key map [mouse-2] 'mh-letter-toggle-header-field-display-button))
+ (mh-do-in-xemacs
+ (define-key map '(button2)
+ 'mh-letter-toggle-header-field-display-button))
+ map))
+
+(defun mh-letter-toggle-header-field-display-button (event)
+ "Toggle header field display at location of EVENT.
+This function does the same thing as `mh-letter-toggle-header-field-display'
+except that it is callable from a mouse button."
+ (interactive "e")
+ (mh-do-at-event-location event
+ (mh-letter-toggle-header-field-display nil)))
+
+(defun mh-letter-toggle-header-field-display (arg)
+ "Toggle display of header field at point.
+If the header is long or spread over multiple lines then hiding it will show
+the first few characters and replace the rest with an ellipsis.
+
+If ARG is negative then header is hidden, if positive it is displayed. If ARG
+is the symbol `long' then keep at most the first 4 lines."
+ (interactive (list nil))
+ (when (and (mh-in-header-p)
+ (progn
+ (end-of-line)
+ (re-search-backward mh-letter-header-field-regexp nil t)))
+ (let ((buffer-read-only nil)
+ (modified-flag (buffer-modified-p))
+ (begin (point))
+ end)
+ (end-of-line)
+ (setq end (1- (if (re-search-forward "^[^ \t]" nil t)
+ (match-beginning 0)
+ (point-max))))
+ (goto-char begin)
+ ;; Make it clickable...
+ (add-text-properties begin end `(keymap ,mh-hidden-header-keymap
+ mouse-face highlight))
+ (unwind-protect
+ (cond ((or (and (not arg)
+ (text-property-any begin end 'invisible 'vanish))
+ (and (numberp arg) (>= arg 0))
+ (and (eq arg 'long) (> (line-beginning-position 5) end)))
+ (remove-text-properties begin end '(invisible nil))
+ (search-forward ":" (line-end-position) t)
+ (mh-letter-skip-leading-whitespace-in-header-field))
+ ((eq arg 'long)
+ (end-of-line 4)
+ (mh-letter-truncate-header-field end)
+ (beginning-of-line))
+ (t (end-of-line)
+ (mh-letter-truncate-header-field end)
+ (beginning-of-line)))
+ (set-buffer-modified-p modified-flag)))))
+
+(defun mh-letter-truncate-header-field (end)
+ "Replace text from current line till END with an ellipsis.
+If the current line is too long truncate a part of it as well."
+ (let ((max-len (min (window-width) 62)))
+ (when (> (+ (current-column) 4) max-len)
+ (backward-char (- (+ (current-column) 5) max-len)))
+ (when (> end (point))
+ (add-text-properties (point) end '(invisible vanish)))))
+
+(defun mh-letter-hide-all-skipped-fields ()
+ "Hide all skipped fields."
+ (save-excursion
+ (goto-char (point-min))
+ (save-restriction
+ (narrow-to-region (point) (mh-mail-header-end))
+ (while (re-search-forward mh-letter-header-field-regexp nil t)
+ (if (mh-letter-skipped-header-field-p (match-string 1))
+ (mh-letter-toggle-header-field-display -1)
+ (mh-letter-toggle-header-field-display 'long))
+ (beginning-of-line 2)))))
+
+(defun mh-interactive-read-address (prompt)
+ "Read an address.
+If `mh-compose-prompt-flag' is non-nil, then read an address with PROMPT.
+Otherwise return the empty string."
+ (if mh-compose-prompt-flag (mh-read-address prompt) ""))
+
+(defun mh-interactive-read-string (prompt)
+ "Read a string.
+If `mh-compose-prompt-flag' is non-nil, then read a string with PROMPT.
+Otherwise return the empty string."
+ (if mh-compose-prompt-flag (read-string prompt) ""))
+
+(defun mh-letter-adjust-point ()
+ "Move cursor to first header field if are using the no prompt mode."
+ (unless mh-compose-prompt-flag
+ (goto-char (point-max))
+ (mh-letter-next-header-field)))
;;; Build the letter-mode keymap:
;;; If this changes, modify mh-letter-mode-help-messages accordingly, above.
(gnus-define-keys mh-letter-mode-map
+ " " mh-letter-complete-or-space
+ "," mh-letter-confirm-address
"\C-c?" mh-help
+ "\C-c\C-\\" mh-fully-kill-draft ;if no C-q
+ "\C-c\C-^" mh-insert-signature ;if no C-s
"\C-c\C-c" mh-send-letter
"\C-c\C-d" mh-insert-identity
"\C-c\C-e" mh-edit-mhn
"\C-c\C-fs" mh-to-field
"\C-c\C-ft" mh-to-field
"\C-c\C-i" mh-insert-letter
- "\C-c\C-m\C-e" mh-mml-secure-message-encrypt-pgpmime
+ "\C-c\C-m\C-e" mh-mml-secure-message-encrypt
"\C-c\C-m\C-f" mh-compose-forward
+ "\C-c\C-m\C-g" mh-mhn-compose-anon-ftp
"\C-c\C-m\C-i" mh-compose-insertion
"\C-c\C-m\C-m" mh-mml-to-mime
- "\C-c\C-m\C-s" mh-mml-secure-message-sign-pgpmime
+ "\C-c\C-m\C-n" mh-mml-unsecure-message
+ "\C-c\C-m\C-s" mh-mml-secure-message-sign
+ "\C-c\C-m\C-t" mh-mhn-compose-external-compressed-tar
"\C-c\C-m\C-u" mh-revert-mhn-edit
- "\C-c\C-me" mh-mml-secure-message-encrypt-pgpmime
+ "\C-c\C-m\C-x" mh-mhn-compose-external-type
+ "\C-c\C-mee" mh-mml-secure-message-encrypt
+ "\C-c\C-mes" mh-mml-secure-message-signencrypt
"\C-c\C-mf" mh-compose-forward
+ "\C-c\C-mg" mh-mhn-compose-anon-ftp
"\C-c\C-mi" mh-compose-insertion
"\C-c\C-mm" mh-mml-to-mime
- "\C-c\C-ms" mh-mml-secure-message-sign-pgpmime
+ "\C-c\C-mn" mh-mml-unsecure-message
+ "\C-c\C-mse" mh-mml-secure-message-signencrypt
+ "\C-c\C-mss" mh-mml-secure-message-sign
+ "\C-c\C-mt" mh-mhn-compose-external-compressed-tar
"\C-c\C-mu" mh-revert-mhn-edit
+ "\C-c\C-mx" mh-mhn-compose-external-type
"\C-c\C-o" mh-open-line
"\C-c\C-q" mh-fully-kill-draft
- "\C-c\C-\\" mh-fully-kill-draft ;if no C-q
"\C-c\C-s" mh-insert-signature
- "\C-c\C-^" mh-insert-signature ;if no C-s
+ "\C-c\C-t" mh-letter-toggle-header-field-display
"\C-c\C-w" mh-check-whom
"\C-c\C-y" mh-yank-cur-msg
- "\M-\t" mh-letter-complete)
+ "\C-c\M-d" mh-insert-auto-fields
+ "\M-\t" mh-letter-complete
+ "\t" mh-letter-next-header-field-or-indent
+ [backtab] mh-letter-previous-header-field)
;; "C-c /" prefix is used in mh-letter-mode by pgp.el and mailcrypt.el.
-;;;###autoload(add-to-list 'auto-mode-alist '("/drafts/[0-9]+\\'" . mh-letter-mode))
-
(provide 'mh-comp)
;;; Local Variables:
;;; sentence-end-double-space: nil
;;; End:
+;;; arch-tag: 62865511-e610-4923-b0b5-f45a8ab70a34
;;; mh-comp.el ends here