Return to rmailout.el CVS log

Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / lisp

Annotation of 43BSD/contrib/emacs/lisp/rmailout.el, revision 1.1

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.