Mercurial > emacs
diff lisp/mail/rmailout.el @ 63:714e88ef93c8
Initial revision
author | root <root> |
---|---|
date | Tue, 22 May 1990 23:49:44 +0000 |
parents | |
children | 1a0f15a66c06 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/mail/rmailout.el Tue May 22 23:49:44 1990 +0000 @@ -0,0 +1,163 @@ +;; "RMAIL" mail reader for Emacs: output message to a file. +;; Copyright (C) 1985, 1987 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 1, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +;; Temporary until Emacs always has this variable. +(defvar rmail-delete-after-output nil + "*Non-nil means automatically delete a message that is copied to a file.") + +(defun rmail-output-to-rmail-file (count file-name) + "Append the current message to an Rmail file named FILE-NAME. +If the file does not exist, ask if it should be created. +If file is being visited, the message is appended to the Emacs +buffer visiting that file. +A prefix argument N says to output N consecutive messages +starting with the current one. Deleted messages are skipped and don't count." + (interactive (list (prefix-numeric-value current-prefix-arg) + (read-file-name + (concat "Output message to Rmail file: (default " + (file-name-nondirectory rmail-last-rmail-file) + ") ") + (file-name-directory rmail-last-rmail-file) + rmail-last-rmail-file))) + (setq file-name (expand-file-name file-name)) + (setq rmail-last-rmail-file file-name) + (rmail-maybe-set-message-counters) + (or (get-file-buffer file-name) + (file-exists-p file-name) + (if (yes-or-no-p + (concat "\"" file-name "\" does not exist, create it? ")) + (let ((file-buffer (create-file-buffer file-name))) + (save-excursion + (set-buffer file-buffer) + (rmail-insert-rmail-file-header) + (let ((require-final-newline nil)) + (write-region (point-min) (point-max) file-name t 1))) + (kill-buffer file-buffer)) + (error "Output file does not exist"))) + (while (> count 0) + (let (redelete) + (unwind-protect + (progn + (save-restriction + (widen) + (if (rmail-message-deleted-p rmail-current-message) + (progn (setq redelete t) + (rmail-set-attribute "deleted" nil))) + ;; Decide whether to append to a file or to an Emacs buffer. + (save-excursion + (let ((buf (get-file-buffer file-name)) + (cur (current-buffer)) + (beg (1+ (rmail-msgbeg rmail-current-message))) + (end (1+ (rmail-msgend rmail-current-message)))) + (if (not buf) + (append-to-file beg end file-name) + (if (eq buf (current-buffer)) + (error "Can't output message to same file it's already in")) + ;; File has been visited, in buffer BUF. + (set-buffer buf) + (let ((buffer-read-only nil) + (msg (and (boundp 'rmail-current-message) + rmail-current-message))) + ;; If MSG is non-nil, buffer is in RMAIL mode. + (if msg + (progn + (rmail-maybe-set-message-counters) + (widen) + (narrow-to-region (point-max) (point-max)) + (insert-buffer-substring cur beg end) + (goto-char (point-min)) + (widen) + (search-backward "\n\^_") + (narrow-to-region (point) (point-max)) + (rmail-count-new-messages t) + (rmail-show-message msg)) + ;; Output file not in rmail mode => just insert at the end. + (narrow-to-region (point-min) (1+ (buffer-size))) + (goto-char (point-max)) + (insert-buffer-substring cur beg end))))))) + (rmail-set-attribute "filed" t)) + (if redelete (rmail-set-attribute "deleted" t)))) + (setq count (1- count)) + (if rmail-delete-after-output + (rmail-delete-forward) + (if (> count 0) + (rmail-next-undeleted-message 1))))) + +(defun rmail-output (count file-name) + "Append this message to Unix mail file named FILE-NAME. +A prefix argument N says to output N consecutive messages +starting with the current one. Deleted messages are skipped and don't count." + (interactive + (list (prefix-numeric-value current-prefix-arg) + (read-file-name + (concat "Output message to Unix mail file" + (if rmail-last-file + (concat " (default " + (file-name-nondirectory rmail-last-file) + "): " ) + ": ")) + (and rmail-last-file (file-name-directory rmail-last-file)) + rmail-last-file))) + (setq file-name (expand-file-name file-name)) + (setq rmail-last-file file-name) + (while (> count 0) + (let ((rmailbuf (current-buffer)) + (tembuf (get-buffer-create " rmail-output")) + (case-fold-search t)) + (save-excursion + (set-buffer tembuf) + (erase-buffer) + ;; If we can do it, read a little of the file + ;; to check whether it is an RMAIL file. + ;; If it is, don't mess it up. + (if (fboundp 'insert-partial-file-contents) + (progn + (insert-partial-file-contents file-name 0 20) + (if (looking-at "BABYL OPTIONS:\n") + (error (save-excursion + (set-buffer rmailbuf) + (substitute-command-keys + "File %s is an RMAIL file; use the \\[rmail-output-to-rmail-file] command")) + file-name)) + (erase-buffer))) + (insert-buffer-substring rmailbuf) + (insert "\n") + (goto-char (point-min)) + (insert "From " + (mail-strip-quoted-names (or (mail-fetch-field "from") + (mail-fetch-field "really-from") + (mail-fetch-field "sender") + "unknown")) + " " (current-time-string) "\n") + ;; ``Quote'' "\nFrom " as "\n>From " + ;; (note that this isn't really quoting, as there is no requirement + ;; that "\n[>]+From " be quoted in the same transparent way.) + (while (search-forward "\nFrom " nil t) + (forward-char -5) + (insert ?>)) + (append-to-file (point-min) (point-max) file-name)) + (kill-buffer tembuf)) + (if (equal major-mode 'rmail-mode) + (rmail-set-attribute "filed" t)) + (setq count (1- count)) + (if rmail-delete-after-output + (rmail-delete-forward) + (if (> count 0) + (rmail-next-undeleted-message 1)))))