1;;; sendmail.el --- mail sending commands for Emacs -*- lexical-binding:t -*- 2 3;; Copyright (C) 1985-1986, 1992-1996, 1998, 2000-2021 Free Software 4;; Foundation, Inc. 5 6;; Maintainer: emacs-devel@gnu.org 7;; Keywords: mail 8 9;; This file is part of GNU Emacs. 10 11;; GNU Emacs is free software: you can redistribute it and/or modify 12;; it under the terms of the GNU General Public License as published by 13;; the Free Software Foundation, either version 3 of the License, or 14;; (at your option) any later version. 15 16;; GNU Emacs is distributed in the hope that it will be useful, 17;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19;; GNU General Public License for more details. 20 21;; You should have received a copy of the GNU General Public License 22;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 23 24;;; Commentary: 25 26;; This mode provides mail-sending facilities from within Emacs. It is 27;; documented in the Emacs user's manual. 28 29;;; Code: 30(require 'mail-utils) 31(require 'rfc2047) 32(autoload 'message-make-date "message") 33 34(defgroup sendmail nil 35 "Mail sending commands for Emacs." 36 :prefix "mail-" 37 :group 'mail) 38 39(defcustom mail-setup-with-from t 40 "Non-nil means insert `From:' field when setting up the message." 41 :type 'boolean 42 :version "22.1") 43 44(defcustom sendmail-program 45 (or (executable-find "sendmail") 46 (cond 47 ((file-exists-p "/usr/sbin/sendmail") "/usr/sbin/sendmail") 48 ((file-exists-p "/usr/lib/sendmail") "/usr/lib/sendmail") 49 ((file-exists-p "/usr/ucblib/sendmail") "/usr/ucblib/sendmail") 50 (t "sendmail"))) 51 "Program used to send messages." 52 :version "24.1" ; add executable-find, remove fakemail 53 :type 'file) 54 55;;;###autoload 56(defcustom mail-from-style 'angles 57 "Specifies how \"From:\" fields look. 58 59If nil, they contain just the return address like: 60 king@grassland.com 61If `parens', they look like: 62 king@grassland.com (Elvis Parsley) 63If `angles', they look like: 64 Elvis Parsley <king@grassland.com> 65 66Otherwise, most addresses look like `angles', but they look like 67`parens' if `angles' would need quoting and `parens' would not." 68 ;; The value `system-default' is now deprecated. 69 :type '(choice (const :tag "simple" nil) 70 (const parens) 71 (const angles) 72 (const default)) 73 :version "27.1") 74(make-obsolete-variable 75 'mail-from-style 76 "only the `angles' value is valid according to RFC5322." "27.1" 'set) 77 78;;;###autoload 79(defcustom mail-specify-envelope-from nil 80 "If non-nil, specify the envelope-from address when sending mail. 81The value used to specify it is whatever is found in 82the variable `mail-envelope-from', with `user-mail-address' as fallback. 83 84On most systems, specifying the envelope-from address is a 85privileged operation. This variable affects sendmail and 86smtpmail -- if you use feedmail to send mail, see instead the 87variable `feedmail-deduce-envelope-from'." 88 :version "21.1" 89 :type 'boolean) 90 91(defcustom mail-envelope-from nil 92 "If non-nil, designate the envelope-from address when sending mail. 93This only has an effect if `mail-specify-envelope-from' is non-nil. 94The value should be either a string, or the symbol `header' (in 95which case the contents of the \"From\" header of the message 96being sent is used), or nil (in which case the value of 97`user-mail-address' is used)." 98 :version "21.1" 99 :type '(choice (string :tag "From-name") 100 (const :tag "Use From: header from message" header) 101 (const :tag "Use `user-mail-address'" nil))) 102 103;;;###autoload 104(defcustom mail-self-blind nil 105 "Non-nil means insert Bcc to self in messages to be sent. 106This is done when the message is initialized, 107so you can remove or alter the Bcc field to override the default. 108If you are using `message-mode' to compose messages, customize the 109variable `message-default-mail-headers' instead." 110 :type 'boolean) 111 112;;;###autoload 113(defcustom mail-interactive t 114 ;; We used to use a default of nil rather than t, but nowadays it is very 115 ;; common for sendmail to be misconfigured, so one cannot rely on the 116 ;; bounce message to be delivered anywhere, least of all to the 117 ;; user's mailbox. 118 "Non-nil means when sending a message wait for and display errors. 119Otherwise, let mailer send back a message to report errors." 120 :type 'boolean 121 :version "23.1") ; changed from nil to t 122 123(defcustom mail-yank-ignored-headers 124 (concat "^" 125 (regexp-opt '("via" "mail-from" "origin" "status" "remailed" 126 "received" "message-id" "summary-line" "to" "subject" 127 "in-reply-to" "return-path" "mail-reply-to" 128 ;; Should really be rmail-attribute-header and 129 ;; rmail-keyword-header, but this file does not 130 ;; require rmail (at run time). 131 "x-rmail-attributes" "x-rmail-keywords" 132 "mail-followup-to") "\\(?:") 133 ":") 134 "Delete these headers from old message when it's inserted in a reply." 135 :type 'regexp 136 :version "23.1") 137 138;; Useful to set in site-init.el 139;;;###autoload 140(defcustom send-mail-function 141 ;; Assume smtpmail is the preferred choice if it's already configured. 142 (if (and (boundp 'smtpmail-smtp-server) 143 smtpmail-smtp-server) 144 #'smtpmail-send-it #'sendmail-query-once) 145 "Function to call to send the current buffer as mail. 146The headers should be delimited by a line which is 147not a valid RFC 822 (or later) header or continuation line, 148that matches the variable `mail-header-separator'. 149This is used by the default mail-sending commands. See also 150`message-send-mail-function' for use with the Message package." 151 :type '(radio (function-item sendmail-send-it :tag "Use Sendmail package") 152 (function-item sendmail-query-once :tag "Query the user") 153 (function-item smtpmail-send-it :tag "Use SMTPmail package") 154 (function-item feedmail-send-it :tag "Use Feedmail package") 155 (function-item mailclient-send-it :tag "Use Mailclient package") 156 function) 157 :version "24.1") 158 159;;;###autoload 160(defcustom mail-header-separator (purecopy "--text follows this line--") 161 "Line used to separate headers from text in messages being composed." 162 :type 'string) 163 164;; Set up mail-header-separator for use as a category text property. 165(put 'mail-header-separator 'rear-nonsticky '(category)) 166;; This was a nice idea, for preventing accidental modification of 167;; the separator. But I found it also prevented or obstructed 168;; certain deliberate operations, such as copying the separator line 169;; up to the top to send myself a copy of an already sent outgoing message 170;; and other things. So I turned it off. --rms. 171;;(put 'mail-header-separator 'read-only t) 172 173;;;###autoload 174(defcustom mail-archive-file-name nil 175 "Name of file to write all outgoing messages in, or nil for none. 176This is normally an mbox file, but for backwards compatibility may also 177be a Babyl file. 178If you are using `message-mode' to compose messages, customize the 179variable `message-default-mail-headers' instead." 180 :type '(choice file (const nil))) 181 182;;;###autoload 183(defcustom mail-default-reply-to nil 184 "Address to insert as default Reply-To field of outgoing messages. 185If nil, it will be initialized from the REPLYTO environment variable 186when you first send mail. 187If you are using `message-mode' to compose messages, customize the 188variable `message-default-mail-headers' instead." 189 :type '(choice (const nil) string)) 190 191(defcustom mail-alias-file nil 192 "If non-nil, the name of a file to use instead of the sendmail default. 193This file defines aliases to be expanded by the mailer; this is a different 194feature from that of defining aliases in `.mailrc' to be expanded in Emacs. 195This variable has no effect unless your system uses sendmail as its mailer. 196The default file is defined in sendmail's configuration file, e.g. 197`/etc/aliases'." 198 :type '(choice (const :tag "Sendmail default" nil) file)) 199 200;;;###autoload 201(defcustom mail-personal-alias-file (purecopy "~/.mailrc") 202 "If non-nil, the name of the user's personal mail alias file. 203This file typically should be in same format as the `.mailrc' file used by 204the `Mail' or `mailx' program. 205This file need not actually exist." 206 :type '(choice (const nil) file)) 207 208;;;###autoload 209(defcustom mail-setup-hook nil 210 "Normal hook, run each time a new outgoing message is initialized." 211 :type 'hook 212 :options '(fortune-to-signature spook mail-abbrevs-setup)) 213 214;;;###autoload 215(defvar mail-aliases t 216 "Alist of mail address aliases, 217or t meaning should be initialized from your mail aliases file. 218\(The file's name is normally `~/.mailrc', but `mail-personal-alias-file' 219can specify a different file name.) 220The alias definitions in the file have this form: 221 alias ALIAS MEANING") 222 223(defvar mail-alias-modtime nil 224 "The modification time of your mail alias file when it was last examined.") 225 226;;;###autoload 227(defcustom mail-yank-prefix "> " 228 "Prefix insert on lines of yanked message being replied to. 229If this is nil, use indentation, as specified by `mail-indentation-spaces'." 230 :type '(choice (const nil) string)) 231 232;;;###autoload 233(defcustom mail-indentation-spaces 3 234 "Number of spaces to insert at the beginning of each cited line. 235Used by `mail-yank-original' via `mail-indent-citation'." 236 :type 'integer) 237 238;;;###autoload 239(defcustom mail-citation-hook nil 240 "Hook for modifying a citation just inserted in the mail buffer. 241Each hook function can find the citation between (point) and (mark t), 242and should leave point and mark around the citation text as modified. 243The hook functions can find the header of the cited message 244in the variable `mail-citation-header', whether or not this is included 245in the cited portion of the message. 246 247If this hook is entirely empty (nil), a default action is taken 248instead of no action." 249 :type 'hook) 250 251(defvar mail-citation-header nil 252 "While running `mail-citation-hook', this variable holds the message header. 253This enables the hook functions to see the whole message header 254regardless of what part of it (if any) is included in the cited text.") 255 256;;;###autoload 257(defcustom mail-citation-prefix-regexp 258 (purecopy "\\([ \t]*\\(\\w\\|[_.]\\)+>+\\|[ \t]*[>|]\\)+") 259 "Regular expression to match a citation prefix plus whitespace. 260It should match whatever sort of citation prefixes you want to handle, 261with whitespace before and after; it should also match just whitespace. 262The default value matches citations like `foo-bar>' plus whitespace." 263 :type 'regexp 264 :version "24.1") 265 266(defvar mail-abbrevs-loaded nil) 267(defvar mail-mode-map 268 (let ((map (make-sparse-keymap))) 269 (define-key map "\M-\t" 'completion-at-point) 270 (define-key map "\C-c?" 'describe-mode) 271 (define-key map "\C-c\C-f\C-t" 'mail-to) 272 (define-key map "\C-c\C-f\C-b" 'mail-bcc) 273 (define-key map "\C-c\C-f\C-f" 'mail-fcc) 274 (define-key map "\C-c\C-f\C-c" 'mail-cc) 275 (define-key map "\C-c\C-f\C-s" 'mail-subject) 276 (define-key map "\C-c\C-f\C-r" 'mail-reply-to) 277 (define-key map "\C-c\C-f\C-a" 'mail-mail-reply-to) ; author 278 (define-key map "\C-c\C-f\C-l" 'mail-mail-followup-to) ; list 279 (define-key map "\C-c\C-t" 'mail-text) 280 (define-key map "\C-c\C-y" 'mail-yank-original) 281 (define-key map "\C-c\C-r" 'mail-yank-region) 282 (define-key map [remap split-line] 'mail-split-line) 283 (define-key map "\C-c\C-q" 'mail-fill-yanked-message) 284 (define-key map "\C-c\C-w" 'mail-signature) 285 (define-key map "\C-c\C-c" 'mail-send-and-exit) 286 (define-key map "\C-c\C-s" 'mail-send) 287 (define-key map "\C-c\C-i" 'mail-insert-file) 288 ;; FIXME add this? "b" = bury buffer. It's in the menu-bar. 289;;; (define-key map "\C-c\C-b" 'mail-dont-send) 290 291 (define-key map [menu-bar mail] 292 (cons "Mail" (make-sparse-keymap "Mail"))) 293 294 (define-key map [menu-bar mail attachment] 295 '("Attach File" . mail-add-attachment)) 296 297 (define-key map [menu-bar mail fill] 298 '("Fill Citation" . mail-fill-yanked-message)) 299 300 (define-key map [menu-bar mail yank] 301 '(menu-item "Cite Original" mail-yank-original :enable mail-reply-action)) 302 303 (define-key map [menu-bar mail signature] 304 '("Insert Signature" . mail-signature)) 305 306 (define-key map [menu-bar mail mail-sep] 307 '("--")) 308 309 (define-key map [menu-bar mail cancel] 310 '("Cancel" . mail-dont-send)) 311 312 (define-key map [menu-bar mail send-stay] 313 '("Send, Keep Editing" . mail-send)) 314 315 (define-key map [menu-bar mail send] 316 '("Send Message" . mail-send-and-exit)) 317 318 (define-key map [menu-bar headers] 319 (cons "Headers" (make-sparse-keymap "Move to Header"))) 320 321 (define-key map [menu-bar headers text] 322 '("Text" . mail-text)) 323 324 (define-key map [menu-bar headers expand-aliases] 325 '("Expand Aliases" . expand-mail-aliases)) 326 327 (define-key map [menu-bar headers mail-reply-to] 328 '("Mail-Reply-To" . mail-mail-reply-to)) 329 330 (define-key map [menu-bar headers mail-followup-to] 331 '("Mail-Followup-To" . mail-mail-followup-to)) 332 333 (define-key map [menu-bar headers reply-to] 334 '("Reply-To" . mail-reply-to)) 335 336 (define-key map [menu-bar headers bcc] 337 '("Bcc" . mail-bcc)) 338 339 (define-key map [menu-bar headers fcc] 340 '("Fcc" . mail-fcc)) 341 342 (define-key map [menu-bar headers cc] 343 '("Cc" . mail-cc)) 344 345 (define-key map [menu-bar headers subject] 346 '("Subject" . mail-subject)) 347 348 (define-key map [menu-bar headers to] 349 '("To" . mail-to)) 350 351 map)) 352 353(autoload 'build-mail-aliases "mailalias" 354 "Read mail aliases from personal aliases file and set `mail-aliases'. 355By default, this is the file specified by `mail-personal-alias-file'." t) 356 357;;;###autoload 358(defcustom mail-signature t 359 "Text inserted at end of mail buffer when a message is initialized. 360If nil, no signature is inserted. 361If t, it means to insert the contents of the file `mail-signature-file'. 362If a string, that string is inserted. 363 (To make a proper signature, the string should begin with \\n\\n-- \\n, 364 which is the standard way to delimit a signature in a message.) 365Otherwise, it should be an expression; it is evaluated 366and should insert whatever you want to insert." 367 :type '(choice (const :tag "None" nil) 368 (const :tag "Use `.signature' file" t) 369 (string :tag "String to insert") 370 (sexp :tag "Expression to evaluate"))) 371(put 'mail-signature 'risky-local-variable t) 372 373;;;###autoload 374(defcustom mail-signature-file (purecopy "~/.signature") 375 "File containing the text inserted at end of mail buffer." 376 :type 'file) 377 378;;;###autoload 379(defcustom mail-default-directory (purecopy "~/") 380 "Value of `default-directory' for Mail mode buffers. 381This directory is used for auto-save files of Mail mode buffers. 382 383Note that Message mode does not use this variable; it auto-saves 384in `message-auto-save-directory'." 385 :type '(directory :tag "Directory") 386 :version "22.1") 387 388(defvar mail-reply-action nil) 389(defvar mail-send-actions nil 390 "A list of actions to be performed upon successful sending of a message.") 391(defvar mail-return-action nil) 392 393;;;###autoload 394(defcustom mail-default-headers nil 395 "A string containing header lines, to be inserted in outgoing messages. 396It can contain newlines, and should end in one. It is inserted 397before you edit the message, so you can edit or delete the lines. 398If you are using `message-mode' to compose messages, customize the 399variable `message-default-mail-headers' instead." 400 :type '(choice (const nil) string)) 401 402(defcustom mail-bury-selects-summary t 403 "If non-nil, try to show Rmail summary buffer after returning from mail. 404The functions \\[mail-send-on-exit] or \\[mail-dont-send] select 405the Rmail summary buffer before returning, if it exists and this variable 406is non-nil." 407 :type 'boolean) 408 409(defcustom mail-send-nonascii 'mime 410 "Specify whether to allow sending non-ASCII characters in mail. 411If t, that means do allow it. nil means don't allow it. 412`query' means ask the user each time. 413`mime' means add an appropriate MIME header if none already present. 414The default is `mime'. 415Including non-ASCII characters in a mail message can be problematical 416for the recipient, who may not know how to decode them properly." 417 :type '(choice (const t) (const nil) (const query) (const mime))) 418 419(defcustom mail-use-dsn nil 420 "Ask MTA for notification of failed, delayed or successful delivery. 421Note that only some MTAs (currently only recent versions of Sendmail) 422support Delivery Status Notification." 423 :type '(repeat (radio (const :tag "Failure" failure) 424 (const :tag "Delay" delay) 425 (const :tag "Success" success))) 426 :version "22.1") 427 428;; Note: could use /usr/ucb/mail instead of sendmail; 429;; options -t, and -v if not interactive. 430(defvar mail-mailer-swallows-blank-line nil 431 "Set this non-nil if the system's mailer runs the header and body together. 432The actual value should be an expression to evaluate that returns 433non-nil if the problem will actually occur. 434\(As far as we know, this is not an issue on any system still supported 435by Emacs.)") 436 437(put 'mail-mailer-swallows-blank-line 'risky-local-variable t) ; gets evalled 438(make-obsolete-variable 'mail-mailer-swallows-blank-line 439 "no need to set this on any modern system." 440 "24.1" 'set) 441 442(defvar mail-mode-syntax-table 443 ;; define-derived-mode will make it inherit from text-mode-syntax-table. 444 (let ((st (make-syntax-table))) 445 ;; FIXME this is probably very obsolete now ("percent hack"). 446 ;; sending.texi used to say: 447 ;; Mail mode defines the character `%' as a word separator; this 448 ;; is helpful for using the word commands to edit mail addresses. 449 (modify-syntax-entry ?% ". " st) 450 st) 451 "Syntax table used while in `mail-mode'.") 452 453(defvar mail-font-lock-keywords 454 (eval-when-compile 455 (let* ((cite-chars "[>|}]") 456 (cite-prefix "[:alpha:]") 457 (cite-suffix (concat cite-prefix "0-9_.@-`'\""))) 458 (list '("^\\(To\\|Newsgroups\\):" . font-lock-function-name-face) 459 '("^\\(B?Cc\\|Reply-To\\|Mail-\\(Reply\\|Followup\\)-To\\):" . font-lock-keyword-face) 460 '("^\\(Subject:\\)[ \t]*\\(.+\\)?" 461 (1 font-lock-comment-face) 462;; (2 font-lock-type-face nil t) 463 ) 464 ;; Use EVAL to delay in case `mail-header-separator' gets changed. 465 '(eval . 466 (let ((separator (if (zerop (length mail-header-separator)) 467 " \\`\\' " 468 (regexp-quote mail-header-separator)))) 469 (cons (concat "^" separator "$") 'font-lock-warning-face))) 470 ;; Use MATCH-ANCHORED to effectively anchor the regexp left side. 471 `(,cite-chars 472 (,(concat "\\=[ \t]*" 473 "\\(\\(\\([" cite-prefix "]+[" cite-suffix "]*\\)?" 474 "\\(" cite-chars "[ \t]*\\)\\)+\\)" 475 "\\(.*\\)") 476 (beginning-of-line) (end-of-line) 477 (1 font-lock-comment-delimiter-face nil t) 478 (5 font-lock-comment-face nil t))) 479 '("^\\(X-[A-Za-z0-9-]+\\|In-Reply-To\\):.*\\(\n[ \t]+.*\\)*$" 480 . font-lock-string-face)))) 481 "Additional expressions to highlight in Mail mode.") 482 483 484;;;###autoload 485(defun sendmail-query-once () 486 "Query for `send-mail-function' and send mail with it. 487This also saves the value of `send-mail-function' via Customize." 488 ;; If send-mail-function is already setup, we're incorrectly called 489 ;; a second time, probably because someone's using an old value 490 ;; of send-mail-function. 491 (if (not (eq send-mail-function #'sendmail-query-once)) 492 (funcall send-mail-function) 493 (let ((function (sendmail-query-user-about-smtp))) 494 (funcall function) 495 (when (y-or-n-p "Save this mail sending choice?") 496 (setq send-mail-function function) 497 (customize-save-variable 'send-mail-function function))))) 498 499(defun sendmail-query-user-about-smtp () 500 (let* ((options `(("mail client" . mailclient-send-it) 501 ,@(when (and sendmail-program 502 (executable-find sendmail-program)) 503 '(("transport" . sendmail-send-it))) 504 ("smtp" . smtpmail-send-it))) 505 (choice 506 ;; Query the user. 507 (with-temp-buffer 508 (rename-buffer "*Emacs Mail Setup Help*" t) 509 (insert (substitute-command-keys "\ 510 Emacs is about to send an email message, but it has not been 511 configured for sending email. To tell Emacs how to send email: 512 513 - Type `") 514 (propertize "mail client" 'face 'bold) 515 (substitute-command-keys "\ 516' to start your default email client and 517 pass it the message text.\n\n")) 518 (and sendmail-program 519 (executable-find sendmail-program) 520 (insert (substitute-command-keys "\ 521 - Type `") 522 (propertize "transport" 'face 'bold) 523 (substitute-command-keys "\ 524' to invoke the system's mail transport agent 525 (the `") 526 sendmail-program 527 (substitute-command-keys "' program).\n\n"))) 528 (insert (substitute-command-keys "\ 529 - Type `") 530 (propertize "smtp" 'face 'bold) 531 (substitute-command-keys "' to send mail directly to an \"outgoing mail\" server. 532 (Emacs may prompt you for SMTP settings). 533 534 Emacs will record your selection and will use it thereafter. 535 To change it later, customize the option `send-mail-function'.\n")) 536 (goto-char (point-min)) 537 (display-buffer (current-buffer)) 538 (let ((completion-ignore-case t)) 539 (completing-read 540 (format "Send mail via (default %s): " (caar options)) 541 options nil 'require-match nil nil (car options)))))) 542 ;; Return the choice. 543 (cdr (assoc-string choice options t)))) 544 545(defun sendmail-sync-aliases () 546 (when mail-personal-alias-file 547 (let ((modtime (file-attribute-modification-time 548 (file-attributes mail-personal-alias-file)))) 549 (or (equal mail-alias-modtime modtime) 550 (setq mail-alias-modtime modtime 551 mail-aliases t))))) 552 553 554;;;###autoload 555(define-mail-user-agent 'sendmail-user-agent 556 #'sendmail-user-agent-compose 557 #'mail-send-and-exit) 558 559;;;###autoload 560(defun sendmail-user-agent-compose (&optional to subject other-headers 561 continue switch-function yank-action 562 send-actions return-action 563 &rest ignored) 564 (if switch-function 565 (funcall switch-function "*mail*")) 566 (let ((cc (cdr (assoc-string "cc" other-headers t))) 567 (in-reply-to (cdr (assoc-string "in-reply-to" other-headers t))) 568 (body (cdr (assoc-string "body" other-headers t)))) 569 (or (mail continue to subject in-reply-to cc yank-action 570 send-actions return-action) 571 continue 572 (error "Message aborted")) 573 (save-excursion 574 (rfc822-goto-eoh) 575 (while other-headers 576 (unless (member-ignore-case (car (car other-headers)) 577 '("in-reply-to" "cc" "body")) 578 (insert (car (car other-headers)) ": " 579 (cdr (car other-headers)) 580 (if use-hard-newlines hard-newline "\n"))) 581 (setq other-headers (cdr other-headers))) 582 (when body 583 (forward-line 1) 584 (insert body)) 585 t))) 586 587(defun mail-setup (to subject in-reply-to cc replybuffer 588 actions return-action) 589 (or mail-default-reply-to 590 (setq mail-default-reply-to (getenv "REPLYTO"))) 591 (sendmail-sync-aliases) 592 (when (eq mail-aliases t) 593 (setq mail-aliases nil) 594 (and mail-personal-alias-file 595 (file-exists-p mail-personal-alias-file) 596 (build-mail-aliases))) 597 ;; Don't leave this around from a previous message. 598 (kill-local-variable 'buffer-file-coding-system) 599 ;; This doesn't work for enable-multibyte-characters. 600 ;; (kill-local-variable 'enable-multibyte-characters) 601 (set-buffer-multibyte t) 602 (if current-input-method 603 (deactivate-input-method)) 604 605 ;; Local variables for Mail mode. 606 (setq mail-send-actions actions) 607 (setq mail-reply-action replybuffer) 608 (setq mail-return-action return-action) 609 610 (goto-char (point-min)) 611 (if mail-setup-with-from 612 (mail-insert-from-field)) 613 (insert "To: ") 614 (save-excursion 615 (if to 616 ;; Here removed code to extract names from within <...> 617 ;; on the assumption that mail-strip-quoted-names 618 ;; has been called and has done so. 619 (let ((fill-prefix "\t") 620 (address-start (point))) 621 (insert to "\n") 622 (fill-region-as-paragraph address-start (point-max)) 623 (goto-char (point-max)) 624 (unless (bolp) 625 (newline))) 626 (newline)) 627 (if cc 628 (let ((fill-prefix "\t") 629 (address-start (progn (insert "Cc: ") (point)))) 630 (insert cc "\n") 631 (fill-region-as-paragraph address-start (point-max)) 632 (goto-char (point-max)) 633 (unless (bolp) 634 (newline)))) 635 (if in-reply-to 636 (let ((fill-prefix "\t") 637 (fill-column 78) 638 (address-start (point))) 639 (insert "In-Reply-To: " in-reply-to "\n") 640 (fill-region-as-paragraph address-start (point-max)) 641 (goto-char (point-max)) 642 (unless (bolp) 643 (newline)))) 644 (insert "Subject: " (or subject "") "\n") 645 (if mail-default-headers 646 (insert mail-default-headers)) 647 (if mail-default-reply-to 648 (insert "Reply-To: " mail-default-reply-to "\n")) 649 (if mail-self-blind 650 (insert "Bcc: " user-mail-address "\n")) 651 (if mail-archive-file-name 652 (insert "Fcc: " mail-archive-file-name "\n")) 653 (put-text-property (point) 654 (progn 655 (insert mail-header-separator "\n") 656 (1- (point))) 657 'category 'mail-header-separator) 658 ;; Insert the signature. But remember the beginning of the message. 659 (if to (setq to (point))) 660 (if mail-signature (mail-signature t)) 661 (goto-char (point-max)) 662 (or (bolp) (newline))) 663 (if to (goto-char to)) 664 (or to subject in-reply-to 665 (set-buffer-modified-p nil)) 666 (run-hooks 'mail-setup-hook)) 667 668(defcustom mail-mode-hook nil 669 "Hook run by Mail mode. 670When composing a mail, this runs immediately after creating, or 671switching to, the `*mail*' buffer. See also `mail-setup-hook'." 672 :type 'hook 673 :options '(footnote-mode)) 674 675(defvar mail-mode-abbrev-table text-mode-abbrev-table) 676(defvar mail-encode-mml) 677;;;###autoload 678(define-derived-mode mail-mode text-mode "Mail" 679 "Major mode for editing mail to be sent. 680Like Text Mode but with these additional commands: 681 682\\[mail-send] mail-send (send the message) 683\\[mail-send-and-exit] mail-send-and-exit (send the message and exit) 684 685Here are commands that move to a header field (and create it if there isn't): 686 \\[mail-to] move to To: \\[mail-subject] move to Subj: 687 \\[mail-bcc] move to Bcc: \\[mail-cc] move to Cc: 688 \\[mail-fcc] move to Fcc: \\[mail-reply-to] move to Reply-To: 689 \\[mail-mail-reply-to] move to Mail-Reply-To: 690 \\[mail-mail-followup-to] move to Mail-Followup-To: 691\\[mail-text] move to message text. 692\\[mail-signature] mail-signature (insert `mail-signature-file' file). 693\\[mail-yank-original] mail-yank-original (insert current message, in Rmail). 694\\[mail-fill-yanked-message] mail-fill-yanked-message (fill what was yanked). 695\\[mail-insert-file] insert a text file into the message. 696\\[mail-add-attachment] attach to the message a file as binary attachment. 697Turning on Mail mode runs the normal hooks `text-mode-hook' and 698`mail-mode-hook' (in that order)." 699 (make-local-variable 'mail-reply-action) 700 (make-local-variable 'mail-send-actions) 701 (make-local-variable 'mail-return-action) 702 (make-local-variable 'mail-encode-mml) 703 (setq mail-encode-mml nil) 704 (setq buffer-offer-save t) 705 (make-local-variable 'font-lock-defaults) 706 (setq font-lock-defaults '(mail-font-lock-keywords t t)) 707 (make-local-variable 'paragraph-separate) 708 (setq-local normal-auto-fill-function #'mail-mode-auto-fill) 709 (setq-local fill-paragraph-function #'mail-mode-fill-paragraph) 710 ;; Allow using comment commands to add/remove quoting (this only does 711 ;; anything if mail-yank-prefix is set to a non-nil value). 712 (set (make-local-variable 'comment-start) mail-yank-prefix) 713 (if mail-yank-prefix 714 (set (make-local-variable 'comment-start-skip) 715 (concat "^" (regexp-quote mail-yank-prefix) "[ \t]*"))) 716 (make-local-variable 'adaptive-fill-regexp) 717 ;; Also update the paragraph-separate entry if you change this. 718 (setq adaptive-fill-regexp 719 (concat "[ \t]*[-[:alnum:]]+>+[ \t]*\\|" 720 adaptive-fill-regexp)) 721 (make-local-variable 'adaptive-fill-first-line-regexp) 722 (setq adaptive-fill-first-line-regexp 723 (concat "[ \t]*[-[:alnum:]]*>+[ \t]*\\|" 724 adaptive-fill-first-line-regexp)) 725 (add-hook 'completion-at-point-functions #'mail-completion-at-point-function 726 nil 'local) 727 ;; `-- ' precedes the signature. `-----' appears at the start of the 728 ;; lines that delimit forwarded messages. 729 ;; Lines containing just >= 3 dashes, perhaps after whitespace, 730 ;; are also sometimes used and should be separators. 731 (setq paragraph-separate 732 (concat (regexp-quote mail-header-separator) 733 ;; This is based on adaptive-fill-regexp (presumably 734 ;; the idea is to allow navigation etc of cited paragraphs). 735 "$\\|\t*[-–!|#%;>*·•‣⁃◦ ]+$" 736 "\\|[ \t]*[-[:alnum:]]*>+[ \t]*$\\|[ \t]*$\\|" 737 "--\\( \\|-+\\)$\\|" 738 page-delimiter))) 739 740 741(defun mail-header-end () 742 "Return the buffer location of the end of headers, as a number." 743 (save-restriction 744 (widen) 745 (save-excursion 746 (rfc822-goto-eoh) 747 (point)))) 748 749(defun mail-text-start () 750 "Return the buffer location of the start of text, as a number." 751 (save-restriction 752 (widen) 753 (save-excursion 754 (rfc822-goto-eoh) 755 (forward-line 1) 756 (point)))) 757 758(defun mail-sendmail-delimit-header () 759 "Set up whatever header delimiter convention sendmail will use. 760Concretely: replace the first blank line in the header with the separator." 761 (rfc822-goto-eoh) 762 (insert mail-header-separator) 763 (point)) 764 765(defun mail-sendmail-undelimit-header () 766 "Remove header separator to put the message in correct form for sendmail. 767Leave point at the start of the delimiter line." 768 (goto-char (point-min)) 769 (when (re-search-forward 770 (concat "^" (regexp-quote mail-header-separator) "\n") 771 nil t) 772 (replace-match "\n")) 773 (rfc822-goto-eoh)) 774 775(defun mail-mode-auto-fill () 776 "Carry out Auto Fill for Mail mode. 777If within the headers, this makes the new lines into continuation lines." 778 (if (< (point) (mail-header-end)) 779 (let ((old-line-start (line-beginning-position))) 780 (if (do-auto-fill) 781 (save-excursion 782 (beginning-of-line) 783 (while (not (eq (point) old-line-start)) 784 ;; Use insert-before-markers in case we're inserting 785 ;; before the saved value of point (which is common). 786 (insert-before-markers " ") 787 (forward-line -1)) 788 t))) 789 (do-auto-fill))) 790 791(defun mail-mode-fill-paragraph (arg) 792 ;; Do something special only if within the headers. 793 (if (< (point) (mail-header-end)) 794 (let (beg end fieldname) 795 (when (prog1 (re-search-backward "^[-a-zA-Z]+:" nil 'yes) 796 (setq beg (point))) 797 (setq fieldname 798 (downcase (buffer-substring beg (1- (match-end 0)))))) 799 (forward-line 1) 800 ;; Find continuation lines and get rid of their continuation markers. 801 (while (looking-at "[ \t]") 802 (delete-horizontal-space) 803 (forward-line 1)) 804 (setq end (point-marker)) 805 (goto-char beg) 806 ;; If this field contains addresses, 807 ;; make sure we can fill after each address. 808 (if (member fieldname 809 '("to" "cc" "bcc" "from" "reply-to" 810 "mail-reply-to" "mail-followup-to" 811 "resent-to" "resent-cc" "resent-bcc" 812 "resent-from" "resent-reply-to")) 813 (while (search-forward "," end t) 814 (or (looking-at "[ \t]") 815 (insert " ")))) 816 (fill-region-as-paragraph beg end arg) 817 ;; Mark all lines except the first as continuations. 818 (goto-char beg) 819 (forward-line 1) 820 (while (< (point) end) 821 (insert " ") 822 (forward-line 1)) 823 (move-marker end nil) 824 t))) 825 826;; User-level commands for sending. 827 828(defun mail-send-and-exit (&optional arg) 829 "Send message like `mail-send', then, if no errors, exit from mail buffer. 830Prefix arg means don't delete this window." 831 (interactive "P") 832 (mail-send) 833 (mail-bury arg)) 834 835(defun mail-dont-send (&optional arg) 836 "Don't send the message you have been editing. 837Prefix arg means don't delete this window." 838 (interactive "P") 839 (mail-bury arg)) 840 841(defun mail-bury (&optional arg) 842 "Bury this mail buffer." 843 (let ((newbuf (other-buffer (current-buffer))) 844 (return-action mail-return-action)) 845 (bury-buffer (current-buffer)) 846 ;; If there is an Rmail buffer, return to it nicely 847 ;; even if this message was not started by an Rmail command. 848 (unless return-action 849 (dolist (buffer (buffer-list)) 850 (if (and (eq (buffer-local-value 'major-mode buffer) 'rmail-mode) 851 (null return-action) 852 ;; Don't match message-viewer buffer. 853 (not (string-match "\\` " (buffer-name buffer)))) 854 (setq return-action `(rmail-mail-return ,buffer))))) 855 (if (and (null arg) return-action) 856 (apply (car return-action) (cdr return-action)) 857 (switch-to-buffer newbuf)))) 858 859(defcustom mail-send-hook nil 860 "Hook run just before sending a message." 861 :type 'hook 862 :options '(flyspell-mode-off)) 863 864;;;###autoload 865(defcustom mail-mailing-lists nil 866"List of mailing list addresses the user is subscribed to. 867The variable is used to trigger insertion of the \"Mail-Followup-To\" 868header when sending a message to a mailing list." 869 :type '(repeat string)) 870 871(declare-function mml-to-mime "mml" ()) 872 873(defun mail-send () 874 "Send the message in the current buffer. 875If `mail-interactive' is non-nil, wait for success indication 876or error messages, and inform user. 877Otherwise any failure is reported in a message back to 878the user from the mailer." 879 (interactive) 880 (if (if buffer-file-name 881 (y-or-n-p "Send buffer contents as mail message? ") 882 (or (buffer-modified-p) 883 (y-or-n-p "Message already sent; resend? "))) 884 (let ((inhibit-read-only t) 885 (opoint (point)) 886 (ml (when mail-mailing-lists 887 ;; The surrounding regexp assumes the use of 888 ;; `mail-strip-quoted-names' on addresses before matching 889 ;; Cannot deal with full RFC 822 (or later), but that is 890 ;; unlikely to be problematic. 891 (concat "\\(?:[[:space:];,]\\|\\`\\)" 892 (regexp-opt mail-mailing-lists t) 893 "\\(?:[[:space:];,]\\|\\'\\)")))) 894 (mail-combine-fields "To") 895 (mail-combine-fields "Cc") 896 ;; If there are mailing lists defined 897 (when ml 898 (save-excursion 899 (let* ((to (mail-fetch-field "to" nil t)) 900 (cc (mail-fetch-field "cc" nil t)) 901 (new-header-values ; To: and Cc: 902 (mail-strip-quoted-names 903 (concat to (when cc (concat ", " cc)))))) 904 ;; If message goes to known mailing list ... 905 (when (string-match ml new-header-values) 906 ;; Add Mail-Followup-To if none yet 907 (unless (mail-fetch-field "mail-followup-to") 908 (goto-char (mail-header-end)) 909 (insert "Mail-Followup-To: " 910 (let ((l)) 911 (mapc 912 ;; remove duplicates 913 (lambda (e) 914 (unless (member e l) 915 (push e l))) 916 (split-string new-header-values 917 ",[[:space:]]+" t)) 918 (mapconcat #'identity l ", ")) 919 "\n")) 920 ;; Add Mail-Reply-To if none yet 921 (unless (mail-fetch-field "mail-reply-to") 922 (goto-char (mail-header-end)) 923 (insert "Mail-Reply-To: " 924 (or (mail-fetch-field "reply-to") 925 user-mail-address) 926 "\n")))))) 927 (unless (memq mail-send-nonascii '(t mime)) 928 (goto-char (point-min)) 929 (skip-chars-forward "\0-\177") 930 (or (= (point) (point-max)) 931 (if (eq mail-send-nonascii 'query) 932 (or (y-or-n-p "Message contains non-ASCII characters; send anyway? ") 933 (error "Aborted")) 934 (error "Message contains non-ASCII characters")))) 935 ;; Complain about any invalid line. 936 (goto-char (point-min)) 937 (re-search-forward (regexp-quote mail-header-separator) (point-max) t) 938 (let ((header-end (or (match-beginning 0) (point-max)))) 939 (goto-char (point-min)) 940 (while (< (point) header-end) 941 (unless (looking-at "[ \t]\\|.*:\\|$") 942 (push-mark opoint) 943 (error "Invalid header line (maybe a continuation line lacks initial whitespace)")) 944 (forward-line 1))) 945 (goto-char opoint) 946 (when mail-encode-mml 947 (mml-to-mime) 948 (setq mail-encode-mml nil)) 949 (run-hooks 'mail-send-hook) 950 (message "Sending...") 951 (funcall send-mail-function) 952 ;; Now perform actions on successful sending. 953 (while mail-send-actions 954 (condition-case nil 955 (apply (car (car mail-send-actions)) 956 (cdr (car mail-send-actions))) 957 (error)) 958 (setq mail-send-actions (cdr mail-send-actions))) 959 (message "Sending...done") 960 ;; If buffer has no file, mark it as unmodified and delete auto-save. 961 (if (not buffer-file-name) 962 (progn 963 (set-buffer-modified-p nil) 964 (delete-auto-save-file-if-necessary t)))))) 965 966(defun mail-envelope-from () 967 "Return the envelope mail address to use when sending mail. 968This function uses `mail-envelope-from'." 969 (if (eq mail-envelope-from 'header) 970 (nth 1 (mail-extract-address-components 971 (mail-fetch-field "From"))) 972 mail-envelope-from)) 973 974;; This does the real work of sending a message via sendmail. 975;; It is called via the variable send-mail-function. 976 977;;;###autoload 978(defvar sendmail-coding-system nil 979 "Coding system for encoding the outgoing mail. 980This has higher priority than the default `buffer-file-coding-system' 981and `default-sendmail-coding-system', 982but lower priority than the local value of `buffer-file-coding-system'. 983See also the function `select-message-coding-system'.") 984 985;;;###autoload 986(defvar default-sendmail-coding-system 'iso-latin-1 987 "Default coding system for encoding the outgoing mail. 988This variable is used only when `sendmail-coding-system' is nil. 989 990This variable is set/changed by the command `set-language-environment'. 991User should not set this variable manually, 992instead use `sendmail-coding-system' to get a constant encoding 993of outgoing mails regardless of the current language environment. 994See also the function `select-message-coding-system'.") 995 996(defun mail-insert-from-field () 997 "Insert the \"From:\" field of a mail header. 998The style of the field is determined by the variable `mail-from-style'. 999This function does not perform RFC2047 encoding." 1000 (let* ((login user-mail-address) 1001 (fullname (user-full-name)) 1002 (quote-fullname nil)) 1003 (if (string-match "[^\0-\177]" fullname) 1004 (setq quote-fullname t)) 1005 (cond ((null mail-from-style) 1006 (insert "From: " login "\n")) 1007 ;; This is deprecated. 1008 ((eq mail-from-style 'system-default) 1009 nil) 1010 ((or (eq mail-from-style 'angles) 1011 (and (not (eq mail-from-style 'parens)) 1012 ;; Use angles if no quoting is needed, or if 1013 ;; parens would need quoting too. 1014 (or (not (string-match "[^- !#-'*+/-9=?A-Z^-~]" fullname)) 1015 (let ((tmp (concat fullname nil))) 1016 (while (string-match "([^()]*)" tmp) 1017 (aset tmp (match-beginning 0) ?-) 1018 (aset tmp (1- (match-end 0)) ?-)) 1019 (string-match "[\\()]" tmp))))) 1020 (insert "From: " fullname) 1021 (let ((fullname-start (+ (point-min) 6)) 1022 (fullname-end (point-marker))) 1023 (goto-char fullname-start) 1024 ;; Look for a character that cannot appear unquoted 1025 ;; according to RFC 822 (or later). 1026 (if (or (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]" 1027 fullname-end 1) 1028 quote-fullname) 1029 (progn 1030 ;; Quote fullname, escaping specials. 1031 (goto-char fullname-start) 1032 (insert "\"") 1033 (while (re-search-forward "[\"\\]" 1034 fullname-end 1) 1035 (replace-match "\\\\\\&" t)) 1036 (insert "\"")))) 1037 (insert " <" login ">\n")) 1038 ;; 'parens or default 1039 (t 1040 (insert "From: " login " (") 1041 (let ((fullname-start (point))) 1042 (if quote-fullname 1043 (insert "\"")) 1044 (insert fullname) 1045 (if quote-fullname 1046 (insert "\"")) 1047 (let ((fullname-end (point-marker))) 1048 (goto-char fullname-start) 1049 ;; \ and nonmatching parentheses must be escaped in comments. 1050 ;; Escape every instance of ()\ ... 1051 (while (re-search-forward "[()\\]" fullname-end 1) 1052 (replace-match "\\\\\\&" t)) 1053 ;; ... then undo escaping of matching parentheses, 1054 ;; including matching nested parentheses. 1055 (goto-char fullname-start) 1056 (while (re-search-forward 1057 "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)" 1058 fullname-end 1) 1059 (replace-match "\\1(\\3)" t) 1060 (goto-char fullname-start)))) 1061 (insert ")\n"))))) 1062 1063(defun mail-combine-fields (field) 1064 "Offer to combine all FIELD fields in buffer into one FIELD field. 1065If this finds multiple FIELD fields, it asks the user whether 1066to combine them into one, and does so if the user says y." 1067 (let ((search-pattern (format "^%s[ \t]*:" field)) 1068 first-to-end 1069 query-asked 1070 query-answer 1071 (old-point (point)) 1072 (old-max (point-max))) 1073 (save-excursion 1074 (save-restriction 1075 (goto-char (point-min)) 1076 (narrow-to-region (point-min) (mail-header-end)) 1077 ;; Find the first FIELD field and record where it ends. 1078 (when (re-search-forward search-pattern nil t) 1079 (forward-line 1) 1080 (re-search-forward "^[^ \t]" nil t) 1081 (beginning-of-line) 1082 (setq first-to-end (point-marker)) 1083 (set-marker-insertion-type first-to-end t) 1084 ;; Find each following FIELD field 1085 ;; and combine it with the first FIELD field. 1086 (while (re-search-forward search-pattern nil t) 1087 ;; For the second FIELD field, ask user to 1088 ;; approve combining them. 1089 ;; But if the user refuse to combine them, signal error. 1090 (unless query-asked 1091 (save-restriction 1092 ;; This is just so the screen doesn't change. 1093 (narrow-to-region (point-min) old-max) 1094 (save-excursion 1095 (goto-char old-point) 1096 (setq query-asked t) 1097 (if (y-or-n-p (format "Message contains multiple %s fields. Combine? " field)) 1098 (setq query-answer t))))) 1099 (when query-answer 1100 (let ((this-to-start (line-beginning-position)) 1101 this-to-end 1102 this-to) 1103 (forward-line 1) 1104 (re-search-forward "^[^ \t]" nil t) 1105 (beginning-of-line) 1106 (setq this-to-end (point)) 1107 ;; Get the text of this FIELD field. 1108 (setq this-to (buffer-substring this-to-start this-to-end)) 1109 ;; Delete it. 1110 (delete-region this-to-start this-to-end) 1111 (save-excursion 1112 ;; Put a comma after the first FIELD field. 1113 (goto-char first-to-end) 1114 (forward-char -1) 1115 (insert ",") 1116 ;; Copy this one after it. 1117 (goto-char first-to-end) 1118 (save-excursion 1119 (insert this-to)) 1120 ;; Replace the FIELD: with spaces. 1121 (looking-at search-pattern) 1122 ;; Try to preserve alignment of contents of the field 1123 (let ((prefix-length (length (match-string 0)))) 1124 (replace-match " ") 1125 (dotimes (_ (1- prefix-length)) 1126 (insert " "))))))) 1127 (set-marker first-to-end nil)))))) 1128 1129(defun mail-encode-header (beg end) 1130 "Encode the mail header between BEG and END according to RFC2047. 1131Return non-nil if and only if some part of the header is encoded." 1132 (save-restriction 1133 (narrow-to-region beg end) 1134 (let* ((selected (select-message-coding-system)) 1135 (mm-coding-system-priorities 1136 (if (and selected (coding-system-get selected :mime-charset)) 1137 (cons selected mm-coding-system-priorities) 1138 mm-coding-system-priorities)) 1139 (tick (buffer-chars-modified-tick)) 1140 ;; Many mailers, including Gnus, passes a message of which 1141 ;; the header is already encoded, so this is necessary to 1142 ;; prevent it from being encoded again. 1143 (rfc2047-encode-encoded-words nil)) 1144 (rfc2047-encode-message-header) 1145 (= tick (buffer-chars-modified-tick))))) 1146 1147;; Normally you will not need to modify these options unless you are 1148;; using some non-genuine substitute for sendmail which does not 1149;; implement each and every option that the original supports. 1150;; E.g., ssmtp does not support "-odb", so, if your site uses it, 1151;; you will need to modify `sendmail-error-reporting-non-interactive' 1152;; in your site-init.el. 1153(defvar sendmail-error-reporting-interactive 1154 ;; These mean "report errors to terminal" and "deliver interactively" 1155 '("-oep" "-odi")) 1156(defvar sendmail-error-reporting-non-interactive 1157 ;; These mean "report errors by mail" and "deliver in background". 1158 '("-oem" "-odb")) 1159 1160(defun sendmail-send-it () 1161 "Send the current mail buffer using the Sendmail package. 1162This is a suitable value for `send-mail-function'. It sends using the 1163external program defined by `sendmail-program'." 1164 (require 'mail-utils) 1165 ;; FIXME: A lot of the work done here seems out-of-place (e.g. it should 1166 ;; happen regardless of the method used to send, whether via SMTP of 1167 ;; /usr/bin/sendmail or anything else). 1168 (let ((errbuf (if mail-interactive 1169 (generate-new-buffer " sendmail errors") 1170 0)) 1171 (error nil) 1172 (tembuf (generate-new-buffer " sendmail temp")) 1173 (multibyte enable-multibyte-characters) 1174 (case-fold-search nil) 1175 (selected-coding (select-message-coding-system)) 1176 resend-to-addresses 1177 delimline 1178 fcc-was-found 1179 (mailbuf (current-buffer)) 1180 ;; Examine these variables now, so that 1181 ;; local binding in the mail buffer will take effect. 1182 (envelope-from 1183 (and mail-specify-envelope-from 1184 (or (mail-envelope-from) user-mail-address)))) 1185 (unwind-protect 1186 (with-current-buffer tembuf 1187 (erase-buffer) 1188 (unless multibyte 1189 (set-buffer-multibyte nil)) 1190 (insert-buffer-substring mailbuf) 1191 (set-buffer-file-coding-system selected-coding) 1192 (goto-char (point-max)) 1193 ;; require one newline at the end. 1194 (or (= (preceding-char) ?\n) 1195 (insert ?\n)) 1196 ;; Change header-delimiter to be what sendmail expects. 1197 (goto-char (mail-header-end)) 1198 (delete-region (point) (progn (end-of-line) (point))) 1199 (setq delimline (point-marker)) 1200 (sendmail-sync-aliases) 1201 (if mail-aliases 1202 (expand-mail-aliases (point-min) delimline)) 1203 (goto-char (point-min)) 1204 ;; Ignore any blank lines in the header 1205 ;; FIXME: mail-header-end should have stopped at an empty line, 1206 ;; so the regexp below should never match before delimline! 1207 (while (and (re-search-forward "\n\n\n*" delimline t) 1208 (< (point) delimline)) 1209 (replace-match "\n")) 1210 (goto-char (point-min)) 1211 ;; Look for Resent- headers. They require sending 1212 ;; the message specially. 1213 (let ((case-fold-search t)) 1214 (goto-char (point-min)) 1215 (while (re-search-forward "^Resent-\\(To\\|Cc\\|Bcc\\):" delimline t) 1216 ;; Put a list of such addresses in resend-to-addresses. 1217 (setq resend-to-addresses 1218 (save-restriction 1219 (narrow-to-region (point) 1220 (save-excursion 1221 (forward-line 1) 1222 (while (looking-at "^[ \t]") 1223 (forward-line 1)) 1224 (point))) 1225 (append (mail-parse-comma-list) 1226 resend-to-addresses))) 1227 ;; Delete Resent-Bcc ourselves 1228 (if (save-excursion (beginning-of-line) 1229 (looking-at "resent-bcc")) 1230 (delete-region (line-beginning-position) 1231 (line-beginning-position 2)))) 1232 ;; Apparently this causes a duplicate Sender. 1233 ;; ;; If the From is different from current user, insert Sender. 1234 ;; (goto-char (point-min)) 1235 ;; (and (re-search-forward "^From:" delimline t) 1236 ;; (progn 1237 ;; (require 'mail-utils) 1238 ;; (not (string-equal 1239 ;; (mail-strip-quoted-names 1240 ;; (save-restriction 1241 ;; (narrow-to-region (point-min) delimline) 1242 ;; (mail-fetch-field "From"))) 1243 ;; (user-login-name)))) 1244 ;; (progn 1245 ;; (forward-line 1) 1246 ;; (insert "Sender: " (user-login-name) "\n"))) 1247 ;; Don't send out a blank subject line 1248 (goto-char (point-min)) 1249 (if (re-search-forward "^Subject:\\([ \t]*\n\\)+\\b" delimline t) 1250 (replace-match "") 1251 ;; This one matches a Subject just before the header delimiter. 1252 (if (and (re-search-forward "^Subject:\\([ \t]*\n\\)+" delimline t) 1253 (= (match-end 0) delimline)) 1254 (replace-match ""))) 1255 ;; Put the "From:" field in unless for some odd reason 1256 ;; they put one in themselves. 1257 (goto-char (point-min)) 1258 (if (not (re-search-forward "^From:" delimline t)) 1259 (mail-insert-from-field)) 1260 ;; Possibly add a MIME header for the current coding system 1261 (let (charset where-content-type) 1262 (goto-char (point-min)) 1263 (setq where-content-type 1264 (re-search-forward "^Content-type:" delimline t)) 1265 (goto-char (point-min)) 1266 (and (eq mail-send-nonascii 'mime) 1267 (not (re-search-forward "^MIME-version:" delimline t)) 1268 (progn (skip-chars-forward "\0-\177") 1269 (/= (point) (point-max))) 1270 selected-coding 1271 (setq charset 1272 (coding-system-get selected-coding :mime-charset)) 1273 (progn 1274 (goto-char delimline) 1275 (insert "MIME-version: 1.0\n" 1276 "Content-type: text/plain; charset=" 1277 (symbol-name charset) 1278 "\nContent-Transfer-Encoding: 8bit\n") 1279 ;; The character set we will actually use 1280 ;; should override any specified in the message itself. 1281 (when where-content-type 1282 (goto-char where-content-type) 1283 (delete-region (point-at-bol) 1284 (progn (forward-line 1) (point))))))) 1285 ;; Insert an extra newline if we need it to work around 1286 ;; Sun's bug that swallows newlines. 1287 (goto-char (1+ delimline)) 1288 (if (eval mail-mailer-swallows-blank-line) 1289 (newline)) 1290 ;; Find and handle any Fcc fields. 1291 (goto-char (point-min)) 1292 (if (re-search-forward "^Fcc:" delimline t) 1293 (progn 1294 (setq fcc-was-found t) 1295 (mail-do-fcc delimline))) 1296 (if mail-interactive 1297 (with-current-buffer errbuf 1298 (erase-buffer)))) 1299 ;; Encode the header according to RFC2047. 1300 (mail-encode-header (point-min) delimline) 1301 (goto-char (point-min)) 1302 (if (let ((case-fold-search t)) 1303 (or resend-to-addresses 1304 (re-search-forward "^To:\\|^cc:\\|^bcc:" 1305 delimline t))) 1306 (let* ((default-directory "/") 1307 (coding-system-for-write selected-coding) 1308 (args 1309 (append (list (point-min) (point-max) 1310 sendmail-program 1311 nil errbuf nil "-oi") 1312 (and envelope-from 1313 (list "-f" envelope-from)) 1314 ;; ;; Don't say "from root" if running under su. 1315 ;; (and (equal (user-real-login-name) "root") 1316 ;; (list "-f" (user-login-name))) 1317 (and mail-alias-file 1318 (list (concat "-oA" mail-alias-file))) 1319 (if mail-interactive 1320 sendmail-error-reporting-interactive 1321 sendmail-error-reporting-non-interactive) 1322 ;; Get the addresses from the message 1323 ;; unless this is a resend. 1324 ;; We must not do that for a resend 1325 ;; because we would find the original addresses. 1326 ;; For a resend, include the specific addresses. 1327 (or resend-to-addresses 1328 '("-t") 1329 ) 1330 (if mail-use-dsn 1331 (list "-N" (mapconcat #'symbol-name 1332 mail-use-dsn ","))) 1333 ) 1334 ) 1335 (exit-value (apply #'call-process-region args))) 1336 (cond ((or (null exit-value) (eq 0 exit-value))) 1337 ((numberp exit-value) 1338 (setq error t) 1339 (error "Sending...failed with exit value %d" exit-value)) 1340 ((stringp exit-value) 1341 (setq error t) 1342 (error "Sending...terminated by signal: %s" exit-value)) 1343 (t 1344 (setq error t) 1345 (error "SENDMAIL-SEND-IT -- fall through: %S" exit-value)))) 1346 (or fcc-was-found 1347 (error "No recipients"))) 1348 (if mail-interactive 1349 (with-current-buffer errbuf 1350 (goto-char (point-min)) 1351 (while (re-search-forward "\n\n* *" nil t) 1352 (replace-match "; ")) 1353 (unless (zerop (buffer-size)) 1354 (setq error t) 1355 (error "Sending...failed to %s" 1356 (buffer-substring (point-min) (point-max))))))) 1357 (kill-buffer tembuf) 1358 (when (buffer-live-p errbuf) 1359 (if error 1360 (switch-to-buffer-other-window errbuf) 1361 (kill-buffer errbuf)))))) 1362 1363(autoload 'rmail-output-to-rmail-buffer "rmailout") 1364 1365(defun mail-do-fcc (header-end) 1366 "Find and act on any Fcc: headers in the current message before HEADER-END. 1367If a buffer is visiting the Fcc file, append to it before 1368offering to save it, if it was modified initially. If this is an 1369Rmail buffer, update Rmail as needed. If there is no buffer, 1370just append to the file, in Babyl format if necessary." 1371 (unless (markerp header-end) 1372 (error "Value of `header-end' must be a marker")) 1373 (let (fcc-list 1374 (mailbuf (current-buffer)) 1375 (time (current-time))) 1376 (save-excursion 1377 (goto-char (point-min)) 1378 (let ((case-fold-search t)) 1379 (while (re-search-forward "^Fcc:[ \t]*" header-end t) 1380 (push (buffer-substring (point) 1381 (progn 1382 (end-of-line) 1383 (skip-chars-backward " \t") 1384 (point))) 1385 fcc-list) 1386 (delete-region (match-beginning 0) 1387 (progn (forward-line 1) (point))))) 1388 (with-temp-buffer 1389 ;; This initial newline is not written out if we create a new 1390 ;; file (see below). 1391 (insert "\nFrom " (user-login-name) " " (current-time-string time) "\n") 1392 ;; Insert the time zone before the year. 1393 (forward-char -1) 1394 (forward-word-strictly -1) 1395 (require 'mail-utils) 1396 (insert (mail-rfc822-time-zone time) " ") 1397 (goto-char (point-max)) 1398 (insert "Date: " (message-make-date) "\n") 1399 (insert-buffer-substring mailbuf) 1400 ;; Make sure messages are separated. 1401 (goto-char (point-max)) 1402 (insert ?\n) 1403 (goto-char 2) 1404 ;; ``Quote'' "^From " as ">From " 1405 ;; (note that this isn't really quoting, as there is no requirement 1406 ;; that "^[>]+From " be quoted in the same transparent way.) 1407 (let ((case-fold-search nil)) 1408 (while (search-forward "\nFrom " nil t) 1409 (forward-char -5) 1410 (insert ?>))) 1411 (dolist (fcc fcc-list) 1412 (let* ((buffer (find-buffer-visiting fcc)) 1413 (curbuf (current-buffer)) 1414 dont-write-the-file 1415 buffer-matches-file 1416 (beg (point-min)) ; the initial blank line 1417 (end (point-max)) 1418 ;; After the ^From line. 1419 (beg2 (save-excursion (goto-char (point-min)) 1420 (forward-line 2) (point)))) 1421 (if buffer 1422 ;; File is present in a buffer => append to that buffer. 1423 (with-current-buffer buffer 1424 (setq buffer-matches-file 1425 (and (not (buffer-modified-p)) 1426 (verify-visited-file-modtime buffer))) 1427 (let ((msg (bound-and-true-p rmail-current-message)) 1428 (buffer-read-only nil)) 1429 ;; If MSG is non-nil, buffer is in Rmail mode. 1430 (if msg 1431 (let ((buff (generate-new-buffer " *mail-do-fcc"))) 1432 (unwind-protect 1433 (progn 1434 (with-current-buffer buff 1435 (insert-buffer-substring curbuf (1+ beg) end)) 1436 (rmail-output-to-rmail-buffer buff msg)) 1437 (kill-buffer buff))) 1438 ;; Output file not in Rmail mode => just insert 1439 ;; at the end. 1440 (save-restriction 1441 (widen) 1442 (goto-char (point-max)) 1443 (insert-buffer-substring curbuf beg end))) 1444 ;; Offer to save the buffer if it was modified 1445 ;; before we started. 1446 (unless buffer-matches-file 1447 (if (y-or-n-p (format "Save file %s? " fcc)) 1448 (save-buffer)) 1449 (setq dont-write-the-file t))))) 1450 ;; Append to the file directly, unless we've already taken 1451 ;; care of it. 1452 (unless dont-write-the-file 1453 (if (and (file-exists-p fcc) 1454 (mail-file-babyl-p fcc)) 1455 ;; If the file is a Babyl file, convert the message to 1456 ;; Babyl format. Even though Rmail no longer uses 1457 ;; Babyl, this code can remain for the time being, on 1458 ;; the off-chance one Fccs to a Babyl file that has 1459 ;; not yet been converted to mbox. 1460 (let ((coding-system-for-write 1461 (or rmail-file-coding-system 'emacs-mule))) 1462 (with-temp-buffer 1463 (insert "\C-l\n0, unseen,,\n*** EOOH ***\nDate: " 1464 (mail-rfc822-date) "\n") 1465 (insert-buffer-substring curbuf beg2 end) 1466 (insert "\n\C-_") 1467 (write-region (point-min) (point-max) fcc t))) 1468 ;; Ensure there is a blank line between messages, but 1469 ;; not at the very start of the file. 1470 (write-region (if (file-exists-p fcc) 1471 (point-min) 1472 (1+ (point-min))) 1473 (point-max) fcc t))) 1474 (and buffer (not dont-write-the-file) 1475 (with-current-buffer buffer 1476 (set-visited-file-modtime))))))))) 1477 1478(defun mail-sent-via () 1479 "Make a Sent-via header line from each To or Cc header line." 1480 (declare (obsolete "nobody can remember what it is for." "24.1")) 1481 (interactive) 1482 (save-excursion 1483 ;; put a marker at the end of the header 1484 (let ((end (copy-marker (mail-header-end))) 1485 (case-fold-search t)) 1486 (goto-char (point-min)) 1487 ;; search for the To: lines and make Sent-via: lines from them 1488 ;; search for the next To: line 1489 (while (re-search-forward "^\\(to\\|cc\\):" end t) 1490 ;; Grab this line plus all its continuations, sans the `to:'. 1491 (let ((to-line 1492 (buffer-substring (point) 1493 (progn 1494 (if (re-search-forward "^[^ \t\n]" end t) 1495 (backward-char 1) 1496 (goto-char end)) 1497 (point))))) 1498 ;; Insert a copy, with altered header field name. 1499 (insert-before-markers "Sent-via:" to-line)))))) 1500 1501(defun mail-to () 1502 "Move point to end of To field, creating it if necessary." 1503 (interactive) 1504 (expand-abbrev) 1505 (mail-position-on-field "To")) 1506 1507(defun mail-subject () 1508 "Move point to end of Subject field, creating it if necessary." 1509 (interactive) 1510 (expand-abbrev) 1511 (mail-position-on-field "Subject")) 1512 1513(defun mail-cc () 1514 "Move point to end of Cc field, creating it if necessary." 1515 (interactive) 1516 (expand-abbrev) 1517 (or (mail-position-on-field "cc" t) 1518 (progn (mail-position-on-field "to") 1519 (insert "\nCC: ")))) 1520 1521(defun mail-bcc () 1522 "Move point to end of Bcc field, creating it if necessary." 1523 (interactive) 1524 (expand-abbrev) 1525 (or (mail-position-on-field "bcc" t) 1526 (progn (mail-position-on-field "to") 1527 (insert "\nBcc: ")))) 1528 1529(defun mail-fcc (folder) 1530 "Add a new Fcc field, with file name completion." 1531 (interactive "FFolder carbon copy: ") 1532 (expand-abbrev) 1533 (or (mail-position-on-field "fcc" t) ;Put new field after exiting Fcc. 1534 (mail-position-on-field "to")) 1535 (insert "\nFcc: " folder)) 1536 1537(defun mail-reply-to () 1538 "Move point to end of Reply-To field, creating it if necessary." 1539 (interactive) 1540 (expand-abbrev) 1541 (mail-position-on-field "Reply-To")) 1542 1543(defun mail-mail-reply-to () 1544 "Move point to end of Mail-Reply-To field, creating it if necessary." 1545 (interactive) 1546 (expand-abbrev) 1547 (or (mail-position-on-field "mail-reply-to" t) 1548 (progn (mail-position-on-field "to") 1549 (insert "\nMail-Reply-To: ")))) 1550 1551(defun mail-mail-followup-to () 1552 "Move point to end of Mail-Followup-To field, creating it if necessary." 1553 (interactive) 1554 (expand-abbrev) 1555 (or (mail-position-on-field "mail-followup-to" t) 1556 (progn (mail-position-on-field "to") 1557 (insert "\nMail-Followup-To: ")))) 1558 1559(defun mail-position-on-field (field &optional soft) 1560 "Move to the end of the contents of header field FIELD. 1561If there is no such header, insert one, unless SOFT is non-nil. 1562If there are multiple FIELD fields, this goes to the first. 1563Returns non-nil if FIELD was originally present." 1564 (let (end 1565 (case-fold-search t)) 1566 (setq end (mail-header-end)) 1567 (goto-char (point-min)) 1568 (if (re-search-forward (concat "^" (regexp-quote field) ":") end t) 1569 (progn 1570 (re-search-forward "^[^ \t]" nil 'move) 1571 (beginning-of-line) 1572 (skip-chars-backward "\n") 1573 t) 1574 (or soft 1575 (progn (goto-char end) 1576 (insert field ": \n") 1577 (skip-chars-backward "\n"))) 1578 nil))) 1579 1580(defun mail-text () 1581 "Move point to beginning of text field." 1582 (interactive) 1583 (expand-abbrev) 1584 (goto-char (mail-text-start))) 1585 1586(defun mail-signature (&optional atpoint) 1587 "Sign letter with signature. 1588If the variable `mail-signature' is a string, inserts it. 1589If it is t or nil, inserts the contents of the file `mail-signature-file'. 1590Otherwise, evals `mail-signature'. 1591Prefix argument ATPOINT means insert at point rather than the end." 1592 (interactive "*P") 1593 ;; Test for an unreadable file here, before we delete trailing 1594 ;; whitespace, so that we don't modify the buffer needlessly. 1595 (if (and (memq mail-signature '(t nil)) 1596 (not (file-readable-p mail-signature-file))) 1597 (if (called-interactively-p 'interactive) 1598 (message "The signature file `%s' could not be read" 1599 mail-signature-file)) 1600 (save-excursion 1601 (unless atpoint 1602 (goto-char (point-max)) 1603 ;; Delete trailing whitespace and blank lines. 1604 (skip-chars-backward " \t\n") 1605 (end-of-line) 1606 (delete-region (point) (point-max))) 1607 (cond ((stringp mail-signature) 1608 (insert mail-signature)) 1609 ((memq mail-signature '(t nil)) 1610 (insert "\n\n-- \n") 1611 (insert-file-contents (expand-file-name mail-signature-file))) 1612 (t 1613 ;; FIXME add condition-case error handling? 1614 (eval mail-signature)))))) 1615 1616(defun mail-fill-yanked-message (&optional justifyp) 1617 "Fill the paragraphs of a message yanked into this one. 1618Numeric argument means justify as well." 1619 (interactive "P") 1620 (save-excursion 1621 (goto-char (mail-text-start)) 1622 (fill-individual-paragraphs (point) 1623 (point-max) 1624 justifyp 1625 mail-citation-prefix-regexp))) 1626 1627(defun mail-indent-citation () 1628 "Modify text just inserted from a message to be cited. 1629The inserted text should be the region. 1630When this function returns, the region is again around the modified text. 1631 1632Normally, indent each nonblank line `mail-indentation-spaces' spaces. 1633However, if `mail-yank-prefix' is non-nil, insert that prefix on each line." 1634 (mail-yank-clear-headers (region-beginning) (region-end)) 1635 (if (null mail-yank-prefix) 1636 (indent-rigidly (region-beginning) (region-end) 1637 mail-indentation-spaces) 1638 (save-excursion 1639 (let ((end (set-marker (make-marker) (region-end)))) 1640 (goto-char (region-beginning)) 1641 (while (< (point) end) 1642 (insert mail-yank-prefix) 1643 (forward-line 1)))))) 1644 1645(defun mail-yank-original (arg) 1646 "Insert the message being replied to, if any (in Rmail). 1647Puts point after the text and mark before. 1648Normally, indents each nonblank line ARG spaces (default 3). 1649However, if `mail-yank-prefix' is non-nil, insert that prefix on each line. 1650 1651Just \\[universal-argument] as argument means don't indent, insert no prefix, 1652and don't delete any header fields." 1653 (interactive "P") 1654 (if mail-reply-action 1655 (let ((start (point)) 1656 (original mail-reply-action) 1657 (omark (mark t))) 1658 (and (consp original) (eq (car original) 'insert-buffer) 1659 (setq original (nth 1 original))) 1660 (if (consp original) 1661 (progn 1662 ;; Call yank function, and set the mark if it doesn't. 1663 (apply (car original) (cdr original)) 1664 (if (eq omark (mark t)) 1665 (push-mark))) 1666 ;; If the original message is in another window in the same 1667 ;; frame, delete that window to save space. 1668 (delete-windows-on original t) 1669 (with-no-warnings 1670 ;; We really want this to set mark. 1671 (insert-buffer original) 1672 ;; If they yank the original text, the encoding of the 1673 ;; original message is a better default than 1674 ;; the default buffer-file-coding-system. 1675 (and (coding-system-equal 1676 (default-value 'buffer-file-coding-system) 1677 buffer-file-coding-system) 1678 (setq buffer-file-coding-system 1679 (coding-system-change-text-conversion 1680 buffer-file-coding-system 1681 (coding-system-base 1682 (with-current-buffer original 1683 buffer-file-coding-system)))))) 1684 (set-text-properties (point) (mark t) nil)) 1685 (if (consp arg) 1686 nil 1687 (goto-char start) 1688 (let ((mail-indentation-spaces (if arg (prefix-numeric-value arg) 1689 mail-indentation-spaces)) 1690 ;; Avoid error in Transient Mark mode 1691 ;; on account of mark's being inactive. 1692 (mark-even-if-inactive t)) 1693 (cond (mail-citation-hook 1694 ;; Bind mail-citation-header to the inserted 1695 ;; message's header. 1696 (let ((mail-citation-header 1697 (buffer-substring-no-properties 1698 start 1699 (save-excursion 1700 (save-restriction 1701 (narrow-to-region start (point-max)) 1702 (goto-char start) 1703 (rfc822-goto-eoh) 1704 (point)))))) 1705 (run-hooks 'mail-citation-hook))) 1706 (t 1707 (mail-indent-citation))))) 1708 ;; This is like exchange-point-and-mark, but doesn't activate the mark. 1709 ;; It is cleaner to avoid activation, even though the command 1710 ;; loop would deactivate the mark because we inserted text. 1711 (goto-char (prog1 (mark t) 1712 (set-marker (mark-marker) (point) (current-buffer)))) 1713 (if (not (eolp)) (insert ?\n))))) 1714 1715(defun mail-yank-clear-headers (start end) 1716 (if (< end start) 1717 (let (temp) 1718 (setq temp start start end end temp))) 1719 (if mail-yank-ignored-headers 1720 (save-excursion 1721 (goto-char start) 1722 (if (search-forward "\n\n" end t) 1723 (save-restriction 1724 (narrow-to-region start (point)) 1725 (goto-char start) 1726 (while (let ((case-fold-search t)) 1727 (re-search-forward mail-yank-ignored-headers nil t)) 1728 (beginning-of-line) 1729 (delete-region (point) 1730 (progn (re-search-forward "\n[^ \t]") 1731 (forward-char -1) 1732 (point))))))))) 1733 1734(defun mail-yank-region (arg) 1735 "Insert the selected region from the message being replied to. 1736Puts point after the text and mark before. 1737Normally, indents each nonblank line ARG spaces (default 3). 1738However, if `mail-yank-prefix' is non-nil, insert that prefix on each line. 1739 1740Just \\[universal-argument] as argument means don't indent, insert no prefix, 1741and don't delete any header fields." 1742 (interactive "P") 1743 (and (consp mail-reply-action) 1744 (memq (car mail-reply-action) 1745 '(rmail-yank-current-message insert-buffer)) 1746 (with-current-buffer (nth 1 mail-reply-action) 1747 (or (mark t) 1748 (error "No mark set: %S" (current-buffer)))) 1749 (let ((buffer (nth 1 mail-reply-action)) 1750 (start (point)) 1751 ;; Avoid error in Transient Mark mode 1752 ;; on account of mark's being inactive. 1753 (mark-even-if-inactive t)) 1754 ;; Insert the citation text. 1755 (insert (with-current-buffer buffer 1756 (buffer-substring-no-properties (point) (mark)))) 1757 (push-mark start) 1758 ;; Indent or otherwise annotate the citation text. 1759 (if (consp arg) 1760 nil 1761 (let ((mail-indentation-spaces (if arg (prefix-numeric-value arg) 1762 mail-indentation-spaces))) 1763 (if mail-citation-hook 1764 ;; Bind mail-citation-header to the original message's header. 1765 (let ((mail-citation-header 1766 (with-current-buffer buffer 1767 (buffer-substring-no-properties 1768 (point-min) 1769 (save-excursion 1770 (goto-char (point-min)) 1771 (rfc822-goto-eoh) 1772 (point)))))) 1773 (run-hooks 'mail-citation-hook)) 1774 (mail-indent-citation))))))) 1775 1776(defun mail-split-line () 1777 "Split current line, moving portion beyond point vertically down. 1778If the current line has `mail-yank-prefix', insert it on the new line." 1779 (interactive "*") 1780 (split-line mail-yank-prefix)) 1781 1782 1783(defun mail-insert-file (&optional file) 1784 "Insert a file at the end of the buffer, with separator lines around it." 1785 (interactive "fAttach file: ") 1786 (save-excursion 1787 (goto-char (point-max)) 1788 (or (bolp) (newline)) 1789 (newline) 1790 (let ((start (point)) 1791 middle) 1792 (insert (format "===File %s===" file)) 1793 (insert-char ?= (max 0 (- 60 (current-column)))) 1794 (newline) 1795 (setq middle (point)) 1796 (insert "============================================================\n") 1797 (push-mark) 1798 (goto-char middle) 1799 (insert-file-contents file) 1800 (or (bolp) (newline)) 1801 (goto-char start)))) 1802 1803(define-obsolete-function-alias 'mail-attach-file #'mail-insert-file "24.1") 1804 1805(declare-function mml-attach-file "mml" 1806 (file &optional type description disposition)) 1807(declare-function mm-default-file-encoding "mm-encode" (file)) 1808 1809(defun mail-add-attachment (file) 1810 "Add FILE as a MIME attachment to the end of the mail message being composed." 1811 (interactive "fAttach file: ") 1812 (mml-attach-file file 1813 (or (mm-default-file-encoding file) 1814 "application/octet-stream") nil) 1815 (setq mail-encode-mml t)) 1816 1817 1818;; Put these commands last, to reduce chance of lossage from quitting 1819;; in middle of loading the file. 1820 1821;;;###autoload 1822(defun mail (&optional noerase to subject in-reply-to cc replybuffer 1823 actions return-action) 1824 "Edit a message to be sent. Prefix arg means resume editing (don't erase). 1825When this function returns, the buffer `*mail*' is selected. 1826The value is t if the message was newly initialized; otherwise, nil. 1827 1828Optionally, the signature file `mail-signature-file' can be inserted at the 1829end; see the variable `mail-signature'. 1830 1831\\<mail-mode-map> 1832While editing message, type \\[mail-send-and-exit] to send the message and exit. 1833 1834Various special commands starting with C-c are available in sendmail mode 1835to move to message header fields: 1836\\{mail-mode-map} 1837 1838If `mail-self-blind' is non-nil, a Bcc to yourself is inserted 1839when the message is initialized. 1840 1841If `mail-default-reply-to' is non-nil, it should be an address (a string); 1842a Reply-To: field with that address is inserted. 1843 1844If `mail-archive-file-name' is non-nil, an Fcc field with that file name 1845is inserted. 1846 1847The normal hook `mail-setup-hook' is run after the message is 1848initialized. It can add more default fields to the message. 1849 1850The first argument, NOERASE, determines what to do when there is 1851an existing modified `*mail*' buffer. If NOERASE is nil, the 1852existing mail buffer is used, and the user is prompted whether to 1853keep the old contents or to erase them. If NOERASE has the value 1854`new', a new mail buffer will be created instead of using the old 1855one. Any other non-nil value means to always select the old 1856buffer without erasing the contents. 1857 1858The second through fifth arguments, 1859 TO, SUBJECT, IN-REPLY-TO and CC, specify if non-nil 1860 the initial contents of those header fields. 1861 These arguments should not have final newlines. 1862The sixth argument REPLYBUFFER is a buffer which contains an 1863 original message being replied to, or else an action 1864 of the form (FUNCTION . ARGS) which says how to insert the original. 1865 Or it can be nil, if not replying to anything. 1866The seventh argument ACTIONS is a list of actions to take 1867 if/when the message is sent. Each action looks like (FUNCTION . ARGS); 1868 when the message is sent, we apply FUNCTION to ARGS. 1869 This is how Rmail arranges to mark messages `answered'." 1870 (interactive "P") 1871 (if (eq noerase 'new) 1872 (pop-to-buffer-same-window (generate-new-buffer "*mail*")) 1873 (and noerase 1874 (not (get-buffer "*mail*")) 1875 (setq noerase nil)) 1876 (pop-to-buffer-same-window "*mail*")) 1877 1878 ;; Avoid danger that the auto-save file can't be written. 1879 (let ((dir (expand-file-name 1880 (file-name-as-directory mail-default-directory)))) 1881 (if (file-exists-p dir) 1882 (setq default-directory dir))) 1883 ;; Only call auto-save-mode if necessary, to avoid changing auto-save file. 1884 (if (or (and auto-save-default (not buffer-auto-save-file-name)) 1885 (and (not auto-save-default) buffer-auto-save-file-name)) 1886 (auto-save-mode auto-save-default)) 1887 (mail-mode) 1888 ;; Disconnect the buffer from its visited file 1889 ;; (in case the user has actually visited a file *mail*). 1890 ;; (set-visited-file-name nil) 1891 (let (initialized) 1892 (and (not (and noerase 1893 (not (eq noerase 'new)))) 1894 (if buffer-file-name 1895 (if (buffer-modified-p) 1896 (when (y-or-n-p "Buffer has unsaved changes; reinitialize it and discard them? ") 1897 (if (y-or-n-p "Disconnect buffer from visited file? ") 1898 (set-visited-file-name nil)) 1899 t) 1900 (when (y-or-n-p "Reinitialize buffer, and disconnect it from the visited file? ") 1901 (set-visited-file-name nil) 1902 t)) 1903 ;; A non-file-visiting buffer. 1904 (if (buffer-modified-p) 1905 (y-or-n-p "Unsent message being composed; erase it? ") 1906 t)) 1907 (let ((inhibit-read-only t)) 1908 (erase-buffer) 1909 (mail-setup to subject in-reply-to cc replybuffer actions 1910 return-action) 1911 (setq initialized t))) 1912 (if (and buffer-auto-save-file-name 1913 (file-exists-p buffer-auto-save-file-name)) 1914 (message "Auto save file for draft message exists; consider M-x mail-recover")) 1915 initialized)) 1916 1917(declare-function dired-view-file "dired" ()) 1918(declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep)) 1919 1920(defun mail-recover-1 () 1921 "Pop up a list of auto-saved draft messages so you can recover one of them." 1922 (interactive) 1923 (let ((file-name (make-auto-save-file-name)) 1924 (ls-lisp-support-shell-wildcards t) 1925 non-random-len wildcard) 1926 ;; Remove the random part from the auto-save-file-name, and 1927 ;; create a wildcard which matches possible candidates. 1928 ;; Note: this knows that make-auto-save-file-name appends 1929 ;; "#<RANDOM-STUFF>#" to the buffer name, where RANDOM-STUFF 1930 ;; is the result of (make-temp-name ""). 1931 (setq non-random-len 1932 (- (length file-name) (length (make-temp-name "")) 1)) 1933 (setq wildcard (concat (substring file-name 0 non-random-len) "*")) 1934 (if (null (file-expand-wildcards wildcard)) 1935 (message "There are no auto-saved drafts to recover") 1936 ;; Bind dired-trivial-filenames to t because all auto-save file 1937 ;; names are normally ``trivial'', so Dired will set point after 1938 ;; all the files, at buffer bottom. We want it on the first 1939 ;; file instead. 1940 ;; Require dired so that dired-trivial-filenames does not get 1941 ;; unbound on exit from the let. 1942 (require 'dired) 1943 (defvar dired-trivial-filenames) 1944 (let ((dired-trivial-filenames t)) 1945 (dired-other-window wildcard (concat dired-listing-switches " -t"))) 1946 (rename-buffer "*Auto-saved Drafts*" t) 1947 (save-excursion 1948 (goto-char (point-min)) 1949 (or (looking-at " Move to the draft file you want to recover,") 1950 (let ((inhibit-read-only t)) 1951 ;; Each line starts with a space so that Font Lock mode 1952 ;; won't highlight the first character. 1953 (insert "\ 1954 Move to the draft file you want to recover, then type C-c C-c 1955 to recover text of message whose composition was interrupted. 1956 To browse text of a draft, type v on the draft file's line. 1957 1958 You can also delete some of these files; 1959 type d on a line to mark that file for deletion. 1960 1961 List of possible auto-save files for recovery: 1962 1963")))) 1964 (use-local-map 1965 (let ((map (make-sparse-keymap))) 1966 (set-keymap-parent map (current-local-map)) 1967 map)) 1968 (define-key (current-local-map) "v" 1969 (lambda () 1970 (interactive) 1971 (let ((coding-system-for-read 'utf-8-emacs-unix)) 1972 (dired-view-file)))) 1973 (define-key (current-local-map) "\C-c\C-c" 1974 (lambda () 1975 (interactive) 1976 (let ((fname (dired-get-filename)) 1977 ;; Auto-saved files are written in the internal 1978 ;; representation, so they should be read accordingly. 1979 (coding-system-for-read 'utf-8-emacs-unix)) 1980 (switch-to-buffer-other-window "*mail*") 1981 (let ((buffer-read-only nil)) 1982 (erase-buffer) 1983 (insert-file-contents fname nil) 1984 ;; insert-file-contents will set buffer-file-coding-system 1985 ;; to utf-8-emacs, which is probably not what they want to 1986 ;; use for sending the message. But we don't know what 1987 ;; was its value before the buffer was killed or Emacs 1988 ;; crashed. We therefore reset buffer-file-coding-system 1989 ;; to the default value, so that either the default does 1990 ;; TRT, or the user will get prompted for the right 1991 ;; encoding when they send the message. 1992 (setq buffer-file-coding-system 1993 (default-value 'buffer-file-coding-system))))))))) 1994 1995(declare-function dired-move-to-filename "dired" (&optional raise-error eol)) 1996(declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep)) 1997(declare-function dired-view-file "dired" ()) 1998 1999(defun mail-recover () 2000 "Recover interrupted mail composition from auto-save files. 2001 2002If the mail buffer has a current valid auto-save file, 2003the command recovers that file. Otherwise, it displays a 2004buffer showing the existing auto-saved draft messages; 2005you can move to one of them and type C-c C-c to recover that one." 2006 (interactive) 2007 ;; In case they invoke us from some random buffer... 2008 (switch-to-buffer "*mail*") 2009 ;; If *mail* didn't exist, set its directory, so that auto-saved 2010 ;; drafts will be found. 2011 (let ((dir (expand-file-name 2012 (file-name-as-directory mail-default-directory)))) 2013 (if (file-exists-p dir) 2014 (setq default-directory dir))) 2015 (or (eq major-mode 'mail-mode) 2016 (mail-mode)) 2017 (let ((file-name buffer-auto-save-file-name)) 2018 (cond ((and file-name (file-exists-p file-name)) 2019 (let ((dispbuf 2020 ;; This used to invoke `ls' via call-process, but 2021 ;; dired-noselect is more portable to systems where 2022 ;; `ls' is not a standard program (it will use 2023 ;; ls-lisp instead). 2024 (dired-noselect file-name 2025 (concat dired-listing-switches " -t")))) 2026 (save-selected-window 2027 (switch-to-buffer-other-window dispbuf) 2028 (goto-char (point-min)) 2029 (forward-line 2) 2030 (dired-move-to-filename) 2031 (setq dispbuf (rename-buffer "*Directory*" t))) 2032 (if (not (yes-or-no-p 2033 (format "Recover mail draft from auto save file %s? " 2034 file-name))) 2035 (error "mail-recover canceled") 2036 (let ((buffer-read-only nil) 2037 (buffer-coding buffer-file-coding-system) 2038 ;; Auto-save files are written in internal 2039 ;; representation of non-ASCII characters. 2040 (coding-system-for-read 'utf-8-emacs-unix)) 2041 (erase-buffer) 2042 (insert-file-contents file-name nil) 2043 (setq buffer-file-coding-system buffer-coding))))) 2044 (t (mail-recover-1))))) 2045 2046;;;###autoload 2047(defun mail-other-window (&optional noerase to subject in-reply-to cc replybuffer sendactions) 2048 "Like `mail' command, but display mail buffer in another window." 2049 (interactive "P") 2050 (switch-to-buffer-other-window "*mail*") 2051 (mail noerase to subject in-reply-to cc replybuffer sendactions)) 2052 2053;;;###autoload 2054(defun mail-other-frame (&optional noerase to subject in-reply-to cc replybuffer sendactions) 2055 "Like `mail' command, but display mail buffer in another frame." 2056 (interactive "P") 2057 (switch-to-buffer-other-frame "*mail*") 2058 (mail noerase to subject in-reply-to cc replybuffer sendactions)) 2059 2060;; Do not add anything but external entries on this page. 2061 2062(provide 'sendmail) 2063;;; sendmail.el ends here 2064