Return to sendmail.el CVS log

Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / lisp

Annotation of 43BSDReno/contrib/emacs-18.55/lisp/sendmail.el, revision 1.1

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 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: (provide 'sendmail)
        !            23: 
        !            24: ;(defconst mail-self-blind nil
        !            25: ;  "Non-nil means insert BCC to self in messages to be sent.
        !            26: ;This is done when the message is initialized,
        !            27: ;so you can remove or alter the BCC field to override the default.")
        !            28: 
        !            29: ;(defconst mail-interactive nil
        !            30: ;  "Non-nil means when sending a message wait for and display errors.
        !            31: ;nil means let mailer mail back a message to report errors.")
        !            32: 
        !            33: ;(defconst mail-yank-ignored-headers
        !            34: ;   "^via:\\|^mail-from:\\|^origin:\\|^status:\\|^remailed\\|^received:\\|^message-id:\\|^summary-line:\\|^to:\\|^subject:\\|^in-reply-to:\\|^return-path:"
        !            35: ;   "Delete these headers from old message when it's inserted in a reply.")
        !            36: ;(defvar send-mail-function 'sendmail-send-it
        !            37: ;  "Function to call to send the current buffer as mail.
        !            38: ;The headers are be delimited by a line which is mail-header-separator"")
        !            39: 
        !            40: ; really defined in loaddefs for emacs 17.17+
        !            41: ;(defvar mail-header-separator "--text follows this line--"
        !            42: ;  "*Line used to separate headers from text in messages being composed.")
        !            43: ; really defined in loaddefs for emacs 17.17+
        !            44: ;(defvar mail-archive-file-name nil
        !            45: ;  "*Name of file to write all outgoing messages in, or nil for none.")
        !            46: ; really defined in loaddefs for emacs 17.17+
        !            47: (defvar mail-aliases t
        !            48:   "Alias of mail address aliases,
        !            49: or t meaning should be initialized from .mailrc.")
        !            50: 
        !            51: (defvar mail-default-reply-to nil
        !            52:   "*Address to insert as default Reply-to field of outgoing messages.")
        !            53: 
        !            54: (defvar mail-abbrevs-loaded nil)
        !            55: (defvar mail-mode-map nil)
        !            56: 
        !            57: (autoload 'build-mail-aliases "mailalias"
        !            58:   "Read mail aliases from ~/.mailrc and set mail-aliases."
        !            59:   nil)
        !            60: 
        !            61: (autoload 'expand-mail-aliases "mailalias"
        !            62:   "Expand all mail aliases in suitable header fields found between BEG and END.
        !            63: Suitable header fields are To, CC and BCC."
        !            64:   nil)
        !            65: 
        !            66: (defun mail-setup (to subject in-reply-to cc replybuffer)
        !            67:   (if (eq mail-aliases t)
        !            68:       (progn
        !            69:        (setq mail-aliases nil)
        !            70:        (if (file-exists-p "~/.mailrc")
        !            71:            (build-mail-aliases))))
        !            72:   (setq mail-reply-buffer replybuffer)
        !            73:   (goto-char (point-min))
        !            74:   (insert "To: ")
        !            75:   (save-excursion
        !            76:     (if to
        !            77:        (progn
        !            78:          (insert to "\n")
        !            79:          ;;; Here removed code to extract names from within <...>
        !            80:          ;;; on the assumption that mail-strip-quoted-names
        !            81:          ;;; has been called and has done so.
        !            82:          (let ((fill-prefix "\t"))
        !            83:            (fill-region (point-min) (point-max))))
        !            84:       (newline))
        !            85:     (if cc
        !            86:        (let ((opos (point))
        !            87:              (fill-prefix "\t"))
        !            88:          (insert "CC: " cc "\n")
        !            89:          (fill-region-as-paragraph opos (point-max))))
        !            90:     (if in-reply-to
        !            91:        (insert "In-reply-to: " in-reply-to "\n"))
        !            92:     (insert "Subject: " (or subject "") "\n")
        !            93:     (if mail-default-reply-to
        !            94:        (insert "Reply-to: " mail-default-reply-to "\n"))
        !            95:     (if mail-self-blind
        !            96:        (insert "BCC: " (user-login-name) "\n"))
        !            97:     (if mail-archive-file-name
        !            98:        (insert "FCC: " mail-archive-file-name "\n"))
        !            99:     (insert mail-header-separator "\n"))
        !           100:   (if to (goto-char (point-max)))
        !           101:   (or to subject in-reply-to
        !           102:       (set-buffer-modified-p nil))
        !           103:   (run-hooks 'mail-setup-hook))
        !           104: 
        !           105: (defun mail-mode ()
        !           106:   "Major mode for editing mail to be sent.
        !           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:          (erase-buffer)
        !           188:          (insert-buffer-substring mailbuf)
        !           189:          (goto-char (point-max))
        !           190:          ;; require one newline at the end.
        !           191:          (or (= (preceding-char) ?\n)
        !           192:              (insert ?\n))
        !           193:          ;; Change header-delimiter to be what sendmail expects.
        !           194:          (goto-char (point-min))
        !           195:          (re-search-forward
        !           196:            (concat "^" (regexp-quote mail-header-separator) "\n"))
        !           197:          (replace-match "\n")
        !           198:          (backward-char 1)
        !           199:          (setq delimline (point-marker))
        !           200:          (if mail-aliases
        !           201:              (expand-mail-aliases (point-min) delimline))
        !           202:          (goto-char (point-min))
        !           203:          ;; ignore any blank lines in the header
        !           204:          (while (and (re-search-forward "\n\n\n*" delimline t)
        !           205:                      (< (point) delimline))
        !           206:            (replace-match "\n"))
        !           207:          (let ((case-fold-search t))
        !           208:            ;; Find and handle any FCC fields.
        !           209:            (goto-char (point-min))
        !           210:            (if (re-search-forward "^FCC:" delimline t)
        !           211:                (mail-do-fcc delimline))
        !           212:            ;; If there is a From and no Sender, put it a Sender.
        !           213:            (goto-char (point-min))
        !           214:            (and (re-search-forward "^From:"  delimline t)
        !           215:                 (not (save-excursion
        !           216:                        (goto-char (point-min))
        !           217:                        (re-search-forward "^Sender:" delimline t)))
        !           218:                 (progn
        !           219:                   (forward-line 1)
        !           220:                   (insert "Sender: " (user-login-name) "\n")))
        !           221:            ;; don't send out a blank subject line
        !           222:            (goto-char (point-min))
        !           223:            (if (re-search-forward "^Subject:[ \t]*\n" delimline t)
        !           224:                (replace-match ""))
        !           225:            (if mail-interactive
        !           226:                (save-excursion
        !           227:                  (set-buffer errbuf)
        !           228:                  (erase-buffer))))
        !           229:          (apply 'call-process-region
        !           230:                 (append (list (point-min) (point-max)
        !           231:                               (if (boundp 'sendmail-program)
        !           232:                                   sendmail-program
        !           233:                                 "/usr/lib/sendmail")
        !           234:                               nil errbuf nil
        !           235:                               "-oi" "-t")
        !           236:                         ;; Always specify who from,
        !           237:                         ;; since some systems have broken sendmails.
        !           238:                         (list "-f" (user-login-name))
        !           239: ;;;                     ;; Don't say "from root" if running under su.
        !           240: ;;;                     (and (equal (user-real-login-name) "root")
        !           241: ;;;                          (list "-f" (user-login-name)))
        !           242:                         ;; These mean "report errors by mail"
        !           243:                         ;; and "deliver in background".
        !           244:                         (if (null mail-interactive) '("-oem" "-odb"))))
        !           245:          (if mail-interactive
        !           246:              (save-excursion
        !           247:                (set-buffer errbuf)
        !           248:                (goto-char (point-min))
        !           249:                (while (re-search-forward "\n\n* *" nil t)
        !           250:                  (replace-match "; "))
        !           251:                (if (not (zerop (buffer-size)))
        !           252:                    (error "Sending...failed to %s"
        !           253:                           (buffer-substring (point-min) (point-max)))))))
        !           254:       (kill-buffer tembuf)
        !           255:       (if (bufferp errbuf)
        !           256:          (kill-buffer errbuf)))))
        !           257: 
        !           258: (defun mail-do-fcc (header-end)
        !           259:   (let (fcc-list
        !           260:        (rmailbuf (current-buffer))
        !           261:        (tembuf (generate-new-buffer " rmail output"))
        !           262:        (case-fold-search t))
        !           263:     (save-excursion
        !           264:       (goto-char (point-min))
        !           265:       (while (re-search-forward "^FCC:[ \t]*" header-end t)
        !           266:        (setq fcc-list (cons (buffer-substring (point)
        !           267:                                               (progn
        !           268:                                                 (end-of-line)
        !           269:                                                 (skip-chars-backward " \t")
        !           270:                                                 (point)))
        !           271:                             fcc-list))
        !           272:        (delete-region (match-beginning 0)
        !           273:                       (progn (forward-line 1) (point))))
        !           274:       (set-buffer tembuf)
        !           275:       (erase-buffer)
        !           276:       (insert "\nFrom " (user-login-name) " "
        !           277:              (current-time-string) "\n")
        !           278:       (insert-buffer-substring rmailbuf)
        !           279:       ;; Make sure messages are separated.
        !           280:       (goto-char (point-max))
        !           281:       (insert ?\n)
        !           282:       (goto-char 2)
        !           283:       ;; ``Quote'' "^From " as ">From "
        !           284:       ;;  (note that this isn't really quoting, as there is no requirement
        !           285:       ;;   that "^[>]+From " be quoted in the same transparent way.)
        !           286:       (let ((case-fold-search nil))
        !           287:        (while (search-forward "\nFrom " nil t)
        !           288:          (forward-char -5)
        !           289:          (insert ?>)))
        !           290:       (while fcc-list
        !           291:        (let ((buffer (get-file-buffer (car fcc-list))))
        !           292:          (if buffer
        !           293:              ;; File is present in a buffer => append to that buffer.
        !           294:              (let ((curbuf (current-buffer))
        !           295:                    (beg (point-min)) (end (point-max)))
        !           296:                (save-excursion
        !           297:                  (set-buffer buffer)
        !           298:                  (goto-char (point-max))
        !           299:                  (insert-buffer-substring curbuf beg end)))
        !           300:            ;; Else append to the file directly.
        !           301:            (write-region (point-min) (point-max) (car fcc-list) t)))
        !           302:        (setq fcc-list (cdr fcc-list))))
        !           303:     (kill-buffer tembuf)))
        !           304: 
        !           305: (defun mail-to ()
        !           306:   "Move point to end of To-field."
        !           307:   (interactive)
        !           308:   (expand-abbrev)
        !           309:   (mail-position-on-field "To"))
        !           310: 
        !           311: (defun mail-subject ()
        !           312:   "Move point to end of Subject-field."
        !           313:   (interactive)
        !           314:   (expand-abbrev)
        !           315:   (mail-position-on-field "Subject"))
        !           316: 
        !           317: (defun mail-cc ()
        !           318:   "Move point to end of CC-field.  Create a CC field if none."
        !           319:   (interactive)
        !           320:   (expand-abbrev)
        !           321:   (or (mail-position-on-field "cc" t)
        !           322:       (progn (mail-position-on-field "to")
        !           323:             (insert "\nCC: "))))
        !           324: 
        !           325: (defun mail-bcc ()
        !           326:   "Move point to end of BCC-field.  Create a BCC field if none."
        !           327:   (interactive)
        !           328:   (expand-abbrev)
        !           329:   (or (mail-position-on-field "bcc" t)
        !           330:       (progn (mail-position-on-field "to")
        !           331:             (insert "\nBCC: "))))
        !           332: 
        !           333: (defun mail-position-on-field (field &optional soft)
        !           334:   (let (end
        !           335:        (case-fold-search t))
        !           336:     (goto-char (point-min))
        !           337:     (search-forward (concat "\n" mail-header-separator "\n"))
        !           338:     (setq end (match-beginning 0))
        !           339:     (goto-char (point-min))
        !           340:     (if (re-search-forward (concat "^" (regexp-quote field) ":") end t)
        !           341:        (progn
        !           342:          (re-search-forward "^[^ \t]" nil 'move)
        !           343:          (beginning-of-line)
        !           344:          (skip-chars-backward "\n")
        !           345:          t)
        !           346:       (or soft
        !           347:          (progn (goto-char end)
        !           348:                 (skip-chars-backward "\n")
        !           349:                 (insert "\n" field ": ")))
        !           350:       nil)))
        !           351: 
        !           352: (defun mail-signature ()
        !           353:   "Sign letter with contents of ~/.signature file."
        !           354:   (interactive)
        !           355:   (save-excursion
        !           356:     (goto-char (point-max))
        !           357:     (insert-file-contents (expand-file-name "~/.signature"))))
        !           358: 
        !           359: (defun mail-fill-yanked-message (&optional justifyp)
        !           360:   "Fill the paragraphs of a message yanked into this one.
        !           361: Numeric argument means justify as well."
        !           362:   (interactive "P")
        !           363:   (save-excursion
        !           364:     (goto-char (point-min))
        !           365:     (search-forward (concat "\n" mail-header-separator "\n") nil t)
        !           366:     (fill-individual-paragraphs (point)
        !           367:                                (point-max)
        !           368:                                justifyp
        !           369:                                t)))
        !           370: (defun mail-yank-original (arg)
        !           371:   "Insert the message being replied to, if any (in rmail).
        !           372: Puts point before the text and mark after.
        !           373: Indents each nonblank line ARG spaces (default 3).
        !           374: Just \\[universal-argument] as argument means don't indent
        !           375: and don't delete any header fields."
        !           376:   (interactive "P")
        !           377:   (if mail-reply-buffer
        !           378:       (let ((start (point)))
        !           379:        (delete-windows-on mail-reply-buffer)
        !           380:        (insert-buffer mail-reply-buffer)
        !           381:        (if (consp arg)
        !           382:            nil
        !           383:          (mail-yank-clear-headers start (mark))
        !           384:          (indent-rigidly start (mark)
        !           385:                          (if arg (prefix-numeric-value arg) 3)))
        !           386:        (exchange-point-and-mark)
        !           387:        (if (not (eolp)) (insert ?\n)))))
        !           388: 
        !           389: (defun mail-yank-clear-headers (start end)
        !           390:   (save-excursion
        !           391:     (goto-char start)
        !           392:     (if (search-forward "\n\n" end t)
        !           393:        (save-restriction
        !           394:          (narrow-to-region start (point))
        !           395:          (goto-char start)
        !           396:          (while (let ((case-fold-search t))
        !           397:                   (re-search-forward mail-yank-ignored-headers nil t))
        !           398:            (beginning-of-line)
        !           399:            (delete-region (point)
        !           400:                           (progn (re-search-forward "\n[^ \t]")
        !           401:                                  (forward-char -1)
        !           402:                                  (point))))))))
        !           403: 
        !           404: ;; Put these last, to reduce chance of lossage from quitting in middle of loading the file.
        !           405: 
        !           406: (defun mail (&optional noerase to subject in-reply-to cc replybuffer)
        !           407:   "Edit a message to be sent.  Argument means resume editing (don't erase).
        !           408: Returns with message buffer selected; value t if message freshly initialized.
        !           409: While editing message, type C-c C-c to send the message and exit.
        !           410: 
        !           411: Various special commands starting with C-c are available in sendmail mode
        !           412: to move to message header fields:
        !           413: \\{mail-mode-map}
        !           414: 
        !           415: If mail-self-blind is non-nil, a BCC to yourself is inserted
        !           416: when the message is initialized.
        !           417: 
        !           418: If mail-default-reply-to is non-nil, it should be an address (a string);
        !           419: a Reply-to: field with that address is inserted.
        !           420: 
        !           421: If mail-archive-file-name is non-nil, an FCC field with that file name
        !           422: is inserted.
        !           423: 
        !           424: If mail-setup-hook is bound, its value is called with no arguments
        !           425: after the message is initialized.  It can add more default fields.
        !           426: 
        !           427: When calling from a program, the second through fifth arguments
        !           428:  TO, SUBJECT, IN-REPLY-TO and CC specify if non-nil
        !           429:  the initial contents of those header fields.
        !           430:  These arguments should not have final newlines.
        !           431: The sixth argument REPLYBUFFER is a buffer whose contents
        !           432:  should be yanked if the user types C-c C-y."
        !           433:   (interactive "P")
        !           434:   (switch-to-buffer "*mail*")
        !           435:   (setq default-directory (expand-file-name "~/"))
        !           436:   (auto-save-mode auto-save-default)
        !           437:   (mail-mode)
        !           438:   (and (not noerase)
        !           439:        (or (not (buffer-modified-p))
        !           440:           (y-or-n-p "Unsent message being composed; erase it? "))
        !           441:        (progn (erase-buffer)
        !           442:              (mail-setup to subject in-reply-to cc replybuffer)
        !           443:              t)))
        !           444: 
        !           445: (defun mail-other-window (&optional noerase to subject in-reply-to cc replybuffer)
        !           446:   "Like `mail' command, but display mail buffer in another window."
        !           447:   (interactive "P")
        !           448:   (let ((pop-up-windows t))
        !           449:     (pop-to-buffer "*mail*"))
        !           450:   (mail noerase to subject in-reply-to cc replybuffer))
        !           451: 
        !           452: ;;; 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.