![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to rmailout.el CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Apple XNU] / GNUtools / emacs / lisp|
Return to rmailout.el CVS log | Up to [Apple XNU] / GNUtools / emacs / lisp |
1.1 root 1: ;; "RMAIL" mail reader for Emacs: output message to a file.
2: ;; Copyright (C) 1985, 1987 Free Software Foundation, Inc.
3:
4: ;; This file is part of GNU Emacs.
5:
6: ;; GNU Emacs is free software; you can redistribute it and/or modify
7: ;; it under the terms of the GNU General Public License as published by
8: ;; the Free Software Foundation; either version 1, or (at your option)
9: ;; any later version.
10:
11: ;; GNU Emacs is distributed in the hope that it will be useful,
12: ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13: ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14: ;; GNU General Public License for more details.
15:
16: ;; You should have received a copy of the GNU General Public License
17: ;; along with GNU Emacs; see the file COPYING. If not, write to
18: ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
19:
20:
21: ;; Temporary until Emacs always has this variable.
22: (defvar rmail-delete-after-output nil
23: "*Non-nil means automatically delete a message that is copied to a file.")
24:
25: (defun rmail-output-to-rmail-file (file-name)
26: "Append the current message to an Rmail file named FILE-NAME.
27: If the file does not exist, ask if it should be created.
28: If file is being visited, the message is appended to the Emacs
29: buffer visiting that file."
30: (interactive (list (read-file-name
31: (concat "Output message to Rmail file: (default "
32: (file-name-nondirectory rmail-last-rmail-file)
33: ") ")
34: (file-name-directory rmail-last-rmail-file)
35: rmail-last-rmail-file)))
36: (setq file-name (expand-file-name file-name))
37: (setq rmail-last-rmail-file file-name)
38: (rmail-maybe-set-message-counters)
39: (or (get-file-buffer file-name)
40: (file-exists-p file-name)
41: (if (yes-or-no-p
42: (concat "\"" file-name "\" does not exist, create it? "))
43: (let ((file-buffer (create-file-buffer file-name)))
44: (save-excursion
45: (set-buffer file-buffer)
46: (rmail-insert-rmail-file-header)
47: (let ((require-final-newline nil))
48: (write-region (point-min) (point-max) file-name t 1)))
49: (kill-buffer file-buffer))
50: (error "Output file does not exist")))
51: (save-restriction
52: (widen)
53: ;; Decide whether to append to a file or to an Emacs buffer.
54: (save-excursion
55: (let ((buf (get-file-buffer file-name))
56: (cur (current-buffer))
57: (beg (1+ (rmail-msgbeg rmail-current-message)))
58: (end (1+ (rmail-msgend rmail-current-message))))
59: (if (not buf)
60: (append-to-file beg end file-name)
61: (if (eq buf (current-buffer))
62: (error "Can't output message to same file it's already in"))
63: ;; File has been visited, in buffer BUF.
64: (set-buffer buf)
65: (let ((buffer-read-only nil)
66: (msg (and (boundp 'rmail-current-message)
67: rmail-current-message)))
68: ;; If MSG is non-nil, buffer is in RMAIL mode.
69: (if msg
70: (rmail-maybe-set-message-counters))
71: (widen)
72: (narrow-to-region (point-max) (point-max))
73: (insert-buffer-substring cur beg end)
74: (if msg
75: (progn
76: (goto-char (point-min))
77: (widen)
78: (search-backward "\^_")
79: (narrow-to-region (point) (point-max))
80: (goto-char (1+ (point-min)))
81: (rmail-count-new-messages t)
82: (rmail-show-message msg))))))))
83: (rmail-set-attribute "filed" t)
84: (and rmail-delete-after-output (rmail-delete-forward)))
85:
86: (defun rmail-output (file-name)
87: "Append this message to Unix mail file named FILE-NAME."
88: (interactive
89: (list
90: (read-file-name
91: (concat "Output message to Unix mail file"
92: (if rmail-last-file
93: (concat " (default "
94: (file-name-nondirectory rmail-last-file)
95: "): " )
96: ": "))
97: (and rmail-last-file (file-name-directory rmail-last-file))
98: rmail-last-file)))
99: (setq file-name (expand-file-name file-name))
100: (setq rmail-last-file file-name)
101: (let ((rmailbuf (current-buffer))
102: (tembuf (get-buffer-create " rmail-output"))
103: (case-fold-search t))
104: (save-excursion
105: (set-buffer tembuf)
106: (erase-buffer)
107: (insert-buffer-substring rmailbuf)
108: (insert "\n")
109: (goto-char (point-min))
110: (insert "From "
111: (if (mail-fetch-field "from")
112: (mail-strip-quoted-names (mail-fetch-field "from"))
113: "unknown")
114: " " (current-time-string) "\n")
115: ;; ``Quote'' "\nFrom " as "\n>From "
116: ;; (note that this isn't really quoting, as there is no requirement
117: ;; that "\n[>]+From " be quoted in the same transparent way.)
118: (while (search-forward "\nFrom " nil t)
119: (forward-char -5)
120: (insert ?>))
121: (append-to-file (point-min) (point-max) file-name))
122: (kill-buffer tembuf))
123: (if (equal major-mode 'rmail-mode)
124: (progn
125: (rmail-set-attribute "filed" t)
126: (and rmail-delete-after-output (rmail-delete-forward)))))
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.