![[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 [CSRG BSD Unix] / 43BSD / contrib / emacs / lisp|
Return to sendmail.el CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / lisp |
1.1 ! root 1: ;; Mail sending commands for Emacs. ! 2: ;; Copyright (C) 1985 Richard M. Stallman. ! 3: ! 4: ;; This file is part of GNU Emacs. ! 5: ! 6: ;; GNU Emacs is distributed in the hope that it will be useful, ! 7: ;; but WITHOUT ANY WARRANTY. No author or distributor ! 8: ;; accepts responsibility to anyone for the consequences of using it ! 9: ;; or for whether it serves any particular purpose or works at all, ! 10: ;; unless he says so in writing. Refer to the GNU Emacs General Public ! 11: ;; License for full details. ! 12: ! 13: ;; Everyone is granted permission to copy, modify and redistribute ! 14: ;; GNU Emacs, but only under the conditions described in the ! 15: ;; GNU Emacs General Public License. A copy of this license is ! 16: ;; supposed to have been given to you along with GNU Emacs so you ! 17: ;; can know your rights and responsibilities. It should be in a ! 18: ;; file named COPYING. Among other things, the copyright notice ! 19: ;; and this notice must be preserved on all copies. ! 20: ! 21: ! 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: ;(defconst mail-interactive nil ! 28: ; "Non-nil means when sending a message wait for and display errors. ! 29: ;nil means let mailer mail back a message to report errors.") ! 30: ! 31: ;(defconst mail-yank-ignored-headers ! 32: ; "^via:\\|^mail-from:\\|^origin:\\|^status:\\|^remailed\\|^received:\\|^message-id:\\|^summary-line:\\|^to:\\|^subject:\\|^in-reply-to:\\|^return-path:" ! 33: ; "Delete these headers from old message when it's inserted in a reply.") ! 34: ;(defvar send-mail-function 'sendmail-send-it ! 35: ; "Function to call to send the current buffer as mail. ! 36: ;The headers are be delimited by a line which is mail-header-separator"") ! 37: ! 38: ; really defined in loaddefs for emacs 17.17+ ! 39: ;(defvar mail-header-separator "--text follows this line--" ! 40: ; "*Line used to separate headers from text in messages being composed.") ! 41: ; really defined in loaddefs for emacs 17.17+ ! 42: ;(defvar mail-archive-file-name nil ! 43: ; "*Name of file to write all outgoing messages in, or nil for none.") ! 44: ; really defined in loaddefs for emacs 17.17+ ! 45: (defvar mail-aliases t ! 46: "Alias of mail address aliases, ! 47: or t meaning should be initialized from .mailrc.") ! 48: ! 49: (defvar mail-abbrevs-loaded nil) ! 50: (defvar mail-mode-map nil) ! 51: ! 52: (autoload 'build-mail-aliases "mailalias" ! 53: "Read mail aliases from ~/.mailrc and set mail-aliases." ! 54: nil) ! 55: ! 56: (autoload 'expand-mail-aliases "mailalias" ! 57: "Expand all mail aliases in suitable header fields found between BEG and END. ! 58: Suitable header fields are To, CC and BCC." ! 59: nil) ! 60: ! 61: (defun mail-setup (to subject in-reply-to cc replybuffer) ! 62: (if (eq mail-aliases t) ! 63: (progn ! 64: (setq mail-aliases nil) ! 65: (if (file-exists-p "~/.mailrc") ! 66: (build-mail-aliases)))) ! 67: (setq mail-reply-buffer replybuffer) ! 68: (goto-char (point-min)) ! 69: (insert "To: ") ! 70: (save-excursion ! 71: (if to ! 72: (progn ! 73: (insert to "\n") ! 74: ;;; Here removed code to extract names from within <...> ! 75: ;;; on the assumption that mail-strip-quoted-names ! 76: ;;; has been called and has done so. ! 77: (let ((fill-prefix "\t")) ! 78: (fill-region (point-min) (point-max)))) ! 79: (newline)) ! 80: (if cc ! 81: (let ((opos (point)) ! 82: (fill-prefix "\t")) ! 83: (insert "CC: " cc "\n") ! 84: (fill-region-as-paragraph opos (point-max)))) ! 85: (if in-reply-to ! 86: (insert "In-reply-to: " in-reply-to "\n")) ! 87: (insert "Subject: " (or subject "") "\n") ! 88: (if mail-self-blind ! 89: (insert "BCC: " (user-login-name) "\n")) ! 90: (if mail-archive-file-name ! 91: (insert "FCC: " mail-archive-file-name "\n")) ! 92: (insert mail-header-separator "\n")) ! 93: (if to (goto-char (point-max))) ! 94: (or to subject in-reply-to ! 95: (set-buffer-modified-p nil)) ! 96: (run-hooks 'mail-setup-hook)) ! 97: ! 98: (defun mail-mode () ! 99: "Major mode for editing mail to be sent. ! 100: Like Text Mode but with these additional commands: ! 101: C-c C-s mail-send (send the message) C-c C-c mail-send-and-exit ! 102: C-c t mail-to (move to To: field) C-c s mail-subject (move to Subj:) ! 103: C-c b mail-bcc (move to BCC: field) C-c c mail-cc (move to CC: field) ! 104: C-c w mail-signature (insert ~/.signature at end). ! 105: C-c y mail-yank-original (insert current message, in Rmail). ! 106: C-c q mail-fill-yanked-message (fill what was yanked)." ! 107: (interactive) ! 108: (kill-all-local-variables) ! 109: (make-local-variable 'mail-reply-buffer) ! 110: (setq mail-reply-buffer nil) ! 111: (set-syntax-table text-mode-syntax-table) ! 112: (use-local-map mail-mode-map) ! 113: (setq local-abbrev-table text-mode-abbrev-table) ! 114: (setq major-mode 'mail-mode) ! 115: (setq mode-name "Mail") ! 116: (make-local-variable 'paragraph-separate) ! 117: (make-local-variable 'paragraph-start) ! 118: (setq paragraph-start (concat "^" mail-header-separator ! 119: "$\\|^[ \t]*[-_][-_][-_]+$\\|" ! 120: paragraph-start)) ! 121: (setq paragraph-separate (concat "^" mail-header-separator ! 122: "$\\|^[ \t]*[-_][-_][-_]+$\\|" ! 123: paragraph-separate)) ! 124: (run-hooks 'text-mode-hook 'mail-mode-hook)) ! 125: ! 126: (if mail-mode-map ! 127: nil ! 128: (setq mail-mode-map (make-sparse-keymap)) ! 129: (define-key mail-mode-map "\C-c?" 'describe-mode) ! 130: (define-key mail-mode-map "\C-ct" 'mail-to) ! 131: (define-key mail-mode-map "\C-cb" 'mail-bcc) ! 132: (define-key mail-mode-map "\C-cc" 'mail-cc) ! 133: (define-key mail-mode-map "\C-cs" 'mail-subject) ! 134: (define-key mail-mode-map "\C-cw" 'mail-signature) ; who ! 135: (define-key mail-mode-map "\C-cy" 'mail-yank-original) ! 136: (define-key mail-mode-map "\C-cq" 'mail-fill-yanked-message) ! 137: (define-key mail-mode-map "\C-c\C-c" 'mail-send-and-exit) ! 138: (define-key mail-mode-map "\C-c\C-s" 'mail-send)) ! 139: ! 140: (defun mail-send-and-exit () ! 141: "Send message like mail-send, then, if no errors, exit from mail buffer." ! 142: (interactive) ! 143: (mail-send) ! 144: (bury-buffer (current-buffer)) ! 145: (if (eq (next-window (selected-window)) (selected-window)) ! 146: (switch-to-buffer (other-buffer (current-buffer))) ! 147: (delete-window))) ! 148: ! 149: (defun mail-send () ! 150: "Send the message in the current buffer. ! 151: If mail-interactive is non-nil, wait for success indication ! 152: or error messages, and inform user. ! 153: Otherwise any failure is reported in a message back to ! 154: the user from the mailer." ! 155: (interactive) ! 156: (message "Sending...") ! 157: (funcall send-mail-function) ! 158: (set-buffer-modified-p nil) ! 159: (delete-auto-save-file-if-necessary) ! 160: (message "Sending...done")) ! 161: ! 162: (defun sendmail-send-it () ! 163: (let ((errbuf (if mail-interactive ! 164: (generate-new-buffer " sendmail errors") ! 165: 0)) ! 166: (tembuf (generate-new-buffer " sendmail temp")) ! 167: ;; This gets set back to t midway through. ! 168: (case-fold-search nil) ! 169: delimline ! 170: (mailbuf (current-buffer))) ! 171: (unwind-protect ! 172: (save-excursion ! 173: (set-buffer tembuf) ! 174: (erase-buffer) ! 175: (insert-buffer-substring mailbuf) ! 176: (goto-char (point-max)) ! 177: ;; require one newline at the end. ! 178: (or (= (preceding-char) ?\n) ! 179: (insert ?\n)) ! 180: ;; Change header-delimiter to be what sendmail expects. ! 181: (goto-char (point-min)) ! 182: (search-forward (concat "\n" mail-header-separator "\n")) ! 183: (replace-match "\n\n") ! 184: (backward-char 1) ! 185: (setq delimline (point-marker)) ! 186: (if mail-aliases ! 187: (expand-mail-aliases (point-min) delimline)) ! 188: (goto-char (point-min)) ! 189: ;; ignore any blank lines in the header ! 190: (while (and (re-search-forward "\n\n\n*" delimline t) ! 191: (< (point) delimline)) ! 192: (replace-match "\n")) ! 193: ;; Find and handle any FCC fields. ! 194: (goto-char (point-min)) ! 195: (setq case-fold-search t) ! 196: (if (re-search-forward "^FCC:" delimline t) ! 197: (mail-do-fcc delimline)) ! 198: ;; If there is a From and no Sender, put it a Sender. ! 199: (goto-char (point-min)) ! 200: (and (re-search-forward "^From:" delimline t) ! 201: (not (save-excursion (goto-char (dot-min)) ! 202: (re-search-forward "^Sender:" delimline t))) ! 203: (progn ! 204: (forward-line 1) ! 205: (insert "Sender: " (user-login-name) "\n"))) ! 206: ;; don't send out a blank subject line ! 207: (goto-char (point-min)) ! 208: (if (re-search-forward "^Subject:[ \t]*\n" delimline t) ! 209: (replace-match "")) ! 210: (if mail-interactive ! 211: (save-excursion ! 212: (set-buffer errbuf) ! 213: (erase-buffer))) ! 214: (apply 'call-process-region ! 215: (append (list (point-min) (point-max) ! 216: (if (boundp 'sendmail-program) ! 217: sendmail-program ! 218: "/usr/lib/sendmail") ! 219: nil errbuf nil ! 220: "-oi" "-t") ! 221: ;; Don't say "from root" if running under su. ! 222: (and (equal (user-real-login-name) "root") ! 223: (list "-f" (user-login-name))) ! 224: ;; These mean "report errors by mail" ! 225: ;; and "deliver in background". ! 226: (if (null mail-interactive) '("-oem" "-odb")))) ! 227: (if mail-interactive ! 228: (save-excursion ! 229: (set-buffer errbuf) ! 230: (goto-char (point-min)) ! 231: (while (re-search-forward "\n\n* *" nil t) ! 232: (replace-match "; ")) ! 233: (if (not (zerop (buffer-size))) ! 234: (error "Sending...failed to %s" ! 235: (buffer-substring (point-min) (point-max))))))) ! 236: (kill-buffer tembuf) ! 237: (if (bufferp errbuf) ! 238: (kill-buffer errbuf))))) ! 239: ! 240: (defun mail-do-fcc (header-end) ! 241: (let (fcc-list ! 242: (rmailbuf (current-buffer)) ! 243: (tembuf (generate-new-buffer " rmail output")) ! 244: (case-fold-search t)) ! 245: (save-excursion ! 246: (goto-char (point-min)) ! 247: (while (re-search-forward "^FCC:[ \t]*" header-end t) ! 248: (setq fcc-list (cons (buffer-substring (point) ! 249: (progn ! 250: (end-of-line) ! 251: (skip-chars-backward " \t") ! 252: (point))) ! 253: fcc-list)) ! 254: (delete-region (match-beginning 0) (1+ (point)))) ! 255: (set-buffer tembuf) ! 256: (erase-buffer) ! 257: (insert "\nFrom " (user-login-name) " " ! 258: (current-time-string) "\n") ! 259: (insert-buffer-substring rmailbuf) ! 260: ;; Make sure messages are separated. ! 261: (goto-char (point-max)) ! 262: (insert ?\n) ! 263: (goto-char 2) ! 264: ;; ``Quote'' "^From " as ">From " ! 265: ;; (note that this isn't really quoting, as there is no requirement ! 266: ;; that "^[>]+From " be quoted in the same transparent way.) ! 267: (setq case-fold-search nil) ! 268: (while (search-forward "\nFrom " nil t) ! 269: (forward-char -5) ! 270: (insert ?>)) ! 271: (while fcc-list ! 272: (write-region (point-min) (point-max) (car fcc-list) t) ! 273: (setq fcc-list (cdr fcc-list)))) ! 274: (kill-buffer tembuf))) ! 275: ! 276: (defun mail-to () ! 277: "Move point to end of To-field." ! 278: (interactive) ! 279: (expand-abbrev) ! 280: (mail-position-on-field "to")) ! 281: ! 282: (defun mail-subject () ! 283: "Move point to end of Subject-field." ! 284: (interactive) ! 285: (expand-abbrev) ! 286: (mail-position-on-field "Subject")) ! 287: ! 288: (defun mail-cc () ! 289: "Move point to end of CC-field. Create a CC field if none." ! 290: (interactive) ! 291: (expand-abbrev) ! 292: (or (mail-position-on-field "cc" t) ! 293: (progn (mail-position-on-field "to") ! 294: (insert "\nCC: ")))) ! 295: ! 296: (defun mail-bcc () ! 297: "Move point to end of BCC-field. Create a BCC field if none." ! 298: (interactive) ! 299: (expand-abbrev) ! 300: (or (mail-position-on-field "bcc" t) ! 301: (progn (mail-position-on-field "to") ! 302: (insert "\nBCC: ")))) ! 303: ! 304: (defun mail-position-on-field (field &optional soft) ! 305: (let (end (case-fold-search t)) ! 306: (goto-char (point-min)) ! 307: (search-forward (concat "\n" mail-header-separator "\n")) ! 308: (setq end (match-beginning 0)) ! 309: (goto-char (point-min)) ! 310: (if (re-search-forward (concat "^" (regexp-quote field) ":") end t) ! 311: (progn ! 312: (re-search-forward "^[^ \t]" nil 'move) ! 313: (beginning-of-line) ! 314: (skip-chars-backward "\n") ! 315: t) ! 316: (and (not soft) ! 317: (progn (goto-char end) ! 318: (skip-chars-backward "\n") ! 319: (insert "\n" field ": ")))))) ! 320: ! 321: (defun mail-signature () ! 322: "Sign letter with contents of ~/.signature file." ! 323: (interactive) ! 324: (save-excursion ! 325: (goto-char (point-max)) ! 326: (insert-file-contents (expand-file-name "~/.signature")))) ! 327: ! 328: (defun mail-fill-yanked-message (&optional justifyp) ! 329: "Fill the paragraphs of a message yanked into this one. ! 330: Numeric argument means justify as well." ! 331: (interactive "P") ! 332: (save-excursion ! 333: (goto-char (point-min)) ! 334: (search-forward (concat "\n" mail-header-separator "\n") nil t) ! 335: (fill-individual-paragraphs (point) ! 336: (point-max) ! 337: justifyp ! 338: t))) ! 339: (defun mail-yank-original (arg) ! 340: "Insert the message being replied to, if any (in rmail). ! 341: Puts point before the text and mark after. ! 342: Indents each nonblank line ARG spaces (default 3). ! 343: Just \\[universal-argument] as argument means don't indent ! 344: and don't delete any header fields." ! 345: (interactive "P") ! 346: (if mail-reply-buffer ! 347: (let ((start (point))) ! 348: (delete-windows-on mail-reply-buffer) ! 349: (insert-buffer mail-reply-buffer) ! 350: (if (consp arg) ! 351: nil ! 352: (mail-yank-clear-headers start (mark)) ! 353: (indent-rigidly start (mark) ! 354: (if arg (prefix-numeric-value arg) 3))) ! 355: (exchange-point-and-mark) ! 356: (if (not (eolp)) (insert ?\n))))) ! 357: ! 358: (defun mail-yank-clear-headers (start end) ! 359: (save-excursion ! 360: (goto-char start) ! 361: (if (search-forward "\n\n" end t) ! 362: (save-restriction ! 363: (narrow-to-region start (point)) ! 364: (goto-char start) ! 365: (while (let ((case-fold-search t)) ! 366: (re-search-forward mail-yank-ignored-headers nil t)) ! 367: (beginning-of-line) ! 368: (delete-region (point) ! 369: (progn (re-search-forward "\n[^ \t]") ! 370: (forward-char -1) ! 371: (point)))))))) ! 372: ! 373: ;; Put these last, to reduce chance of lossage from quitting in middle of loading the file. ! 374: ! 375: (defun mail (&optional noerase to subject in-reply-to cc replybuffer) ! 376: "Edit a message to be sent. Argument means resume editing (don't erase). ! 377: Returns with message buffer seleted; value t if message freshly initialized. ! 378: While editing message, type C-c C-c to send the message and exit. ! 379: ! 380: Various special commands starting with C-c are available in sendmail mode ! 381: to move to message header fields. Type C-c? for a list of them. ! 382: ! 383: If mail-self-blind is non-nil, a BCC to yourself is inserted ! 384: when the message is initialized. ! 385: ! 386: If mail-setup-hook is bound, its value is called with no arguments ! 387: after the message is initialized. It can add more default fields. ! 388: ! 389: When calling from a program, the second through fifth arguments ! 390: TO, SUBJECT, CC and IN-REPLY-TO specify if non-nil ! 391: the initial contents of those header fields. ! 392: These arguments should not have final newlines. ! 393: The sixth argument REPLYBUFFER is a buffer whose contents ! 394: should be yanked if the user types C-c y." ! 395: (interactive "P") ! 396: (switch-to-buffer "*mail*") ! 397: (setq default-directory (expand-file-name "~/")) ! 398: (auto-save-mode auto-save-default) ! 399: (mail-mode) ! 400: (and (not noerase) ! 401: (or (not (buffer-modified-p)) ! 402: (y-or-n-p "Unsent message being composed; erase it? ")) ! 403: (progn (erase-buffer) ! 404: (mail-setup to subject in-reply-to cc replybuffer) ! 405: t))) ! 406: ! 407: (defun mail-other-window (&optional noerase to subject in-reply-to cc replybuffer) ! 408: "Like \"mail\" command, but display mail buffer in another window." ! 409: (interactive "P") ! 410: (let ((pop-up-windows t)) ! 411: (pop-to-buffer "*mail*")) ! 412: (setq default-directory (expand-file-name "~/")) ! 413: (auto-save-mode auto-save-default) ! 414: (mail-mode) ! 415: (and (not noerase) ! 416: (or (not (buffer-modified-p)) ! 417: (y-or-n-p "Unsent message being composed; erase it? ")) ! 418: (progn (erase-buffer) ! 419: (mail-setup to subject in-reply-to cc replybuffer) ! 420: t))) ! 421: ! 422: ;;; 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.