lisp/mail/rmailout.el

   1 ;;; rmailout.el --- "RMAIL" mail reader for Emacs: output message to a file
   2
   3 ;; Copyright (C) 1985, 1987, 1993-1994, 2001-2016 Free Software
   4 ;; Foundation, Inc.
   5
   6 ;; Maintainer: emacs-devel@gnu.org
   7 ;; Keywords: mail
   8 ;; Package: rmail
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software: you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation, either version 3 of the License, or
  15 ;; (at your option) any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  24
  25 ;;; Commentary:
  26
  27 ;;; Code:
  28
  29 (require 'rmail)
  30 (provide 'rmailout)
  31
  32 (defcustom rmail-output-decode-coding nil
  33   "If non-nil, do coding system decoding when outputting message as Babyl."
  34   :type 'boolean
  35   :group 'rmail-output)
  36
  37 (defcustom rmail-output-file-alist nil
  38   "Alist matching regexps to suggested output Rmail files.
  39 This is a list of elements of the form (REGEXP . NAME-EXP).
  40 The suggestion is taken if REGEXP matches anywhere in the message buffer.
  41 NAME-EXP may be a string constant giving the file name to use,
  42 or more generally it may be any kind of expression that returns
  43 a file name as a string."
  44   :type '(repeat (cons regexp
  45                        (choice :value ""
  46                                (string :tag "File Name")
  47                                sexp)))
  48   :group 'rmail-output)
  49 ;; This is risky because NAME-EXP gets evalled.
  50 ;;;###autoload(put 'rmail-output-file-alist 'risky-local-variable t)
  51
  52 (defcustom rmail-fields-not-to-output nil
  53   "Regexp describing fields to exclude when outputting a message to a file.
  54 The function `rmail-delete-unwanted-fields' uses this, ignoring case."
  55   :type '(choice (const :tag "None" nil)
  56                  regexp)
  57   :group 'rmail-output)
  58
  59 (defun rmail-output-read-file-name ()
  60   "Read the file name to use for `rmail-output'.
  61 Set `rmail-default-file' to this name as well as returning it.
  62 This uses `rmail-output-file-alist'."
  63   (let* ((default-file
  64            (or
  65             (when rmail-output-file-alist
  66               (or rmail-buffer (error "There is no Rmail buffer"))
  67               (save-current-buffer
  68                 (set-buffer rmail-buffer)
  69                 (let ((beg (rmail-msgbeg rmail-current-message))
  70                       (end (rmail-msgend rmail-current-message)))
  71                   (if (rmail-buffers-swapped-p) (set-buffer rmail-view-buffer))
  72                   (save-excursion
  73                     (save-restriction
  74                       (widen)
  75                       (narrow-to-region beg end)
  76                       (let ((tail rmail-output-file-alist)
  77                             answer err)
  78                         ;; Suggest a file based on a pattern match.
  79                         (while (and tail (not answer))
  80                           (goto-char (point-min))
  81                           (if (re-search-forward (caar tail) nil t)
  82                               (setq answer
  83                                     (condition-case err
  84                                         (eval (cdar tail))
  85                                       (error
  86                                        (display-warning
  87                                         'rmail-output
  88                                         (format-message "\
  89 Error evaluating `rmail-output-file-alist' element:
  90 regexp: %s
  91 action: %s
  92 error: %S\n"
  93                                                 (caar tail) (cdar tail) err)
  94                                         :error)
  95                                        nil))))
  96                           (setq tail (cdr tail)))
  97                         answer))))))
  98             ;; If no suggestion, use same file as last time.
  99             rmail-default-file))
 100          (read-file
 101           (expand-file-name
 102            (read-file-name
 103             (concat "Output message to mail file (default "
 104                     (file-name-nondirectory default-file)
 105                     "): ")
 106             (file-name-directory default-file)
 107             (abbreviate-file-name default-file))
 108            (file-name-directory default-file))))
 109     (setq rmail-default-file
 110           (if (file-directory-p read-file)
 111               (expand-file-name (file-name-nondirectory default-file)
 112                                 read-file)
 113             (expand-file-name
 114              (or read-file (file-name-nondirectory default-file))
 115              (file-name-directory default-file))))))
 116
 117 (defun rmail-delete-unwanted-fields (preserve)
 118   "Delete all headers matching `rmail-fields-not-to-output'.
 119 Retains headers matching the regexp PRESERVE.  Ignores case.
 120 The buffer should be narrowed to just the header."
 121   (if rmail-fields-not-to-output
 122       (save-excursion
 123         (goto-char (point-min))
 124         (let ((case-fold-search t))
 125           (while (re-search-forward rmail-fields-not-to-output nil t)
 126             (beginning-of-line)
 127             (unless (looking-at preserve)
 128               (delete-region (point) (line-beginning-position 2))))))))
 129 \f
 130 (defun rmail-output-as-babyl (file-name nomsg)
 131   "Convert the current buffer's text to Babyl and output to FILE-NAME.
 132 Alters the current buffer's text, so it should be a temporary buffer.
 133 If a buffer is visiting FILE-NAME, adds the text to that buffer
 134 rather than saving the file directly.  If the buffer is an Rmail buffer,
 135 updates it accordingly.  If no buffer is visiting FILE-NAME, appends
 136 the text directly to FILE-NAME, and displays a \"Wrote file\" message
 137 unless NOMSG is a symbol (neither nil nor t)."
 138   (let ((coding-system-for-write 'emacs-mule-unix))
 139     (save-restriction
 140       (goto-char (point-min))
 141       (search-forward "\n\n" nil 'move)
 142       (narrow-to-region (point-min) (point))
 143       (if rmail-fields-not-to-output
 144           (rmail-delete-unwanted-fields nil)))
 145
 146     ;; Convert to Babyl format.
 147     (rmail-convert-to-babyl-format)
 148     ;; Write it into the file, or its buffer.
 149     (let ((buf (find-buffer-visiting file-name))
 150           (tembuf (current-buffer)))
 151       (if (null buf)
 152           (write-region (point-min) (point-max) file-name t nomsg)
 153         (if (eq buf (current-buffer))
 154             (error "Can't output message to same file it's already in"))
 155         ;; File has been visited, in buffer BUF.
 156         (set-buffer buf)
 157         (let ((inhibit-read-only t)
 158               (msg (bound-and-true-p rmail-current-message)))
 159           ;; If MSG is non-nil, buffer is in RMAIL mode.
 160           (if msg
 161               (rmail-output-to-babyl-buffer tembuf msg)
 162             ;; Output file not in rmail mode => just insert at the end.
 163             (narrow-to-region (point-min) (1+ (buffer-size)))
 164             (goto-char (point-max))
 165             (insert-buffer-substring tembuf)))))))
 166
 167 ;; Called only if rmail-summary-exists, which means rmailsum is loaded.
 168 (declare-function rmail-update-summary "rmailsum" (&rest ignore))
 169
 170 (defun rmail-output-to-babyl-buffer (tembuf msg)
 171   "Copy message in TEMBUF into the current Babyl Rmail buffer.
 172 Do what is necessary to make Rmail know about the new message, then
 173 display message number MSG."
 174   ;; Turn on Auto Save mode, if it's off in this buffer but enabled by default.
 175   (and (not buffer-auto-save-file-name)
 176        auto-save-default
 177        (auto-save-mode t))
 178   (rmail-maybe-set-message-counters)
 179   (widen)
 180   (narrow-to-region (point-max) (point-max))
 181   (insert-buffer-substring tembuf)
 182   (goto-char (point-min))
 183   (widen)
 184   (search-backward "\n\^_")
 185   (narrow-to-region (point) (point-max))
 186   (rmail-count-new-messages t)
 187   (if (rmail-summary-exists)
 188       (rmail-select-summary (rmail-update-summary)))
 189   (rmail-show-message-1 msg))
 190 \f
 191 (defun rmail-convert-to-babyl-format ()
 192   "Convert the mbox message in the current buffer to Babyl format."
 193   (let ((count 0) (start (point-min))
 194         (case-fold-search nil)
 195         (buffer-undo-list t))
 196     (goto-char (point-min))
 197     (save-restriction
 198       (unless (looking-at "^From ")
 199         (error "Invalid mbox message"))
 200       (insert "\^L\n0,,\n*** EOOH ***\n")
 201       (rmail-nuke-pinhead-header)
 202       ;; Decode base64 or quoted printable contents, Rmail style.
 203       (let* ((header-end (save-excursion
 204                            (and (re-search-forward "\n\n" nil t)
 205                                 (1- (point)))))
 206              (case-fold-search t)
 207              (quoted-printable-header-field-end
 208               (save-excursion
 209                 (re-search-forward
 210                  "^content-transfer-encoding:\\(\n?[\t ]\\)*quoted-printable\\(\n?[\t ]\\)*"
 211                  header-end t)))
 212              (base64-header-field-end
 213               (and
 214                ;; Don't decode non-text data.
 215                (save-excursion
 216                  (re-search-forward
 217                   "^content-type:\\(\n?[\t ]\\)\\(text\\|message\\)/"
 218                   header-end t))
 219                (save-excursion
 220                  (re-search-forward
 221                   "^content-transfer-encoding:\\(\n?[\t ]\\)*base64\\(\n?[\t ]\\)*"
 222                   header-end t)))))
 223
 224         (goto-char (point-max))
 225         (if quoted-printable-header-field-end
 226             (save-excursion
 227               (unless (mail-unquote-printable-region
 228                        header-end (point) nil t t)
 229                 (message "Malformed MIME quoted-printable message"))
 230               ;; Change "quoted-printable" to "8bit",
 231               ;; to reflect the decoding we just did.
 232               (goto-char quoted-printable-header-field-end)
 233               (delete-region (point) (search-backward ":"))
 234               (insert ": 8bit")))
 235         (if base64-header-field-end
 236             (save-excursion
 237               (when (condition-case nil
 238                         (progn
 239                           (base64-decode-region
 240                            (1+ header-end)
 241                            (save-excursion
 242                              ;; Prevent base64-decode-region
 243                              ;; from removing newline characters.
 244                              (skip-chars-backward "\n\t ")
 245                              (point)))
 246                           t)
 247                       (error nil))
 248                 ;; Change "base64" to "8bit", to reflect the
 249                 ;; decoding we just did.
 250                 (goto-char base64-header-field-end)
 251                 (delete-region (point) (search-backward ":"))
 252                 (insert ": 8bit")))))
 253       ;; Transform anything within the message text
 254       ;; that might appear to be the end of a Babyl-format message.
 255       (save-excursion
 256         (save-restriction
 257           (narrow-to-region start (point))
 258           (goto-char (point-min))
 259           (while (search-forward "\n\^_" nil t) ; single char
 260             (replace-match "\n^_"))))           ; 2 chars: "^" and "_"
 261       ;; This is for malformed messages that don't end in newline.
 262       ;; There shouldn't be any, but some users say occasionally
 263       ;; there are some.
 264       (or (bolp) (newline))
 265       (insert ?\^_)
 266       (setq last-coding-system-used nil)
 267       ;; Decode coding system, following specs in the message header,
 268       ;; and record what coding system was decoded.
 269       (if rmail-output-decode-coding
 270           (let ((mime-charset
 271                  (if (save-excursion
 272                        (goto-char start)
 273                        (search-forward "\n\n" nil t)
 274                        (let ((case-fold-search t))
 275                          (re-search-backward
 276                           rmail-mime-charset-pattern
 277                           start t)))
 278                      (intern (downcase (match-string 1))))))
 279             (rmail-decode-region start (point) mime-charset)))
 280       (save-excursion
 281         (goto-char start)
 282         (forward-line 3)
 283         (insert "X-Coding-System: "
 284                 (symbol-name last-coding-system-used)
 285                 "\n")))))
 286
 287 (defun rmail-nuke-pinhead-header ()
 288   "Delete the \"From \" line in the current mbox message.
 289 The variable `rmail-unix-mail-delimiter' specifies the From line format.
 290 Replaces the From line with a \"Mail-from\" header.  Adds \"Date\" and
 291 \"From\" headers if they are not already present."
 292   (save-excursion
 293     (save-restriction
 294       (let ((start (point))
 295             (end (progn
 296                    (condition-case ()
 297                        (search-forward "\n\n")
 298                      (error
 299                       (goto-char (point-max))
 300                       (insert "\n\n")))
 301                    (point)))
 302             has-from has-date)
 303         (narrow-to-region start end)
 304         (let ((case-fold-search t))
 305           (goto-char start)
 306           (setq has-from (search-forward "\nFrom:" nil t))
 307           (goto-char start)
 308           (setq has-date (and (search-forward "\nDate:" nil t) (point)))
 309           (goto-char start))
 310         (let ((case-fold-search nil))
 311           (if (re-search-forward (concat "^" rmail-unix-mail-delimiter) nil t)
 312               (replace-match
 313                 (concat
 314                   "Mail-from: \\&"
 315                   ;; Keep and reformat the date if we don't
 316                   ;;  have a Date: field.
 317                   (if has-date
 318                       ""
 319                     (concat
 320                      "Date: \\2, \\4 \\3 \\9 \\5 "
 321
 322                      ;; The timezone could be matched by group 7 or group 10.
 323                      ;; If neither of them matched, assume EST, since only
 324                      ;; Easterners would be so sloppy.
 325                      ;; It's a shame the substitution can't use "\\10".
 326                      (cond
 327                       ((/= (match-beginning 7) (match-end 7)) "\\7")
 328                       ((/= (match-beginning 10) (match-end 10))
 329                        (buffer-substring (match-beginning 10)
 330                                          (match-end 10)))
 331                       (t "EST"))
 332                      "\n"))
 333                   ;; Keep and reformat the sender if we don't
 334                   ;; have a From: field.
 335                   (if has-from
 336                       ""
 337                     "From: \\1\n"))
 338                 t)))))))
 339 \f
 340 (autoload 'mail-mbox-from "mail-utils")
 341
 342 (defun rmail-output-as-mbox (file-name nomsg &optional as-seen)
 343   "Convert the current buffer's text to mbox and output to FILE-NAME.
 344 Alters the current buffer's text, so it should be a temporary buffer.
 345 If a buffer is visiting FILE-NAME, adds the text to that buffer
 346 rather than saving the file directly.  If the buffer is an Rmail buffer,
 347 updates it accordingly.  If no buffer is visiting FILE-NAME, appends
 348 the text directly to FILE-NAME, and displays a \"Wrote file\" message
 349 unless NOMSG is a symbol (neither nil nor t).
 350 AS-SEEN is non-nil if we are copying the message \"as seen\"."
 351   (let ((case-fold-search t)
 352         encrypted-file-name
 353         from date)
 354     (goto-char (point-min))
 355     ;; Preserve the Mail-From and MIME-Version fields
 356     ;; even if they have been pruned.
 357     (search-forward "\n\n" nil 'move)
 358     (narrow-to-region (point-min) (point))
 359     (rmail-delete-unwanted-fields
 360      (if rmail-enable-mime "Mail-From"
 361        "Mail-From\\|MIME-Version\\|Content-type"))
 362     (goto-char (point-min))
 363     (or (looking-at "From ")
 364         (insert (mail-mbox-from)))
 365     (widen)
 366     ;; Make sure message ends with blank line.
 367     (goto-char (point-max))
 368     (rmail-ensure-blank-line)
 369     (goto-char (point-min))
 370     (let ((buf (find-buffer-visiting file-name))
 371           (tembuf (current-buffer)))
 372       (when (string-match "[.]gpg\\'" file-name)
 373         (setq encrypted-file-name file-name
 374               file-name (substring file-name 0 (match-beginning 0))))
 375       (if (null buf)
 376           (let ((coding-system-for-write 'raw-text-unix)
 377                 (coding-system-for-read 'raw-text-unix))
 378             ;; If the specified file is encrypted, decrypt it.
 379             (when encrypted-file-name
 380               (with-temp-buffer
 381                 (insert-file-contents encrypted-file-name)
 382                 (write-region 1 (point-max) file-name nil 'nomsg)))
 383             ;; FIXME should ensure existing file ends with a blank line.
 384             (write-region (point-min) (point-max) file-name t
 385                           (if (or nomsg encrypted-file-name)
 386                               'nomsg))
 387             ;; If the specified file was encrypted, re-encrypt it.
 388             (when encrypted-file-name
 389               ;; Save the old encrypted file as a backup.
 390               (rename-file encrypted-file-name
 391                            (make-backup-file-name encrypted-file-name)
 392                            t)
 393               (if (= 0
 394                      (call-process "gpg" nil nil
 395                                    "--use-agent" "--batch" "--no-tty"
 396                                    "--encrypt" "-r"
 397                                    user-mail-address
 398                                    file-name))
 399                   ;; Delete the unencrypted file if encryption succeeded.
 400                   (delete-file file-name)
 401                 ;; If encrypting failed, put back the original
 402                 ;; encrypted file and signal an error.
 403                 (rename-file (make-backup-file-name encrypted-file-name)
 404                              encrypted-file-name
 405                              t)
 406                 (error "Encryption failed; %s unchanged"
 407                        encrypted-file-name))
 408               (unless nomsg
 409                 (message "Added to %s" encrypted-file-name)))
 410             )
 411         (if (eq buf (current-buffer))
 412             (error "Can't output message to same file it's already in"))
 413         ;; File has been visited, in buffer BUF.
 414         (set-buffer buf)
 415         (let ((inhibit-read-only t)
 416               (msg (and (boundp 'rmail-current-message)
 417                         rmail-current-message)))
 418           (and msg as-seen
 419                (error "Can't output \"as seen\" to a visited Rmail file"))
 420           (if msg
 421               (rmail-output-to-rmail-buffer tembuf msg)
 422             ;; Output file not in Rmail mode => just insert at the end.
 423             (narrow-to-region (point-min) (1+ (buffer-size)))
 424             (goto-char (point-max))
 425             (insert-buffer-substring tembuf)))))))
 426
 427 (defun rmail-output-to-rmail-buffer (tembuf msg)
 428   "Copy message in TEMBUF into the current Rmail buffer.
 429 Do what is necessary to make Rmail know about the new message. then
 430 display message number MSG."
 431   (save-excursion
 432     (rmail-swap-buffers-maybe)
 433     (rmail-modify-format)
 434     ;; Turn on Auto Save mode, if it's off in this buffer but enabled
 435     ;; by default.
 436     (and (not buffer-auto-save-file-name)
 437          auto-save-default
 438          (auto-save-mode t))
 439     (rmail-maybe-set-message-counters)
 440     ;; Insert the new message after the last old message.
 441     (widen)
 442     (unless (zerop (buffer-size))
 443       ;; Make sure the last old message ends with a blank line.
 444       (goto-char (point-max))
 445       (rmail-ensure-blank-line)
 446       ;; Insert the new message at the end.
 447       (narrow-to-region (point-max) (point-max)))
 448     (insert-buffer-substring tembuf)
 449     (rmail-count-new-messages t)
 450     ;; FIXME should re-use existing windows.
 451     (if (rmail-summary-exists)
 452         (rmail-select-summary (rmail-update-summary)))
 453     (rmail-show-message-1 msg)))
 454 \f
 455 ;;; There are functions elsewhere in Emacs that use this function;
 456 ;;; look at them before you change the calling method.
 457 ;;;###autoload
 458 (defun rmail-output (file-name &optional count noattribute not-rmail)
 459   "Append this message to mail file FILE-NAME.
 460 Writes mbox format, unless FILE-NAME exists and is Babyl format, in which
 461 case it writes Babyl.
 462
 463 Interactively, the default file name comes from `rmail-default-file',
 464 which is updated to the name you use in this command.  In all uses, if
 465 FILE-NAME is not absolute, it is expanded with the directory part of
 466 `rmail-default-file'.
 467
 468 If a buffer is visiting FILE-NAME, adds the text to that buffer
 469 rather than saving the file directly.  If the buffer is an Rmail
 470 buffer, updates it accordingly.
 471
 472 This command always outputs the complete message header, even if
 473 the header display is currently pruned.
 474
 475 Optional prefix argument COUNT (default 1) says to output that
 476 many consecutive messages, starting with the current one (ignoring
 477 deleted messages).  If `rmail-delete-after-output' is non-nil, deletes
 478 messages after output.
 479
 480 The optional third argument NOATTRIBUTE, if non-nil, says not to
 481 set the `filed' attribute, and not to display a \"Wrote file\"
 482 message (if writing a file directly).
 483
 484 Set the optional fourth argument NOT-RMAIL non-nil if you call this
 485 from a non-Rmail buffer.  In this case, COUNT is ignored."
 486   (interactive
 487    (list (rmail-output-read-file-name)
 488          (prefix-numeric-value current-prefix-arg)))
 489   (or count (setq count 1))
 490   (setq file-name
 491         (expand-file-name file-name
 492                           (and rmail-default-file
 493                                (file-name-directory rmail-default-file))))
 494   ;; Warn about creating new file.
 495   (or (find-buffer-visiting file-name)
 496       (file-exists-p file-name)
 497       (yes-or-no-p (concat "\"" file-name "\" does not exist, create it? "))
 498       (error "Output file does not exist"))
 499   (if noattribute (setq noattribute 'nomsg))
 500   (let ((babyl-format (and (file-readable-p file-name)
 501                            (mail-file-babyl-p file-name)))
 502         (cur (current-buffer))
 503         (buf (find-buffer-visiting file-name)))
 504
 505     ;; If a babyl file is visited in a buffer, is it visited as babyl
 506     ;; or as mbox?
 507     (and babyl-format buf
 508          (with-current-buffer buf
 509            (save-restriction
 510              (widen)
 511              (save-excursion
 512                (goto-char (point-min))
 513                (setq babyl-format
 514                      (looking-at "BABYL OPTIONS:"))))))
 515
 516     (if not-rmail                ; eg via message-fcc-handler-function
 517         (with-temp-buffer
 518           (insert-buffer-substring cur)
 519           ;; Output in the appropriate format.
 520           (if babyl-format
 521               (progn
 522                 (goto-char (point-min))
 523                 ;; rmail-convert-to-babyl-format errors if no From line,
 524                 ;; whereas rmail-output-as-mbox inserts one.
 525                 (or (looking-at "From ")
 526                     (insert (mail-mbox-from)))
 527                 (rmail-output-as-babyl file-name noattribute))
 528             (rmail-output-as-mbox file-name noattribute)))
 529       ;; Called from an Rmail buffer.
 530       (if rmail-buffer
 531           (set-buffer rmail-buffer)
 532         (error "There is no Rmail buffer"))
 533       (if (zerop rmail-total-messages)
 534           (error "No messages to output"))
 535       (let ((orig-count count)
 536             beg end)
 537         (while (> count 0)
 538           (setq beg (rmail-msgbeg rmail-current-message)
 539                 end (rmail-msgend rmail-current-message))
 540           ;; All access to the buffer's local variables is now finished...
 541           (save-excursion
 542             ;; ... so it is ok to go to a different buffer.
 543             (if (rmail-buffers-swapped-p) (set-buffer rmail-view-buffer))
 544             (setq cur (current-buffer))
 545             (save-restriction
 546               (widen)
 547               (with-temp-buffer
 548                 (insert-buffer-substring cur beg end)
 549                 (if babyl-format
 550                     (rmail-output-as-babyl file-name noattribute)
 551                   (rmail-output-as-mbox file-name noattribute)))))
 552           (or noattribute               ; mark message as "filed"
 553               (rmail-set-attribute rmail-filed-attr-index t))
 554           (setq count (1- count))
 555           (let ((next-message-p
 556                  (if rmail-delete-after-output
 557                      (rmail-delete-forward)
 558                    (if (> count 0)
 559                        (rmail-next-undeleted-message 1))))
 560                 (num-appended (- orig-count count)))
 561             (if (and (> count 0) (not next-message-p))
 562                 (error "Only %d message%s appended" num-appended
 563                        (if (= num-appended 1) "" "s")))))))))
 564
 565 ;; FIXME nothing outside uses this, so NOT-RMAIL could be dropped.
 566 ;; FIXME this duplicates code from rmail-output.
 567 ;;;###autoload
 568 (defun rmail-output-as-seen (file-name &optional count noattribute not-rmail)
 569   "Append this message to mbox file named FILE-NAME.
 570 The details are as for `rmail-output', except that:
 571   i) the header is output as currently seen
 572  ii) this function cannot write to Babyl files
 573 iii) an Rmail buffer cannot be visiting FILE-NAME
 574
 575 Note that if NOT-RMAIL is non-nil, there is no difference between this
 576 function and `rmail-output'.  This argument may be removed in future,
 577 so you should call `rmail-output' directly in that case."
 578   (interactive
 579    (list (rmail-output-read-file-name)
 580          (prefix-numeric-value current-prefix-arg)))
 581   (if not-rmail
 582       (rmail-output file-name count noattribute not-rmail)
 583     (or count (setq count 1))
 584     (setq file-name
 585           (expand-file-name file-name
 586                             (and rmail-default-file
 587                                  (file-name-directory rmail-default-file))))
 588     ;; Warn about creating new file.
 589     (or (find-buffer-visiting file-name)
 590         (file-exists-p file-name)
 591         (yes-or-no-p (concat "\"" file-name "\" does not exist, create it? "))
 592         (error "Output file does not exist"))
 593     ;; FIXME why not?
 594     (if (and (file-readable-p file-name) (mail-file-babyl-p file-name))
 595         (error "Cannot output `as seen' to a Babyl file"))
 596     (if noattribute (setq noattribute 'nomsg))
 597     (if rmail-buffer
 598         (set-buffer rmail-buffer)
 599       (error "There is no Rmail buffer"))
 600     (if (zerop rmail-total-messages)
 601         (error "No messages to output"))
 602     (let ((orig-count count)
 603           (cur (current-buffer)))
 604       (while (> count 0)
 605         (let (beg end)
 606           ;; If operating from whole-mbox buffer, get message bounds.
 607           (or (rmail-buffers-swapped-p)
 608               (setq beg (rmail-msgbeg rmail-current-message)
 609                     end (rmail-msgend rmail-current-message)))
 610           (save-restriction
 611             (widen)
 612             ;; If operating from the view buffer, get the bounds.
 613             (or beg
 614                 (setq beg (point-min)
 615                       end (point-max)))
 616             (with-temp-buffer
 617               (insert-buffer-substring cur beg end)
 618               (rmail-output-as-mbox file-name noattribute t))))
 619         (or noattribute         ; mark message as "filed"
 620             (rmail-set-attribute rmail-filed-attr-index t))
 621         (setq count (1- count))
 622         (let ((next-message-p
 623                (if rmail-delete-after-output
 624                    (rmail-delete-forward)
 625                  (if (> count 0)
 626                      (rmail-next-undeleted-message 1))))
 627               (num-appended (- orig-count count)))
 628           (if (and (> count 0) (not next-message-p))
 629               (error "Only %d message%s appended" num-appended
 630                      (if (= num-appended 1) "" "s"))))))))
 631
 632 \f
 633 ;;;###autoload
 634 (defun rmail-output-body-to-file (file-name)
 635   "Write this message body to the file FILE-NAME.
 636 Interactively, the default file name comes from either the message
 637 \"Subject\" header, or from `rmail-default-body-file'.  Updates the value
 638 of `rmail-default-body-file' accordingly.  In all uses, if FILE-NAME
 639 is not absolute, it is expanded with the directory part of
 640 `rmail-default-body-file'.
 641
 642 Note that this overwrites FILE-NAME (after confirmation), rather
 643 than appending to it.  Deletes the message after writing if
 644 `rmail-delete-after-output' is non-nil."
 645   (interactive
 646    (let ((default-file
 647            (or (mail-fetch-field "Subject")
 648                rmail-default-body-file)))
 649      (setq default-file
 650            (replace-regexp-in-string ":" "-" default-file))
 651      (setq default-file
 652            (replace-regexp-in-string " " "-" default-file))
 653      (list (setq rmail-default-body-file
 654                  (read-file-name
 655                   "Output message body to file: "
 656                   (and default-file (file-name-directory default-file))
 657                   default-file
 658                   nil default-file)))))
 659   (setq file-name
 660         (expand-file-name file-name
 661                           (and rmail-default-body-file
 662                                (file-name-directory rmail-default-body-file))))
 663   (if (zerop rmail-current-message)
 664       (error "No message to output"))
 665   (save-excursion
 666     (goto-char (point-min))
 667     (search-forward "\n\n")
 668     (and (file-exists-p file-name)
 669          (not (y-or-n-p (format "File %s exists; overwrite? " file-name)))
 670          (error "Operation aborted"))
 671     (write-region (point) (point-max) file-name))
 672   (if rmail-delete-after-output
 673       (rmail-delete-forward)))
 674
 675 ;;; rmailout.el ends here