![[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 [CSRG BSD Unix] / 43BSD / contrib / emacs / lisp|
Return to rmailout.el CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / lisp |
1.1 root 1: ;; "RMAIL" mail reader for Emacs: output message to a file.
2: ;; Copyright (C) 1985 Richard M. Stallman.
3:
4: ;; This file is part of GNU Emacs.
5:
6: ;; GNU Emacs is distributed in the hope that it will be useful,
7: ;; but WITHOUT ANY WARRANTY. No author or distributor
8: ;; accepts responsibility to anyone for the consequences of using it
9: ;; or for whether it serves any particular purpose or works at all,
10: ;; unless he says so in writing. Refer to the GNU Emacs General Public
11: ;; License for full details.
12:
13: ;; Everyone is granted permission to copy, modify and redistribute
14: ;; GNU Emacs, but only under the conditions described in the
15: ;; GNU Emacs General Public License. A copy of this license is
16: ;; supposed to have been given to you along with GNU Emacs so you
17: ;; can know your rights and responsibilities. It should be in a
18: ;; file named COPYING. Among other things, the copyright notice
19: ;; and this notice must be preserved on all copies.
20:
21:
22: ;; Temporary until Emacs always has this variable.
23: (defvar rmail-delete-after-output nil
24: "*Non-nil means automatically delete a message that is copied to a file.")
25:
26: (defun rmail-output-to-rmail-file (file-name)
27: "Append the current message to an Rmail file named FILE-NAME.
28: If the file does not exist, ask if it should be created.
29: If file is being visited, the message is appended to the Emacs
30: buffer visiting that file."
31: (interactive
32: (list
33: (read-file-name
34: (concat "Output message to Rmail file: (default "
35: (file-name-nondirectory rmail-last-rmail-file)
36: ") ")
37: (file-name-directory rmail-last-rmail-file)
38: rmail-last-rmail-file)))
39: (setq file-name (expand-file-name file-name))
40: (setq rmail-last-rmail-file file-name)
41: (rmail-maybe-set-message-counters)
42: (or (get-file-buffer file-name)
43: (file-exists-p file-name)
44: (if (yes-or-no-p
45: (concat "\"" file-name "\" does not exist, create it? "))
46: (let ((file-buffer (create-file-buffer file-name)))
47: (save-excursion
48: (set-buffer file-buffer)
49: (rmail-insert-rmail-file-header)
50: (let ((require-final-newline nil))
51: (write-region (point-min) (point-max) file-name t 1)))
52: (kill-buffer file-buffer))
53: (error "Output file does not exist")))
54: (save-restriction
55: (widen)
56: ;; Decide whether to append to a file or to an Emacs buffer.
57: (save-excursion
58: (let ((buf (get-file-buffer file-name))
59: (cur (current-buffer))
60: (beg (1+ (rmail-msgbeg rmail-current-message)))
61: (end (1+ (rmail-msgend rmail-current-message))))
62: (if (not buf)
63: (append-to-file beg end file-name)
64: ;; File has been visited, in buffer BUF.
65: (set-buffer buf)
66: (let ((buffer-read-only nil)
67: (msg rmail-current-message))
68: ;; If MSG is non-nil, buffer is in RMAIL mode.
69: (if msg
70: (progn (widen)
71: (narrow-to-region (point-max) (point-max))))
72: (insert-buffer-substring cur beg end)
73: (if msg
74: (progn
75: (goto-char (point-min))
76: (widen)
77: (search-backward "\^_")
78: (narrow-to-region (point) (point-max))
79: (goto-char (1+ (point-min)))
80: (rmail-count-new-messages)
81: (rmail-show-message msg))))))))
82: (rmail-set-attribute "filed" t)
83: (and rmail-delete-after-output (rmail-delete-forward)))
84:
85: (defun rmail-output (file-name)
86: "Append this message to Unix mail file named FILE-NAME."
87: (interactive
88: (list
89: (read-file-name
90: (concat "Output message to Unix mail file: (default "
91: (file-name-nondirectory rmail-last-file)
92: ") ")
93: (file-name-directory rmail-last-file)
94: rmail-last-file)))
95: (setq file-name (expand-file-name file-name))
96: (setq rmail-last-file file-name)
97: (let ((rmailbuf (current-buffer))
98: (tembuf (get-buffer-create " rmail-output"))
99: (case-fold-search t))
100: (save-excursion
101: (set-buffer tembuf)
102: (erase-buffer)
103: (insert-buffer-substring rmailbuf)
104: (insert "\n")
105: (goto-char (point-min))
106: (insert "From "
107: (mail-strip-quoted-names (mail-fetch-field "from")) " "
108: (current-time-string) "\n")
109: ;; ``Quote'' "\nFrom " as "\n>From "
110: ;; (note that this isn't really quoting, as there is no requirement
111: ;; that "\n[>]+From " be quoted in the same transparent way.)
112: (while (search-forward "\nFrom " nil t)
113: (forward-char -5)
114: (insert ?>))
115: (append-to-file (point-min) (point-max) file-name))
116: (kill-buffer tembuf))
117: (rmail-set-attribute "filed" t)
118: (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.