![[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] / 43BSDReno / contrib / emacs-18.55 / lisp|
Return to rmailout.el CVS log | Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / 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 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 (list (read-file-name ! 32: (concat "Output message to Rmail file: (default " ! 33: (file-name-nondirectory rmail-last-rmail-file) ! 34: ") ") ! 35: (file-name-directory rmail-last-rmail-file) ! 36: rmail-last-rmail-file))) ! 37: (setq file-name (expand-file-name file-name)) ! 38: (setq rmail-last-rmail-file file-name) ! 39: (rmail-maybe-set-message-counters) ! 40: (or (get-file-buffer file-name) ! 41: (file-exists-p file-name) ! 42: (if (yes-or-no-p ! 43: (concat "\"" file-name "\" does not exist, create it? ")) ! 44: (let ((file-buffer (create-file-buffer file-name))) ! 45: (save-excursion ! 46: (set-buffer file-buffer) ! 47: (rmail-insert-rmail-file-header) ! 48: (let ((require-final-newline nil)) ! 49: (write-region (point-min) (point-max) file-name t 1))) ! 50: (kill-buffer file-buffer)) ! 51: (error "Output file does not exist"))) ! 52: (save-restriction ! 53: (widen) ! 54: ;; Decide whether to append to a file or to an Emacs buffer. ! 55: (save-excursion ! 56: (let ((buf (get-file-buffer file-name)) ! 57: (cur (current-buffer)) ! 58: (beg (1+ (rmail-msgbeg rmail-current-message))) ! 59: (end (1+ (rmail-msgend rmail-current-message)))) ! 60: (if (not buf) ! 61: (append-to-file beg end file-name) ! 62: (if (eq buf (current-buffer)) ! 63: (error "Can't output message to same file it's already in")) ! 64: ;; File has been visited, in buffer BUF. ! 65: (set-buffer buf) ! 66: (let ((buffer-read-only nil) ! 67: (msg (and (boundp 'rmail-current-message) ! 68: rmail-current-message))) ! 69: ;; If MSG is non-nil, buffer is in RMAIL mode. ! 70: (if msg ! 71: (progn (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: (or (mail-strip-quoted-names (mail-fetch-field "from")) ! 112: "unknown") ! 113: " " (current-time-string) "\n") ! 114: ;; ``Quote'' "\nFrom " as "\n>From " ! 115: ;; (note that this isn't really quoting, as there is no requirement ! 116: ;; that "\n[>]+From " be quoted in the same transparent way.) ! 117: (while (search-forward "\nFrom " nil t) ! 118: (forward-char -5) ! 119: (insert ?>)) ! 120: (append-to-file (point-min) (point-max) file-name)) ! 121: (kill-buffer tembuf)) ! 122: (if (equal major-mode 'rmail-mode) ! 123: (progn ! 124: (rmail-set-attribute "filed" t) ! 125: (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.