1;;; mh-letter.el --- MH-Letter mode 2 3;; Copyright (C) 1993, 1995, 1997, 4;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. 5 6;; Author: Bill Wohler <wohler@newt.com> 7;; Maintainer: Bill Wohler <wohler@newt.com> 8;; Keywords: mail 9;; See: mh-e.el 10 11;; This file is part of GNU Emacs. 12 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) 16;; any later version. 17 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. 22 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. 27 28;;; Commentary: 29 30;; Mode for composing and sending a draft message. 31 32;; Functions that would ordinarily be in here that are needed by 33;; mh-show.el should be placed in the Message Utilities section in 34;; mh-utils.el. That will help prevent the loading of this file until 35;; a message is actually composed. 36 37;;; Change Log: 38 39;;; Code: 40 41(require 'mh-e) 42 43(require 'gnus-util) 44 45;; Dynamically-created functions not found in mh-loaddefs.el. 46(autoload 'mh-tool-bar-letter-buttons-init "mh-tool-bar") 47(autoload 'mh-tool-bar-init "mh-tool-bar") 48 49(autoload 'mml-insert-tag "mml") 50 51;;; Variables 52 53(defvar mh-letter-complete-function-alist 54 '((bcc . mh-alias-letter-expand-alias) 55 (cc . mh-alias-letter-expand-alias) 56 (dcc . mh-alias-letter-expand-alias) 57 (fcc . mh-folder-expand-at-point) 58 (from . mh-alias-letter-expand-alias) 59 (mail-followup-to . mh-alias-letter-expand-alias) 60 (mail-reply-to . mh-alias-letter-expand-alias) 61 (reply-to . mh-alias-letter-expand-alias) 62 (to . mh-alias-letter-expand-alias)) 63 "Alist of header fields and completion functions to use.") 64 65(defvar mh-yank-hooks nil 66 "Obsolete hook for modifying a citation just inserted in the mail buffer. 67 68Each hook function can find the citation between point and mark. 69And each hook function should leave point and mark around the 70citation text as modified. 71 72This is a normal hook, misnamed for historical reasons. It is 73semi-obsolete and is only used if `mail-citation-hook' is nil.") 74 75 76 77;;; Letter Menu 78 79(easy-menu-define 80 mh-letter-menu mh-letter-mode-map "Menu for MH-E letter mode." 81 '("Letter" 82 ["Send This Draft" mh-send-letter t] 83 ["Split Current Line" mh-open-line t] 84 ["Check Recipient" mh-check-whom t] 85 ["Yank Current Message" mh-yank-cur-msg t] 86 ["Insert a Message..." mh-insert-letter t] 87 ["Insert Signature" mh-insert-signature t] 88 ("Encrypt/Sign Message" 89 ["Sign Message" 90 mh-mml-secure-message-sign mh-pgp-support-flag] 91 ["Encrypt Message" 92 mh-mml-secure-message-encrypt mh-pgp-support-flag] 93 ["Sign+Encrypt Message" 94 mh-mml-secure-message-signencrypt mh-pgp-support-flag] 95 ["Disable Security" 96 mh-mml-unsecure-message mh-pgp-support-flag] 97 "--" 98 "Security Method" 99 ["PGP (MIME)" (setq mh-mml-method-default "pgpmime") 100 :style radio 101 :selected (equal mh-mml-method-default "pgpmime")] 102 ["PGP" (setq mh-mml-method-default "pgp") 103 :style radio 104 :selected (equal mh-mml-method-default "pgp")] 105 ["S/MIME" (setq mh-mml-method-default "smime") 106 :style radio 107 :selected (equal mh-mml-method-default "smime")] 108 "--" 109 ["Save Method as Default" 110 (customize-save-variable 'mh-mml-method-default mh-mml-method-default) t] 111 ) 112 ["Compose Insertion..." mh-compose-insertion t] 113 ["Compose Compressed tar (MH)..." 114 mh-mh-compose-external-compressed-tar t] 115 ["Compose Get File (MH)..." mh-mh-compose-anon-ftp t] 116 ["Compose Forward..." mh-compose-forward t] 117 ;; The next two will have to be merged. But I also need to make sure the 118 ;; user can't mix tags of both types. 119 ["Pull in All Compositions (MH)" 120 mh-mh-to-mime (mh-mh-directive-present-p)] 121 ["Pull in All Compositions (MML)" 122 mh-mml-to-mime (mh-mml-tag-present-p)] 123 ["Revert to Non-MIME Edit (MH)" 124 mh-mh-to-mime-undo (equal mh-compose-insertion 'mh)] 125 ["Kill This Draft" mh-fully-kill-draft t])) 126 127 128 129;;; MH-Letter Keys 130 131;; If this changes, modify mh-letter-mode-help-messages accordingly, above. 132(gnus-define-keys mh-letter-mode-map 133 " " mh-letter-complete-or-space 134 "," mh-letter-confirm-address 135 "\C-c?" mh-help 136 "\C-c\C-\\" mh-fully-kill-draft ;if no C-q 137 "\C-c\C-^" mh-insert-signature ;if no C-s 138 "\C-c\C-c" mh-send-letter 139 "\C-c\C-d" mh-insert-identity 140 "\C-c\C-e" mh-mh-to-mime 141 "\C-c\C-f\C-a" mh-to-field 142 "\C-c\C-f\C-b" mh-to-field 143 "\C-c\C-f\C-c" mh-to-field 144 "\C-c\C-f\C-d" mh-to-field 145 "\C-c\C-f\C-f" mh-to-fcc 146 "\C-c\C-f\C-l" mh-to-field 147 "\C-c\C-f\C-m" mh-to-field 148 "\C-c\C-f\C-r" mh-to-field 149 "\C-c\C-f\C-s" mh-to-field 150 "\C-c\C-f\C-t" mh-to-field 151 "\C-c\C-fa" mh-to-field 152 "\C-c\C-fb" mh-to-field 153 "\C-c\C-fc" mh-to-field 154 "\C-c\C-fd" mh-to-field 155 "\C-c\C-ff" mh-to-fcc 156 "\C-c\C-fl" mh-to-field 157 "\C-c\C-fm" mh-to-field 158 "\C-c\C-fr" mh-to-field 159 "\C-c\C-fs" mh-to-field 160 "\C-c\C-ft" mh-to-field 161 "\C-c\C-i" mh-insert-letter 162 "\C-c\C-m\C-e" mh-mml-secure-message-encrypt 163 "\C-c\C-m\C-f" mh-compose-forward 164 "\C-c\C-m\C-g" mh-mh-compose-anon-ftp 165 "\C-c\C-m\C-i" mh-compose-insertion 166 "\C-c\C-m\C-m" mh-mml-to-mime 167 "\C-c\C-m\C-n" mh-mml-unsecure-message 168 "\C-c\C-m\C-s" mh-mml-secure-message-sign 169 "\C-c\C-m\C-t" mh-mh-compose-external-compressed-tar 170 "\C-c\C-m\C-u" mh-mh-to-mime-undo 171 "\C-c\C-m\C-x" mh-mh-compose-external-type 172 "\C-c\C-mee" mh-mml-secure-message-encrypt 173 "\C-c\C-mes" mh-mml-secure-message-signencrypt 174 "\C-c\C-mf" mh-compose-forward 175 "\C-c\C-mg" mh-mh-compose-anon-ftp 176 "\C-c\C-mi" mh-compose-insertion 177 "\C-c\C-mm" mh-mml-to-mime 178 "\C-c\C-mn" mh-mml-unsecure-message 179 "\C-c\C-mse" mh-mml-secure-message-signencrypt 180 "\C-c\C-mss" mh-mml-secure-message-sign 181 "\C-c\C-mt" mh-mh-compose-external-compressed-tar 182 "\C-c\C-mu" mh-mh-to-mime-undo 183 "\C-c\C-mx" mh-mh-compose-external-type 184 "\C-c\C-o" mh-open-line 185 "\C-c\C-q" mh-fully-kill-draft 186 "\C-c\C-s" mh-insert-signature 187 "\C-c\C-t" mh-letter-toggle-header-field-display 188 "\C-c\C-w" mh-check-whom 189 "\C-c\C-y" mh-yank-cur-msg 190 "\C-c\M-d" mh-insert-auto-fields 191 "\M-\t" mh-letter-complete 192 "\t" mh-letter-next-header-field-or-indent 193 [backtab] mh-letter-previous-header-field) 194 195;; "C-c /" prefix is used in mh-letter-mode by pgp.el and mailcrypt.el. 196 197 198 199;;; MH-Letter Help Messages 200 201;; Group messages logically, more or less. 202(defvar mh-letter-mode-help-messages 203 '((nil 204 "Send letter: \\[mh-send-letter] " 205 "Open line: \\[mh-open-line]\n" 206 "Kill letter: \\[mh-fully-kill-draft] " 207 "Check recipients: \\[mh-check-whom]\n\n" 208 "Insert:\n" 209 " Current message: \\[mh-yank-cur-msg]\n" 210 " Attachment: \\[mh-compose-insertion]\n" 211 " Message to forward: \\[mh-compose-forward]\n" 212 " Signature: \\[mh-insert-signature]\n\n" 213 "Security:\n" 214 " Encrypt message: \\[mh-mml-secure-message-encrypt]\n" 215 " Sign message: \\[mh-mml-secure-message-sign]\n" 216 " Sign+Encrypt message: \\[mh-mml-secure-message-signencrypt]")) 217 "Key binding cheat sheet. 218 219This is an associative array which is used to show the most 220common commands. The key is a prefix char. The value is one or 221more strings which are concatenated together and displayed in the 222minibuffer if ? is pressed after the prefix character. The 223special key nil is used to display the non-prefixed commands. 224 225The substitutions described in `substitute-command-keys' are 226performed as well.") 227 228 229 230;;; MH-Letter Font Lock 231 232(defvar mh-letter-font-lock-keywords 233 `(,@(mh-show-font-lock-keywords-with-cite) 234 (mh-font-lock-field-data 235 (1 'mh-letter-header-field prepend t))) 236 "Additional expressions to highlight in MH-Letter buffers.") 237 238(defun mh-font-lock-field-data (limit) 239 "Find header field region between point and LIMIT." 240 (and (< (point) (mh-letter-header-end)) 241 (< (point) limit) 242 (let ((end (min limit (mh-letter-header-end))) 243 (point (point)) 244 data-end data-begin field) 245 (end-of-line) 246 (setq data-end (if (re-search-forward "^[^ \t]" end t) 247 (match-beginning 0) 248 end)) 249 (goto-char (1- data-end)) 250 (if (not (re-search-backward "\\(^[^ \t][^:]*\\):[ \t]*" nil t)) 251 (setq data-begin (point-min)) 252 (setq data-begin (match-end 0)) 253 (setq field (match-string 1))) 254 (setq data-begin (max point data-begin)) 255 (goto-char (if (equal point data-end) (1+ data-end) data-end)) 256 (cond ((and field (mh-letter-skipped-header-field-p field)) 257 (set-match-data nil) 258 nil) 259 (t (set-match-data 260 (list data-begin data-end data-begin data-end)) 261 t))))) 262 263(defun mh-letter-header-end () 264 "Find the end of the message header. 265This function is to be used only for font locking. It works by 266searching for `mh-mail-header-separator' in the buffer." 267 (save-excursion 268 (goto-char (point-min)) 269 (cond ((equal mh-mail-header-separator "") (point-min)) 270 ((search-forward (format "\n%s\n" mh-mail-header-separator) nil t) 271 (mh-line-beginning-position 0)) 272 (t (point-min))))) 273 274 275 276;;; MH-Letter Mode 277 278;; Shush compiler. 279(defvar font-lock-defaults) ; XEmacs 280 281;; Ensure new buffers won't get this mode if default-major-mode is nil. 282(put 'mh-letter-mode 'mode-class 'special) 283 284;;;###mh-autoload 285(define-derived-mode mh-letter-mode mail-mode "MH-Letter" 286 "Mode for composing letters in MH-E\\<mh-letter-mode-map>. 287 288When you have finished composing, type \\[mh-send-letter] to send 289the message using the MH mail handling system. 290 291There are two types of tags used by MH-E when composing MIME 292messages: MML and MH. The option `mh-compose-insertion' controls 293what type of tags are inserted by MH-E commands. These tags can 294be converted to MIME body parts by running \\[mh-mh-to-mime] for 295MH-style directives or \\[mh-mml-to-mime] for MML tags. 296 297Options that control this mode can be changed with 298\\[customize-group]; specify the \"mh-compose\" group. 299 300When a message is composed, the hooks `text-mode-hook', 301`mail-mode-hook', and `mh-letter-mode-hook' are run (in that 302order). 303 304\\{mh-letter-mode-map}" 305 (mh-find-path) 306 (make-local-variable 'mh-send-args) 307 (make-local-variable 'mh-annotate-char) 308 (make-local-variable 'mh-annotate-field) 309 (make-local-variable 'mh-previous-window-config) 310 (make-local-variable 'mh-sent-from-folder) 311 (make-local-variable 'mh-sent-from-msg) 312 (mh-do-in-gnu-emacs 313 (unless mh-letter-tool-bar-map 314 (mh-tool-bar-letter-buttons-init)) 315 (set (make-local-variable 'tool-bar-map) mh-letter-tool-bar-map)) 316 (mh-do-in-xemacs 317 (mh-tool-bar-init :letter)) 318 ;; Set the local value of mh-mail-header-separator according to what is 319 ;; present in the buffer... 320 (set (make-local-variable 'mh-mail-header-separator) 321 (save-excursion 322 (goto-char (mh-mail-header-end)) 323 (buffer-substring-no-properties (point) (mh-line-end-position)))) 324 (make-local-variable 'mail-header-separator) 325 (setq mail-header-separator mh-mail-header-separator) ;override sendmail.el 326 (mh-set-help mh-letter-mode-help-messages) 327 (setq buffer-invisibility-spec '((vanish . t) t)) 328 (set (make-local-variable 'line-move-ignore-invisible) t) 329 330 ;; Enable undo since a show-mode buffer might have been reused. 331 (buffer-enable-undo) 332 (make-local-variable 'font-lock-defaults) 333 (cond 334 ((or (equal mh-highlight-citation-style 'font-lock) 335 (equal mh-highlight-citation-style 'gnus)) 336 ;; Let's use font-lock even if gnus is used in show-mode. The reason 337 ;; is that gnus uses static text properties which are not appropriate 338 ;; for a buffer that will be edited. So the choice here is either fontify 339 ;; the citations and header... 340 (setq font-lock-defaults '(mh-letter-font-lock-keywords t))) 341 (t 342 ;; ...or the header only 343 (setq font-lock-defaults '((mh-show-font-lock-keywords) t)))) 344 (easy-menu-add mh-letter-menu) 345 ;; Maybe we want to use the existing Mail menu from mail-mode in 346 ;; 9.0; in the mean time, let's remove it since the redundancy will 347 ;; only produce confusion. 348 (define-key mh-letter-mode-map [menu-bar mail] 'undefined) 349 (mh-do-in-xemacs (easy-menu-remove mail-menubar-menu)) 350 (setq fill-column mh-letter-fill-column) 351 ;; If text-mode-hook turned on auto-fill, tune it for messages 352 (when auto-fill-function 353 (make-local-variable 'auto-fill-function) 354 (setq auto-fill-function 'mh-auto-fill-for-letter))) 355 356 357 358;;; MH-Letter Commands 359 360;; Alphabetical. 361;; See also mh-comp.el and mh-mime.el. 362 363(defun mh-check-whom () 364 "Verify recipients, showing expansion of any aliases. 365 366This command expands aliases so you can check the actual address(es) 367in the alias. A new buffer named \"*MH-E Recipients*\" is created with 368the output of \"whom\"." 369 (interactive) 370 (let ((file-name buffer-file-name)) 371 (save-buffer) 372 (message "Checking recipients...") 373 (mh-in-show-buffer (mh-recipients-buffer) 374 (bury-buffer (current-buffer)) 375 (erase-buffer) 376 (mh-exec-cmd-output "whom" t file-name)) 377 (message "Checking recipients...done"))) 378 379(defun mh-insert-letter (folder message verbatim) 380 "Insert a message. 381 382This command prompts you for the FOLDER and MESSAGE number, which 383defaults to the current message in that folder. It then inserts 384the message, indented by `mh-ins-buf-prefix' (\"> \") unless 385`mh-yank-behavior' is set to one of the supercite flavors in 386which case supercite is used to format the message. Certain 387undesirable header fields (see 388`mh-invisible-header-fields-compiled') are removed before 389insertion. 390 391If given a prefix argument VERBATIM, the header is left intact, the 392message is not indented, and \"> \" is not inserted before each line. 393This command leaves the mark before the letter and point after it." 394 (interactive 395 (let* ((folder 396 (mh-prompt-for-folder "Message from" mh-sent-from-folder nil)) 397 (default 398 (if (equal folder mh-sent-from-folder) 399 (or mh-sent-from-msg (nth 0 (mh-translate-range folder "cur"))) 400 (nth 0 (mh-translate-range folder "cur")))) 401 (message 402 (read-string (concat "Message number" 403 (or (and default 404 (format " (default %d): " default)) 405 ": ")) 406 nil nil 407 (if (numberp default) 408 (int-to-string default) 409 default)))) 410 (list folder message current-prefix-arg))) 411 (if (equal message "") 412 (error "No message number given")) 413 (save-restriction 414 (narrow-to-region (point) (point)) 415 (let ((start (point-min))) 416 (insert-file-contents 417 (expand-file-name message (mh-expand-file-name folder))) 418 (when (not verbatim) 419 (mh-clean-msg-header start mh-invisible-header-fields-compiled nil) 420 (goto-char (point-max)) ;Needed for sc-cite-original 421 (push-mark) ;Needed for sc-cite-original 422 (goto-char (point-min)) ;Needed for sc-cite-original 423 (mh-insert-prefix-string mh-ins-buf-prefix))))) 424 425;;;###mh-autoload 426(defun mh-insert-signature (&optional file) 427 "Insert signature in message. 428 429This command inserts your signature at the current cursor location. 430 431By default, the text of your signature is taken from the file 432\"~/.signature\". You can read from other sources by changing the 433option `mh-signature-file-name'. 434 435A signature separator (\"-- \") will be added if the signature block 436does not contain one and `mh-signature-separator-flag' is on. 437 438The hook `mh-insert-signature-hook' is run after the signature is 439inserted. Hook functions may access the actual name of the file or the 440function used to insert the signature with `mh-signature-file-name'. 441 442The signature can also be inserted using Identities (see 443`mh-identity-list'). 444 445In a program, you can pass in a signature FILE." 446 (interactive) 447 (save-excursion 448 (insert "\n") 449 (let ((mh-signature-file-name (or file mh-signature-file-name)) 450 (mh-mh-p (mh-mh-directive-present-p)) 451 (mh-mml-p (mh-mml-tag-present-p))) 452 (save-restriction 453 (narrow-to-region (point) (point)) 454 (cond 455 ((mh-file-is-vcard-p mh-signature-file-name) 456 (if (equal mh-compose-insertion 'mml) 457 (insert "<#part type=\"text/x-vcard\" filename=\"" 458 mh-signature-file-name 459 "\" disposition=inline description=VCard>\n<#/part>") 460 (insert "#text/x-vcard; name=\"" 461 (file-name-nondirectory mh-signature-file-name) 462 "\" [VCard] " (expand-file-name mh-signature-file-name)))) 463 (t 464 (cond 465 (mh-mh-p 466 (insert "#\n" "Content-Description: Signature\n")) 467 (mh-mml-p 468 (mml-insert-tag 'part 'type "text/plain" 'disposition "inline" 469 'description "Signature"))) 470 (cond ((null mh-signature-file-name)) 471 ((and (stringp mh-signature-file-name) 472 (file-readable-p mh-signature-file-name)) 473 (insert-file-contents mh-signature-file-name)) 474 ((functionp mh-signature-file-name) 475 (funcall mh-signature-file-name))))) 476 (save-restriction 477 (widen) 478 (run-hooks 'mh-insert-signature-hook)) 479 (goto-char (point-min)) 480 (when (and (not (mh-file-is-vcard-p mh-signature-file-name)) 481 mh-signature-separator-flag 482 (> (point-max) (point-min)) 483 (not (mh-signature-separator-p))) 484 (cond (mh-mh-p 485 (forward-line 2)) 486 (mh-mml-p 487 (forward-line 1))) 488 (insert mh-signature-separator)) 489 (if (not (> (point-max) (point-min))) 490 (message "No signature found"))))) 491 (force-mode-line-update)) 492 493(defun mh-letter-complete (arg) 494 "Perform completion on header field or word preceding point. 495 496If the field contains addresses (for example, \"To:\" or \"Cc:\") 497or folders (for example, \"Fcc:\") then this command will provide 498alias completion. In the body of the message, this command runs 499`mh-letter-complete-function' instead, which is set to 500`ispell-complete-word' by default. This command takes a prefix 501argument ARG that is passed to the 502`mh-letter-complete-function'." 503 (interactive "P") 504 (let ((func nil)) 505 (cond ((not (mh-in-header-p)) 506 (funcall mh-letter-complete-function arg)) 507 ((setq func (cdr (assoc (mh-letter-header-field-at-point) 508 mh-letter-complete-function-alist))) 509 (funcall func)) 510 (t (funcall mh-letter-complete-function arg))))) 511 512(defun mh-letter-complete-or-space (arg) 513 "Perform completion or insert space. 514 515Turn on the option `mh-compose-space-does-completion-flag' to use 516this command to perform completion in the header. Otherwise, a 517space is inserted; use a prefix argument ARG to specify more than 518one space." 519 (interactive "p") 520 (let ((func nil) 521 (end-of-prev (save-excursion 522 (goto-char (mh-beginning-of-word)) 523 (mh-beginning-of-word -1)))) 524 (cond ((not mh-compose-space-does-completion-flag) 525 (self-insert-command arg)) 526 ((not (mh-in-header-p)) (self-insert-command arg)) 527 ((> (point) end-of-prev) (self-insert-command arg)) 528 ((setq func (cdr (assoc (mh-letter-header-field-at-point) 529 mh-letter-complete-function-alist))) 530 (funcall func)) 531 (t (self-insert-command arg))))) 532 533(defun mh-letter-confirm-address () 534 "Flash alias expansion. 535 536Addresses are separated by a comma\; when you press the comma, 537this command flashes the alias expansion in the minibuffer if 538`mh-alias-flash-on-comma' is turned on." 539 (interactive) 540 (cond ((not (mh-in-header-p)) (self-insert-command 1)) 541 ((eq (cdr (assoc (mh-letter-header-field-at-point) 542 mh-letter-complete-function-alist)) 543 'mh-alias-letter-expand-alias) 544 (mh-alias-reload-maybe) 545 (mh-alias-minibuffer-confirm-address)) 546 (t (self-insert-command 1)))) 547 548(defun mh-letter-next-header-field-or-indent (arg) 549 "Cycle to next field. 550 551Within the header of the message, this command moves between 552fields that are highlighted with the face 553`mh-letter-header-field', skipping those fields listed in 554`mh-compose-skipped-header-fields'. After the last field, this 555command then moves point to the message body before cycling back 556to the first field. If point is already past the first line of 557the message body, then this command indents by calling 558`indent-relative' with the given prefix argument ARG." 559 (interactive "P") 560 (let ((header-end (save-excursion 561 (goto-char (mh-mail-header-end)) 562 (forward-line) 563 (point)))) 564 (if (> (point) header-end) 565 (indent-relative arg) 566 (mh-letter-next-header-field)))) 567 568(defun mh-letter-previous-header-field () 569 "Cycle to the previous header field. 570 571This command moves backwards between the fields and cycles to the 572body of the message after the first field. Unlike the command 573\\[mh-letter-next-header-field-or-indent], it will always take 574point to the last field from anywhere in the body." 575 (interactive) 576 (let ((header-end (mh-mail-header-end))) 577 (if (>= (point) header-end) 578 (goto-char header-end) 579 (mh-header-field-beginning)) 580 (cond ((re-search-backward mh-letter-header-field-regexp nil t) 581 (if (mh-letter-skipped-header-field-p (match-string 1)) 582 (mh-letter-previous-header-field) 583 (goto-char (match-end 0)) 584 (mh-letter-skip-leading-whitespace-in-header-field))) 585 (t (goto-char header-end) 586 (forward-line))))) 587 588(defun mh-open-line () 589 "Insert a newline and leave point before it. 590 591This command is similar to the command \\[open-line] in that it 592inserts a newline after point. It differs in that it also inserts 593the right number of quoting characters and spaces so that the 594next line begins in the same column as it was. This is useful 595when breaking up paragraphs in replies." 596 (interactive) 597 (let ((column (current-column)) 598 (prefix (mh-current-fill-prefix))) 599 (if (> (length prefix) column) 600 (message "Sorry, point seems to be within the line prefix") 601 (newline 2) 602 (insert prefix) 603 (while (> column (current-column)) 604 (insert " ")) 605 (forward-line -1)))) 606 607(defun mh-to-fcc (&optional folder) 608 "Move to \"Fcc:\" header field. 609 610This command will prompt you for the FOLDER name in which to file 611a copy of the draft." 612 (interactive (list (mh-prompt-for-folder 613 "Fcc" 614 (or (and mh-default-folder-for-message-function 615 (save-excursion 616 (goto-char (point-min)) 617 (funcall 618 mh-default-folder-for-message-function))) 619 "") 620 t))) 621 (let ((last-input-char ?\C-f)) 622 (expand-abbrev) 623 (save-excursion 624 (mh-to-field) 625 (insert (if (mh-folder-name-p folder) 626 (substring folder 1) 627 folder))))) 628 629(defvar mh-to-field-choices '(("a" . "Mail-Reply-To:") 630 ("b" . "Bcc:") 631 ("c" . "Cc:") 632 ("d" . "Dcc:") 633 ("f" . "Fcc:") 634 ("l" . "Mail-Followup-To:") 635 ("m" . "From:") 636 ("r" . "Reply-To:") 637 ("s" . "Subject:") 638 ("t" . "To:")) 639 "Alist of (final-character . field-name) choices for `mh-to-field'.") 640 641(defun mh-to-field () 642 "Move to specified header field. 643 644The field is indicated by the previous keystroke (the last 645keystroke of the command) according to the list in the variable 646`mh-to-field-choices'. 647Create the field if it does not exist. 648Set the mark to point before moving." 649 (interactive) 650 (expand-abbrev) 651 (let ((target (cdr (or (assoc (char-to-string (logior last-input-char ?`)) 652 mh-to-field-choices) 653 ;; also look for a char for version 4 compat 654 (assoc (logior last-input-char ?`) 655 mh-to-field-choices)))) 656 (case-fold-search t)) 657 (push-mark) 658 (cond ((mh-position-on-field target) 659 (let ((eol (point))) 660 (skip-chars-backward " \t") 661 (delete-region (point) eol)) 662 (if (and (not (eq (logior last-input-char ?`) ?s)) 663 (save-excursion 664 (backward-char 1) 665 (not (looking-at "[:,]")))) 666 (insert ", ") 667 (insert " "))) 668 (t 669 (if (mh-position-on-field "To:") 670 (forward-line 1)) 671 (insert (format "%s \n" target)) 672 (backward-char 1))))) 673 674;;;###mh-autoload 675(defun mh-yank-cur-msg () 676 "Insert the current message into the draft buffer. 677 678It is often useful to insert a snippet of text from a letter that 679someone mailed to provide some context for your reply. This 680command does this by adding an attribution, yanking a portion of 681text from the message to which you're replying, and inserting 682`mh-ins-buf-prefix' (`> ') before each line. 683 684The attribution consists of the sender's name and email address 685followed by the content of the option 686`mh-extract-from-attribution-verb'. 687 688You can also turn on the option 689`mh-delete-yanked-msg-window-flag' to delete the window 690containing the original message after yanking it to make more 691room on your screen for your reply. 692 693You can control how the message to which you are replying is 694yanked into your reply using `mh-yank-behavior'. 695 696If this isn't enough, you can gain full control over the 697appearance of the included text by setting `mail-citation-hook' 698to a function that modifies it. For example, if you set this hook 699to `trivial-cite' (which is NOT part of Emacs), set 700`mh-yank-behavior' to \"Body and Header\" (see URL 701`http://shasta.cs.uiuc.edu/~lrclause/tc.html'). 702 703Note that if `mail-citation-hook' is set, `mh-ins-buf-prefix' is 704not inserted. If the option `mh-yank-behavior' is set to one of 705the supercite flavors, the hook `mail-citation-hook' is ignored 706and `mh-ins-buf-prefix' is not inserted." 707 (interactive) 708 (if (and mh-sent-from-folder 709 (save-excursion (set-buffer mh-sent-from-folder) mh-show-buffer) 710 (save-excursion (set-buffer mh-sent-from-folder) 711 (get-buffer mh-show-buffer)) 712 mh-sent-from-msg) 713 (let ((to-point (point)) 714 (to-buffer (current-buffer))) 715 (set-buffer mh-sent-from-folder) 716 (if mh-delete-yanked-msg-window-flag 717 (delete-windows-on mh-show-buffer)) 718 (set-buffer mh-show-buffer) ; Find displayed message 719 (let* ((from-attr (mh-extract-from-attribution)) 720 (yank-region (mh-mark-active-p nil)) 721 (mh-ins-str 722 (cond ((and yank-region 723 (or (eq 'supercite mh-yank-behavior) 724 (eq 'autosupercite mh-yank-behavior) 725 (eq t mh-yank-behavior))) 726 ;; supercite needs the full header 727 (concat 728 (buffer-substring (point-min) (mh-mail-header-end)) 729 "\n" 730 (buffer-substring (region-beginning) (region-end)))) 731 (yank-region 732 (buffer-substring (region-beginning) (region-end))) 733 ((or (eq 'body mh-yank-behavior) 734 (eq 'attribution mh-yank-behavior) 735 (eq 'autoattrib mh-yank-behavior)) 736 (buffer-substring 737 (save-excursion 738 (goto-char (point-min)) 739 (mh-goto-header-end 1) 740 (point)) 741 (point-max))) 742 ((or (eq 'supercite mh-yank-behavior) 743 (eq 'autosupercite mh-yank-behavior) 744 (eq t mh-yank-behavior)) 745 (buffer-substring (point-min) (point-max))) 746 (t 747 (buffer-substring (point) (point-max)))))) 748 (set-buffer to-buffer) 749 (save-restriction 750 (narrow-to-region to-point to-point) 751 (insert (mh-filter-out-non-text mh-ins-str)) 752 (goto-char (point-max)) ;Needed for sc-cite-original 753 (push-mark) ;Needed for sc-cite-original 754 (goto-char (point-min)) ;Needed for sc-cite-original 755 (mh-insert-prefix-string mh-ins-buf-prefix) 756 (when (or (eq 'attribution mh-yank-behavior) 757 (eq 'autoattrib mh-yank-behavior)) 758 (insert from-attr) 759 (mh-identity-insert-attribution-verb nil) 760 (insert "\n\n")) 761 ;; If the user has selected a region, he has already "edited" the 762 ;; text, so leave the cursor at the end of the yanked text. In 763 ;; either case, leave a mark at the opposite end of the included 764 ;; text to make it easy to jump or delete to the other end of the 765 ;; text. 766 (push-mark) 767 (goto-char (point-max)) 768 (if (null yank-region) 769 (mh-exchange-point-and-mark-preserving-active-mark))))) 770 (error "There is no current message"))) 771 772 773 774;;; Support Routines 775 776(defun mh-auto-fill-for-letter () 777 "Perform auto-fill for message. 778Header is treated specially by inserting a tab before continuation 779lines." 780 (if (mh-in-header-p) 781 (let ((fill-prefix "\t")) 782 (do-auto-fill)) 783 (do-auto-fill))) 784 785(defun mh-filter-out-non-text (string) 786 "Return STRING but without adornments such as MIME buttons and smileys." 787 (with-temp-buffer 788 ;; Insert the string to filter 789 (insert string) 790 (goto-char (point-min)) 791 792 ;; Remove the MIME buttons 793 (let ((can-move-forward t) 794 (in-button nil)) 795 (while can-move-forward 796 (cond ((and (not (get-text-property (point) 'mh-data)) 797 in-button) 798 (delete-region (1- (point)) (point)) 799 (setq in-button nil)) 800 ((get-text-property (point) 'mh-data) 801 (delete-region (point) 802 (save-excursion (forward-line) (point))) 803 (setq in-button t)) 804 (t (setq can-move-forward (= (forward-line) 0)))))) 805 806 ;; Return the contents without properties... This gets rid of emphasis 807 ;; and smileys 808 (buffer-substring-no-properties (point-min) (point-max)))) 809 810(defun mh-current-fill-prefix () 811 "Return the `fill-prefix' on the current line as a string." 812 (save-excursion 813 (beginning-of-line) 814 ;; This assumes that the major-mode sets up adaptive-fill-regexp 815 ;; correctly such as mh-letter-mode or sendmail.el's mail-mode. But 816 ;; perhaps I should use the variable and simply inserts its value here, 817 ;; and set it locally in a let scope. --psg 818 (if (re-search-forward adaptive-fill-regexp nil t) 819 (match-string 0) 820 ""))) 821 822;;;###mh-autoload 823(defun mh-letter-next-header-field () 824 "Cycle to the next header field. 825If we are at the last header field go to the start of the message 826body." 827 (let ((header-end (mh-mail-header-end))) 828 (cond ((>= (point) header-end) (goto-char (point-min))) 829 ((< (point) (progn 830 (beginning-of-line) 831 (re-search-forward mh-letter-header-field-regexp 832 (mh-line-end-position) t) 833 (point))) 834 (beginning-of-line)) 835 (t (end-of-line))) 836 (cond ((re-search-forward mh-letter-header-field-regexp header-end t) 837 (if (mh-letter-skipped-header-field-p (match-string 1)) 838 (mh-letter-next-header-field) 839 (mh-letter-skip-leading-whitespace-in-header-field))) 840 (t (goto-char header-end) 841 (forward-line))))) 842 843;;;###mh-autoload 844(defun mh-position-on-field (field &optional ignored) 845 "Move to the end of the FIELD in the header. 846Move to end of entire header if FIELD not found. 847Returns non-nil iff FIELD was found. 848The optional second arg is for pre-version 4 compatibility and is 849IGNORED." 850 (cond ((mh-goto-header-field field) 851 (mh-header-field-end) 852 t) 853 ((mh-goto-header-end 0) 854 nil))) 855 856(defun mh-letter-header-field-at-point () 857 "Return the header field name at point. 858A symbol is returned whose name is the string obtained by 859downcasing the field name." 860 (save-excursion 861 (end-of-line) 862 (and (re-search-backward mh-letter-header-field-regexp nil t) 863 (intern (downcase (match-string 1)))))) 864 865(defun mh-folder-expand-at-point () 866 "Do folder name completion in Fcc header field." 867 (let* ((end (point)) 868 (beg (mh-beginning-of-word)) 869 (folder (buffer-substring-no-properties beg end)) 870 (leading-plus (and (> (length folder) 0) (equal (aref folder 0) ?+))) 871 (choices (mapcar (lambda (x) (list x)) 872 (mh-folder-completion-function folder nil t)))) 873 (unless leading-plus 874 (setq folder (concat "+" folder))) 875 (mh-complete-word folder choices beg end))) 876 877;;;###mh-autoload 878(defun mh-complete-word (word choices begin end) 879 "Complete WORD at from CHOICES. 880Any match found replaces the text from BEGIN to END." 881 (let ((completion (try-completion word choices)) 882 (completions-buffer "*Completions*")) 883 (cond ((eq completion t) 884 (ignore-errors 885 (kill-buffer completions-buffer)) 886 (message "Completed: %s" word)) 887 ((null completion) 888 (ignore-errors 889 (kill-buffer completions-buffer)) 890 (message "No completion for %s" word)) 891 ((stringp completion) 892 (if (equal word completion) 893 (with-output-to-temp-buffer completions-buffer 894 (mh-display-completion-list (all-completions word choices) 895 word)) 896 (ignore-errors 897 (kill-buffer completions-buffer)) 898 (delete-region begin end) 899 (insert completion)))))) 900 901(defun mh-file-is-vcard-p (file) 902 "Return t if FILE is a .vcf vcard." 903 (let ((case-fold-search t)) 904 (and (stringp file) 905 (file-exists-p file) 906 (or (and (not (mh-have-file-command)) 907 (not (null (string-match "\.vcf$" file)))) 908 (string-equal "text/x-vcard" (mh-file-mime-type file)))))) 909 910;;;###mh-autoload 911(defun mh-letter-toggle-header-field-display-button (event) 912 "Toggle header field display at location of EVENT. 913This function does the same thing as 914`mh-letter-toggle-header-field-display' except that it is 915callable from a mouse button." 916 (interactive "e") 917 (mh-do-at-event-location event 918 (mh-letter-toggle-header-field-display nil))) 919 920(defun mh-extract-from-attribution () 921 "Extract phrase or comment from From header field." 922 (save-excursion 923 (if (not (mh-goto-header-field "From: ")) 924 nil 925 (skip-chars-forward " ") 926 (cond 927 ((looking-at "\"\\([^\"\n]+\\)\" \\(<.+>\\)") 928 (format "%s %s " (match-string 1)(match-string 2))) 929 ((looking-at "\\([^<\n]+<.+>\\)$") 930 (format "%s " (match-string 1))) 931 ((looking-at "\\([^ ]+@[^ ]+\\) +(\\(.+\\))$") 932 (format "%s <%s> " (match-string 2)(match-string 1))) 933 ((looking-at " *\\(.+\\)$") 934 (format "%s " (match-string 1))))))) 935 936(defun mh-insert-prefix-string (mh-ins-string) 937 "Insert prefix string before each line in buffer. 938The inserted letter is cited using `sc-cite-original' if 939`mh-yank-behavior' is one of 'supercite or 'autosupercite. 940Otherwise, simply insert MH-INS-STRING before each line." 941 (goto-char (point-min)) 942 (cond ((or (eq mh-yank-behavior 'supercite) 943 (eq mh-yank-behavior 'autosupercite)) 944 (sc-cite-original)) 945 (mail-citation-hook 946 (run-hooks 'mail-citation-hook)) 947 (mh-yank-hooks ;old hook name 948 (run-hooks 'mh-yank-hooks)) 949 (t 950 (or (bolp) (forward-line 1)) 951 (while (< (point) (point-max)) 952 (insert mh-ins-string) 953 (forward-line 1)) 954 (goto-char (point-min))))) ;leave point like sc-cite-original 955 956(provide 'mh-letter) 957 958;; Local Variables: 959;; indent-tabs-mode: nil 960;; sentence-end-double-space: nil 961;; End: 962 963;; arch-tag: 0548632c-aadb-4e3b-bb80-bbd62ff90bf3 964;;; mh-letter.el ends here 965