| 1 | ;; Mail sending commands for Emacs. |
| 2 | ;; Copyright (C) 1985, 1986, 1992 Free Software Foundation, Inc. |
| 3 | |
| 4 | ;; This file is part of GNU Emacs. |
| 5 | |
| 6 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
| 7 | ;; it under the terms of the GNU General Public License as published by |
| 8 | ;; the Free Software Foundation; either version 1, or (at your option) |
| 9 | ;; any later version. |
| 10 | |
| 11 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 12 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 13 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 14 | ;; GNU General Public License for more details. |
| 15 | |
| 16 | ;; You should have received a copy of the GNU General Public License |
| 17 | ;; along with GNU Emacs; see the file COPYING. If not, write to |
| 18 | ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. |
| 19 | |
| 20 | |
| 21 | ;;;###autoload |
| 22 | (defconst mail-self-blind nil "\ |
| 23 | Non-nil means insert BCC to self in messages to be sent. |
| 24 | This is done when the message is initialized, |
| 25 | so you can remove or alter the BCC field to override the default.") |
| 26 | |
| 27 | ;;;###autoload |
| 28 | (defconst mail-interactive nil "\ |
| 29 | Non-nil means when sending a message wait for and display errors. |
| 30 | nil means let mailer mail back a message to report errors.") |
| 31 | |
| 32 | ;;;###autoload |
| 33 | (defconst mail-yank-ignored-headers "^via:\\|^mail-from:\\|^origin:\\|^status:\\|^remailed\\|^received:\\|^message-id:\\|^summary-line:\\|^to:\\|^subject:\\|^in-reply-to:\\|^return-path:" "\ |
| 34 | Delete these headers from old message when it's inserted in a reply.") |
| 35 | |
| 36 | ;; Useful to set in site-init.el |
| 37 | ;;;###autoload |
| 38 | (defconst send-mail-function 'sendmail-send-it "\ |
| 39 | Function to call to send the current buffer as mail. |
| 40 | The headers are be delimited by a line which is mail-header-separator.") |
| 41 | |
| 42 | ;;;###autoload |
| 43 | (defvar mail-header-separator "--text follows this line--" "\ |
| 44 | *Line used to separate headers from text in messages being composed.") |
| 45 | |
| 46 | ;;;###autoload |
| 47 | (defvar mail-archive-file-name nil "\ |
| 48 | *Name of file to write all outgoing messages in, or nil for none. |
| 49 | Do not use an rmail file here! Instead, use its inbox file.") |
| 50 | |
| 51 | (defvar mail-default-reply-to nil |
| 52 | "*Address to insert as default Reply-to field of outgoing messages.") |
| 53 | |
| 54 | (defvar mail-alias-file nil |
| 55 | "*If non-nil, the name of a file to use instead of `/usr/lib/aliases'. |
| 56 | This file defines aliases to be expanded by the mailer; this is a different |
| 57 | feature from that of defining aliases in `.mailrc' to be expanded in Emacs. |
| 58 | This variable has no effect unless your system uses sendmail as its mailer.") |
| 59 | |
| 60 | (defvar mail-yank-prefix nil |
| 61 | "*Prefix insert on lines of yanked message being replied to. |
| 62 | nil means use indentation.") |
| 63 | |
| 64 | (defvar mail-abbrevs-loaded nil) |
| 65 | (defvar mail-mode-map nil) |
| 66 | |
| 67 | (defvar mail-signature nil |
| 68 | "*Text inserted at end of mail buffer when a message is initialized. |
| 69 | If t, it means to insert the contents of the file `~/.signature'.") |
| 70 | |
| 71 | (defvar mail-reply-buffer nil) |
| 72 | (defvar mail-send-actions nil |
| 73 | "A list of actions to be performed upon successful sending of a message.") |
| 74 | |
| 75 | (defvar mail-default-headers nil |
| 76 | "*A string containing header lines, to be inserted in outgoing messages. |
| 77 | It is inserted before you edit the message, |
| 78 | so you can edit or delete these lines.") |
| 79 | |
| 80 | (defvar mail-mode-syntax-table nil |
| 81 | "Syntax table used while in mail mode.") |
| 82 | |
| 83 | (if (null mail-mode-syntax-table) |
| 84 | (progn |
| 85 | (setq mail-mode-syntax-table (copy-syntax-table text-mode-syntax-table)) |
| 86 | (modify-syntax-entry ?% ". " mail-mode-syntax-table))) |
| 87 | |
| 88 | (defun mail-setup (to subject in-reply-to cc replybuffer actions) |
| 89 | (setq mail-send-actions actions) |
| 90 | (mail-aliases-setup) |
| 91 | (setq mail-reply-buffer replybuffer) |
| 92 | (goto-char (point-min)) |
| 93 | (insert "To: ") |
| 94 | (save-excursion |
| 95 | (if to |
| 96 | (progn |
| 97 | (insert to "\n") |
| 98 | ;;; Here removed code to extract names from within <...> |
| 99 | ;;; on the assumption that mail-strip-quoted-names |
| 100 | ;;; has been called and has done so. |
| 101 | (let ((fill-prefix "\t")) |
| 102 | (fill-region (point-min) (point-max)))) |
| 103 | (newline)) |
| 104 | (if cc |
| 105 | (let ((opos (point)) |
| 106 | (fill-prefix "\t")) |
| 107 | (insert "CC: " cc "\n") |
| 108 | (fill-region-as-paragraph opos (point-max)))) |
| 109 | (if in-reply-to |
| 110 | (insert "In-reply-to: " in-reply-to "\n")) |
| 111 | (insert "Subject: " (or subject "") "\n") |
| 112 | (if mail-default-headers |
| 113 | (insert mail-default-headers)) |
| 114 | (if mail-default-reply-to |
| 115 | (insert "Reply-to: " mail-default-reply-to "\n")) |
| 116 | (if mail-self-blind |
| 117 | (insert "BCC: " (user-login-name) "\n")) |
| 118 | (if mail-archive-file-name |
| 119 | (insert "FCC: " mail-archive-file-name "\n")) |
| 120 | (insert mail-header-separator "\n") |
| 121 | ;; Read the .signature file if we haven't already done so |
| 122 | ;; (and if the user has not overridden it). |
| 123 | (cond ((eq mail-signature t) |
| 124 | (insert "--\n") |
| 125 | (insert-file-contents "~/.signature")) |
| 126 | (mail-signature |
| 127 | (insert mail-signature))) |
| 128 | (goto-char (point-max)) |
| 129 | (or (bolp) (newline))) |
| 130 | (if to (goto-char (point-max))) |
| 131 | (or to subject in-reply-to |
| 132 | (set-buffer-modified-p nil)) |
| 133 | (run-hooks 'mail-setup-hook)) |
| 134 | |
| 135 | ;;;###autoload |
| 136 | (defun mail-mode () |
| 137 | "Major mode for editing mail to be sent. |
| 138 | Like Text Mode but with these additional commands: |
| 139 | C-c C-s mail-send (send the message) C-c C-c mail-send-and-exit |
| 140 | C-c C-f move to a header field (and create it if there isn't): |
| 141 | C-c C-f C-t move to To: C-c C-f C-s move to Subj: |
| 142 | C-c C-f C-b move to BCC: C-c C-f C-c move to CC: |
| 143 | C-c C-t move to message text. |
| 144 | C-c C-y mail-yank-original (insert current message, in Rmail). |
| 145 | C-c C-q mail-fill-yanked-message (fill what was yanked). |
| 146 | C-c C-v mail-sent-via (add a sent-via field for each To or CC)." |
| 147 | (interactive) |
| 148 | (kill-all-local-variables) |
| 149 | (make-local-variable 'mail-reply-buffer) |
| 150 | (setq mail-reply-buffer nil) |
| 151 | (make-local-variable 'mail-send-actions) |
| 152 | (set-syntax-table mail-mode-syntax-table) |
| 153 | (use-local-map mail-mode-map) |
| 154 | (setq local-abbrev-table text-mode-abbrev-table) |
| 155 | (setq major-mode 'mail-mode) |
| 156 | (setq mode-name "Mail") |
| 157 | (setq buffer-offer-save t) |
| 158 | (make-local-variable 'paragraph-separate) |
| 159 | (make-local-variable 'paragraph-start) |
| 160 | (setq paragraph-start (concat "^" mail-header-separator |
| 161 | "$\\|^[ \t]*[-_][-_][-_]+$\\|" |
| 162 | paragraph-start)) |
| 163 | (setq paragraph-separate (concat "^" mail-header-separator |
| 164 | "$\\|^[ \t]*[-_][-_][-_]+$\\|" |
| 165 | paragraph-separate)) |
| 166 | (run-hooks 'text-mode-hook 'mail-mode-hook)) |
| 167 | |
| 168 | (if mail-mode-map |
| 169 | nil |
| 170 | (setq mail-mode-map (nconc (make-sparse-keymap) text-mode-map)) |
| 171 | (define-key mail-mode-map "\C-c?" 'describe-mode) |
| 172 | (define-key mail-mode-map "\C-c\C-f\C-t" 'mail-to) |
| 173 | (define-key mail-mode-map "\C-c\C-f\C-b" 'mail-bcc) |
| 174 | (define-key mail-mode-map "\C-c\C-f\C-f" 'mail-fcc) |
| 175 | (define-key mail-mode-map "\C-c\C-f\C-c" 'mail-cc) |
| 176 | (define-key mail-mode-map "\C-c\C-f\C-s" 'mail-subject) |
| 177 | (define-key mail-mode-map "\C-c\C-t" 'mail-text) |
| 178 | (define-key mail-mode-map "\C-c\C-y" 'mail-yank-original) |
| 179 | (define-key mail-mode-map "\C-c\C-q" 'mail-fill-yanked-message) |
| 180 | (define-key mail-mode-map "\C-c\C-w" 'mail-signature) |
| 181 | (define-key mail-mode-map "\C-c\C-v" 'mail-sent-via) |
| 182 | (define-key mail-mode-map "\C-c\C-c" 'mail-send-and-exit) |
| 183 | (define-key mail-mode-map "\C-c\C-s" 'mail-send)) |
| 184 | \f |
| 185 | (defun mail-send-and-exit (arg) |
| 186 | "Send message like mail-send, then, if no errors, exit from mail buffer. |
| 187 | Prefix arg means don't delete this window." |
| 188 | (interactive "P") |
| 189 | (mail-send) |
| 190 | (bury-buffer (current-buffer)) |
| 191 | (if (or (one-window-p) arg) |
| 192 | (switch-to-buffer (other-buffer (current-buffer))) |
| 193 | (delete-window))) |
| 194 | |
| 195 | (defun mail-send () |
| 196 | "Send the message in the current buffer. |
| 197 | If `mail-interactive' is non-nil, wait for success indication |
| 198 | or error messages, and inform user. |
| 199 | Otherwise any failure is reported in a message back to |
| 200 | the user from the mailer." |
| 201 | (interactive) |
| 202 | (if (or (buffer-modified-p) |
| 203 | (y-or-n-p "Message already sent; resend? ")) |
| 204 | (progn |
| 205 | (message "Sending...") |
| 206 | (run-hooks 'mail-send-hook) |
| 207 | (funcall send-mail-function) |
| 208 | ;; Now perform actions on successful sending. |
| 209 | (while mail-send-actions |
| 210 | (condition-case nil |
| 211 | (apply (car (car mail-send-actions)) (cdr (car mail-send-actions))) |
| 212 | (error)) |
| 213 | (setq mail-send-actions (cdr mail-send-actions))) |
| 214 | (set-buffer-modified-p nil) |
| 215 | (delete-auto-save-file-if-necessary t) |
| 216 | (message "Sending...done")))) |
| 217 | |
| 218 | (defun sendmail-send-it () |
| 219 | (let ((errbuf (if mail-interactive |
| 220 | (generate-new-buffer " sendmail errors") |
| 221 | 0)) |
| 222 | (tembuf (generate-new-buffer " sendmail temp")) |
| 223 | (case-fold-search nil) |
| 224 | delimline |
| 225 | (mailbuf (current-buffer))) |
| 226 | (unwind-protect |
| 227 | (save-excursion |
| 228 | (set-buffer tembuf) |
| 229 | (erase-buffer) |
| 230 | (insert-buffer-substring mailbuf) |
| 231 | (goto-char (point-max)) |
| 232 | ;; require one newline at the end. |
| 233 | (or (= (preceding-char) ?\n) |
| 234 | (insert ?\n)) |
| 235 | ;; Change header-delimiter to be what sendmail expects. |
| 236 | (goto-char (point-min)) |
| 237 | (re-search-forward |
| 238 | (concat "^" (regexp-quote mail-header-separator) "\n")) |
| 239 | (replace-match "\n") |
| 240 | (backward-char 1) |
| 241 | (setq delimline (point-marker)) |
| 242 | (goto-char (point-min)) |
| 243 | ;; ignore any blank lines in the header |
| 244 | (while (and (re-search-forward "\n\n\n*" delimline t) |
| 245 | (< (point) delimline)) |
| 246 | (replace-match "\n")) |
| 247 | (let ((case-fold-search t)) |
| 248 | (goto-char (point-min)) |
| 249 | (if (re-search-forward "^Sender:" delimline t) |
| 250 | (error "Sender may not be specified.")) |
| 251 | ;; Find and handle any FCC fields. |
| 252 | (goto-char (point-min)) |
| 253 | (if (re-search-forward "^FCC:" delimline t) |
| 254 | (mail-do-fcc delimline)) |
| 255 | ;; If the From is different than current user, insert Sender. |
| 256 | (goto-char (point-min)) |
| 257 | (and (re-search-forward "^From:" delimline t) |
| 258 | (progn |
| 259 | (require 'mail-utils) |
| 260 | (not (string-equal |
| 261 | (mail-strip-quoted-names |
| 262 | (save-restriction |
| 263 | (narrow-to-region (point-min) delimline) |
| 264 | (mail-fetch-field "From"))) |
| 265 | (user-login-name)))) |
| 266 | (progn |
| 267 | (forward-line 1) |
| 268 | (insert "Sender: " (user-login-name) "\n"))) |
| 269 | ;; "S:" is an abbreviation for "Subject:". |
| 270 | (goto-char (point-min)) |
| 271 | (if (re-search-forward "^S:" delimline t) |
| 272 | (replace-match "Subject:")) |
| 273 | ;; Don't send out a blank subject line |
| 274 | (goto-char (point-min)) |
| 275 | (if (re-search-forward "^Subject:[ \t]*\n" delimline t) |
| 276 | (replace-match "")) |
| 277 | (if mail-interactive |
| 278 | (save-excursion |
| 279 | (set-buffer errbuf) |
| 280 | (erase-buffer)))) |
| 281 | (apply 'call-process-region |
| 282 | (append (list (point-min) (point-max) |
| 283 | (if (boundp 'sendmail-program) |
| 284 | sendmail-program |
| 285 | "/usr/lib/sendmail") |
| 286 | nil errbuf nil |
| 287 | "-oi" "-t") |
| 288 | ;; Always specify who from, |
| 289 | ;; since some systems have broken sendmails. |
| 290 | (list "-f" (user-login-name)) |
| 291 | ;;; ;; Don't say "from root" if running under su. |
| 292 | ;;; (and (equal (user-real-login-name) "root") |
| 293 | ;;; (list "-f" (user-login-name))) |
| 294 | (and mail-alias-file |
| 295 | (list (concat "-oA" mail-alias-file))) |
| 296 | ;; These mean "report errors by mail" |
| 297 | ;; and "deliver in background". |
| 298 | (if (null mail-interactive) '("-oem" "-odb")))) |
| 299 | (if mail-interactive |
| 300 | (save-excursion |
| 301 | (set-buffer errbuf) |
| 302 | (goto-char (point-min)) |
| 303 | (while (re-search-forward "\n\n* *" nil t) |
| 304 | (replace-match "; ")) |
| 305 | (if (not (zerop (buffer-size))) |
| 306 | (error "Sending...failed to %s" |
| 307 | (buffer-substring (point-min) (point-max))))))) |
| 308 | (kill-buffer tembuf) |
| 309 | (if (bufferp errbuf) |
| 310 | (kill-buffer errbuf))))) |
| 311 | |
| 312 | (defun mail-do-fcc (header-end) |
| 313 | (let (fcc-list |
| 314 | (rmailbuf (current-buffer)) |
| 315 | (tembuf (generate-new-buffer " rmail output")) |
| 316 | (case-fold-search t)) |
| 317 | (save-excursion |
| 318 | (goto-char (point-min)) |
| 319 | (while (re-search-forward "^FCC:[ \t]*" header-end t) |
| 320 | (setq fcc-list (cons (buffer-substring (point) |
| 321 | (progn |
| 322 | (end-of-line) |
| 323 | (skip-chars-backward " \t") |
| 324 | (point))) |
| 325 | fcc-list)) |
| 326 | (delete-region (match-beginning 0) |
| 327 | (progn (forward-line 1) (point)))) |
| 328 | (set-buffer tembuf) |
| 329 | (erase-buffer) |
| 330 | (insert "\nFrom " (user-login-name) " " |
| 331 | (current-time-string) "\n") |
| 332 | (insert-buffer-substring rmailbuf) |
| 333 | ;; Make sure messages are separated. |
| 334 | (goto-char (point-max)) |
| 335 | (insert ?\n) |
| 336 | (goto-char 2) |
| 337 | ;; ``Quote'' "^From " as ">From " |
| 338 | ;; (note that this isn't really quoting, as there is no requirement |
| 339 | ;; that "^[>]+From " be quoted in the same transparent way.) |
| 340 | (let ((case-fold-search nil)) |
| 341 | (while (search-forward "\nFrom " nil t) |
| 342 | (forward-char -5) |
| 343 | (insert ?>))) |
| 344 | (while fcc-list |
| 345 | (let ((buffer (get-file-buffer (car fcc-list)))) |
| 346 | (if buffer |
| 347 | ;; File is present in a buffer => append to that buffer. |
| 348 | (let ((curbuf (current-buffer)) |
| 349 | (beg (point-min)) (end (point-max))) |
| 350 | (save-excursion |
| 351 | (set-buffer buffer) |
| 352 | ;; Keep the end of the accessible portion at the same place |
| 353 | ;; unless it is the end of the buffer. |
| 354 | (let ((max (if (/= (1+ (buffer-size)) (point-max)) |
| 355 | (point-max)))) |
| 356 | (unwind-protect |
| 357 | (progn |
| 358 | (narrow-to-region (point-min) (1+ (buffer-size))) |
| 359 | (goto-char (point-max)) |
| 360 | (if (eq major-mode 'rmail-mode) |
| 361 | ;; Append as a message to an RMAIL file |
| 362 | (let ((buffer-read-only nil)) |
| 363 | ;; This forces RMAIL's message counters to be |
| 364 | ;; recomputed when the next RMAIL operation is |
| 365 | ;; done on the buffer. |
| 366 | ;; See rmail-maybe-set-message-counters. |
| 367 | (setq rmail-total-messages nil) |
| 368 | (insert "\C-l\n0, unseen,,\n*** EOOH ***\n" |
| 369 | "From: " (user-login-name) "\n" |
| 370 | "Date: " (current-time-string) "\n") |
| 371 | (insert-buffer-substring curbuf beg end) |
| 372 | (insert "\n\C-_")) |
| 373 | (insert-buffer-substring curbuf beg end))) |
| 374 | (if max (narrow-to-region (point-min) max)))))) |
| 375 | ;; Else append to the file directly. |
| 376 | (write-region |
| 377 | ;; Include a blank line before if file already exists. |
| 378 | (if (file-exists-p (car fcc-list)) (point-min) (1+ (point-min))) |
| 379 | (point-max) (car fcc-list) t))) |
| 380 | (setq fcc-list (cdr fcc-list)))) |
| 381 | (kill-buffer tembuf))) |
| 382 | |
| 383 | (defun mail-sent-via () |
| 384 | "Make a Sent-via header line from each To or CC header line." |
| 385 | (interactive) |
| 386 | (save-excursion |
| 387 | (goto-char (point-min)) |
| 388 | ;; find the header-separator |
| 389 | (search-forward (concat "\n" mail-header-separator "\n")) |
| 390 | (forward-line -1) |
| 391 | ;; put a marker at the end of the header |
| 392 | (let ((end (point-marker)) |
| 393 | (case-fold-search t) |
| 394 | to-line) |
| 395 | (goto-char (point-min)) |
| 396 | ;; search for the To: lines and make Sent-via: lines from them |
| 397 | ;; search for the next To: line |
| 398 | (while (re-search-forward "^\\(to\\|cc\\):" end t) |
| 399 | ;; Grab this line plus all its continuations, sans the `to:'. |
| 400 | (let ((to-line |
| 401 | (buffer-substring (point) |
| 402 | (progn |
| 403 | (if (re-search-forward "^[^ \t\n]" end t) |
| 404 | (backward-char 1) |
| 405 | (goto-char end)) |
| 406 | (point))))) |
| 407 | ;; Insert a copy, with altered header field name. |
| 408 | (insert-before-markers "Sent-via:" to-line)))))) |
| 409 | \f |
| 410 | (defun mail-to () |
| 411 | "Move point to end of To-field." |
| 412 | (interactive) |
| 413 | (expand-abbrev) |
| 414 | (mail-position-on-field "To")) |
| 415 | |
| 416 | (defun mail-subject () |
| 417 | "Move point to end of Subject-field." |
| 418 | (interactive) |
| 419 | (expand-abbrev) |
| 420 | (mail-position-on-field "Subject")) |
| 421 | |
| 422 | (defun mail-cc () |
| 423 | "Move point to end of CC-field. Create a CC field if none." |
| 424 | (interactive) |
| 425 | (expand-abbrev) |
| 426 | (or (mail-position-on-field "cc" t) |
| 427 | (progn (mail-position-on-field "to") |
| 428 | (insert "\nCC: ")))) |
| 429 | |
| 430 | (defun mail-bcc () |
| 431 | "Move point to end of BCC-field. Create a BCC field if none." |
| 432 | (interactive) |
| 433 | (expand-abbrev) |
| 434 | (or (mail-position-on-field "bcc" t) |
| 435 | (progn (mail-position-on-field "to") |
| 436 | (insert "\nBCC: ")))) |
| 437 | |
| 438 | (defun mail-fcc () |
| 439 | "Add a new FCC field, with file name completion." |
| 440 | (interactive) |
| 441 | (expand-abbrev) |
| 442 | (or (mail-position-on-field "fcc" t) ;Put new field after exiting FCC. |
| 443 | (mail-position-on-field "to")) |
| 444 | (insert "\nFCC: " (read-file-name "Folder carbon copy: "))) |
| 445 | |
| 446 | (defun mail-position-on-field (field &optional soft) |
| 447 | (let (end |
| 448 | (case-fold-search t)) |
| 449 | (goto-char (point-min)) |
| 450 | (re-search-forward (concat "^" (regexp-quote mail-header-separator) "\n")) |
| 451 | (setq end (match-beginning 0)) |
| 452 | (goto-char (point-min)) |
| 453 | (if (re-search-forward (concat "^" (regexp-quote field) ":") end t) |
| 454 | (progn |
| 455 | (re-search-forward "^[^ \t]" nil 'move) |
| 456 | (beginning-of-line) |
| 457 | (skip-chars-backward "\n") |
| 458 | t) |
| 459 | (or soft |
| 460 | (progn (goto-char end) |
| 461 | (skip-chars-backward "\n") |
| 462 | (insert field ": \n") |
| 463 | (skip-chars-backward "\n"))) |
| 464 | nil))) |
| 465 | |
| 466 | (defun mail-text () |
| 467 | "Move point to beginning of text field." |
| 468 | (interactive) |
| 469 | (goto-char (point-min)) |
| 470 | (search-forward (concat "\n" mail-header-separator "\n"))) |
| 471 | \f |
| 472 | (defun mail-signature () |
| 473 | "Sign letter with contents of ~/.signature file." |
| 474 | (interactive) |
| 475 | (save-excursion |
| 476 | (goto-char (point-max)) |
| 477 | (skip-chars-backward " \t\n") |
| 478 | (end-of-line) |
| 479 | (delete-region (point) (point-max)) |
| 480 | (insert "\n\n--\n") |
| 481 | (insert-file-contents (expand-file-name "~/.signature")))) |
| 482 | |
| 483 | (defun mail-fill-yanked-message (&optional justifyp) |
| 484 | "Fill the paragraphs of a message yanked into this one. |
| 485 | Numeric argument means justify as well." |
| 486 | (interactive "P") |
| 487 | (save-excursion |
| 488 | (goto-char (point-min)) |
| 489 | (search-forward (concat "\n" mail-header-separator "\n") nil t) |
| 490 | (fill-individual-paragraphs (point) |
| 491 | (point-max) |
| 492 | justifyp |
| 493 | t))) |
| 494 | |
| 495 | (defun mail-yank-original (arg) |
| 496 | "Insert the message being replied to, if any (in rmail). |
| 497 | Puts point before the text and mark after. |
| 498 | Normally, indents each nonblank line ARG spaces (default 3). |
| 499 | However, if `mail-yank-prefix' is non-nil, insert that prefix on each line. |
| 500 | |
| 501 | Just \\[universal-argument] as argument means don't indent, insert no prefix, |
| 502 | and don't delete any header fields." |
| 503 | (interactive "P") |
| 504 | (if mail-reply-buffer |
| 505 | (let ((start (point))) |
| 506 | (delete-windows-on mail-reply-buffer) |
| 507 | (insert-buffer mail-reply-buffer) |
| 508 | (if (consp arg) |
| 509 | nil |
| 510 | (mail-yank-clear-headers start (mark)) |
| 511 | (if (null mail-yank-prefix) |
| 512 | (indent-rigidly start (mark) |
| 513 | (if arg (prefix-numeric-value arg) 3)) |
| 514 | (save-excursion |
| 515 | (goto-char start) |
| 516 | (while (< (point) (mark)) |
| 517 | (insert mail-yank-prefix) |
| 518 | (forward-line 1))))) |
| 519 | (exchange-point-and-mark) |
| 520 | (if (not (eolp)) (insert ?\n))))) |
| 521 | |
| 522 | (defun mail-yank-clear-headers (start end) |
| 523 | (save-excursion |
| 524 | (goto-char start) |
| 525 | (if (search-forward "\n\n" end t) |
| 526 | (save-restriction |
| 527 | (narrow-to-region start (point)) |
| 528 | (goto-char start) |
| 529 | (while (let ((case-fold-search t)) |
| 530 | (re-search-forward mail-yank-ignored-headers nil t)) |
| 531 | (beginning-of-line) |
| 532 | (delete-region (point) |
| 533 | (progn (re-search-forward "\n[^ \t]") |
| 534 | (forward-char -1) |
| 535 | (point)))))))) |
| 536 | \f |
| 537 | ;; Put these last, to reduce chance of lossage from quitting in middle of loading the file. |
| 538 | |
| 539 | ;;;###autoload |
| 540 | (defun mail (&optional noerase to subject in-reply-to cc replybuffer actions) |
| 541 | "Edit a message to be sent. Argument means resume editing (don't erase). |
| 542 | Search for an existing mail buffer currently not in use and initialize it, |
| 543 | or make a new one if all existing mail buffers are busy. |
| 544 | With an argument, search for a busy existing mail buffer and re-select it. |
| 545 | |
| 546 | Returns with message buffer selected; value t if message freshly initialized. |
| 547 | By default, the signature file `~/.signature' is inserted at the end; |
| 548 | see the variable `mail-signature'. |
| 549 | |
| 550 | \\<mail-mode-map> |
| 551 | While editing message, type \\[mail-send-and-exit] to send the message and exit. |
| 552 | |
| 553 | Various special commands starting with C-c are available in sendmail mode |
| 554 | to move to message header fields: |
| 555 | \\{mail-mode-map} |
| 556 | |
| 557 | If `mail-self-blind' is non-nil, a BCC to yourself is inserted |
| 558 | when the message is initialized. |
| 559 | |
| 560 | If `mail-default-reply-to' is non-nil, it should be an address (a string); |
| 561 | a Reply-to: field with that address is inserted. |
| 562 | |
| 563 | If `mail-archive-file-name' is non-nil, an FCC field with that file name |
| 564 | is inserted. |
| 565 | |
| 566 | If `mail-setup-hook' is bound, its value is called with no arguments |
| 567 | after the message is initialized. It can add more default fields. |
| 568 | |
| 569 | When calling from a program, the second through fifth arguments |
| 570 | TO, SUBJECT, IN-REPLY-TO and CC specify if non-nil |
| 571 | the initial contents of those header fields. |
| 572 | These arguments should not have final newlines. |
| 573 | The sixth argument REPLYBUFFER is a buffer whose contents |
| 574 | should be yanked if the user types C-c C-y. |
| 575 | The seventh argument ACTIONS is a list of actions to take |
| 576 | if/when the message is sent. Each action looks like (FUNCTION . ARGS); |
| 577 | when the message is sent, we apply FUNCTION to ARGS. |
| 578 | This is how Rmail arranges to mark messages `answered'." |
| 579 | (interactive "P") |
| 580 | (let ((index 1) |
| 581 | buffer) |
| 582 | ;; If requested, look for a mail buffer that is modified and go to it. |
| 583 | (if noerase |
| 584 | (progn |
| 585 | (while (and (setq buffer |
| 586 | (get-buffer (if (= 1 index) "*mail*" |
| 587 | (format "*mail*<%d>" index)))) |
| 588 | (not (buffer-modified-p buffer))) |
| 589 | (setq index (1+ index))) |
| 590 | (if buffer (switch-to-buffer buffer) |
| 591 | ;; If none exists, start a new message. |
| 592 | ;; This will never re-use an existing unmodified mail buffer |
| 593 | ;; (since index is not 1 anymore). Perhaps it should. |
| 594 | (setq noerase nil)))) |
| 595 | ;; Unless we found a modified message and are happy, start a new message. |
| 596 | (if (not noerase) |
| 597 | (progn |
| 598 | ;; Look for existing unmodified mail buffer. |
| 599 | (while (and (setq buffer |
| 600 | (get-buffer (if (= 1 index) "*mail*" |
| 601 | (format "*mail*<%d>" index)))) |
| 602 | (buffer-modified-p buffer)) |
| 603 | (setq index (1+ index))) |
| 604 | ;; If none, make a new one. |
| 605 | (or buffer |
| 606 | (setq buffer (generate-new-buffer "*mail*"))) |
| 607 | ;; Go there and initialize it. |
| 608 | (switch-to-buffer buffer) |
| 609 | (erase-buffer) |
| 610 | (setq default-directory (expand-file-name "~/")) |
| 611 | (auto-save-mode auto-save-default) |
| 612 | (mail-mode) |
| 613 | (mail-setup to subject in-reply-to cc replybuffer actions) |
| 614 | (if (and buffer-auto-save-file-name |
| 615 | (file-exists-p buffer-auto-save-file-name)) |
| 616 | (message "Auto save file for draft message exists; consider M-x mail-recover")) |
| 617 | t)))) |
| 618 | |
| 619 | ;;;###autoload |
| 620 | (define-key ctl-x-map "m" 'mail) |
| 621 | |
| 622 | (defun mail-recover () |
| 623 | "Reread contents of current buffer from its last auto-save file." |
| 624 | (interactive) |
| 625 | (let ((file-name (make-auto-save-file-name))) |
| 626 | (cond ((save-window-excursion |
| 627 | (if (not (eq system-type 'vax-vms)) |
| 628 | (with-output-to-temp-buffer "*Directory*" |
| 629 | (buffer-disable-undo standard-output) |
| 630 | (call-process "ls" nil standard-output nil "-l" file-name))) |
| 631 | (yes-or-no-p (format "Recover auto save file %s? " file-name))) |
| 632 | (let ((buffer-read-only nil)) |
| 633 | (erase-buffer) |
| 634 | (insert-file-contents file-name nil))) |
| 635 | (t (error "mail-recover cancelled."))))) |
| 636 | |
| 637 | ;;;###autoload |
| 638 | (defun mail-other-window (&optional noerase to subject in-reply-to cc replybuffer sendactions) |
| 639 | "Like `mail' command, but display mail buffer in another window." |
| 640 | (interactive "P") |
| 641 | (let ((pop-up-windows t)) |
| 642 | (pop-to-buffer "*mail*")) |
| 643 | (mail noerase to subject in-reply-to cc replybuffer sendactions)) |
| 644 | |
| 645 | ;;;###autoload |
| 646 | (defun mail-other-screen (&optional noerase to subject in-reply-to cc replybuffer sendactions) |
| 647 | "Like `mail' command, but display mail buffer in another screen." |
| 648 | (interactive "P") |
| 649 | (let ((pop-up-screens t)) |
| 650 | (pop-to-buffer "*mail*")) |
| 651 | (mail noerase to subject in-reply-to cc replybuffer sendactions)) |
| 652 | |
| 653 | |
| 654 | ;;;###autoload |
| 655 | (define-key ctl-x-4-map "m" 'mail-other-window) |
| 656 | |
| 657 | ;;;###autoload |
| 658 | (define-key ctl-x-3-map "m" 'mail-other-screen) |
| 659 | |
| 660 | |
| 661 | ;;; Do not add anything but external entries on this page. |
| 662 | |
| 663 | (provide 'sendmail) |
| 664 | |