diff options
| author | Richard M. Stallman | 1993-07-09 20:46:42 +0000 |
|---|---|---|
| committer | Richard M. Stallman | 1993-07-09 20:46:42 +0000 |
| commit | dba3adb09b723188607eb156d6d51a4bb5d3ae5f (patch) | |
| tree | 4b4a1b20f06d77afada0f95f52b57118f9991446 | |
| parent | f920529b21e5729a63681f2590e31887314c9716 (diff) | |
| download | emacs-dba3adb09b723188607eb156d6d51a4bb5d3ae5f.tar.gz emacs-dba3adb09b723188607eb156d6d51a4bb5d3ae5f.zip | |
(rmail-output): If file is an Rmail file,
use rmail-output-to-rmail-file.
(rmail-output-to-rmail-file): If file exists
and is not an Rmail file, use rmail-output.
If we find an element in rmail-output-file-alist, eval it.
(rmail-file-p): New function.
(rmail-output-file-alist): Now contains expressions to eval.
| -rw-r--r-- | lisp/mail/rmailout.el | 226 |
1 files changed, 117 insertions, 109 deletions
diff --git a/lisp/mail/rmailout.el b/lisp/mail/rmailout.el index f97cb2dcb04..d2584dd848b 100644 --- a/lisp/mail/rmailout.el +++ b/lisp/mail/rmailout.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; rmailout.el --- "RMAIL" mail reader for Emacs: output message to a file. | 1 | ;;; rmailout.el --- "RMAIL" mail reader for Emacs: output message to a file. |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1985, 1987 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1985, 1987, 1993 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Maintainer: FSF | 5 | ;; Maintainer: FSF |
| 6 | ;; Keywords: mail | 6 | ;; Keywords: mail |
| @@ -29,7 +29,10 @@ | |||
| 29 | 29 | ||
| 30 | (defvar rmail-output-file-alist nil | 30 | (defvar rmail-output-file-alist nil |
| 31 | "*Alist matching regexps to suggested output Rmail files. | 31 | "*Alist matching regexps to suggested output Rmail files. |
| 32 | This is a list of elements of the form (REGEXP . FILENAME).") | 32 | This is a list of elements of the form (REGEXP . NAME-EXP). |
| 33 | NAME-EXP may be a string constant giving the file name to use, | ||
| 34 | or more generally it may be any kind of expression that returns | ||
| 35 | a file name as a string.") | ||
| 33 | 36 | ||
| 34 | ;;; There are functions elsewhere in Emacs that use this function; check | 37 | ;;; There are functions elsewhere in Emacs that use this function; check |
| 35 | ;;; them out before you change the calling method. | 38 | ;;; them out before you change the calling method. |
| @@ -38,6 +41,9 @@ This is a list of elements of the form (REGEXP . FILENAME).") | |||
| 38 | If the file does not exist, ask if it should be created. | 41 | If the file does not exist, ask if it should be created. |
| 39 | If file is being visited, the message is appended to the Emacs | 42 | If file is being visited, the message is appended to the Emacs |
| 40 | buffer visiting that file. | 43 | buffer visiting that file. |
| 44 | If the file exists and is not an Rmail file, | ||
| 45 | the message is appended in inbox format. | ||
| 46 | |||
| 41 | A prefix argument N says to output N consecutive messages | 47 | A prefix argument N says to output N consecutive messages |
| 42 | starting with the current one. Deleted messages are skipped and don't count." | 48 | starting with the current one. Deleted messages are skipped and don't count." |
| 43 | (interactive | 49 | (interactive |
| @@ -49,7 +55,7 @@ starting with the current one. Deleted messages are skipped and don't count." | |||
| 49 | (save-excursion | 55 | (save-excursion |
| 50 | (goto-char (point-min)) | 56 | (goto-char (point-min)) |
| 51 | (if (re-search-forward (car (car tail)) nil t) | 57 | (if (re-search-forward (car (car tail)) nil t) |
| 52 | (setq answer (cdr (car tail)))) | 58 | (setq answer (eval (cdr (car tail))))) |
| 53 | (setq tail (cdr tail)))) | 59 | (setq tail (cdr tail)))) |
| 54 | ;; If not suggestions, use same file as last time. | 60 | ;; If not suggestions, use same file as last time. |
| 55 | (or answer rmail-last-rmail-file)))) | 61 | (or answer rmail-last-rmail-file)))) |
| @@ -64,69 +70,81 @@ starting with the current one. Deleted messages are skipped and don't count." | |||
| 64 | (setq file-name | 70 | (setq file-name |
| 65 | (expand-file-name file-name | 71 | (expand-file-name file-name |
| 66 | (file-name-directory rmail-last-rmail-file))) | 72 | (file-name-directory rmail-last-rmail-file))) |
| 67 | (setq rmail-last-rmail-file file-name) | 73 | (if (and (file-readable-p file-name) (not (rmail-file-p file-name))) |
| 68 | (rmail-maybe-set-message-counters) | 74 | (rmail-output file-name count) |
| 69 | (setq file-name (abbreviate-file-name file-name)) | 75 | (setq rmail-last-rmail-file file-name) |
| 70 | (or (get-file-buffer file-name) | 76 | (rmail-maybe-set-message-counters) |
| 71 | (file-exists-p file-name) | 77 | (setq file-name (abbreviate-file-name file-name)) |
| 72 | (if (yes-or-no-p | 78 | (or (get-file-buffer file-name) |
| 73 | (concat "\"" file-name "\" does not exist, create it? ")) | 79 | (file-exists-p file-name) |
| 74 | (let ((file-buffer (create-file-buffer file-name))) | 80 | (if (yes-or-no-p |
| 75 | (save-excursion | 81 | (concat "\"" file-name "\" does not exist, create it? ")) |
| 76 | (set-buffer file-buffer) | 82 | (let ((file-buffer (create-file-buffer file-name))) |
| 77 | (rmail-insert-rmail-file-header) | ||
| 78 | (let ((require-final-newline nil)) | ||
| 79 | (write-region (point-min) (point-max) file-name t 1))) | ||
| 80 | (kill-buffer file-buffer)) | ||
| 81 | (error "Output file does not exist"))) | ||
| 82 | (while (> count 0) | ||
| 83 | (let (redelete) | ||
| 84 | (unwind-protect | ||
| 85 | (progn | ||
| 86 | (save-restriction | ||
| 87 | (widen) | ||
| 88 | (if (rmail-message-deleted-p rmail-current-message) | ||
| 89 | (progn (setq redelete t) | ||
| 90 | (rmail-set-attribute "deleted" nil))) | ||
| 91 | ;; Decide whether to append to a file or to an Emacs buffer. | ||
| 92 | (save-excursion | 83 | (save-excursion |
| 93 | (let ((buf (get-file-buffer file-name)) | 84 | (set-buffer file-buffer) |
| 94 | (cur (current-buffer)) | 85 | (rmail-insert-rmail-file-header) |
| 95 | (beg (1+ (rmail-msgbeg rmail-current-message))) | 86 | (let ((require-final-newline nil)) |
| 96 | (end (1+ (rmail-msgend rmail-current-message)))) | 87 | (write-region (point-min) (point-max) file-name t 1))) |
| 97 | (if (not buf) | 88 | (kill-buffer file-buffer)) |
| 98 | (append-to-file beg end file-name) | 89 | (error "Output file does not exist"))) |
| 99 | (if (eq buf (current-buffer)) | 90 | (while (> count 0) |
| 100 | (error "Can't output message to same file it's already in")) | 91 | (let (redelete) |
| 101 | ;; File has been visited, in buffer BUF. | 92 | (unwind-protect |
| 102 | (set-buffer buf) | 93 | (progn |
| 103 | (let ((buffer-read-only nil) | 94 | (save-restriction |
| 104 | (msg (and (boundp 'rmail-current-message) | 95 | (widen) |
| 105 | rmail-current-message))) | 96 | (if (rmail-message-deleted-p rmail-current-message) |
| 106 | ;; If MSG is non-nil, buffer is in RMAIL mode. | 97 | (progn (setq redelete t) |
| 107 | (if msg | 98 | (rmail-set-attribute "deleted" nil))) |
| 108 | (progn | 99 | ;; Decide whether to append to a file or to an Emacs buffer. |
| 109 | (rmail-maybe-set-message-counters) | 100 | (save-excursion |
| 110 | (widen) | 101 | (let ((buf (get-file-buffer file-name)) |
| 111 | (narrow-to-region (point-max) (point-max)) | 102 | (cur (current-buffer)) |
| 112 | (insert-buffer-substring cur beg end) | 103 | (beg (1+ (rmail-msgbeg rmail-current-message))) |
| 113 | (goto-char (point-min)) | 104 | (end (1+ (rmail-msgend rmail-current-message)))) |
| 114 | (widen) | 105 | (if (not buf) |
| 115 | (search-backward "\n\^_") | 106 | (append-to-file beg end file-name) |
| 116 | (narrow-to-region (point) (point-max)) | 107 | (if (eq buf (current-buffer)) |
| 117 | (rmail-count-new-messages t) | 108 | (error "Can't output message to same file it's already in")) |
| 118 | (rmail-show-message msg)) | 109 | ;; File has been visited, in buffer BUF. |
| 119 | ;; Output file not in rmail mode => just insert at the end. | 110 | (set-buffer buf) |
| 120 | (narrow-to-region (point-min) (1+ (buffer-size))) | 111 | (let ((buffer-read-only nil) |
| 121 | (goto-char (point-max)) | 112 | (msg (and (boundp 'rmail-current-message) |
| 122 | (insert-buffer-substring cur beg end))))))) | 113 | rmail-current-message))) |
| 123 | (rmail-set-attribute "filed" t)) | 114 | ;; If MSG is non-nil, buffer is in RMAIL mode. |
| 124 | (if redelete (rmail-set-attribute "deleted" t)))) | 115 | (if msg |
| 125 | (setq count (1- count)) | 116 | (progn |
| 126 | (if rmail-delete-after-output | 117 | (rmail-maybe-set-message-counters) |
| 127 | (rmail-delete-forward) | 118 | (widen) |
| 128 | (if (> count 0) | 119 | (narrow-to-region (point-max) (point-max)) |
| 129 | (rmail-next-undeleted-message 1))))) | 120 | (insert-buffer-substring cur beg end) |
| 121 | (goto-char (point-min)) | ||
| 122 | (widen) | ||
| 123 | (search-backward "\n\^_") | ||
| 124 | (narrow-to-region (point) (point-max)) | ||
| 125 | (rmail-count-new-messages t) | ||
| 126 | (rmail-show-message msg)) | ||
| 127 | ;; Output file not in rmail mode => just insert at the end. | ||
| 128 | (narrow-to-region (point-min) (1+ (buffer-size))) | ||
| 129 | (goto-char (point-max)) | ||
| 130 | (insert-buffer-substring cur beg end))))))) | ||
| 131 | (rmail-set-attribute "filed" t)) | ||
| 132 | (if redelete (rmail-set-attribute "deleted" t)))) | ||
| 133 | (setq count (1- count)) | ||
| 134 | (if rmail-delete-after-output | ||
| 135 | (rmail-delete-forward) | ||
| 136 | (if (> count 0) | ||
| 137 | (rmail-next-undeleted-message 1)))))) | ||
| 138 | |||
| 139 | ;; Returns t if file FILE is an Rmail file. | ||
| 140 | (defun rmail-file-p (file) | ||
| 141 | (let ((buf (generate-new-buffer " *rmail-file-p*"))) | ||
| 142 | (unwind-protect | ||
| 143 | (save-excursion | ||
| 144 | (set-buffer buf) | ||
| 145 | (insert-file-contents file nil 0 100) | ||
| 146 | (looking-at "BABYL OPTIONS:")) | ||
| 147 | (kill-buffer buf)))) | ||
| 130 | 148 | ||
| 131 | ;;; There are functions elsewhere in Emacs that use this function; check | 149 | ;;; There are functions elsewhere in Emacs that use this function; check |
| 132 | ;;; them out before you change the calling method. | 150 | ;;; them out before you change the calling method. |
| @@ -151,49 +169,39 @@ When called from lisp code, N may be omitted." | |||
| 151 | (expand-file-name file-name | 169 | (expand-file-name file-name |
| 152 | (and rmail-last-file | 170 | (and rmail-last-file |
| 153 | (file-name-directory rmail-last-file)))) | 171 | (file-name-directory rmail-last-file)))) |
| 154 | (setq rmail-last-file file-name) | 172 | (if (and (file-readable-p file) (rmail-file-p file-name)) |
| 155 | (while (> count 0) | 173 | (rmail-output-to-rmail-file file-name count) |
| 156 | (let ((rmailbuf (current-buffer)) | 174 | (setq rmail-last-file file-name) |
| 157 | (tembuf (get-buffer-create " rmail-output")) | 175 | (while (> count 0) |
| 158 | (case-fold-search t)) | 176 | (let ((rmailbuf (current-buffer)) |
| 159 | (save-excursion | 177 | (tembuf (get-buffer-create " rmail-output")) |
| 160 | (set-buffer tembuf) | 178 | (case-fold-search t)) |
| 161 | (erase-buffer) | 179 | (save-excursion |
| 162 | ;; If we can do it, read a little of the file | 180 | (set-buffer tembuf) |
| 163 | ;; to check whether it is an RMAIL file. | 181 | (erase-buffer) |
| 164 | ;; If it is, don't mess it up. | 182 | (insert-buffer-substring rmailbuf) |
| 165 | (and (file-readable-p file-name) | 183 | (insert "\n") |
| 166 | (progn (insert-file-contents file-name nil 0 20) | 184 | (goto-char (point-min)) |
| 167 | (looking-at "BABYL OPTIONS:\n")) | 185 | (insert "From " |
| 168 | (error (save-excursion | 186 | (mail-strip-quoted-names (or (mail-fetch-field "from") |
| 169 | (set-buffer rmailbuf) | 187 | (mail-fetch-field "really-from") |
| 170 | (substitute-command-keys | 188 | (mail-fetch-field "sender") |
| 171 | "Use \\[rmail-output-to-rmail-file] to output to Rmail file `%s'")) | 189 | "unknown")) |
| 172 | (file-name-nondirectory file-name))) | 190 | " " (current-time-string) "\n") |
| 173 | (erase-buffer) | 191 | ;; ``Quote'' "\nFrom " as "\n>From " |
| 174 | (insert-buffer-substring rmailbuf) | 192 | ;; (note that this isn't really quoting, as there is no requirement |
| 175 | (insert "\n") | 193 | ;; that "\n[>]+From " be quoted in the same transparent way.) |
| 176 | (goto-char (point-min)) | 194 | (while (search-forward "\nFrom " nil t) |
| 177 | (insert "From " | 195 | (forward-char -5) |
| 178 | (mail-strip-quoted-names (or (mail-fetch-field "from") | 196 | (insert ?>)) |
| 179 | (mail-fetch-field "really-from") | 197 | (append-to-file (point-min) (point-max) file-name)) |
| 180 | (mail-fetch-field "sender") | 198 | (kill-buffer tembuf)) |
| 181 | "unknown")) | 199 | (if (equal major-mode 'rmail-mode) |
| 182 | " " (current-time-string) "\n") | 200 | (rmail-set-attribute "filed" t)) |
| 183 | ;; ``Quote'' "\nFrom " as "\n>From " | 201 | (setq count (1- count)) |
| 184 | ;; (note that this isn't really quoting, as there is no requirement | 202 | (if rmail-delete-after-output |
| 185 | ;; that "\n[>]+From " be quoted in the same transparent way.) | 203 | (rmail-delete-forward) |
| 186 | (while (search-forward "\nFrom " nil t) | 204 | (if (> count 0) |
| 187 | (forward-char -5) | 205 | (rmail-next-undeleted-message 1))))) |
| 188 | (insert ?>)) | ||
| 189 | (append-to-file (point-min) (point-max) file-name)) | ||
| 190 | (kill-buffer tembuf)) | ||
| 191 | (if (equal major-mode 'rmail-mode) | ||
| 192 | (rmail-set-attribute "filed" t)) | ||
| 193 | (setq count (1- count)) | ||
| 194 | (if rmail-delete-after-output | ||
| 195 | (rmail-delete-forward) | ||
| 196 | (if (> count 0) | ||
| 197 | (rmail-next-undeleted-message 1))))) | ||
| 198 | 206 | ||
| 199 | ;;; rmailout.el ends here | 207 | ;;; rmailout.el ends here |