Mercurial > emacs
comparison lisp/mail/rmailout.el @ 5011:22c7b341d536
(rmail-output): New argument FROM-GNUS.
| author | Richard M. Stallman <rms@gnu.org> |
|---|---|
| date | Mon, 15 Nov 1993 01:05:37 +0000 |
| parents | b70799eabd57 |
| children | 26abd5d13762 |
comparison
equal
deleted
inserted
replaced
| 5010:9595049f63a9 | 5011:22c7b341d536 |
|---|---|
| 147 (looking-at "BABYL OPTIONS:")) | 147 (looking-at "BABYL OPTIONS:")) |
| 148 (kill-buffer buf)))) | 148 (kill-buffer buf)))) |
| 149 | 149 |
| 150 ;;; There are functions elsewhere in Emacs that use this function; check | 150 ;;; There are functions elsewhere in Emacs that use this function; check |
| 151 ;;; them out before you change the calling method. | 151 ;;; them out before you change the calling method. |
| 152 (defun rmail-output (file-name &optional count noattribute) | 152 (defun rmail-output (file-name &optional count noattribute from-gnus) |
| 153 "Append this message to Unix mail file named FILE-NAME. | 153 "Append this message to Unix mail file named FILE-NAME. |
| 154 A prefix argument N says to output N consecutive messages | 154 A prefix argument N says to output N consecutive messages |
| 155 starting with the current one. Deleted messages are skipped and don't count. | 155 starting with the current one. Deleted messages are skipped and don't count. |
| 156 When called from lisp code, N may be omitted. | 156 When called from lisp code, N may be omitted. |
| 157 | 157 |
| 158 If the pruned message header is shown on the current message, then | 158 If the pruned message header is shown on the current message, then |
| 159 messages will be appended with pruned headers; otherwise, messages | 159 messages will be appended with pruned headers; otherwise, messages |
| 160 will be appended with their original headers. | 160 will be appended with their original headers. |
| 161 | 161 |
| 162 The optional third argument NOATTRIBUTE, if non-nil, says not | 162 The optional third argument NOATTRIBUTE, if non-nil, says not |
| 163 to set the `filed' attribute, and not to display a message." | 163 to set the `filed' attribute, and not to display a message. |
| 164 | |
| 165 The optional fourth argument FROM-GNUS is set when called from GNUS." | |
| 164 (interactive | 166 (interactive |
| 165 (list (setq rmail-last-file | 167 (list (setq rmail-last-file |
| 166 (read-file-name | 168 (read-file-name |
| 167 (concat "Output message to Unix mail file" | 169 (concat "Output message to Unix mail file" |
| 168 (if rmail-last-file | 170 (if rmail-last-file |
| 183 (let ((orig-count count) | 185 (let ((orig-count count) |
| 184 (rmailbuf (current-buffer)) | 186 (rmailbuf (current-buffer)) |
| 185 (case-fold-search t) | 187 (case-fold-search t) |
| 186 (tembuf (get-buffer-create " rmail-output")) | 188 (tembuf (get-buffer-create " rmail-output")) |
| 187 (original-headers-p | 189 (original-headers-p |
| 188 (save-excursion | 190 (and (not from-gnus) |
| 189 (save-restriction | 191 (save-excursion |
| 190 (narrow-to-region (rmail-msgbeg rmail-current-message) (point-max)) | 192 (save-restriction |
| 191 (goto-char (point-min)) | 193 (narrow-to-region (rmail-msgbeg rmail-current-message) (point-max)) |
| 192 (forward-line 1) | 194 (goto-char (point-min)) |
| 193 (= (following-char) ?0)))) | 195 (forward-line 1) |
| 196 (= (following-char) ?0))))) | |
| 194 header-beginning | 197 header-beginning |
| 195 mail-from) | 198 mail-from) |
| 196 (while (> count 0) | 199 (while (> count 0) |
| 197 (setq mail-from | 200 (or from-gnus |
| 198 (save-excursion | 201 (setq mail-from |
| 199 (save-restriction | 202 (save-excursion |
| 200 (widen) | 203 (save-restriction |
| 201 (goto-char (rmail-msgbeg rmail-current-message)) | 204 (widen) |
| 202 (setq header-beginning (point)) | 205 (goto-char (rmail-msgbeg rmail-current-message)) |
| 203 (search-forward "\n*** EOOH ***\n") | 206 (setq header-beginning (point)) |
| 204 (narrow-to-region header-beginning (point)) | 207 (search-forward "\n*** EOOH ***\n") |
| 205 (mail-fetch-field "Mail-From")))) | 208 (narrow-to-region header-beginning (point)) |
| 209 (mail-fetch-field "Mail-From"))))) | |
| 206 (save-excursion | 210 (save-excursion |
| 207 (set-buffer tembuf) | 211 (set-buffer tembuf) |
| 208 (erase-buffer) | 212 (erase-buffer) |
| 209 (insert-buffer-substring rmailbuf) | 213 (insert-buffer-substring rmailbuf) |
| 210 (insert "\n") | 214 (insert "\n") |
| 227 (if noattribute 'nomsg))) | 231 (if noattribute 'nomsg))) |
| 228 (or noattribute | 232 (or noattribute |
| 229 (if (equal major-mode 'rmail-mode) | 233 (if (equal major-mode 'rmail-mode) |
| 230 (rmail-set-attribute "filed" t))) | 234 (rmail-set-attribute "filed" t))) |
| 231 (setq count (1- count)) | 235 (setq count (1- count)) |
| 232 (let ((next-message-p | 236 (or from-gnus |
| 233 (if rmail-delete-after-output | 237 (let ((next-message-p |
| 234 (rmail-delete-forward) | 238 (if rmail-delete-after-output |
| 235 (if (> count 0) | 239 (rmail-delete-forward) |
| 236 (rmail-next-undeleted-message 1)))) | 240 (if (> count 0) |
| 237 (num-appended (- orig-count count))) | 241 (rmail-next-undeleted-message 1)))) |
| 238 (if (and next-message-p original-headers-p) | 242 (num-appended (- orig-count count))) |
| 239 (rmail-toggle-header)) | 243 (if (and next-message-p original-headers-p) |
| 240 (if (and (> count 0) (not next-message-p)) | 244 (rmail-toggle-header)) |
| 241 (progn | 245 (if (and (> count 0) (not next-message-p)) |
| 242 (error | 246 (progn |
| 243 (save-excursion | 247 (error |
| 244 (set-buffer rmailbuf) | 248 (save-excursion |
| 245 (format "Only %d message%s appended" num-appended | 249 (set-buffer rmailbuf) |
| 246 (if (= num-appended 1) "" "s")))) | 250 (format "Only %d message%s appended" num-appended |
| 247 (setq count 0))))) | 251 (if (= num-appended 1) "" "s")))) |
| 252 (setq count 0)))))) | |
| 248 (kill-buffer tembuf)))) | 253 (kill-buffer tembuf)))) |
| 249 | 254 |
| 250 ;;; rmailout.el ends here | 255 ;;; rmailout.el ends here |