1;;; mh-comp.el --- MH-E functions for composing and sending messages 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;; This file includes the functions in the MH-Folder maps that get us 31;; into MH-Letter mode, as well the functions in the MH-Letter mode 32;; that are used to send the mail. Other that those, functions that 33;; are needed in mh-letter.el should be found there. 34 35;;; Change Log: 36 37;;; Code: 38 39(require 'mh-e) 40(require 'mh-gnus) ;needed because mh-gnus.el not compiled 41(require 'mh-scan) 42 43(require 'sendmail) 44 45(autoload 'easy-menu-add "easymenu") 46(autoload 'mml-insert-tag "mml") 47 48 49 50;;; Site Customization 51 52(defvar mh-send-prog "send" 53 "Name of the MH send program. 54Some sites need to change this because of a name conflict.") 55 56(defvar mh-send-uses-spost-flag nil 57 "Non-nil means \"send\" uses \"spost\" to submit messages. 58 59If the value of \"postproc:\" is \"spost\", you may need to set 60this variable to t to tell MH-E to avoid using features of 61\"post\" that are not supported by \"spost\". You'll know that 62you'll need to do this if sending mail fails with an error of 63\"spost: -msgid unknown\".") 64 65(defvar mh-redist-background nil 66 "If non-nil redist will be done in background like send. 67This allows transaction log to be visible if -watch, -verbose or 68-snoop are used.") 69 70 71 72;;; Variables 73 74(defvar mh-comp-formfile "components" 75 "Name of file to be used as a skeleton for composing messages. 76 77Default is \"components\". 78 79If not an absolute file name, the file is searched for first in the 80user's MH directory, then in the system MH lib directory.") 81 82(defvar mh-repl-formfile "replcomps" 83 "Name of file to be used as a skeleton for replying to messages. 84 85Default is \"replcomps\". 86 87If not an absolute file name, the file is searched for first in the 88user's MH directory, then in the system MH lib directory.") 89 90(defvar mh-repl-group-formfile "replgroupcomps" 91 "Name of file to be used as a skeleton for replying to messages. 92 93Default is \"replgroupcomps\". 94 95This file is used to form replies to the sender and all recipients of 96a message. Only used if `(mh-variant-p 'nmh)' is non-nil. 97If not an absolute file name, the file is searched for first in the 98user's MH directory, then in the system MH lib directory.") 99 100(defvar mh-rejected-letter-start 101 (format "^%s$" 102 (regexp-opt 103 '("Content-Type: message/rfc822" ;MIME MDN 104 "------ This is a copy of the message, including all the headers. ------";from exim 105 "--- Below this line is a copy of the message."; from qmail 106 " ----- Unsent message follows -----" ;from sendmail V5 107 " --------Unsent Message below:" ; from sendmail at BU 108 " ----- Original message follows -----" ;from sendmail V8 109 "------- Unsent Draft" ;from MH itself 110 "---------- Original Message ----------" ;from zmailer 111 " --- The unsent message follows ---" ;from AIX mail system 112 " Your message follows:" ;from MMDF-II 113 "Content-Description: Returned Content" ;1993 KJ sendmail 114 )))) 115 116(defvar mh-new-draft-cleaned-headers 117 "^Date:\\|^Received:\\|^Message-Id:\\|^From:\\|^Sender:\\|^Errors-To:\\|^Delivery-Date:\\|^Return-Path:" 118 "Regexp of header lines to remove before offering a message as a new draft\\<mh-folder-mode-map>. 119Used by the \\[mh-edit-again] and \\[mh-extract-rejected-mail] commands.") 120 121(defvar mh-letter-mode-syntax-table nil 122 "Syntax table used by MH-E while in MH-Letter mode.") 123 124(if mh-letter-mode-syntax-table 125 () 126 (setq mh-letter-mode-syntax-table 127 (make-syntax-table text-mode-syntax-table)) 128 (modify-syntax-entry ?% "." mh-letter-mode-syntax-table)) 129 130(defvar mh-send-args "" 131 "Extra args to pass to \"send\" command.") 132 133(defvar mh-annotate-char nil 134 "Character to use to annotate `mh-sent-from-msg'.") 135 136(defvar mh-annotate-field nil 137 "Field name for message annotation.") 138 139(defvar mh-insert-auto-fields-done-local nil 140 "Buffer-local variable set when `mh-insert-auto-fields' called successfully.") 141(make-variable-buffer-local 'mh-insert-auto-fields-done-local) 142 143 144 145;;; MH-E Entry Points 146 147;;;###autoload 148(defun mh-smail () 149 "Compose a message with the MH mail system. 150See `mh-send' for more details on composing mail." 151 (interactive) 152 (mh-find-path) 153 (call-interactively 'mh-send)) 154 155;;;###autoload 156(defun mh-smail-other-window () 157 "Compose a message with the MH mail system in other window. 158See `mh-send' for more details on composing mail." 159 (interactive) 160 (mh-find-path) 161 (call-interactively 'mh-send-other-window)) 162 163(defun mh-send-other-window (to cc subject) 164 "Compose a message in another window. 165 166See `mh-send' for more information and a description of how the 167TO, CC, and SUBJECT arguments are used." 168 (interactive (list 169 (mh-interactive-read-address "To: ") 170 (mh-interactive-read-address "Cc: ") 171 (mh-interactive-read-string "Subject: "))) 172 (let ((pop-up-windows t)) 173 (mh-send-sub to cc subject (current-window-configuration)))) 174 175(defvar mh-error-if-no-draft nil) ;raise error over using old draft 176 177;;;###autoload 178(defun mh-smail-batch (&optional to subject other-headers &rest ignored) 179 "Compose a message with the MH mail system. 180 181This function does not prompt the user for any header fields, and 182thus is suitable for use by programs that want to create a mail 183buffer. Users should use \\[mh-smail] to compose mail. 184 185Optional arguments for setting certain fields include TO, 186SUBJECT, and OTHER-HEADERS. Additional arguments are IGNORED. 187 188This function remains for Emacs 21 compatibility. New 189applications should use `mh-user-agent-compose'." 190 (mh-find-path) 191 (let ((mh-error-if-no-draft t)) 192 (mh-send (or to "") "" (or subject "")))) 193 194;;;###autoload 195(define-mail-user-agent 'mh-e-user-agent 196 'mh-user-agent-compose 'mh-send-letter 'mh-fully-kill-draft 197 'mh-before-send-letter-hook) 198 199;;;###autoload 200(defun mh-user-agent-compose (&optional to subject other-headers continue 201 switch-function yank-action 202 send-actions) 203 "Set up mail composition draft with the MH mail system. 204This is the `mail-user-agent' entry point to MH-E. This function 205conforms to the contract specified by `define-mail-user-agent' 206which means that this function should accept the same arguments 207as `compose-mail'. 208 209The optional arguments TO and SUBJECT specify recipients and the 210initial Subject field, respectively. 211 212OTHER-HEADERS is an alist specifying additional header fields. 213Elements look like (HEADER . VALUE) where both HEADER and VALUE 214are strings. 215 216CONTINUE, SWITCH-FUNCTION, YANK-ACTION and SEND-ACTIONS are 217ignored." 218 (mh-find-path) 219 (let ((mh-error-if-no-draft t)) 220 (mh-send to "" subject) 221 (while other-headers 222 (mh-insert-fields (concat (car (car other-headers)) ":") 223 (cdr (car other-headers))) 224 (setq other-headers (cdr other-headers))))) 225 226;; Shush compiler. 227(defvar sendmail-coding-system) ; XEmacs 228 229;;;###autoload 230(defun mh-send-letter (&optional arg) 231 "Save draft and send message. 232 233When you are all through editing a message, you send it with this 234command. You can give a prefix argument ARG to monitor the first stage 235of the delivery\; this output can be found in a buffer called \"*MH-E 236Mail Delivery*\". 237 238The hook `mh-before-send-letter-hook' is run at the beginning of 239this command. For example, if you want to check your spelling in 240your message before sending, add the function `ispell-message'. 241 242Unless `mh-insert-auto-fields' had previously been called 243manually, the function `mh-insert-auto-fields' is called to 244insert fields based upon the recipients. If fields are added, you 245are given a chance to see and to confirm these fields before the 246message is actually sent. You can do away with this confirmation 247by turning off the option `mh-auto-fields-prompt-flag'. 248 249In case the MH \"send\" program is installed under a different name, 250use `mh-send-prog' to tell MH-E the name." 251 (interactive "P") 252 (run-hooks 'mh-before-send-letter-hook) 253 (if (and (mh-insert-auto-fields t) 254 mh-auto-fields-prompt-flag 255 (goto-char (point-min))) 256 (if (not (y-or-n-p "Auto fields inserted, send? ")) 257 (error "Send aborted"))) 258 (cond ((mh-mh-directive-present-p) 259 (mh-mh-to-mime)) 260 ((or (mh-mml-tag-present-p) (not (mh-ascii-buffer-p))) 261 (mh-mml-to-mime))) 262 (save-buffer) 263 (message "Sending...") 264 (let ((draft-buffer (current-buffer)) 265 (file-name buffer-file-name) 266 (config mh-previous-window-config) 267 (coding-system-for-write 268 (if (and (local-variable-p 'buffer-file-coding-system 269 (current-buffer)) ;XEmacs needs two args 270 ;; We're not sure why, but buffer-file-coding-system 271 ;; tends to get set to undecided-unix. 272 (not (memq buffer-file-coding-system 273 '(undecided undecided-unix undecided-dos)))) 274 buffer-file-coding-system 275 (or (and (boundp 'sendmail-coding-system) sendmail-coding-system) 276 (and (boundp 'default-buffer-file-coding-system ) 277 default-buffer-file-coding-system) 278 'iso-latin-1)))) 279 ;; Older versions of spost do not support -msgid and -mime. 280 (unless mh-send-uses-spost-flag 281 ;; Adding a Message-ID field looks good, makes it easier to search for 282 ;; message in your +outbox, and best of all doesn't break threading for 283 ;; the recipient if you reply to a message in your +outbox. 284 (setq mh-send-args (concat "-msgid " mh-send-args)) 285 ;; The default BCC encapsulation will make a MIME message unreadable. 286 ;; With nmh use the -mime arg to prevent this. 287 (if (and (mh-variant-p 'nmh) 288 (mh-goto-header-field "Bcc:") 289 (mh-goto-header-field "Content-Type:")) 290 (setq mh-send-args (concat "-mime " mh-send-args)))) 291 (cond (arg 292 (pop-to-buffer mh-mail-delivery-buffer) 293 (erase-buffer) 294 (mh-exec-cmd-output mh-send-prog t "-watch" "-nopush" 295 "-nodraftfolder" mh-send-args file-name) 296 (goto-char (point-max)) ; show the interesting part 297 (recenter -1) 298 (set-buffer draft-buffer)) ; for annotation below 299 (t 300 (mh-exec-cmd-daemon mh-send-prog nil "-nodraftfolder" "-noverbose" 301 (split-string mh-send-args) file-name))) 302 (if mh-annotate-char 303 (mh-annotate-msg mh-sent-from-msg 304 mh-sent-from-folder 305 mh-annotate-char 306 "-component" mh-annotate-field 307 "-text" (format "\"%s %s\"" 308 (mh-get-header-field "To:") 309 (mh-get-header-field "Cc:")))) 310 311 (cond ((or (not arg) 312 (y-or-n-p "Kill draft buffer? ")) 313 (kill-buffer draft-buffer) 314 (if config 315 (set-window-configuration config)))) 316 (if arg 317 (message "Sending...done") 318 (message "Sending...backgrounded")))) 319 320;;;###autoload 321(defun mh-fully-kill-draft () 322 "Quit editing and delete draft message. 323 324If for some reason you are not happy with the draft, you can use 325this command to kill the draft buffer and delete the draft 326message. Use the command \\[kill-buffer] if you don't want to 327delete the draft message." 328 (interactive) 329 (if (y-or-n-p "Kill draft message? ") 330 (let ((config mh-previous-window-config)) 331 (if (file-exists-p buffer-file-name) 332 (delete-file buffer-file-name)) 333 (set-buffer-modified-p nil) 334 (kill-buffer (buffer-name)) 335 (message "") 336 (if config 337 (set-window-configuration config))) 338 (error "Message not killed"))) 339 340 341 342;;; MH-Folder Commands 343 344;; Alphabetical. 345 346;;;###mh-autoload 347(defun mh-edit-again (message) 348 "Edit a MESSAGE to send it again. 349 350If you don't complete a draft for one reason or another, and if 351the draft buffer is no longer available, you can pick your draft 352up again with this command. If you don't use a draft folder, your 353last \"draft\" file will be used. If you use draft folders, 354you'll need to visit the draft folder with \"\\[mh-visit-folder] 355drafts <RET>\", use \\[mh-next-undeleted-msg] to move to the 356appropriate message, and then use \\[mh-edit-again] to prepare 357the message for editing. 358 359This command can also be used to take messages that were sent to 360you and to send them to more people. 361 362Don't use this command to re-edit a message from a Mailer-Daemon 363who complained that your mail wasn't posted for some reason or 364another (see `mh-extract-rejected-mail'). 365 366The default message is the current message. 367 368See also `mh-send'." 369 (interactive (list (mh-get-msg-num t))) 370 (let* ((from-folder mh-current-folder) 371 (config (current-window-configuration)) 372 (draft 373 (cond ((and mh-draft-folder (equal from-folder mh-draft-folder)) 374 (pop-to-buffer (find-file-noselect (mh-msg-filename message)) 375 t) 376 (rename-buffer (format "draft-%d" message)) 377 ;; Make buffer writable... 378 (setq buffer-read-only nil) 379 ;; If buffer was being used to display the message reinsert 380 ;; from file... 381 (when (eq major-mode 'mh-show-mode) 382 (erase-buffer) 383 (insert-file-contents buffer-file-name)) 384 (buffer-name)) 385 (t 386 (mh-read-draft "clean-up" (mh-msg-filename message) nil))))) 387 (mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil) 388 (mh-insert-header-separator) 389 (goto-char (point-min)) 390 (save-buffer) 391 (mh-compose-and-send-mail draft "" from-folder nil nil nil nil nil nil 392 config) 393 (mh-letter-mode-message) 394 (mh-letter-adjust-point))) 395 396;;;###mh-autoload 397(defun mh-extract-rejected-mail (message) 398 "Edit a MESSAGE that was returned by the mail system. 399 400This command prepares the message for editing by removing the 401Mailer-Daemon envelope and unneeded header fields. Fix whatever 402addressing problem you had, and send the message again with 403\\[mh-send-letter]. 404 405The default message is the current message. 406 407See also `mh-send'." 408 (interactive (list (mh-get-msg-num t))) 409 (let ((from-folder mh-current-folder) 410 (config (current-window-configuration)) 411 (draft (mh-read-draft "extraction" (mh-msg-filename message) nil))) 412 (goto-char (point-min)) 413 (cond ((re-search-forward mh-rejected-letter-start nil t) 414 (skip-chars-forward " \t\n") 415 (delete-region (point-min) (point)) 416 (mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil)) 417 (t 418 (message "Does not appear to be a rejected letter"))) 419 (mh-insert-header-separator) 420 (goto-char (point-min)) 421 (save-buffer) 422 (mh-compose-and-send-mail draft "" from-folder message 423 (mh-get-header-field "To:") 424 (mh-get-header-field "From:") 425 (mh-get-header-field "Cc:") 426 nil nil config) 427 (mh-letter-mode-message))) 428 429;;;###mh-autoload 430(defun mh-forward (to cc &optional range) 431 "Forward message. 432 433You are prompted for the TO and CC recipients. You are given a 434draft to edit that looks like it would if you had run the MH 435command \"forw\". You can then add some text. 436 437You can forward several messages by using a RANGE. All of the 438messages in the range are inserted into your draft. Check the 439documentation of `mh-interactive-range' to see how RANGE is read 440in interactive use. 441 442The hook `mh-forward-hook' is called on the draft. 443 444See also `mh-compose-forward-as-mime-flag', 445`mh-forward-subject-format', and `mh-send'." 446 (interactive (list (mh-interactive-read-address "To: ") 447 (mh-interactive-read-address "Cc: ") 448 (mh-interactive-range "Forward"))) 449 (let* ((folder mh-current-folder) 450 (msgs (mh-range-to-msg-list range)) 451 (config (current-window-configuration)) 452 (fwd-msg-file (mh-msg-filename (car msgs) folder)) 453 ;; forw always leaves file in "draft" since it doesn't have -draft 454 (draft-name (expand-file-name "draft" mh-user-path)) 455 (draft (cond ((or (not (file-exists-p draft-name)) 456 (y-or-n-p "The file draft exists; discard it? ")) 457 (mh-exec-cmd "forw" "-build" 458 (if (and (mh-variant-p 'nmh) 459 mh-compose-forward-as-mime-flag) 460 "-mime") 461 mh-current-folder 462 (mh-coalesce-msg-list msgs)) 463 (prog1 464 (mh-read-draft "" draft-name t) 465 (mh-insert-fields "To:" to "Cc:" cc) 466 (save-buffer))) 467 (t 468 (mh-read-draft "" draft-name nil))))) 469 (let (orig-from 470 orig-subject) 471 (save-excursion 472 (set-buffer (get-buffer-create mh-temp-buffer)) 473 (erase-buffer) 474 (insert-file-contents fwd-msg-file) 475 (setq orig-from (mh-get-header-field "From:")) 476 (setq orig-subject (mh-get-header-field "Subject:"))) 477 (let ((forw-subject 478 (mh-forwarded-letter-subject orig-from orig-subject))) 479 (mh-insert-fields "Subject:" forw-subject) 480 (goto-char (point-min)) 481 ;; If using MML, translate MH-style directive 482 (if (equal mh-compose-insertion 'mml) 483 (save-excursion 484 (goto-char (mh-mail-header-end)) 485 (while 486 (re-search-forward 487 "^#forw \\[\\([^]]+\\)\\] \\(+\\S-+\\) \\(.*\\)$" 488 (point-max) t) 489 (let ((description (if (equal (match-string 1) 490 "forwarded messages") 491 "forwarded message %d" 492 (match-string 1))) 493 (msgs (split-string (match-string 3))) 494 (i 0)) 495 (beginning-of-line) 496 (delete-region (point) (progn (forward-line 1) (point))) 497 (dolist (msg msgs) 498 (setq i (1+ i)) 499 (mh-mml-forward-message (format description i) 500 folder msg)))))) 501 ;; Postition just before forwarded message 502 (if (re-search-forward "^------- Forwarded Message" nil t) 503 (forward-line -1) 504 (goto-char (mh-mail-header-end)) 505 (forward-line 1)) 506 (delete-other-windows) 507 (mh-add-msgs-to-seq msgs 'forwarded t) 508 (mh-compose-and-send-mail draft "" folder msgs 509 to forw-subject cc 510 mh-note-forw "Forwarded:" 511 config) 512 (mh-letter-mode-message) 513 (mh-letter-adjust-point) 514 (run-hooks 'mh-forward-hook))))) 515 516(defun mh-forwarded-letter-subject (from subject) 517 "Return a Subject suitable for a forwarded message. 518Original message has headers FROM and SUBJECT." 519 (let ((addr-start (string-match "<" from)) 520 (comment (string-match "(" from))) 521 (cond ((and addr-start (> addr-start 0)) 522 ;; Full Name <luser@host> 523 (setq from (substring from 0 (1- addr-start)))) 524 (comment 525 ;; luser@host (Full Name) 526 (setq from (substring from (1+ comment) (1- (length from))))))) 527 (format mh-forward-subject-format from subject)) 528 529;;;###mh-autoload 530(defun mh-redistribute (to cc &optional message) 531 "Redistribute a message. 532 533This command is similar in function to forwarding mail, but it 534does not allow you to edit the message, nor does it add your name 535to the \"From\" header field. It appears to the recipient as if 536the message had come from the original sender. When you run this 537command, you are prompted for the TO and CC recipients. The 538default MESSAGE is the current message. 539 540Also investigate the command \\[mh-edit-again] for another way to 541redistribute messages. 542 543See also `mh-redist-full-contents-flag'." 544 (interactive (list (mh-read-address "Redist-To: ") 545 (mh-read-address "Redist-Cc: ") 546 (mh-get-msg-num t))) 547 (or message 548 (setq message (mh-get-msg-num t))) 549 (save-window-excursion 550 (let ((folder mh-current-folder) 551 (draft (mh-read-draft "redistribution" 552 (if mh-redist-full-contents-flag 553 (mh-msg-filename message) 554 nil) 555 nil))) 556 (mh-goto-header-end 0) 557 (insert "Resent-To: " to "\n") 558 (if (not (equal cc "")) (insert "Resent-cc: " cc "\n")) 559 (mh-clean-msg-header 560 (point-min) 561 "^Message-Id:\\|^Received:\\|^Return-Path:\\|^Sender:\\|^Date:\\|^From:" 562 nil) 563 (save-buffer) 564 (message "Redistributing...") 565 (let ((env "mhdist=1")) 566 ;; Setup environment... 567 (setq env (concat env " mhaltmsg=" 568 (if mh-redist-full-contents-flag 569 buffer-file-name 570 (mh-msg-filename message folder)))) 571 (unless mh-redist-full-contents-flag 572 (setq env (concat env " mhannotate=1"))) 573 ;; Redistribute... 574 (if mh-redist-background 575 (mh-exec-cmd-env-daemon env mh-send-prog nil buffer-file-name) 576 (mh-exec-cmd-error env mh-send-prog "-push" buffer-file-name)) 577 ;; Annotate... 578 (mh-annotate-msg message folder mh-note-dist 579 "-component" "Resent:" 580 "-text" (format "\"%s %s\"" to cc))) 581 (kill-buffer draft) 582 (message "Redistributing...done")))) 583 584;;;###mh-autoload 585(defun mh-reply (message &optional reply-to includep) 586 "Reply to a MESSAGE. 587 588When you reply to a message, you are first prompted with \"Reply 589to whom?\" (unless the optional argument REPLY-TO is provided). 590You have several choices here. 591 592 Response Reply Goes To 593 594 from The person who sent the message. This is the 595 default, so <RET> is sufficient. 596 597 to Replies to the sender, plus all recipients in the 598 \"To:\" header field. 599 600 all cc Forms a reply to the addresses in the 601 \"Mail-Followup-To:\" header field if one 602 exists; otherwise forms a reply to the sender, 603 plus all recipients. 604 605Depending on your answer, \"repl\" is given a different argument 606to form your reply. Specifically, a choice of \"from\" or none at 607all runs \"repl -nocc all\", and a choice of \"to\" runs \"repl 608-cc to\". Finally, either \"cc\" or \"all\" runs \"repl -cc all 609-nocc me\". 610 611Two windows are then created. One window contains the message to 612which you are replying in an MH-Show buffer. Your draft, in 613MH-Letter mode (*note `mh-letter-mode'), is in the other window. 614If the reply draft was not one that you expected, check the 615things that affect the behavior of \"repl\" which include the 616\"repl:\" profile component and the \"replcomps\" and 617\"replgroupcomps\" files. 618 619If you supply a prefix argument INCLUDEP, the message you are 620replying to is inserted in your reply after having first been run 621through \"mhl\" with the format file \"mhl.reply\". 622 623Alternatively, you can customize the option `mh-yank-behavior' 624and choose one of its \"Automatically\" variants to do the same 625thing. If you do so, the prefix argument has no effect. 626 627Another way to include the message automatically in your draft is 628to use \"repl: -filter repl.filter\" in your MH profile. 629 630If you wish to customize the header or other parts of the reply 631draft, please see \"repl\" and \"mh-format\". 632 633See also `mh-reply-show-message-flag', 634`mh-reply-default-reply-to', and `mh-send'." 635 (interactive (list 636 (mh-get-msg-num t) 637 (let ((minibuffer-help-form 638 "from => Sender only\nto => Sender and primary recipients\ncc or all => Sender and all recipients")) 639 (or mh-reply-default-reply-to 640 (completing-read "Reply to whom (default from): " 641 '(("from") ("to") ("cc") ("all")) 642 nil 643 t))) 644 current-prefix-arg)) 645 (let* ((folder mh-current-folder) 646 (show-buffer mh-show-buffer) 647 (config (current-window-configuration)) 648 (group-reply (or (equal reply-to "cc") (equal reply-to "all"))) 649 (form-file (cond ((and (mh-variant-p 'nmh 'mu-mh) group-reply 650 (stringp mh-repl-group-formfile)) 651 mh-repl-group-formfile) 652 ((stringp mh-repl-formfile) mh-repl-formfile) 653 (t nil)))) 654 (message "Composing a reply...") 655 (mh-exec-cmd "repl" "-build" "-noquery" "-nodraftfolder" 656 (if form-file 657 (list "-form" form-file)) 658 mh-current-folder message 659 (cond ((or (equal reply-to "from") (equal reply-to "")) 660 '("-nocc" "all")) 661 ((equal reply-to "to") 662 '("-cc" "to")) 663 (group-reply (if (mh-variant-p 'nmh 'mu-mh) 664 '("-group" "-nocc" "me") 665 '("-cc" "all" "-nocc" "me")))) 666 (cond ((or (eq mh-yank-behavior 'autosupercite) 667 (eq mh-yank-behavior 'autoattrib)) 668 '("-noformat")) 669 (includep '("-filter" "mhl.reply")) 670 (t '()))) 671 (let ((draft (mh-read-draft "reply" 672 (expand-file-name "reply" mh-user-path) 673 t))) 674 (delete-other-windows) 675 (save-buffer) 676 677 (let ((to (mh-get-header-field "To:")) 678 (subject (mh-get-header-field "Subject:")) 679 (cc (mh-get-header-field "Cc:"))) 680 (goto-char (point-min)) 681 (mh-goto-header-end 1) 682 (or includep 683 (not mh-reply-show-message-flag) 684 (mh-in-show-buffer (show-buffer) 685 (mh-display-msg message folder))) 686 (mh-add-msgs-to-seq message 'answered t) 687 (message "Composing a reply...done") 688 (mh-compose-and-send-mail draft "" folder message to subject cc 689 mh-note-repl "Replied:" config)) 690 (when (and (or (eq 'autosupercite mh-yank-behavior) 691 (eq 'autoattrib mh-yank-behavior)) 692 (eq (mh-show-buffer-message-number) mh-sent-from-msg)) 693 (undo-boundary) 694 (mh-yank-cur-msg)) 695 (mh-letter-mode-message)))) 696 697;;;###mh-autoload 698(defun mh-send (to cc subject) 699 "Compose a message. 700 701Your letter appears in an Emacs buffer whose mode is 702MH-Letter (see `mh-letter-mode'). 703 704The arguments TO, CC, and SUBJECT can be used to prefill the 705draft fields or suppress the prompts if `mh-compose-prompt-flag' 706is on. They are also passed to the function set in the option 707`mh-compose-letter-function'. 708 709See also `mh-insert-x-mailer-flag' and `mh-letter-mode-hook'. 710 711Outside of an MH-Folder buffer (`mh-folder-mode'), you must call 712either \\[mh-smail] or \\[mh-smail-other-window] to compose a new 713message." 714 (interactive (list 715 (mh-interactive-read-address "To: ") 716 (mh-interactive-read-address "Cc: ") 717 (mh-interactive-read-string "Subject: "))) 718 (let ((config (current-window-configuration))) 719 (delete-other-windows) 720 (mh-send-sub to cc subject config))) 721 722 723 724;;; Support Routines 725 726(defun mh-interactive-read-address (prompt) 727 "Read an address. 728If `mh-compose-prompt-flag' is non-nil, then read an address with 729PROMPT. 730Otherwise return the empty string." 731 (if mh-compose-prompt-flag (mh-read-address prompt) "")) 732 733(defun mh-interactive-read-string (prompt) 734 "Read a string. 735If `mh-compose-prompt-flag' is non-nil, then read a string with 736PROMPT. 737Otherwise return the empty string." 738 (if mh-compose-prompt-flag (read-string prompt) "")) 739 740;;;###mh-autoload 741(defun mh-show-buffer-message-number (&optional buffer) 742 "Message number of displayed message in corresponding show buffer. 743 744Return nil if show buffer not displayed. 745If in `mh-letter-mode', don't display the message number being replied 746to, but rather the message number of the show buffer associated with 747our originating folder buffer. 748Optional argument BUFFER can be used to specify the buffer." 749 (save-excursion 750 (if buffer 751 (set-buffer buffer)) 752 (cond ((eq major-mode 'mh-show-mode) 753 (let ((number-start (mh-search-from-end ?/ buffer-file-name))) 754 (string-to-number (substring buffer-file-name 755 (1+ number-start))))) 756 ((and (eq major-mode 'mh-folder-mode) 757 mh-show-buffer 758 (get-buffer mh-show-buffer)) 759 (mh-show-buffer-message-number mh-show-buffer)) 760 ((and (eq major-mode 'mh-letter-mode) 761 mh-sent-from-folder 762 (get-buffer mh-sent-from-folder)) 763 (mh-show-buffer-message-number mh-sent-from-folder)) 764 (t 765 nil)))) 766 767(defun mh-send-sub (to cc subject config) 768 "Do the real work of composing and sending a letter. 769Expects the TO, CC, and SUBJECT fields as arguments. 770CONFIG is the window configuration before sending mail." 771 (let ((folder mh-current-folder) 772 (msg-num (mh-get-msg-num nil))) 773 (message "Composing a message...") 774 (let ((draft (mh-read-draft 775 "message" 776 (let (components) 777 (cond 778 ((file-exists-p 779 (setq components 780 (expand-file-name mh-comp-formfile mh-user-path))) 781 components) 782 ((file-exists-p 783 (setq components 784 (expand-file-name mh-comp-formfile mh-lib))) 785 components) 786 (t 787 (error "Can't find %s in %s or %s" 788 mh-comp-formfile mh-user-path mh-lib)))) 789 nil))) 790 (mh-insert-fields "To:" to "Subject:" subject "Cc:" cc) 791 (goto-char (point-max)) 792 (mh-compose-and-send-mail draft "" folder msg-num 793 to subject cc 794 nil nil config) 795 (mh-letter-mode-message) 796 (mh-letter-adjust-point)))) 797 798(defun mh-read-draft (use initial-contents delete-contents-file) 799 "Read draft file into a draft buffer and make that buffer the current one. 800 801USE is a message used for prompting about the intended use of the 802message. 803INITIAL-CONTENTS is filename that is read into an empty buffer, or nil 804if buffer should not be modified. Delete the initial-contents file if 805DELETE-CONTENTS-FILE flag is set. 806Returns the draft folder's name. 807If the draft folder facility is enabled in ~/.mh_profile, a new buffer 808is used each time and saved in the draft folder. The draft file can 809then be reused." 810 (cond (mh-draft-folder 811 (let ((orig-default-dir default-directory) 812 (draft-file-name (mh-new-draft-name))) 813 (pop-to-buffer (generate-new-buffer 814 (format "draft-%s" 815 (file-name-nondirectory draft-file-name)))) 816 (condition-case () 817 (insert-file-contents draft-file-name t) 818 (file-error)) 819 (setq default-directory orig-default-dir))) 820 (t 821 (let ((draft-name (expand-file-name "draft" mh-user-path))) 822 (pop-to-buffer "draft") ; Create if necessary 823 (if (buffer-modified-p) 824 (if (y-or-n-p "Draft has been modified; kill anyway? ") 825 (set-buffer-modified-p nil) 826 (error "Draft preserved"))) 827 (setq buffer-file-name draft-name) 828 (clear-visited-file-modtime) 829 (unlock-buffer) 830 (cond ((and (file-exists-p draft-name) 831 (not (equal draft-name initial-contents))) 832 (insert-file-contents draft-name) 833 (delete-file draft-name)))))) 834 (cond ((and initial-contents 835 (or (zerop (buffer-size)) 836 (if (y-or-n-p 837 (format "A draft exists. Use for %s? " use)) 838 (if mh-error-if-no-draft 839 (error "A prior draft exists")) 840 t))) 841 (erase-buffer) 842 (insert-file-contents initial-contents) 843 (if delete-contents-file (delete-file initial-contents)))) 844 (auto-save-mode 1) 845 (if mh-draft-folder 846 (save-buffer)) ; Do not reuse draft name 847 (buffer-name)) 848 849(defun mh-new-draft-name () 850 "Return the pathname of folder for draft messages." 851 (save-excursion 852 (mh-exec-cmd-quiet t "mhpath" mh-draft-folder "new") 853 (buffer-substring (point-min) (1- (point-max))))) 854 855(defun mh-insert-fields (&rest name-values) 856 "Insert the NAME-VALUES pairs in the current buffer. 857If the field exists, append the value to it. 858Do not insert any pairs whose value is the empty string." 859 (let ((case-fold-search t)) 860 (while name-values 861 (let ((field-name (car name-values)) 862 (value (car (cdr name-values)))) 863 (if (not (string-match "^.*:$" field-name)) 864 (setq field-name (concat field-name ":"))) 865 (cond ((or (null value) 866 (equal value "")) 867 nil) 868 ((mh-position-on-field field-name) 869 (insert " " (or value ""))) 870 (t 871 (insert field-name " " value "\n"))) 872 (setq name-values (cdr (cdr name-values))))))) 873 874(defun mh-compose-and-send-mail (draft send-args 875 sent-from-folder sent-from-msg 876 to subject cc 877 annotate-char annotate-field 878 config) 879 "Edit and compose a draft message in buffer DRAFT and send or save it. 880SEND-ARGS is the argument passed to the send command. 881SENT-FROM-FOLDER is buffer containing scan listing of current folder, 882or nil if none exists. 883SENT-FROM-MSG is the message number or sequence name or nil. 884The TO, SUBJECT, and CC fields are passed to the 885`mh-compose-letter-function'. 886If ANNOTATE-CHAR is non-null, it is used to notate the scan listing of 887the message. In that case, the ANNOTATE-FIELD is used to build a 888string for `mh-annotate-msg'. 889CONFIG is the window configuration to restore after sending the 890letter." 891 (pop-to-buffer draft) 892 (mh-letter-mode) 893 894 ;; Insert identity. 895 (mh-insert-identity mh-identity-default t) 896 (mh-identity-make-menu) 897 (mh-identity-add-menu) 898 899 ;; Insert extra fields. 900 (mh-insert-x-mailer) 901 (mh-insert-x-face) 902 903 (mh-letter-hide-all-skipped-fields) 904 905 (setq mh-sent-from-folder sent-from-folder) 906 (setq mh-sent-from-msg sent-from-msg) 907 (setq mh-send-args send-args) 908 (setq mh-annotate-char annotate-char) 909 (setq mh-annotate-field annotate-field) 910 (setq mh-previous-window-config config) 911 (setq mode-line-buffer-identification (list " {%b}")) 912 (mh-logo-display) 913 (mh-make-local-hook 'kill-buffer-hook) 914 (add-hook 'kill-buffer-hook 'mh-tidy-draft-buffer nil t) 915 (run-hook-with-args 'mh-compose-letter-function to subject cc)) 916 917(defun mh-insert-x-mailer () 918 "Append an X-Mailer field to the header. 919The versions of MH-E, Emacs, and MH are shown." 920 ;; Lazily initialize mh-x-mailer-string. 921 (when (and mh-insert-x-mailer-flag (null mh-x-mailer-string)) 922 (setq mh-x-mailer-string 923 (format "MH-E %s; %s; %sEmacs %s" 924 mh-version mh-variant-in-use 925 (if mh-xemacs-flag "X" "GNU ") 926 (cond ((not mh-xemacs-flag) 927 (string-match "[0-9]+\\.[0-9]+\\(\\.[0-9]+\\)?" 928 emacs-version) 929 (match-string 0 emacs-version)) 930 ((string-match "[0-9.]*\\( +\([ a-z]+[0-9]+\)\\)?" 931 emacs-version) 932 (match-string 0 emacs-version)) 933 (t (format "%s.%s" emacs-major-version 934 emacs-minor-version)))))) 935 ;; Insert X-Mailer, but only if it doesn't already exist. 936 (save-excursion 937 (when (and mh-insert-x-mailer-flag 938 (null (mh-goto-header-field "X-Mailer"))) 939 (mh-insert-fields "X-Mailer:" mh-x-mailer-string)))) 940 941(defun mh-insert-x-face () 942 "Append X-Face, Face or X-Image-URL field to header. 943If the field already exists, this function does nothing." 944 (when (and (file-exists-p mh-x-face-file) 945 (file-readable-p mh-x-face-file)) 946 (save-excursion 947 (unless (or (mh-position-on-field "X-Face") 948 (mh-position-on-field "Face") 949 (mh-position-on-field "X-Image-URL")) 950 (save-excursion 951 (goto-char (+ (point) (cadr (insert-file-contents mh-x-face-file)))) 952 (if (not (looking-at "^")) 953 (insert "\n"))) 954 (unless (looking-at "\\(X-Face\\|Face\\|X-Image-URL\\): ") 955 (insert "X-Face: ")))))) 956 957(defun mh-tidy-draft-buffer () 958 "Run when a draft buffer is destroyed." 959 (let ((buffer (get-buffer mh-recipients-buffer))) 960 (if buffer 961 (kill-buffer buffer)))) 962 963(defun mh-letter-mode-message () 964 "Display a help message for users of `mh-letter-mode'. 965This should be the last function called when composing the draft." 966 (message "%s" (substitute-command-keys 967 (concat "Type \\[mh-send-letter] to send message, " 968 "\\[mh-help] for help")))) 969 970(defun mh-letter-adjust-point () 971 "Move cursor to first header field if are using the no prompt mode." 972 (unless mh-compose-prompt-flag 973 (goto-char (point-max)) 974 (mh-letter-next-header-field))) 975 976(defun mh-annotate-msg (msg buffer note &rest args) 977 "Mark MSG in BUFFER with character NOTE and annotate message with ARGS. 978MSG can be a message number, a list of message numbers, or a 979sequence." 980 (apply 'mh-exec-cmd "anno" buffer 981 (if (listp msg) (append msg args) (cons msg args))) 982 (save-excursion 983 (cond ((get-buffer buffer) ; Buffer may be deleted 984 (set-buffer buffer) 985 (mh-iterate-on-range nil msg 986 (mh-notate nil note 987 (+ mh-cmd-note mh-scan-field-destination-offset))))))) 988 989(defun mh-insert-header-separator () 990 "Insert `mh-mail-header-separator', if absent." 991 (save-excursion 992 (goto-char (point-min)) 993 (rfc822-goto-eoh) 994 (if (looking-at "$") 995 (insert mh-mail-header-separator)))) 996 997;;;###mh-autoload 998(defun mh-insert-auto-fields (&optional non-interactive) 999 "Insert custom fields if recipient is found in `mh-auto-fields-list'. 1000 1001Once the header contains one or more recipients, you may run this 1002command to insert these fields manually. However, if you use this 1003command, the automatic insertion when the message is sent is 1004disabled. 1005 1006In a program, set buffer-local `mh-insert-auto-fields-done-local' 1007if header fields were added. If NON-INTERACTIVE is non-nil, 1008perform actions quietly and only if 1009`mh-insert-auto-fields-done-local' is nil. Return t if fields 1010added; otherwise return nil." 1011 (interactive) 1012 (when (or (not non-interactive) 1013 (not mh-insert-auto-fields-done-local)) 1014 (save-excursion 1015 (when (and (or (mh-goto-header-field "To:") 1016 (mh-goto-header-field "cc:"))) 1017 (let ((list mh-auto-fields-list) 1018 (fields-inserted nil)) 1019 (while list 1020 (let ((regexp (nth 0 (car list))) 1021 (entries (nth 1 (car list)))) 1022 (when (mh-regexp-in-field-p regexp "To:" "cc:") 1023 (setq mh-insert-auto-fields-done-local t) 1024 (setq fields-inserted t) 1025 (if (not non-interactive) 1026 (message "Fields for %s added" regexp)) 1027 (let ((entry-list entries)) 1028 (while entry-list 1029 (let ((field (caar entry-list)) 1030 (value (cdar entry-list))) 1031 (cond 1032 ((equal ":identity" field) 1033 (when 1034 ;;(and (not mh-identity-local) 1035 ;; Bug 1204506. But do we need to be able 1036 ;; to set an identity manually that won't be 1037 ;; overridden by mh-insert-auto-fields? 1038 (assoc value mh-identity-list) 1039 ;;) 1040 (mh-insert-identity value))) 1041 (t 1042 (mh-modify-header-field field value 1043 (equal field "From"))))) 1044 (setq entry-list (cdr entry-list)))))) 1045 (setq list (cdr list))) 1046 fields-inserted))))) 1047 1048(defun mh-modify-header-field (field value &optional overwrite-flag) 1049 "To header FIELD add VALUE. 1050If OVERWRITE-FLAG is non-nil then the old value, if present, is 1051discarded." 1052 (cond ((and overwrite-flag 1053 (mh-goto-header-field (concat field ":"))) 1054 (insert " " value) 1055 (delete-region (point) (mh-line-end-position))) 1056 ((and (not overwrite-flag) 1057 (mh-regexp-in-field-p (concat "\\b" value "\\b") field)) 1058 ;; Already there, do nothing. 1059 ) 1060 ((and (not overwrite-flag) 1061 (mh-goto-header-field (concat field ":"))) 1062 (insert " " value ",")) 1063 (t 1064 (mh-goto-header-end 0) 1065 (insert field ": " value "\n")))) 1066 1067(defun mh-regexp-in-field-p (regexp &rest fields) 1068 "Non-nil means REGEXP was found in FIELDS." 1069 (save-excursion 1070 (let ((search-result nil) 1071 (field)) 1072 (while fields 1073 (setq field (car fields)) 1074 (if (and (mh-goto-header-field field) 1075 (re-search-forward 1076 regexp (save-excursion (mh-header-field-end)(point)) t)) 1077 (setq fields nil 1078 search-result t) 1079 (setq fields (cdr fields)))) 1080 search-result))) 1081 1082(defun mh-ascii-buffer-p () 1083 "Check if current buffer is entirely composed of ASCII. 1084The function doesn't work for XEmacs since `find-charset-region' 1085doesn't exist there." 1086 (loop for charset in (mh-funcall-if-exists 1087 find-charset-region (point-min) (point-max)) 1088 unless (eq charset 'ascii) return nil 1089 finally return t)) 1090 1091(provide 'mh-comp) 1092 1093;; Local Variables: 1094;; indent-tabs-mode: nil 1095;; sentence-end-double-space: nil 1096;; End: 1097 1098;; arch-tag: 62865511-e610-4923-b0b5-f45a8ab70a34 1099;;; mh-comp.el ends here 1100