lisp/mail/rmailout.el

   1 ;;; rmailout.el --- "RMAIL" mail reader for Emacs: output message to a file.
   2
   3 ;; Copyright (C) 1985, 1987 Free Software Foundation, Inc.
   4
   5 ;; Maintainer: FSF
   6 ;; Keywords: mail
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software; you can redistribute it and/or modify
  11 ;; it 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 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  23
  24 ;;; Code:
  25
  26 ;; Temporary until Emacs always has this variable.
  27 (defvar rmail-delete-after-output nil
  28   "*Non-nil means automatically delete a message that is copied to a file.")
  29
  30 (defvar rmail-output-file-alist nil
  31   "*Alist matching regexps to suggested output Rmail files.
  32 This is a list of elements of the form (REGEXP . FILENAME).")
  33
  34 ;;; There are functions elsewhere in Emacs that use this function; check
  35 ;;; them out before you change the calling method.
  36 (defun rmail-output-to-rmail-file (file-name &optional count)
  37   "Append the current message to an Rmail file named FILE-NAME.
  38 If the file does not exist, ask if it should be created.
  39 If file is being visited, the message is appended to the Emacs
  40 buffer visiting that file.
  41 A prefix argument N says to output N consecutive messages
  42 starting with the current one.  Deleted messages are skipped and don't count."
  43   (interactive (list (read-file-name
  44                       (concat "Output message to Rmail file: (default "
  45                               (file-name-nondirectory rmail-last-rmail-file)
  46                               ") ")
  47                       (file-name-directory rmail-last-rmail-file)
  48                       (let (answer tail)
  49                         (setq tail rmail-output-file-alist)
  50                         ;; Suggest a file based on a pattern match.
  51                         (while (and tail (not answer))
  52                           (save-excursion
  53                             (goto-char (point-min))
  54                             (if (re-search-forward (car (car tail)) nil t)
  55                                 (setq answer (cdr (car tail))))
  56                             (setq tail (cdr tail))))
  57                         ;; If not suggestions, use same file as last time.
  58                         (or answer rmail-last-rmail-file)))
  59                      (prefix-numeric-value current-prefix-arg)))
  60   (or count (setq count 1))
  61   (setq file-name
  62         (expand-file-name file-name
  63                           (file-name-directory rmail-last-rmail-file)))
  64   (setq rmail-last-rmail-file file-name)
  65   (rmail-maybe-set-message-counters)
  66   (setq file-name (abbreviate-file-name file-name))
  67   (or (get-file-buffer file-name)
  68       (file-exists-p file-name)
  69       (if (yes-or-no-p
  70            (concat "\"" file-name "\" does not exist, create it? "))
  71           (let ((file-buffer (create-file-buffer file-name)))
  72             (save-excursion
  73               (set-buffer file-buffer)
  74               (rmail-insert-rmail-file-header)
  75               (let ((require-final-newline nil))
  76                 (write-region (point-min) (point-max) file-name t 1)))
  77             (kill-buffer file-buffer))
  78         (error "Output file does not exist")))
  79   (while (> count 0)
  80     (let (redelete)
  81       (unwind-protect
  82           (progn
  83             (save-restriction
  84               (widen)
  85               (if (rmail-message-deleted-p rmail-current-message)
  86                   (progn (setq redelete t)
  87                          (rmail-set-attribute "deleted" nil)))
  88               ;; Decide whether to append to a file or to an Emacs buffer.
  89               (save-excursion
  90                 (let ((buf (get-file-buffer file-name))
  91                       (cur (current-buffer))
  92                       (beg (1+ (rmail-msgbeg rmail-current-message)))
  93                       (end (1+ (rmail-msgend rmail-current-message))))
  94                   (if (not buf)
  95                       (append-to-file beg end file-name)
  96                     (if (eq buf (current-buffer))
  97                         (error "Can't output message to same file it's already in"))
  98                     ;; File has been visited, in buffer BUF.
  99                     (set-buffer buf)
 100                     (let ((buffer-read-only nil)
 101                           (msg (and (boundp 'rmail-current-message)
 102                                     rmail-current-message)))
 103                       ;; If MSG is non-nil, buffer is in RMAIL mode.
 104                       (if msg
 105                           (progn
 106                             (rmail-maybe-set-message-counters)
 107                             (widen)
 108                             (narrow-to-region (point-max) (point-max))
 109                             (insert-buffer-substring cur beg end)
 110                             (goto-char (point-min))
 111                             (widen)
 112                             (search-backward "\n\^_")
 113                             (narrow-to-region (point) (point-max))
 114                             (rmail-count-new-messages t)
 115                             (rmail-show-message msg))
 116               ;; Output file not in rmail mode => just insert at the end.
 117               (narrow-to-region (point-min) (1+ (buffer-size)))
 118               (goto-char (point-max))
 119               (insert-buffer-substring cur beg end)))))))
 120             (rmail-set-attribute "filed" t))
 121         (if redelete (rmail-set-attribute "deleted" t))))
 122     (setq count (1- count))
 123     (if rmail-delete-after-output
 124         (rmail-delete-forward)
 125       (if (> count 0)
 126           (rmail-next-undeleted-message 1)))))
 127
 128 ;;; There are functions elsewhere in Emacs that use this function; check
 129 ;;; them out before you change the calling method.
 130 (defun rmail-output (file-name &optional count)
 131   "Append this message to Unix mail file named FILE-NAME.
 132 A prefix argument N says to output N consecutive messages
 133 starting with the current one.  Deleted messages are skipped and don't count.
 134 When called from lisp code, N may be omitted."
 135   (interactive
 136    (list (read-file-name
 137           (concat "Output message to Unix mail file"
 138                   (if rmail-last-file
 139                       (concat " (default "
 140                               (file-name-nondirectory rmail-last-file)
 141                               "): " )
 142                     ": "))
 143           (and rmail-last-file (file-name-directory rmail-last-file))
 144           rmail-last-file)
 145          (prefix-numeric-value current-prefix-arg)))
 146   (or count (setq count 1))
 147   (setq file-name
 148         (expand-file-name file-name
 149                           (and rmail-last-file
 150                                (file-name-directory rmail-last-file))))
 151   (setq rmail-last-file file-name)
 152   (while (> count 0)
 153     (let ((rmailbuf (current-buffer))
 154           (tembuf (get-buffer-create " rmail-output"))
 155           (case-fold-search t))
 156       (save-excursion
 157         (set-buffer tembuf)
 158         (erase-buffer)
 159         ;; If we can do it, read a little of the file
 160         ;; to check whether it is an RMAIL file.
 161         ;; If it is, don't mess it up.
 162         (if (fboundp 'insert-partial-file-contents)
 163             (progn
 164               (insert-partial-file-contents file-name 0 20)
 165               (if (looking-at "BABYL OPTIONS:\n")
 166                   (error (save-excursion
 167                            (set-buffer rmailbuf)
 168                            (substitute-command-keys
 169                             "File %s is an RMAIL file; use the \\[rmail-output-to-rmail-file] command"))
 170                          file-name))
 171               (erase-buffer)))
 172         (insert-buffer-substring rmailbuf)
 173         (insert "\n")
 174         (goto-char (point-min))
 175         (insert "From "
 176                 (mail-strip-quoted-names (or (mail-fetch-field "from")
 177                                              (mail-fetch-field "really-from")
 178                                              (mail-fetch-field "sender")
 179                                              "unknown"))
 180                 " " (current-time-string) "\n")
 181         ;; ``Quote'' "\nFrom " as "\n>From "
 182         ;;  (note that this isn't really quoting, as there is no requirement
 183         ;;   that "\n[>]+From " be quoted in the same transparent way.)
 184         (while (search-forward "\nFrom " nil t)
 185           (forward-char -5)
 186           (insert ?>))
 187         (append-to-file (point-min) (point-max) file-name))
 188       (kill-buffer tembuf))
 189     (if (equal major-mode 'rmail-mode)
 190         (rmail-set-attribute "filed" t))
 191     (setq count (1- count))
 192     (if rmail-delete-after-output
 193         (rmail-delete-forward)
 194       (if (> count 0)
 195           (rmail-next-undeleted-message 1)))))
 196
 197 ;;; rmailout.el ends here