![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to sendmail.el CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Apple XNU] / GNUtools / emacs / lisp|
Return to sendmail.el CVS log | Up to [Apple XNU] / GNUtools / emacs / lisp |
1.1 ! root 1: ;; Mail sending commands for Emacs. ! 2: ;; Copyright (C) 1985, 1986 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: (provide 'sendmail) ! 22: ! 23: ;(defconst mail-self-blind nil ! 24: ; "Non-nil means insert BCC to self in messages to be sent. ! 25: ;This is done when the message is initialized, ! 26: ;so you can remove or alter the BCC field to override the default.") ! 27: ! 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: ;(defconst mail-yank-ignored-headers ! 33: ; "^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: ;(defvar send-mail-function 'sendmail-send-it ! 36: ; "Function to call to send the current buffer as mail. ! 37: ;The headers are be delimited by a line which is mail-header-separator"") ! 38: ! 39: ; really defined in loaddefs for emacs 17.17+ ! 40: ;(defvar mail-header-separator "--text follows this line--" ! 41: ; "*Line used to separate headers from text in messages being composed.") ! 42: ; really defined in loaddefs for emacs 17.17+ ! 43: ;(defvar mail-archive-file-name nil ! 44: ; "*Name of file to write all outgoing messages in, or nil for none.") ! 45: ; really defined in loaddefs for emacs 17.17+ ! 46: (defvar mail-aliases t ! 47: "Alias of mail address aliases, ! 48: or t meaning should be initialized from .mailrc.") ! 49: ! 50: (defvar mail-default-reply-to nil ! 51: "*Address to insert as default Reply-to field of outgoing messages.") ! 52: ! 53: (defvar mail-abbrevs-loaded nil) ! 54: (defvar mail-mode-map nil) ! 55: ! 56: (autoload 'build-mail-aliases "mailalias" ! 57: "Read mail aliases from ~/.mailrc and set mail-aliases." ! 58: nil) ! 59: ! 60: (autoload 'expand-mail-aliases "mailalias" ! 61: "Expand all mail aliases in suitable header fields found between BEG and END. ! 62: Suitable header fields are To, CC and BCC." ! 63: nil) ! 64: ! 65: (defun mail-setup (to subject in-reply-to cc replybuffer) ! 66: (if (eq mail-aliases t) ! 67: (progn ! 68: (setq mail-aliases nil) ! 69: (if (file-exists-p "~/.mailrc") ! 70: (build-mail-aliases)))) ! 71: (setq mail-reply-buffer replybuffer) ! 72: (goto-char (point-min)) ! 73: (insert "To: ") ! 74: (save-excursion ! 75: (if to ! 76: (progn ! 77: (insert to "\n") ! 78: ;;; Here removed code to extract names from within <...> ! 79: ;;; on the assumption that mail-strip-quoted-names ! 80: ;;; has been called and has done so. ! 81: (let ((fill-prefix "\t")) ! 82: (fill-region (point-min) (point-max)))) ! 83: (newline)) ! 84: (if cc ! 85: (let ((opos (point)) ! 86: (fill-prefix "\t")) ! 87: (insert "CC: " cc "\n") ! 88: (fill-region-as-paragraph opos (point-max)))) ! 89: (if in-reply-to ! 90: (insert "In-reply-to: " in-reply-to "\n")) ! 91: (insert "Subject: " (or subject "") "\n") ! 92: (if mail-default-reply-to ! 93: (insert "Reply-to: " mail-default-reply-to "\n")) ! 94: (if mail-self-blind ! 95: (insert "BCC: " (user-login-name) "\n")) ! 96: (if mail-archive-file-name ! 97: (insert "FCC: " mail-archive-file-name "\n")) ! 98: (insert mail-header-separator "\n")) ! 99: (if to (goto-char (point-max))) ! 100: (or to subject in-reply-to ! 101: (set-buffer-modified-p nil)) ! 102: (run-hooks 'mail-setup-hook)) ! 103: ! 104: (defun mail-mode () ! 105: "Major mode for editing mail to be sent. ! 106: Separate names of recipients (in To: and Cc: fields) with commas. ! 107: Like Text Mode but with these additional commands: ! 108: C-c C-s mail-send (send the message) C-c C-c mail-send-and-exit ! 109: C-c C-f move to a header field (and create it if there isn't): ! 110: C-c C-f C-t move to To: C-c C-f C-s move to Subj: ! 111: C-c C-f C-b move to BCC: C-c C-f C-c move to CC: ! 112: C-c C-w mail-signature (insert ~/.signature at end). ! 113: C-c C-y mail-yank-original (insert current message, in Rmail). ! 114: C-c C-q mail-fill-yanked-message (fill what was yanked)." ! 115: (interactive) ! 116: (kill-all-local-variables) ! 117: (make-local-variable 'mail-reply-buffer) ! 118: (setq mail-reply-buffer nil) ! 119: (set-syntax-table text-mode-syntax-table) ! 120: (use-local-map mail-mode-map) ! 121: (setq local-abbrev-table text-mode-abbrev-table) ! 122: (setq major-mode 'mail-mode) ! 123: (setq mode-name "Mail") ! 124: (setq buffer-offer-save t) ! 125: (make-local-variable 'paragraph-separate) ! 126: (make-local-variable 'paragraph-start) ! 127: (setq paragraph-start (concat "^" mail-header-separator ! 128: "$\\|^[ \t]*[-_][-_][-_]+$\\|" ! 129: paragraph-start)) ! 130: (setq paragraph-separate (concat "^" mail-header-separator ! 131: "$\\|^[ \t]*[-_][-_][-_]+$\\|" ! 132: paragraph-separate)) ! 133: (run-hooks 'text-mode-hook 'mail-mode-hook)) ! 134: ! 135: (if mail-mode-map ! 136: nil ! 137: (setq mail-mode-map (make-sparse-keymap)) ! 138: (define-key mail-mode-map "\C-c?" 'describe-mode) ! 139: (define-key mail-mode-map "\C-c\C-f\C-t" 'mail-to) ! 140: (define-key mail-mode-map "\C-c\C-f\C-b" 'mail-bcc) ! 141: (define-key mail-mode-map "\C-c\C-f\C-c" 'mail-cc) ! 142: (define-key mail-mode-map "\C-c\C-f\C-s" 'mail-subject) ! 143: (define-key mail-mode-map "\C-c\C-w" 'mail-signature) ; who ! 144: (define-key mail-mode-map "\C-c\C-y" 'mail-yank-original) ! 145: (define-key mail-mode-map "\C-c\C-q" 'mail-fill-yanked-message) ! 146: (define-key mail-mode-map "\C-c\C-c" 'mail-send-and-exit) ! 147: (define-key mail-mode-map "\C-c\C-s" 'mail-send)) ! 148: ! 149: (defun mail-send-and-exit (arg) ! 150: "Send message like mail-send, then, if no errors, exit from mail buffer. ! 151: Prefix arg means don't delete this window." ! 152: (interactive "P") ! 153: (mail-send) ! 154: (bury-buffer (current-buffer)) ! 155: (if (and (not arg) ! 156: (not (one-window-p)) ! 157: (save-excursion ! 158: (set-buffer (window-buffer (next-window (selected-window) 'not))) ! 159: (eq major-mode 'rmail-mode))) ! 160: (delete-window) ! 161: (switch-to-buffer (other-buffer (current-buffer))))) ! 162: ! 163: (defun mail-send () ! 164: "Send the message in the current buffer. ! 165: If mail-interactive is non-nil, wait for success indication ! 166: or error messages, and inform user. ! 167: Otherwise any failure is reported in a message back to ! 168: the user from the mailer." ! 169: (interactive) ! 170: (message "Sending...") ! 171: (funcall send-mail-function) ! 172: (set-buffer-modified-p nil) ! 173: (delete-auto-save-file-if-necessary) ! 174: (message "Sending...done")) ! 175: ! 176: (defun sendmail-send-it () ! 177: (let ((errbuf (if mail-interactive ! 178: (generate-new-buffer " sendmail errors") ! 179: 0)) ! 180: (tembuf (generate-new-buffer " sendmail temp")) ! 181: (case-fold-search nil) ! 182: delimline ! 183: (mailbuf (current-buffer))) ! 184: (unwind-protect ! 185: (save-excursion ! 186: (set-buffer tembuf) ! 187: (setq buffer-undo-list t) ! 188: (erase-buffer) ! 189: (insert-buffer-substring mailbuf) ! 190: (goto-char (point-max)) ! 191: ;; require one newline at the end. ! 192: (or (= (preceding-char) ?\n) ! 193: (insert ?\n)) ! 194: ;; Change header-delimiter to be what sendmail expects. ! 195: (goto-char (point-min)) ! 196: (re-search-forward ! 197: (concat "^" (regexp-quote mail-header-separator) "\n")) ! 198: (replace-match "\n") ! 199: (backward-char 1) ! 200: (setq delimline (point-marker)) ! 201: (if mail-aliases ! 202: (expand-mail-aliases (point-min) delimline)) ! 203: (goto-char (point-min)) ! 204: ;; ignore any blank lines in the header ! 205: (while (and (re-search-forward "\n\n\n*" delimline t) ! 206: (< (point) delimline)) ! 207: (replace-match "\n")) ! 208: (let ((case-fold-search t)) ! 209: ;; Find and handle any FCC fields. ! 210: (goto-char (point-min)) ! 211: (if (re-search-forward "^FCC:" delimline t) ! 212: (mail-do-fcc delimline)) ! 213: ;; If there is a From and no Sender, put it a Sender. ! 214: (goto-char (point-min)) ! 215: (and (re-search-forward "^From:" delimline t) ! 216: (not (save-excursion ! 217: (goto-char (point-min)) ! 218: (re-search-forward "^Sender:" delimline t))) ! 219: (progn ! 220: (forward-line 1) ! 221: (insert "Sender: " (user-login-name) "\n"))) ! 222: ;; don't send out a blank subject line ! 223: (goto-char (point-min)) ! 224: (if (re-search-forward "^Subject:[ \t]*\n" delimline t) ! 225: (replace-match "")) ! 226: (if mail-interactive ! 227: (save-excursion ! 228: (set-buffer errbuf) ! 229: (erase-buffer)))) ! 230: (apply 'call-process-region ! 231: (append (list (point-min) (point-max) ! 232: (if (boundp 'sendmail-program) ! 233: sendmail-program ! 234: "/usr/lib/sendmail") ! 235: nil errbuf nil ! 236: "-oi" "-t") ! 237: ;; Always specify who from, ! 238: ;; since some systems have broken sendmails. ! 239: (list "-f" (user-login-name)) ! 240: ;;; ;; Don't say "from root" if running under su. ! 241: ;;; (and (equal (user-real-login-name) "root") ! 242: ;;; (list "-f" (user-login-name))) ! 243: ;; These mean "report errors by mail" ! 244: ;; and "deliver in background". ! 245: (if (null mail-interactive) '("-oem" "-odb")))) ! 246: (if mail-interactive ! 247: (save-excursion ! 248: (set-buffer errbuf) ! 249: (goto-char (point-min)) ! 250: (while (re-search-forward "\n\n* *" nil t) ! 251: (replace-match "; ")) ! 252: (if (not (zerop (buffer-size))) ! 253: (error "Sending...failed to %s" ! 254: (buffer-substring (point-min) (point-max))))))) ! 255: (kill-buffer tembuf) ! 256: (if (bufferp errbuf) ! 257: (kill-buffer errbuf))))) ! 258: ! 259: (defun mail-do-fcc (header-end) ! 260: (let (fcc-list ! 261: (rmailbuf (current-buffer)) ! 262: timezone ! 263: (tembuf (generate-new-buffer " rmail output")) ! 264: (case-fold-search t)) ! 265: (save-excursion ! 266: (goto-char (point-min)) ! 267: (while (re-search-forward "^FCC:[ \t]*" header-end t) ! 268: (setq fcc-list (cons (buffer-substring (point) ! 269: (progn ! 270: (end-of-line) ! 271: (skip-chars-backward " \t") ! 272: (point))) ! 273: fcc-list)) ! 274: (delete-region (match-beginning 0) ! 275: (progn (forward-line 1) (point)))) ! 276: (set-buffer tembuf) ! 277: (erase-buffer) ! 278: (call-process "date" nil t nil) ! 279: (goto-char (point-min)) ! 280: (re-search-forward ! 281: "[0-9] \\([A-Za-z][A-Za-z ]*[A-Za-z]\\)[0-9 ]*$") ! 282: (setq timezone (buffer-substring (match-beginning 1) (match-end 1))) ! 283: (erase-buffer) ! 284: (insert "\nFrom " (user-login-name) " " ! 285: (current-time-string) "\n") ! 286: ;; Insert the time zone before the year. ! 287: (forward-char -1) ! 288: (forward-word -1) ! 289: (insert timezone " ") ! 290: (goto-char (point-max)) ! 291: (insert-buffer-substring rmailbuf) ! 292: ;; Make sure messages are separated. ! 293: (goto-char (point-max)) ! 294: (insert ?\n) ! 295: (goto-char 2) ! 296: ;; ``Quote'' "^From " as ">From " ! 297: ;; (note that this isn't really quoting, as there is no requirement ! 298: ;; that "^[>]+From " be quoted in the same transparent way.) ! 299: (let ((case-fold-search nil)) ! 300: (while (search-forward "\nFrom " nil t) ! 301: (forward-char -5) ! 302: (insert ?>))) ! 303: (while fcc-list ! 304: (let ((buffer (get-file-buffer (car fcc-list)))) ! 305: (if buffer ! 306: ;; File is present in a buffer => append to that buffer. ! 307: (let ((curbuf (current-buffer)) ! 308: (beg (point-min)) (end (point-max))) ! 309: (save-excursion ! 310: (set-buffer buffer) ! 311: (goto-char (point-max)) ! 312: (insert-buffer-substring curbuf beg end))) ! 313: ;; Else append to the file directly. ! 314: (write-region (point-min) (point-max) (car fcc-list) t))) ! 315: (setq fcc-list (cdr fcc-list)))) ! 316: (kill-buffer tembuf))) ! 317: ! 318: (defun mail-to () ! 319: "Move point to end of To-field." ! 320: (interactive) ! 321: (expand-abbrev) ! 322: (mail-position-on-field "To")) ! 323: ! 324: (defun mail-subject () ! 325: "Move point to end of Subject-field." ! 326: (interactive) ! 327: (expand-abbrev) ! 328: (mail-position-on-field "Subject")) ! 329: ! 330: (defun mail-cc () ! 331: "Move point to end of CC-field. Create a CC field if none." ! 332: (interactive) ! 333: (expand-abbrev) ! 334: (or (mail-position-on-field "cc" t) ! 335: (progn (mail-position-on-field "to") ! 336: (insert "\nCC: ")))) ! 337: ! 338: (defun mail-bcc () ! 339: "Move point to end of BCC-field. Create a BCC field if none." ! 340: (interactive) ! 341: (expand-abbrev) ! 342: (or (mail-position-on-field "bcc" t) ! 343: (progn (mail-position-on-field "to") ! 344: (insert "\nBCC: ")))) ! 345: ! 346: (defun mail-position-on-field (field &optional soft) ! 347: (let (end ! 348: (case-fold-search t)) ! 349: (goto-char (point-min)) ! 350: (re-search-forward ! 351: (concat "^" (regexp-quote mail-header-separator) "\n")) ! 352: (setq end (match-beginning 0)) ! 353: (goto-char (point-min)) ! 354: (if (re-search-forward (concat "^" (regexp-quote field) ":") end t) ! 355: (progn ! 356: (re-search-forward "^[^ \t]" nil 'move) ! 357: (beginning-of-line) ! 358: (skip-chars-backward "\n") ! 359: t) ! 360: (or soft ! 361: (progn (goto-char end) ! 362: (insert field ": \n") ! 363: (skip-chars-backward "\n"))) ! 364: nil))) ! 365: ! 366: (defun mail-signature () ! 367: "Sign letter with contents of ~/.signature file." ! 368: (interactive) ! 369: (save-excursion ! 370: (goto-char (point-max)) ! 371: (insert-file-contents (expand-file-name "~/.signature")))) ! 372: ! 373: (defun mail-fill-yanked-message (&optional justifyp) ! 374: "Fill the paragraphs of a message yanked into this one. ! 375: Numeric argument means justify as well." ! 376: (interactive "P") ! 377: (save-excursion ! 378: (goto-char (point-min)) ! 379: (search-forward (concat "\n" mail-header-separator "\n") nil t) ! 380: (fill-individual-paragraphs (point) ! 381: (point-max) ! 382: justifyp ! 383: t))) ! 384: (defun mail-yank-original (arg) ! 385: "Insert the message being replied to, if any (in rmail). ! 386: Puts point before the text and mark after. ! 387: Indents each nonblank line ARG spaces (default 3). ! 388: Just \\[universal-argument] as argument means don't indent ! 389: and don't delete any header fields." ! 390: (interactive "P") ! 391: (if mail-reply-buffer ! 392: (let ((start (point))) ! 393: (delete-windows-on mail-reply-buffer) ! 394: (insert-buffer mail-reply-buffer) ! 395: (if (consp arg) ! 396: nil ! 397: (mail-yank-clear-headers start (mark)) ! 398: (indent-rigidly start (mark) ! 399: (if arg (prefix-numeric-value arg) 3))) ! 400: (exchange-point-and-mark) ! 401: (if (not (eolp)) (insert ?\n))))) ! 402: ! 403: (defun mail-yank-clear-headers (start end) ! 404: (save-excursion ! 405: (goto-char start) ! 406: (if (search-forward "\n\n" end t) ! 407: (save-restriction ! 408: (narrow-to-region start (point)) ! 409: (goto-char start) ! 410: (while (let ((case-fold-search t)) ! 411: (re-search-forward mail-yank-ignored-headers nil t)) ! 412: (beginning-of-line) ! 413: (delete-region (point) ! 414: (progn (re-search-forward "\n[^ \t]") ! 415: (forward-char -1) ! 416: (point)))))))) ! 417: ! 418: ;; Put these last, to reduce chance of lossage from quitting in middle of loading the file. ! 419: ! 420: (defun mail (&optional noerase to subject in-reply-to cc replybuffer) ! 421: "Edit a message to be sent. Argument means resume editing (don't erase). ! 422: Returns with message buffer selected; value t if message freshly initialized. ! 423: While editing message, type C-c C-c to send the message and exit. ! 424: ! 425: Separate names of recipients with commas. ! 426: ! 427: Various special commands starting with C-c are available in sendmail mode ! 428: to move to message header fields: ! 429: \\{mail-mode-map} ! 430: ! 431: If mail-self-blind is non-nil, a BCC to yourself is inserted ! 432: when the message is initialized. ! 433: ! 434: If mail-default-reply-to is non-nil, it should be an address (a string); ! 435: a Reply-to: field with that address is inserted. ! 436: ! 437: If mail-archive-file-name is non-nil, an FCC field with that file name ! 438: is inserted. ! 439: ! 440: If mail-setup-hook is bound, its value is run by means of run-hooks ! 441: after the message is initialized. It can add more default fields. ! 442: See the documentation of run-hooks. ! 443: ! 444: When calling from a program, the second through fifth arguments ! 445: TO, SUBJECT, IN-REPLY-TO and CC specify if non-nil ! 446: the initial contents of those header fields. ! 447: These arguments should not have final newlines. ! 448: The sixth argument REPLYBUFFER is a buffer whose contents ! 449: should be yanked if the user types C-c C-y." ! 450: (interactive "P") ! 451: (switch-to-buffer "*mail*") ! 452: (setq default-directory (expand-file-name "~/")) ! 453: (auto-save-mode auto-save-default) ! 454: (mail-mode) ! 455: (and (not noerase) ! 456: (or (not (buffer-modified-p)) ! 457: (y-or-n-p "Unsent message being composed; erase it? ")) ! 458: (progn (erase-buffer) ! 459: (mail-setup to subject in-reply-to cc replybuffer) ! 460: t))) ! 461: ! 462: (defun mail-other-window (&optional noerase to subject in-reply-to cc replybuffer) ! 463: "Like `mail' command, but display mail buffer in another window." ! 464: (interactive "P") ! 465: (let ((pop-up-windows t)) ! 466: (pop-to-buffer "*mail*")) ! 467: (mail noerase to subject in-reply-to cc replybuffer)) ! 468: ! 469: ;;; Do not add anything but external entries on this page.
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.