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