Mercurial > hg > xemacs-beta
comparison lisp/modes/sendmail.el @ 0:376386a54a3c r19-14
Import from CVS: tag r19-14
| author | cvs |
|---|---|
| date | Mon, 13 Aug 2007 08:45:50 +0200 |
| parents | |
| children | 0293115a14e9 |
comparison
equal
deleted
inserted
replaced
| -1:000000000000 | 0:376386a54a3c |
|---|---|
| 1 ;;; sendmail.el --- mail sending commands for Emacs. | |
| 2 | |
| 3 ;; Copyright (C) 1985, 1986, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. | |
| 4 | |
| 5 ;; Maintainer: FSF | |
| 6 ;; Keywords: mail | |
| 7 | |
| 8 ;; This file is part of XEmacs. | |
| 9 | |
| 10 ;; XEmacs is free software; you can redistribute it and/or modify it | |
| 11 ;; under the terms of the GNU General Public License as published by | |
| 12 ;; the Free Software Foundation; either version 2, or (at your option) | |
| 13 ;; any later version. | |
| 14 | |
| 15 ;; XEmacs is distributed in the hope that it will be useful, but | |
| 16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
| 18 ;; General Public License for more details. | |
| 19 | |
| 20 ;; You should have received a copy of the GNU General Public License | |
| 21 ;; along with XEmacs; see the file COPYING. If not, write to the Free | |
| 22 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
| 23 | |
| 24 ;;; Synched up with: FSF 19.30. | |
| 25 | |
| 26 ;;; Commentary: | |
| 27 | |
| 28 ;; This mode provides mail-sending facilities from within Emacs. It is | |
| 29 ;; documented in the Emacs user's manual. | |
| 30 | |
| 31 ;;; Code: | |
| 32 | |
| 33 ;;;###autoload | |
| 34 (defvar mail-from-style 'angles "\ | |
| 35 *Specifies how \"From:\" fields look. | |
| 36 | |
| 37 If `nil', they contain just the return address like: | |
| 38 king@grassland.com | |
| 39 If `parens', they look like: | |
| 40 king@grassland.com (Elvis Parsley) | |
| 41 If `angles', they look like: | |
| 42 Elvis Parsley <king@grassland.com>") | |
| 43 | |
| 44 ;;;###autoload | |
| 45 (defvar mail-self-blind nil "\ | |
| 46 Non-nil means insert BCC to self in messages to be sent. | |
| 47 This is done when the message is initialized, | |
| 48 so you can remove or alter the BCC field to override the default.") | |
| 49 | |
| 50 ;;;###autoload | |
| 51 (defvar mail-interactive nil "\ | |
| 52 Non-nil means when sending a message wait for and display errors. | |
| 53 nil means let mailer mail back a message to report errors.") | |
| 54 | |
| 55 ;;;###autoload | |
| 56 (defvar mail-dir nil "*Default directory for saving messages.") | |
| 57 | |
| 58 ;;; XEmacs change: moved rmail-ignored-headers here from rmail.el so that | |
| 59 ;;; the value of mail-yank-ignored-headers can default from it. Both of | |
| 60 ;;; these end up in loaddefs.el, but "sendmail" comes before "rmail", so... | |
| 61 ;;; | |
| 62 ;;;###autoload | |
| 63 (defvar rmail-ignored-headers | |
| 64 (purecopy | |
| 65 (concat | |
| 66 "^\\(" | |
| 67 (mapconcat | |
| 68 'identity | |
| 69 '(;; RFC822 | |
| 70 "Sender:" "References:" "Return-Path:" "Received:" | |
| 71 "[^: \t\n]*Message-ID:" "Errors-To:" | |
| 72 ;; RFC977 (NNTP) | |
| 73 "Path:" "Expires:" "Xref:" "Lines:" "Approved:" "Distribution:" | |
| 74 ;; SYSV mail: | |
| 75 "Content-Length:" | |
| 76 ;; MIME: | |
| 77 "Mime-Version:" "Content-Type:" "Content-Transfer-Encoding:" | |
| 78 ;; X400 | |
| 79 "X400-Received:" "X400-Originator:" "X400-Mts-Identifier:" | |
| 80 "X400-Content-Type:" "Content-Identifier:" | |
| 81 ;; RMAIL and /usr/ucb/mail: | |
| 82 "Status:" "Summary-Line:" | |
| 83 ;; Supercite: | |
| 84 "X-Attribution:" | |
| 85 ;; Other random junk occasionally seen: | |
| 86 "Via:" "Sent-Via:" "Mail-From:" "Origin:" "Comments:" "Originator:" | |
| 87 "NF-ID:" "NF-From:" "Posting-Version:" "Posted:" "Posted-Date:" | |
| 88 "Date-Received:" "Relay-Version:" "Article-I\\.D\\.:" "NNTP-Version:" | |
| 89 "NNTP-Posting-Host:" "X-Mailer:" "X-Newsreader:" "News-Software:" | |
| 90 "X-Received:" "X-References:" "X-Envelope-To:" | |
| 91 "X-VMS-" "Remailed-" "X-Plantation:" "X-Windows:" "X-Pgp-" | |
| 92 ) | |
| 93 "\\|") | |
| 94 "\\)")) | |
| 95 "*Gubbish header fields one would rather not see.") | |
| 96 | |
| 97 | |
| 98 ;;;###autoload | |
| 99 (defvar mail-yank-ignored-headers | |
| 100 (purecopy | |
| 101 (concat rmail-ignored-headers "\\|" | |
| 102 "^\\(" | |
| 103 (mapconcat 'identity | |
| 104 '(;; RFC822 | |
| 105 "Resent-To:" "Resent-By:" "Resent-CC:" | |
| 106 "To:" "Subject:" "In-Reply-To:" | |
| 107 ) | |
| 108 "\\|") | |
| 109 "\\)")) | |
| 110 "Delete these headers from old message when it's inserted in a reply.") | |
| 111 ;; minimalist FSF version | |
| 112 ;(defvar mail-yank-ignored-headers "^via:\\|^mail-from:\\|^origin:\\|^status:\\|^remailed\\|^received:\\|^message-id:\\|^summary-line:\\|^to:\\|^subject:\\|^in-reply-to:\\|^return-path:" "\ | |
| 113 ;Delete these headers from old message when it's inserted in a reply.") | |
| 114 | |
| 115 ;; Useful to set in site-init.el | |
| 116 ;;;###autoload | |
| 117 (defvar send-mail-function 'sendmail-send-it "\ | |
| 118 Function to call to send the current buffer as mail. | |
| 119 The headers should be delimited by a line whose contents | |
| 120 match the variable `mail-header-separator'.") | |
| 121 | |
| 122 ;;;###autoload | |
| 123 (defvar mail-header-separator (purecopy "--text follows this line--") "\ | |
| 124 *Line used to separate headers from text in messages being composed.") | |
| 125 | |
| 126 ;;;###autoload | |
| 127 (defvar mail-archive-file-name nil "\ | |
| 128 *Name of file to write all outgoing messages in, or nil for none. | |
| 129 This can be an inbox file or an Rmail file.") | |
| 130 | |
| 131 ;;;###autoload | |
| 132 (defvar mail-default-reply-to nil | |
| 133 "*Address to insert as default Reply-to field of outgoing messages. | |
| 134 If nil, it will be initialized from the REPLYTO environment variable | |
| 135 when you first send mail.") | |
| 136 | |
| 137 ;;;###autoload | |
| 138 (defvar mail-alias-file nil | |
| 139 "*If non-nil, the name of a file to use instead of `/usr/lib/aliases'. | |
| 140 This file defines aliases to be expanded by the mailer; this is a different | |
| 141 feature from that of defining aliases in `.mailrc' to be expanded in Emacs. | |
| 142 This variable has no effect unless your system uses sendmail as its mailer.") | |
| 143 | |
| 144 ;(defvar mail-personal-alias-file "~/.mailrc" | |
| 145 ; "*If non-nil, the name of the user's personal mail alias file. | |
| 146 ;This file typically should be in same format as the `.mailrc' file used by | |
| 147 ;the `Mail' or `mailx' program. | |
| 148 ;This file need not actually exist.") | |
| 149 (defvaralias 'mail-personal-alias-file 'mail-abbrev-mailrc-file) | |
| 150 | |
| 151 (defvar mail-setup-hook nil | |
| 152 "Normal hook, run each time a new outgoing mail message is initialized. | |
| 153 The function `mail-setup' runs this hook.") | |
| 154 | |
| 155 ; These are removed. See `mail-abbrevs.el'. | |
| 156 | |
| 157 ;(defvar mail-aliases t | |
| 158 ; "Alist of mail address aliases, | |
| 159 ;or t meaning should be initialized from your mail aliases file. | |
| 160 ;\(The file's name is normally `~/.mailrc', but your MAILRC environment | |
| 161 ;variable can override that name.) | |
| 162 ;The alias definitions in the file have this form: | |
| 163 ; alias ALIAS MEANING") | |
| 164 ; | |
| 165 ;(defvar mail-alias-modtime nil | |
| 166 ; "The modification time of your mail alias file when it was last examined.") | |
| 167 | |
| 168 ;;;###autoload | |
| 169 (defvar mail-yank-prefix "> " ; XEmacs change | |
| 170 "*Prefix insert on lines of yanked message being replied to. | |
| 171 nil means use indentation.") | |
| 172 | |
| 173 (defvar mail-indentation-spaces 3 | |
| 174 "*Number of spaces to insert at the beginning of each cited line. | |
| 175 Used by `mail-yank-original' via `mail-indent-citation'.") | |
| 176 | |
| 177 (defvar mail-yank-hooks nil | |
| 178 "Obsolete hook for modifying a citation just inserted in the mail buffer. | |
| 179 Each hook function can find the citation between (point) and (mark t). | |
| 180 And each hook function should leave point and mark around the citation | |
| 181 text as modified. | |
| 182 | |
| 183 This is a normal hook, misnamed for historical reasons. | |
| 184 It is semi-obsolete and mail agents should no longer use it.") | |
| 185 | |
| 186 (defvar mail-citation-hook nil | |
| 187 "*Hook for modifying a citation just inserted in the mail buffer. | |
| 188 Each hook function can find the citation between (point) and (mark t). | |
| 189 And each hook function should leave point and mark around the citation | |
| 190 text as modified. | |
| 191 | |
| 192 If this hook is entirely empty (nil), a default action is taken | |
| 193 instead of no action.") | |
| 194 | |
| 195 (defvar mail-abbrevs-loaded nil) | |
| 196 (defvar mail-mode-map nil) | |
| 197 | |
| 198 ; Removed autoloads of `build-mail-aliases' and `expand-mail-aliases'. | |
| 199 ; See `mail-abbrevs.el'. | |
| 200 | |
| 201 (autoload 'mail-aliases-setup "mail-abbrevs") | |
| 202 | |
| 203 ;;;###autoload | |
| 204 (defvar mail-signature nil | |
| 205 "*Text inserted at end of mail buffer when a message is initialized. | |
| 206 If t, it means to insert the contents of the file `mail-signature-file'.") | |
| 207 | |
| 208 (defvar mail-signature-file "~/.signature" | |
| 209 "*File containing the text inserted at end of mail buffer.") | |
| 210 | |
| 211 (defvar mail-reply-buffer nil) | |
| 212 (defvar mail-send-actions nil | |
| 213 "A list of actions to be performed upon successful sending of a message.") | |
| 214 | |
| 215 (defvar mail-default-headers nil | |
| 216 "*A string containing header lines, to be inserted in outgoing messages. | |
| 217 It is inserted before you edit the message, | |
| 218 so you can edit or delete these lines.") | |
| 219 | |
| 220 (defvar mail-bury-selects-summary t | |
| 221 "*If non-nil, try to show RMAIL summary buffer after returning from mail. | |
| 222 The functions \\[mail-send-on-exit] or \\[mail-dont-send] select | |
| 223 the RMAIL summary buffer before returning, if it exists and this variable | |
| 224 is non-nil.") | |
| 225 | |
| 226 ;; Note: could use /usr/ucb/mail instead of sendmail; | |
| 227 ;; options -t, and -v if not interactive. | |
| 228 (defvar mail-mailer-swallows-blank-line | |
| 229 (if (and (string-match "sparc-sun-sunos\\(\\'\\|[^5]\\)" system-configuration) | |
| 230 (file-readable-p "/etc/sendmail.cf") | |
| 231 (let ((buffer (get-buffer-create " *temp*"))) | |
| 232 (unwind-protect | |
| 233 (save-excursion | |
| 234 (set-buffer buffer) | |
| 235 (insert-file-contents "/etc/sendmail.cf") | |
| 236 (goto-char (point-min)) | |
| 237 (let ((case-fold-search nil)) | |
| 238 (re-search-forward "^OR\\>" nil t))) | |
| 239 (kill-buffer buffer)))) | |
| 240 ;; According to RFC822, "The field-name must be composed of printable | |
| 241 ;; ASCII characters (i.e. characters that have decimal values between | |
| 242 ;; 33 and 126, except colon)", i.e. any chars except ctl chars, | |
| 243 ;; space, or colon. | |
| 244 '(looking-at "[ \t]\\|[][!\"#$%&'()*+,-./0-9;<=>?@A-Z\\\\^_`a-z{|}~]+:")) | |
| 245 "Set this non-nil if the system's mailer runs the header and body together. | |
| 246 \(This problem exists on Sunos 4 when sendmail is run in remote mode.) | |
| 247 The value should be an expression to test whether the problem will | |
| 248 actually occur.") | |
| 249 | |
| 250 (defvar mail-use-multiple-buffers-p t | |
| 251 "Non-nil means `mail' will create a new buffer if one already exists.") | |
| 252 | |
| 253 (defvar mail-mode-syntax-table nil | |
| 254 "Syntax table used while in mail mode.") | |
| 255 | |
| 256 (if (not mail-mode-syntax-table) | |
| 257 (progn | |
| 258 (setq mail-mode-syntax-table (copy-syntax-table text-mode-syntax-table)) | |
| 259 (modify-syntax-entry ?% ". " mail-mode-syntax-table))) | |
| 260 | |
| 261 (defvar mail-font-lock-keywords | |
| 262 (let* ((cite-prefix "A-Za-z") (cite-suffix (concat cite-prefix "0-9_.@-"))) | |
| 263 (list '("^To:" . font-lock-function-name-face) | |
| 264 '("^B?CC:\\|^Reply-To:" . font-lock-keyword-face) | |
| 265 '("^\\(Subject:\\)[ \t]*\\(.+\\)?" | |
| 266 (1 font-lock-comment-face) (2 font-lock-type-face nil t)) | |
| 267 (list (concat "^\\(" (regexp-quote mail-header-separator) "\\)$") | |
| 268 1 'font-lock-comment-face) | |
| 269 (cons (concat "^[ \t]*" | |
| 270 "\\([" cite-prefix "]+[" cite-suffix "]*\\)?" | |
| 271 "[>|}].*") | |
| 272 'font-lock-reference-face) | |
| 273 '("^\\(X-[A-Za-z0-9-]+\\|In-reply-to\\):.*" | |
| 274 . font-lock-string-face))) | |
| 275 "Additional expressions to highlight in Mail mode.") | |
| 276 (put 'mail-mode 'font-lock-defaults '(mail-font-lock-keywords t)) | |
| 277 | |
| 278 (defvar mail-send-hook nil | |
| 279 "Normal hook run before sending mail, in Mail mode.") | |
| 280 | |
| 281 ; Removed. See above and `mail-abbrevs.el'. | |
| 282 ;(defun sendmail-synch-aliases () | |
| 283 ; (let ((modtime (nth 5 (file-attributes mail-personal-alias-file)))) | |
| 284 ; (or (equal mail-alias-modtime modtime) | |
| 285 ; (setq mail-alias-modtime modtime | |
| 286 ; mail-aliases t)))) | |
| 287 | |
| 288 (defun mail-setup (to subject in-reply-to cc replybuffer actions) | |
| 289 (or mail-default-reply-to | |
| 290 (setq mail-default-reply-to (getenv "REPLYTO"))) | |
| 291 ;Removed. See `mail-abbrevs.el'. | |
| 292 ; (sendmail-synch-aliases) | |
| 293 ; (if (eq mail-aliases t) | |
| 294 ; (progn | |
| 295 ; (setq mail-aliases nil) | |
| 296 ; (if (file-exists-p mail-personal-alias-file) | |
| 297 ; (build-mail-aliases)))) | |
| 298 (setq mail-send-actions actions) | |
| 299 (mail-aliases-setup) | |
| 300 (setq mail-reply-buffer replybuffer) | |
| 301 (goto-char (point-min)) | |
| 302 (insert "To: ") | |
| 303 (save-excursion | |
| 304 (if to | |
| 305 ;; Here removed code to extract names from within <...> | |
| 306 ;; on the assumption that mail-strip-quoted-names | |
| 307 ;; has been called and has done so. | |
| 308 (let ((fill-prefix "\t") | |
| 309 (address-start (point))) | |
| 310 (insert to "\n") | |
| 311 (fill-region-as-paragraph address-start (point-max))) | |
| 312 (newline)) | |
| 313 (if cc | |
| 314 (let ((fill-prefix "\t") | |
| 315 (address-start (progn (insert "CC: ") (point)))) | |
| 316 (insert cc "\n") | |
| 317 (fill-region-as-paragraph address-start (point-max)))) | |
| 318 (if in-reply-to | |
| 319 (let ((fill-prefix "\t") | |
| 320 (fill-column 78) | |
| 321 (address-start (point))) | |
| 322 (insert "In-reply-to: " in-reply-to "\n") | |
| 323 (fill-region-as-paragraph address-start (point-max)))) | |
| 324 (insert "Subject: " (or subject "") "\n") | |
| 325 (if mail-default-headers | |
| 326 (insert mail-default-headers)) | |
| 327 (if mail-default-reply-to | |
| 328 (insert "Reply-to: " mail-default-reply-to "\n")) | |
| 329 (if mail-self-blind | |
| 330 (insert "BCC: " (user-login-name) "\n")) | |
| 331 (if mail-archive-file-name | |
| 332 (insert "FCC: " mail-archive-file-name "\n")) | |
| 333 (insert mail-header-separator "\n") | |
| 334 | |
| 335 ;; Insert the signature. But remember the beginning of the message. | |
| 336 (if to (setq to (point))) | |
| 337 (cond ((eq mail-signature t) | |
| 338 (if (file-exists-p mail-signature-file) | |
| 339 (progn | |
| 340 (insert "\n\n-- \n") | |
| 341 (insert-file-contents mail-signature-file)))) | |
| 342 (mail-signature | |
| 343 (insert mail-signature))) | |
| 344 (goto-char (point-max)) | |
| 345 (or (bolp) (newline))) | |
| 346 (if to (goto-char to)) | |
| 347 (or to subject in-reply-to | |
| 348 (set-buffer-modified-p nil)) | |
| 349 (run-hooks 'mail-setup-hook)) | |
| 350 | |
| 351 ;;;###autoload | |
| 352 (defun mail-mode () | |
| 353 "Major mode for editing mail to be sent. | |
| 354 Like Text Mode but with these additional commands: | |
| 355 C-c C-s mail-send (send the message) C-c C-c mail-send-and-exit | |
| 356 C-c C-f move to a header field (and create it if there isn't): | |
| 357 C-c C-f C-t move to To: C-c C-f C-s move to Subj: | |
| 358 C-c C-f C-b move to BCC: C-c C-f C-c move to CC: | |
| 359 C-c C-f C-f move to FCC: C-c C-f C-r move to Reply-To: | |
| 360 C-c C-t mail-text (move to beginning of message text). | |
| 361 C-c C-w mail-signature (insert `mail-signature-file' file). | |
| 362 C-c C-y mail-yank-original (insert current message, in Rmail). | |
| 363 C-c C-q mail-fill-yanked-message (fill what was yanked). | |
| 364 C-c C-v mail-sent-via (add a sent-via field for each To or CC)." | |
| 365 (interactive) | |
| 366 (kill-all-local-variables) | |
| 367 (make-local-variable 'mail-reply-buffer) | |
| 368 (setq mail-reply-buffer nil) | |
| 369 (make-local-variable 'mail-send-actions) | |
| 370 (set-syntax-table mail-mode-syntax-table) | |
| 371 (use-local-map mail-mode-map) | |
| 372 (setq local-abbrev-table text-mode-abbrev-table) | |
| 373 (setq major-mode 'mail-mode) | |
| 374 (setq mode-name "Mail") | |
| 375 (setq buffer-offer-save t) | |
| 376 (turn-on-auto-fill) ; XEmacs - maybe filladapt should be default, too. | |
| 377 (make-local-variable 'paragraph-separate) | |
| 378 (make-local-variable 'paragraph-start) | |
| 379 (setq paragraph-start (concat (regexp-quote mail-header-separator) | |
| 380 "$\\|[ \t]*[-_][-_][-_]+$\\|" | |
| 381 paragraph-start)) | |
| 382 (setq paragraph-separate (concat (regexp-quote mail-header-separator) | |
| 383 "$\\|[ \t]*[-_][-_][-_]+$\\|" | |
| 384 paragraph-separate)) | |
| 385 ;; Set menu | |
| 386 (setq mode-popup-menu mail-popup-menu) | |
| 387 (if (featurep 'menubar) | |
| 388 (progn | |
| 389 ;; make a local copy of the menubar, so our modes don't | |
| 390 ;; change the global menubar | |
| 391 (set-buffer-menubar current-menubar) | |
| 392 (add-submenu nil mail-menubar-menu))) | |
| 393 | |
| 394 (run-hooks 'text-mode-hook 'mail-mode-hook)) | |
| 395 | |
| 396 | |
| 397 ;;; Set up keymap. | |
| 398 | |
| 399 (if mail-mode-map | |
| 400 nil | |
| 401 (setq mail-mode-map (make-sparse-keymap)) | |
| 402 (set-keymap-parents mail-mode-map (list text-mode-map)) | |
| 403 (set-keymap-name mail-mode-map 'mail-mode-map) | |
| 404 (define-key mail-mode-map "\C-c?" 'describe-mode) | |
| 405 (define-key mail-mode-map "\C-c\C-f\C-t" 'mail-to) | |
| 406 (define-key mail-mode-map "\C-c\C-f\C-b" 'mail-bcc) | |
| 407 (define-key mail-mode-map "\C-c\C-f\C-f" 'mail-fcc) | |
| 408 (define-key mail-mode-map "\C-c\C-f\C-c" 'mail-cc) | |
| 409 (define-key mail-mode-map "\C-c\C-f\C-s" 'mail-subject) | |
| 410 (define-key mail-mode-map "\C-c\C-f\C-r" 'mail-reply-to) | |
| 411 (define-key mail-mode-map "\C-c\C-t" 'mail-text) | |
| 412 (define-key mail-mode-map "\C-c\C-y" 'mail-yank-original) | |
| 413 (define-key mail-mode-map "\C-c\C-q" 'mail-fill-yanked-message) | |
| 414 (define-key mail-mode-map "\C-c\C-w" 'mail-signature) | |
| 415 ;;CRAP!!(define-key mail-mode-map "\C-c\C-v" 'mail-sent-via)CRAP! | |
| 416 (define-key mail-mode-map "\C-c\C-c" 'mail-send-and-exit) | |
| 417 (define-key mail-mode-map "\C-c\C-s" 'mail-send)) | |
| 418 | |
| 419 ;;; mail-mode popup menu | |
| 420 | |
| 421 (defvar mail-menubar-menu | |
| 422 (purecopy | |
| 423 '("Mail" | |
| 424 "Sending Mail:" | |
| 425 "----" | |
| 426 ["Send and Exit" mail-send-and-exit t] | |
| 427 ["Send Mail" mail-send t] | |
| 428 "----" | |
| 429 "Go to Field:" | |
| 430 "----" | |
| 431 ["To:" mail-to t] | |
| 432 ["Subject:" mail-subject t] | |
| 433 ["CC:" mail-cc t] | |
| 434 ["BCC:" mail-bcc t] | |
| 435 ["Reply-To:" mail-reply-to t] | |
| 436 ;; ["Sent Via:" mail-sent-via t] | |
| 437 ["Text" mail-text t] | |
| 438 "----" | |
| 439 "Miscellaneous Commands:" | |
| 440 "----" | |
| 441 ["Yank Original" mail-yank-original | |
| 442 (not (null mail-reply-buffer))] | |
| 443 ["Fill Yanked Message" mail-fill-yanked-message | |
| 444 (save-excursion | |
| 445 (goto-char (point-min)) | |
| 446 (and (search-forward (concat "\n" mail-header-separator | |
| 447 "\n") nil t) | |
| 448 (not (looking-at "[ \t\n]*\\'"))))] | |
| 449 ["Insert Signature" mail-signature | |
| 450 (and (stringp mail-signature-file) | |
| 451 (file-exists-p mail-signature-file))] | |
| 452 ["Insert File..." insert-file t] | |
| 453 ["Insert Buffer..." insert-buffer t] | |
| 454 "----" | |
| 455 ["Cancel" mail-dont-send t] | |
| 456 )) | |
| 457 "Menubar menu for `mail-mode'.") | |
| 458 | |
| 459 (defvar mail-popup-menu | |
| 460 (purecopy | |
| 461 (cons "Sendmail Commands" | |
| 462 (cdr mail-menubar-menu))) | |
| 463 "Menubar menu for `mail-mode'.") | |
| 464 | |
| 465 | |
| 466 (defun mail-send-and-exit (arg) | |
| 467 "Send message like `mail-send', then, if no errors, exit from mail buffer. | |
| 468 Prefix arg means don't delete this window." | |
| 469 (interactive "P") | |
| 470 (mail-send) | |
| 471 (mail-bury arg)) | |
| 472 | |
| 473 (defun mail-dont-send (arg) | |
| 474 "Don't send the message you have been editing. | |
| 475 Prefix arg means don't delete this window." | |
| 476 (interactive "P") | |
| 477 (mail-bury arg)) | |
| 478 | |
| 479 (defun mail-bury (arg) | |
| 480 "Bury this mail buffer." | |
| 481 (let ((newbuf (other-buffer (current-buffer)))) | |
| 482 (bury-buffer (current-buffer)) | |
| 483 (if (and (fboundp 'frame-parameters) | |
| 484 (cdr (assq 'dedicated (frame-parameters))) | |
| 485 (not (null (delq (selected-frame) (visible-frame-list))))) | |
| 486 (delete-frame (selected-frame)) | |
| 487 (let (rmail-flag summary-buffer) | |
| 488 (and (not arg) | |
| 489 (not (one-window-p)) | |
| 490 (save-excursion | |
| 491 (set-buffer (window-buffer (next-window (selected-window) 'not))) | |
| 492 (setq rmail-flag (eq major-mode 'rmail-mode)) | |
| 493 (setq summary-buffer | |
| 494 (and mail-bury-selects-summary | |
| 495 (boundp 'rmail-summary-buffer) | |
| 496 rmail-summary-buffer | |
| 497 (buffer-name rmail-summary-buffer) | |
| 498 (not (get-buffer-window rmail-summary-buffer)) | |
| 499 rmail-summary-buffer)))) | |
| 500 (if rmail-flag | |
| 501 ;; If the Rmail buffer has a summary, show that. | |
| 502 (if summary-buffer (switch-to-buffer summary-buffer) | |
| 503 (delete-window)) | |
| 504 (switch-to-buffer newbuf)))))) | |
| 505 | |
| 506 (defun mail-send () | |
| 507 "Send the message in the current buffer. | |
| 508 If `mail-interactive' is non-nil, wait for success indication or error | |
| 509 messages, and inform user. Otherwise any failure is reported in a message | |
| 510 back to the user from the mailer." | |
| 511 (interactive) | |
| 512 (if (if buffer-file-name | |
| 513 (y-or-n-p "Send buffer contents as mail message? ") | |
| 514 (or (buffer-modified-p) | |
| 515 (y-or-n-p "Message already sent; resend? "))) | |
| 516 (progn | |
| 517 (expand-abbrev) ; for mail-abbrevs | |
| 518 (run-hooks 'mail-send-hook) | |
| 519 (message "Sending...") | |
| 520 (funcall send-mail-function) | |
| 521 ;; Now perform actions on successful sending. | |
| 522 (while mail-send-actions | |
| 523 (condition-case nil | |
| 524 (apply (car (car mail-send-actions)) | |
| 525 (cdr (car mail-send-actions))) | |
| 526 (error)) | |
| 527 (setq mail-send-actions (cdr mail-send-actions))) | |
| 528 (message "Sending...done") | |
| 529 | |
| 530 ;; If buffer has no file, mark it as unmodified and delete autosave. | |
| 531 (cond ((or (not buffer-file-name) | |
| 532 (not (buffer-modified-p))) | |
| 533 (set-buffer-modified-p nil) | |
| 534 (delete-auto-save-file-if-necessary t)) | |
| 535 ((or noninteractive | |
| 536 (y-or-n-p (format "Save file %s? " buffer-file-name))) | |
| 537 (save-buffer)))))) | |
| 538 | |
| 539 (defun sendmail-send-it () | |
| 540 (require 'mail-utils) | |
| 541 (let ((errbuf (if mail-interactive | |
| 542 (generate-new-buffer " sendmail errors") | |
| 543 0)) | |
| 544 (tembuf (generate-new-buffer " sendmail temp")) | |
| 545 (case-fold-search nil) | |
| 546 resend-to-addresses | |
| 547 delimline | |
| 548 (mailbuf (current-buffer))) | |
| 549 (unwind-protect | |
| 550 (save-excursion | |
| 551 (set-buffer tembuf) | |
| 552 (erase-buffer) | |
| 553 (insert-buffer-substring mailbuf) | |
| 554 (goto-char (point-max)) | |
| 555 ;; require one newline at the end. | |
| 556 (or (= (preceding-char) ?\n) | |
| 557 (insert ?\n)) | |
| 558 ;; Change header-delimiter to be what sendmail expects. | |
| 559 (goto-char (point-min)) | |
| 560 (re-search-forward | |
| 561 (concat "^" (regexp-quote mail-header-separator) "\n")) | |
| 562 (replace-match "\n") | |
| 563 (backward-char 1) | |
| 564 (setq delimline (point-marker)) | |
| 565 ;Removed. See `mail-abbrevs.el'. | |
| 566 ; (sendmail-synch-aliases) | |
| 567 ; (if mail-aliases | |
| 568 ; (expand-mail-aliases (point-min) delimline)) | |
| 569 ; (goto-char (point-min)) | |
| 570 ;; ignore any blank lines in the header | |
| 571 (while (and (re-search-forward "\n\n\n*" delimline t) | |
| 572 (< (point) delimline)) | |
| 573 (replace-match "\n")) | |
| 574 (let ((case-fold-search t)) | |
| 575 (goto-char (point-min)) | |
| 576 (while (re-search-forward "^Resent-to:" delimline t) | |
| 577 (setq resend-to-addresses | |
| 578 (save-restriction | |
| 579 (narrow-to-region (point) | |
| 580 (save-excursion | |
| 581 (end-of-line) | |
| 582 (point))) | |
| 583 (append (mail-parse-comma-list) | |
| 584 resend-to-addresses)))) | |
| 585 ;;; Apparently this causes a duplicate Sender. | |
| 586 ;;; ;; If the From is different than current user, insert Sender. | |
| 587 ;;; (goto-char (point-min)) | |
| 588 ;;; (and (re-search-forward "^From:" delimline t) | |
| 589 ;;; (progn | |
| 590 ;;; (require 'mail-utils) | |
| 591 ;;; (not (string-equal | |
| 592 ;;; (mail-strip-quoted-names | |
| 593 ;;; (save-restriction | |
| 594 ;;; (narrow-to-region (point-min) delimline) | |
| 595 ;;; (mail-fetch-field "From"))) | |
| 596 ;;; (user-login-name)))) | |
| 597 ;;; (progn | |
| 598 ;;; (forward-line 1) | |
| 599 ;;; (insert "Sender: " (user-login-name) "\n"))) | |
| 600 ;; Don't send out a blank subject line | |
| 601 (goto-char (point-min)) | |
| 602 (if (re-search-forward "^Subject:\\([ \t]*\n\\)+\\b" delimline t) | |
| 603 (replace-match "")) | |
| 604 ;; Put the "From:" field in unless for some odd reason | |
| 605 ;; they put one in themselves. | |
| 606 (goto-char (point-min)) | |
| 607 (if (not (re-search-forward "^From:" delimline t)) | |
| 608 (let* ((login user-mail-address) | |
| 609 (fullname (user-full-name))) | |
| 610 (cond ((eq mail-from-style 'angles) | |
| 611 (insert "From: " fullname) | |
| 612 (let ((fullname-start (+ (point-min) 6)) | |
| 613 (fullname-end (point-marker))) | |
| 614 (goto-char fullname-start) | |
| 615 ;; Look for a character that cannot appear unquoted | |
| 616 ;; according to RFC 822. | |
| 617 (if (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]" | |
| 618 fullname-end 1) | |
| 619 (progn | |
| 620 ;; Quote fullname, escaping specials. | |
| 621 (goto-char fullname-start) | |
| 622 (insert "\"") | |
| 623 (while (re-search-forward "[\"\\]" | |
| 624 fullname-end 1) | |
| 625 (replace-match "\\\\\\&" t)) | |
| 626 (insert "\"")))) | |
| 627 (insert " <" login ">\n")) | |
| 628 ((eq mail-from-style 'parens) | |
| 629 (insert "From: " login " (") | |
| 630 (let ((fullname-start (point))) | |
| 631 (insert fullname) | |
| 632 (let ((fullname-end (point-marker))) | |
| 633 (goto-char fullname-start) | |
| 634 ;; RFC 822 says \ and nonmatching parentheses | |
| 635 ;; must be escaped in comments. | |
| 636 ;; Escape every instance of ()\ ... | |
| 637 (while (re-search-forward "[()\\]" fullname-end 1) | |
| 638 (replace-match "\\\\\\&" t)) | |
| 639 ;; ... then undo escaping of matching parentheses, | |
| 640 ;; including matching nested parentheses. | |
| 641 (goto-char fullname-start) | |
| 642 (while (re-search-forward | |
| 643 "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)" | |
| 644 fullname-end 1) | |
| 645 (replace-match "\\1(\\3)" t) | |
| 646 (goto-char fullname-start)))) | |
| 647 (insert ")\n")) | |
| 648 ((null mail-from-style) | |
| 649 (insert "From: " login "\n"))))) | |
| 650 ;; Insert an extra newline if we need it to work around | |
| 651 ;; Sun's bug that swallows newlines. | |
| 652 (goto-char (1+ delimline)) | |
| 653 (if (eval mail-mailer-swallows-blank-line) | |
| 654 (newline)) | |
| 655 ;; Find and handle any FCC fields. | |
| 656 (goto-char (point-min)) | |
| 657 (if (re-search-forward "^FCC:" delimline t) | |
| 658 (mail-do-fcc delimline)) | |
| 659 (if mail-interactive | |
| 660 (save-excursion | |
| 661 (set-buffer errbuf) | |
| 662 (erase-buffer)))) | |
| 663 (let ((default-directory "/")) | |
| 664 (apply 'call-process-region | |
| 665 (append (list (point-min) (point-max) | |
| 666 (if (boundp 'sendmail-program) | |
| 667 sendmail-program | |
| 668 "/usr/lib/sendmail") | |
| 669 nil errbuf nil "-oi") | |
| 670 ;; Always specify who from, | |
| 671 ;; since some systems have broken sendmails. | |
| 672 (list "-f" (user-login-name)) | |
| 673 ;;; ;; Don't say "from root" if running under su. | |
| 674 ;;; (and (equal (user-real-login-name) "root") | |
| 675 ;;; (list "-f" (user-login-name))) | |
| 676 (and mail-alias-file | |
| 677 (list (concat "-oA" mail-alias-file))) | |
| 678 ;; These mean "report errors by mail" | |
| 679 ;; and "deliver in background". | |
| 680 (if (null mail-interactive) '("-oem" "-odb")) | |
| 681 ;; Get the addresses from the message | |
| 682 ;; unless this is a resend. | |
| 683 ;; We must not do that for a resend | |
| 684 ;; because we would find the original addresses. | |
| 685 ;; For a resend, include the specific addresses. | |
| 686 (or resend-to-addresses | |
| 687 '("-t"))))) | |
| 688 (if mail-interactive | |
| 689 (save-excursion | |
| 690 (set-buffer errbuf) | |
| 691 (goto-char (point-min)) | |
| 692 (while (re-search-forward "\n\n* *" nil t) | |
| 693 (replace-match "; ")) | |
| 694 (if (not (zerop (buffer-size))) | |
| 695 (error "Sending...failed to %s" | |
| 696 (buffer-substring (point-min) (point-max))))))) | |
| 697 (kill-buffer tembuf) | |
| 698 (if (bufferp errbuf) | |
| 699 (kill-buffer errbuf))))) | |
| 700 | |
| 701 ;;; FCC hackery, by jwz. This version works on BABYL and VM buffers. | |
| 702 ;;; To accomplish the latter, VM is loaded when this file is compiled. | |
| 703 ;;; Don't worry, it's only loaded at compile-time. | |
| 704 | |
| 705 (defun mail-do-fcc (header-end) | |
| 706 (let (fcc-list | |
| 707 (send-mail-buffer (current-buffer)) | |
| 708 (tembuf (generate-new-buffer " rmail output")) | |
| 709 (case-fold-search t) | |
| 710 beg end) | |
| 711 (or (markerp header-end) (error "header-end must be a marker")) | |
| 712 (save-excursion | |
| 713 (goto-char (point-min)) | |
| 714 (while (re-search-forward "^FCC:[ \t]*" header-end t) | |
| 715 (setq fcc-list (cons (buffer-substring (point) | |
| 716 (progn | |
| 717 (end-of-line) | |
| 718 (skip-chars-backward " \t") | |
| 719 (point))) | |
| 720 fcc-list)) | |
| 721 (delete-region (match-beginning 0) | |
| 722 (progn (forward-line 1) (point)))) | |
| 723 (set-buffer tembuf) | |
| 724 (erase-buffer) | |
| 725 ;; insert just the headers to avoid moving the gap more than | |
| 726 ;; necessary (the message body could be arbitrarily huge.) | |
| 727 (insert-buffer-substring send-mail-buffer 1 header-end) | |
| 728 | |
| 729 ;; if there's no From: or Date: field, cons some. | |
| 730 (goto-char (point-min)) | |
| 731 (or (re-search-forward "^From[ \t]*:" header-end t) | |
| 732 (insert "From: " (user-login-name) " (" (user-full-name) ")\n")) | |
| 733 (goto-char (point-min)) | |
| 734 (or (re-search-forward "^Date[ \t]*:" header-end t) | |
| 735 (mail-do-fcc-insert-date-header)) | |
| 736 | |
| 737 ;; insert a magic From_ line. | |
| 738 (goto-char (point-min)) | |
| 739 (insert "\nFrom " (user-login-name) " " (current-time-string) "\n") | |
| 740 (goto-char (point-max)) | |
| 741 (insert-buffer-substring send-mail-buffer header-end) | |
| 742 (goto-char (point-max)) | |
| 743 (insert ?\n) | |
| 744 (goto-char (1- header-end)) | |
| 745 | |
| 746 ;; ``Quote'' "^From " as ">From " | |
| 747 ;; (note that this isn't really quoting, as there is no requirement | |
| 748 ;; that "^[>]+From " be quoted in the same transparent way.) | |
| 749 (let ((case-fold-search nil)) | |
| 750 (while (search-forward "\nFrom " nil t) | |
| 751 (forward-char -5) | |
| 752 (insert ?>))) | |
| 753 | |
| 754 (setq beg (point-min) | |
| 755 end (point-max)) | |
| 756 (while fcc-list | |
| 757 (let ((target-buffer (get-file-buffer (car fcc-list)))) | |
| 758 (if target-buffer | |
| 759 ;; File is present in a buffer => append to that buffer. | |
| 760 (save-excursion | |
| 761 (set-buffer target-buffer) | |
| 762 (cond ((eq major-mode 'rmail-mode) | |
| 763 (mail-do-fcc-rmail-internal tembuf)) | |
| 764 ((eq major-mode 'vm-mode) | |
| 765 (mail-do-fcc-vm-internal tembuf)) | |
| 766 (t | |
| 767 ;; Append to an ordinary buffer as a Unix mail message. | |
| 768 (goto-char (point-max)) | |
| 769 (insert-buffer-substring tembuf beg end)))) | |
| 770 ;; Else append to the file directly. | |
| 771 ;; (It's OK if it is an RMAIL or VM file -- the message will be | |
| 772 ;; parsed when the file is read in.) | |
| 773 (write-region | |
| 774 (1+ (point-min)) (point-max) (car fcc-list) t))) | |
| 775 (setq fcc-list (cdr fcc-list)))) | |
| 776 (kill-buffer tembuf))) | |
| 777 | |
| 778 (defvar mail-do-fcc-cached-timezone nil) | |
| 779 | |
| 780 (defun mail-do-fcc-insert-date-header () | |
| 781 ;; Convert the ctime() format that `current-time-string' returns into | |
| 782 ;; an RFC-822-legal date. | |
| 783 (let ((s (current-time-string))) | |
| 784 (string-match "\\`\\([A-Z][a-z][a-z]\\) +\\([A-Z][a-z][a-z]\\) +\\([0-9][0-9]?\\) *\\([0-9][0-9]?:[0-9][0-9]:[0-9][0-9]\\) *[0-9]?[0-9]?\\([0-9][0-9]\\)" | |
| 785 s) | |
| 786 (insert "Date: " | |
| 787 (substring s (match-beginning 1) (match-end 1)) ", " | |
| 788 (substring s (match-beginning 3) (match-end 3)) " " | |
| 789 (substring s (match-beginning 2) (match-end 2)) " " | |
| 790 (substring s (match-beginning 5) (match-end 5)) " " | |
| 791 (substring s (match-beginning 4) (match-end 4)) " ") | |
| 792 | |
| 793 (if mail-do-fcc-cached-timezone | |
| 794 (insert mail-do-fcc-cached-timezone "\n") | |
| 795 ;; | |
| 796 ;; First, try to use the current-time-zone function, which may not be | |
| 797 ;; defined, and even if it is defined, may error or return nil. | |
| 798 ;; | |
| 799 (or (condition-case () | |
| 800 (let ((zoneinfo (current-time-zone))) | |
| 801 (setq mail-do-fcc-cached-timezone | |
| 802 (if (stringp (nth 1 zoneinfo)) | |
| 803 (nth 1 zoneinfo) | |
| 804 (or (if (nth 1 zoneinfo) (nth 3 zoneinfo)) | |
| 805 (nth 2 zoneinfo)))) | |
| 806 (if mail-do-fcc-cached-timezone | |
| 807 (insert mail-do-fcc-cached-timezone "\n")) | |
| 808 mail-do-fcc-cached-timezone) | |
| 809 (error nil)) | |
| 810 ;; | |
| 811 ;; Otherwise, run date(1) and parse its output. Yuck! | |
| 812 ;; | |
| 813 (save-restriction | |
| 814 (narrow-to-region (point) (point)) | |
| 815 (call-process "date" nil t nil) | |
| 816 (end-of-line) | |
| 817 (insert "\n") | |
| 818 (forward-word -1) ; skip back over year | |
| 819 (delete-region (1- (point)) (1- (point-max))) ; nuke year to end | |
| 820 (forward-word -1) ; skip back over zone | |
| 821 (delete-region (point-min) (point)) ; nuke beginning to zone | |
| 822 (setq mail-do-fcc-cached-timezone | |
| 823 (buffer-substring (point-min) (1- (point-max))))))))) | |
| 824 | |
| 825 (defun mail-do-fcc-rmail-internal (buffer) | |
| 826 (or (eq major-mode 'rmail-mode) (error "this only works in rmail-mode")) | |
| 827 (let ((b (point-min)) | |
| 828 (e (point-max)) | |
| 829 (buffer-read-only nil)) | |
| 830 (unwind-protect | |
| 831 (progn | |
| 832 (widen) | |
| 833 (goto-char (point-max)) | |
| 834 ;; This forces RMAIL's message counters to be recomputed when the | |
| 835 ;; next RMAIL operation is done on the buffer. | |
| 836 ;; See rmail-maybe-set-message-counters. | |
| 837 (setq rmail-total-messages nil) | |
| 838 (insert "\^L\n0, unseen,,\n*** EOOH ***") | |
| 839 (insert-buffer-substring buffer) | |
| 840 (insert "\n\C-_")) | |
| 841 (narrow-to-region b e) | |
| 842 (rmail-maybe-set-message-counters)))) | |
| 843 | |
| 844 ;;; Load VM into the compilation environment but not the load environment. | |
| 845 (eval-when-compile | |
| 846 (or (and (boundp 'loading-vm-kludge) loading-vm-kludge) | |
| 847 ;; nastiness to avoid circular provide/require dependency nonsense | |
| 848 (fboundp 'vm-spool-files) | |
| 849 (let ((loading-vm-kludge t)) | |
| 850 (require 'vm)))) | |
| 851 | |
| 852 (defun mail-do-fcc-vm-internal (buffer) | |
| 853 (or (eq major-mode 'vm-mode) (error "this only works in vm-mode")) | |
| 854 (let ((buffer-read-only nil) | |
| 855 (foreign-folder-p (not (eq vm-folder-type 'From_)))) | |
| 856 | |
| 857 (if foreign-folder-p | |
| 858 ;; `buffer' has already been prepared with a "From " line which | |
| 859 ;; has a sensible user-id and date in it, but if we're FCCing to | |
| 860 ;; a VM folder that isn't in From_ format, we must discard that | |
| 861 ;; and let VM do whatever voodoo it needs to do. (Actually we | |
| 862 ;; could do this all the time, but then all FCCed messages would | |
| 863 ;; have "From VM ..." envelopes, which is less attractive.) | |
| 864 (save-excursion | |
| 865 (set-buffer buffer) | |
| 866 (goto-char (point-min)) | |
| 867 (skip-chars-forward "\n") | |
| 868 (forward-line) | |
| 869 (delete-region (point-min) (point)))) | |
| 870 | |
| 871 ;; Largely copied from #'vm-save-message in vm-save.el | |
| 872 (vm-save-restriction | |
| 873 (widen) | |
| 874 (goto-char (point-max)) | |
| 875 (if foreign-folder-p | |
| 876 (vm-write-string (current-buffer) | |
| 877 (vm-leading-message-separator vm-folder-type))) | |
| 878 (insert-buffer-substring buffer) | |
| 879 (if foreign-folder-p | |
| 880 (vm-write-string (current-buffer) | |
| 881 (vm-trailing-message-separator vm-folder-type))) | |
| 882 | |
| 883 (vm-increment vm-messages-not-on-disk) | |
| 884 (vm-set-buffer-modified-p t) | |
| 885 (vm-clear-modification-flag-undos) | |
| 886 (vm-check-for-killed-summary) | |
| 887 (vm-assimilate-new-messages) | |
| 888 (vm-update-summary-and-mode-line)))) | |
| 889 | |
| 890 ;;(defun mail-sent-via () | |
| 891 ;; "Make a Sent-via header line from each To or CC header line." | |
| 892 ;; (interactive) | |
| 893 ;; (save-excursion | |
| 894 ;; (goto-char (point-min)) | |
| 895 ;; ;; find the header-separator | |
| 896 ;; (search-forward (concat "\n" mail-header-separator "\n")) | |
| 897 ;; (forward-line -1) | |
| 898 ;; ;; put a marker at the end of the header | |
| 899 ;; (let ((end (point-marker)) | |
| 900 ;; (case-fold-search t) | |
| 901 ;; to-line) | |
| 902 ;; (goto-char (point-min)) | |
| 903 ;; ;; search for the To: lines and make Sent-via: lines from them | |
| 904 ;; ;; search for the next To: line | |
| 905 ;; (while (re-search-forward "^\\(to\\|cc\\):" end t) | |
| 906 ;; ;; Grab this line plus all its continuations, sans the `to:'. | |
| 907 ;; (let ((to-line | |
| 908 ;; (buffer-substring (point) | |
| 909 ;; (progn | |
| 910 ;; (if (re-search-forward "^[^ \t\n]" end t) | |
| 911 ;; (backward-char 1) | |
| 912 ;; (goto-char end)) | |
| 913 ;; (point))))) | |
| 914 ;; ;; Insert a copy, with altered header field name. | |
| 915 ;; (insert-before-markers "Sent-via:" to-line)))))) | |
| 916 | |
| 917 (defun mail-to () | |
| 918 "Move point to end of To-field." | |
| 919 (interactive) | |
| 920 (expand-abbrev) | |
| 921 (mail-position-on-field "To")) | |
| 922 | |
| 923 (defun mail-subject () | |
| 924 "Move point to end of Subject-field." | |
| 925 (interactive) | |
| 926 (expand-abbrev) | |
| 927 (mail-position-on-field "Subject")) | |
| 928 | |
| 929 (defun mail-cc () | |
| 930 "Move point to end of CC-field. Create a CC field if none." | |
| 931 (interactive) | |
| 932 (expand-abbrev) | |
| 933 (or (mail-position-on-field "cc" t) | |
| 934 (progn (mail-position-on-field "to") | |
| 935 (insert "\nCC: ")))) | |
| 936 | |
| 937 (defun mail-bcc () | |
| 938 "Move point to end of BCC-field. Create a BCC field if none." | |
| 939 (interactive) | |
| 940 (expand-abbrev) | |
| 941 (or (mail-position-on-field "bcc" t) | |
| 942 (progn (mail-position-on-field "to") | |
| 943 (insert "\nBCC: ")))) | |
| 944 | |
| 945 (defun mail-fcc (folder) | |
| 946 "Add a new FCC field, with file name completion." | |
| 947 (interactive "FFolder carbon copy: ") | |
| 948 (expand-abbrev) | |
| 949 (or (mail-position-on-field "fcc" t) ;Put new field after exiting FCC. | |
| 950 (mail-position-on-field "to")) | |
| 951 (insert "\nFCC: " folder)) | |
| 952 | |
| 953 (defun mail-reply-to () | |
| 954 "Move point to end of Reply-To-field. Create a Reply-To field if none." | |
| 955 (interactive) | |
| 956 (expand-abbrev) | |
| 957 (or (mail-position-on-field "reply-to" t) | |
| 958 (progn (mail-position-on-field "to") | |
| 959 (insert "\nReply-To: ")))) | |
| 960 | |
| 961 (defun mail-position-on-field (field &optional soft) | |
| 962 (let (end | |
| 963 (case-fold-search t)) | |
| 964 (goto-char (point-min)) | |
| 965 (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) | |
| 966 (setq end (match-beginning 0)) | |
| 967 (goto-char (point-min)) | |
| 968 (if (re-search-forward (concat "^" (regexp-quote field) ":") end t) | |
| 969 (progn | |
| 970 (re-search-forward "^[^ \t]" nil 'move) | |
| 971 (beginning-of-line) | |
| 972 (skip-chars-backward "\n") | |
| 973 t) | |
| 974 (or soft | |
| 975 (progn (goto-char end) | |
| 976 ;; #### FSF has the next two clauses reversed. | |
| 977 ;; which is correct? | |
| 978 (skip-chars-backward "\n") | |
| 979 (insert "\n" field ": "))) | |
| 980 nil))) | |
| 981 | |
| 982 (defun mail-text () | |
| 983 "Move point to beginning of message text." | |
| 984 (interactive) | |
| 985 (expand-abbrev) | |
| 986 (goto-char (point-min)) | |
| 987 (search-forward (concat "\n" mail-header-separator "\n"))) | |
| 988 | |
| 989 (defun mail-signature (&optional atpoint) | |
| 990 "Sign letter with contents of the file `mail-signature-file'. | |
| 991 Prefix arg means put contents at point." | |
| 992 (interactive "P") | |
| 993 (save-excursion | |
| 994 (or atpoint | |
| 995 (goto-char (point-max))) | |
| 996 (skip-chars-backward " \t\n") | |
| 997 (end-of-line) | |
| 998 (or atpoint | |
| 999 (delete-region (point) (point-max))) | |
| 1000 (insert "\n\n-- \n") | |
| 1001 (insert-file-contents (expand-file-name mail-signature-file)))) | |
| 1002 | |
| 1003 (defun mail-fill-yanked-message (&optional justifyp) | |
| 1004 "Fill the paragraphs of a message yanked into this one. | |
| 1005 Numeric argument means justify as well." | |
| 1006 (interactive "P") | |
| 1007 (save-excursion | |
| 1008 (goto-char (point-min)) | |
| 1009 (search-forward (concat "\n" mail-header-separator "\n") nil t) | |
| 1010 (fill-individual-paragraphs (point) | |
| 1011 (point-max) | |
| 1012 justifyp | |
| 1013 t))) | |
| 1014 | |
| 1015 (defun mail-indent-citation () | |
| 1016 "Modify text just inserted from a message to be cited. | |
| 1017 The inserted text should be the region. | |
| 1018 When this function returns, the region is again around the modified text. | |
| 1019 | |
| 1020 Normally, indent each nonblank line `mail-indentation-spaces' spaces. | |
| 1021 However, if `mail-yank-prefix' is non-nil, insert that prefix on each line." | |
| 1022 (let ((start (point))) | |
| 1023 (mail-yank-clear-headers start (mark t)) | |
| 1024 (if (null mail-yank-prefix) | |
| 1025 (indent-rigidly start (mark t) mail-indentation-spaces) | |
| 1026 (save-excursion | |
| 1027 (goto-char start) | |
| 1028 (while (< (point) (mark t)) | |
| 1029 (insert mail-yank-prefix) | |
| 1030 (forward-line 1)))))) | |
| 1031 | |
| 1032 (defun mail-yank-original (arg) | |
| 1033 "Insert the message being replied to, if any (in rmail). | |
| 1034 Puts point before the text and mark after. | |
| 1035 Normally, indents each nonblank line ARG spaces (default 3). | |
| 1036 However, if `mail-yank-prefix' is non-nil, insert that prefix on each line. | |
| 1037 | |
| 1038 Just \\[universal-argument] as argument means don't indent, insert no prefix, | |
| 1039 and don't delete any header fields." | |
| 1040 (interactive "P") | |
| 1041 (if mail-reply-buffer | |
| 1042 (let ((start (point)) | |
| 1043 (reader-buf mail-reply-buffer) | |
| 1044 (reader-window (get-buffer-window mail-reply-buffer | |
| 1045 (selected-frame)))) | |
| 1046 ;; If the original message is in another window in the same frame, | |
| 1047 ;; delete that window to save screen space. | |
| 1048 ;; t means don't alter other frames. | |
| 1049 (if reader-window | |
| 1050 (delete-windows-on reader-buf t)) | |
| 1051 (insert-buffer reader-buf) | |
| 1052 (if (consp arg) | |
| 1053 nil | |
| 1054 (goto-char start) | |
| 1055 (let ((mail-indentation-spaces (if arg (prefix-numeric-value arg) | |
| 1056 mail-indentation-spaces))) | |
| 1057 (cond (mail-citation-hook | |
| 1058 (run-hooks 'mail-citation-hook)) | |
| 1059 (mail-yank-hooks | |
| 1060 (run-hooks 'mail-yank-hooks)) | |
| 1061 (t | |
| 1062 (mail-indent-citation))))) | |
| 1063 (exchange-point-and-mark t) | |
| 1064 (if (not (eolp)) (insert ?\n))))) | |
| 1065 | |
| 1066 (defun mail-yank-clear-headers (start end) | |
| 1067 (if mail-yank-ignored-headers | |
| 1068 (save-excursion | |
| 1069 (goto-char start) | |
| 1070 (if (search-forward "\n\n" end t) | |
| 1071 (save-restriction | |
| 1072 (narrow-to-region start (point)) | |
| 1073 (goto-char start) | |
| 1074 (while (let ((case-fold-search t)) | |
| 1075 (re-search-forward mail-yank-ignored-headers nil t)) | |
| 1076 (beginning-of-line) | |
| 1077 (delete-region (point) | |
| 1078 (progn (re-search-forward "\n[^ \t]") | |
| 1079 (forward-char -1) | |
| 1080 (point))))))))) | |
| 1081 | |
| 1082 ;; Put these last, to reduce chance of lossage from quitting in middle of loading the file. | |
| 1083 | |
| 1084 ;;;###autoload | |
| 1085 (defun mail (&optional noerase to subject in-reply-to cc replybuffer actions) | |
| 1086 "Edit a message to be sent. Prefix arg means resume editing (don't erase). | |
| 1087 When this function returns, the buffer `*mail*' is selected. | |
| 1088 The value is t if the message was newly initialized; otherwise, nil. | |
| 1089 | |
| 1090 Optionally, the signature file `mail-signature-file' can be inserted at the | |
| 1091 end; see the variable `mail-signature'. | |
| 1092 | |
| 1093 \\<mail-mode-map> | |
| 1094 While editing message, type \\[mail-send-and-exit] to send the message and exit. | |
| 1095 | |
| 1096 Various special commands starting with C-c are available in sendmail mode | |
| 1097 to move to message header fields: | |
| 1098 \\{mail-mode-map} | |
| 1099 | |
| 1100 The variable `mail-signature' controls whether the signature file | |
| 1101 `mail-signature-file' is inserted immediately. | |
| 1102 | |
| 1103 If `mail-signature' is nil, use \\[mail-signature] to insert the | |
| 1104 signature in `mail-signature-file'. | |
| 1105 | |
| 1106 If `mail-self-blind' is non-nil, a BCC to yourself is inserted | |
| 1107 when the message is initialized. | |
| 1108 | |
| 1109 If `mail-default-reply-to' is non-nil, it should be an address (a string); | |
| 1110 a Reply-to: field with that address is inserted. | |
| 1111 | |
| 1112 If `mail-archive-file-name' is non-nil, an FCC field with that file name | |
| 1113 is inserted. | |
| 1114 | |
| 1115 The normal hook `mail-setup-hook' is run after the message is | |
| 1116 initialized. It can add more default fields to the message. | |
| 1117 | |
| 1118 When calling from a program, the first argument if non-nil says | |
| 1119 not to erase the existing contents of the `*mail*' buffer. | |
| 1120 | |
| 1121 The second through fifth arguments, | |
| 1122 TO, SUBJECT, IN-REPLY-TO and CC, specify if non-nil | |
| 1123 the initial contents of those header fields. | |
| 1124 These arguments should not have final newlines. | |
| 1125 The sixth argument REPLYBUFFER is a buffer whose contents | |
| 1126 should be yanked if the user types C-c C-y. | |
| 1127 The seventh argument ACTIONS is a list of actions to take | |
| 1128 if/when the message is sent. Each action looks like (FUNCTION . ARGS); | |
| 1129 when the message is sent, we apply FUNCTION to ARGS. | |
| 1130 This is how Rmail arranges to mark messages `answered'." | |
| 1131 (interactive "P") | |
| 1132 (if mail-use-multiple-buffers-p | |
| 1133 | |
| 1134 ;; RMS doesn't like this behavior but it seems more logical to me. --ben | |
| 1135 (let ((index 1) | |
| 1136 buffer) | |
| 1137 ;; If requested, look for a mail buffer that is modified and go to it. | |
| 1138 (if noerase | |
| 1139 (progn | |
| 1140 (while (and (setq buffer | |
| 1141 (get-buffer (if (= 1 index) "*mail*" | |
| 1142 (format "*mail*<%d>" index)))) | |
| 1143 (not (buffer-modified-p buffer))) | |
| 1144 (setq index (1+ index))) | |
| 1145 (if buffer (switch-to-buffer buffer) | |
| 1146 ;; If none exists, start a new message. | |
| 1147 ;; This will never re-use an existing unmodified mail buffer | |
| 1148 ;; (since index is not 1 anymore). Perhaps it should. | |
| 1149 (setq noerase nil)))) | |
| 1150 ;; Unless we found a modified message and are happy, start a | |
| 1151 ;; new message. | |
| 1152 (if (not noerase) | |
| 1153 (progn | |
| 1154 ;; Look for existing unmodified mail buffer. | |
| 1155 (while (and (setq buffer | |
| 1156 (get-buffer (if (= 1 index) "*mail*" | |
| 1157 (format "*mail*<%d>" index)))) | |
| 1158 (buffer-modified-p buffer)) | |
| 1159 (setq index (1+ index))) | |
| 1160 ;; If none, make a new one. | |
| 1161 (or buffer | |
| 1162 (setq buffer (generate-new-buffer "*mail*"))) | |
| 1163 ;; Go there and initialize it. | |
| 1164 (switch-to-buffer buffer) | |
| 1165 (erase-buffer) | |
| 1166 ;; put mail auto-save files in home dir instead of | |
| 1167 ;; scattering them around the file system. | |
| 1168 (setq default-directory (or mail-dir (expand-file-name "~/"))) | |
| 1169 (auto-save-mode auto-save-default) | |
| 1170 (mail-mode) | |
| 1171 (mail-setup to subject in-reply-to cc replybuffer actions) | |
| 1172 (if (and buffer-auto-save-file-name | |
| 1173 (file-exists-p buffer-auto-save-file-name)) | |
| 1174 (message "Auto save file for draft message exists; consider M-x mail-recover")) | |
| 1175 t))) | |
| 1176 | |
| 1177 ;; Alternate behavior that RMS likes. | |
| 1178 (pop-to-buffer "*mail*") | |
| 1179 (auto-save-mode auto-save-default) | |
| 1180 (mail-mode) | |
| 1181 ;; Disconnect the buffer from its visited file | |
| 1182 ;; (in case the user has actually visited a file *mail*). | |
| 1183 ; (set-visited-file-name nil) | |
| 1184 (let (initialized) | |
| 1185 (and (not noerase) | |
| 1186 (or (not (buffer-modified-p)) | |
| 1187 (y-or-n-p "Unsent message being composed; erase it? ")) | |
| 1188 (progn (erase-buffer) | |
| 1189 (mail-setup to subject in-reply-to cc replybuffer actions) | |
| 1190 (setq initialized t))) | |
| 1191 (if (and buffer-auto-save-file-name | |
| 1192 (file-exists-p buffer-auto-save-file-name)) | |
| 1193 (message "Auto save file for draft message exists; consider M-x mail-recover")) | |
| 1194 initialized))) | |
| 1195 | |
| 1196 (defun mail-recover () | |
| 1197 "Reread contents of current buffer from its last auto-save file." | |
| 1198 (interactive) | |
| 1199 (let ((file-name (let ((default-directory (expand-file-name "~/"))) | |
| 1200 ;; put mail auto-save files in home dir instead of | |
| 1201 ;; scattering them around the file system. | |
| 1202 (make-auto-save-file-name)))) | |
| 1203 (cond ((save-window-excursion | |
| 1204 (if (not (eq system-type 'vax-vms)) | |
| 1205 (with-output-to-temp-buffer "*Directory*" | |
| 1206 (buffer-disable-undo standard-output) | |
| 1207 (let ((default-directory "/")) | |
| 1208 (call-process | |
| 1209 "ls" nil standard-output nil "-l" file-name)))) | |
| 1210 (yes-or-no-p (format "Recover auto save file %s? " file-name))) | |
| 1211 (let ((buffer-read-only nil)) | |
| 1212 (erase-buffer) | |
| 1213 (insert-file-contents file-name nil))) | |
| 1214 (t (error "mail-recover cancelled"))))) | |
| 1215 | |
| 1216 ;;;###autoload | |
| 1217 (defun mail-other-window (&optional noerase to subject in-reply-to cc replybuffer sendactions) | |
| 1218 "Like `mail' command, but display mail buffer in another window." | |
| 1219 (interactive "P") | |
| 1220 (let ((pop-up-windows t) | |
| 1221 (special-display-buffer-names nil) | |
| 1222 (special-display-regexps nil) | |
| 1223 (same-window-buffer-names nil) | |
| 1224 (same-window-regexps nil)) | |
| 1225 (pop-to-buffer "*mail*")) | |
| 1226 (mail noerase to subject in-reply-to cc replybuffer sendactions)) | |
| 1227 | |
| 1228 ;;;###autoload | |
| 1229 (defun mail-other-frame (&optional noerase to subject in-reply-to cc | |
| 1230 replybuffer sendactions) | |
| 1231 "Like `mail' command, but display mail buffer in another frame." | |
| 1232 (interactive "P") | |
| 1233 (let ((pop-up-frames t) | |
| 1234 (special-display-buffer-names nil) | |
| 1235 (special-display-regexps nil) | |
| 1236 (same-window-buffer-names nil) | |
| 1237 (same-window-regexps nil)) | |
| 1238 (pop-to-buffer "*mail*")) | |
| 1239 (mail noerase to subject in-reply-to cc replybuffer sendactions)) | |
| 1240 | |
| 1241 ;;; Do not execute these when sendmail.el is loaded, | |
| 1242 ;;; only in loaddefs.el. | |
| 1243 ;;;###autoload (define-key ctl-x-map "m" 'mail) | |
| 1244 ;;;###autoload (define-key ctl-x-4-map "m" 'mail-other-window) | |
| 1245 ;;;###autoload (define-key ctl-x-5-map "m" 'mail-other-frame) | |
| 1246 | |
| 1247 ;;;###autoload (add-hook 'same-window-buffer-names "*mail*") | |
| 1248 | |
| 1249 ;;; Do not add anything but external entries on this page. | |
| 1250 | |
| 1251 (provide 'sendmail) | |
| 1252 | |
| 1253 ;;; sendmail.el ends here |