diff options
| author | Richard M. Stallman | 2009-01-10 23:16:37 +0000 |
|---|---|---|
| committer | Richard M. Stallman | 2009-01-10 23:16:37 +0000 |
| commit | d373dc40ab9296ac59b9e3175e9749b8e57ec29b (patch) | |
| tree | 6dba4c08dc7e10e613151c42a12634848a8f579e | |
| parent | 8deda4af979cad425006c6b1678d5a614af49447 (diff) | |
| download | emacs-d373dc40ab9296ac59b9e3175e9749b8e57ec29b.tar.gz emacs-d373dc40ab9296ac59b9e3175e9749b8e57ec29b.zip | |
(pmail-output-to-r-mail-buffer): New function.
(pmail-output-as-babyl): Use it.
(pmail-output-to-pmail-buffer): New function.
(pmail-output-as-mbox): Use it.
(pmail-output-as-seen): Pass t to pmail-output-as-mbox.
(pmail-output): Call set-buffer later.
| -rw-r--r-- | lisp/mail/pmailout.el | 119 |
1 files changed, 104 insertions, 15 deletions
diff --git a/lisp/mail/pmailout.el b/lisp/mail/pmailout.el index 86e9bec2c00..7099836f3fb 100644 --- a/lisp/mail/pmailout.el +++ b/lisp/mail/pmailout.el | |||
| @@ -115,9 +115,54 @@ It alters the current buffer's text, so it should be a temp buffer." | |||
| 115 | 115 | ||
| 116 | ;; Convert to Babyl format. | 116 | ;; Convert to Babyl format. |
| 117 | (pmail-convert-to-babyl-format) | 117 | (pmail-convert-to-babyl-format) |
| 118 | ;; Write it into the file. | 118 | ;; Write it into the file, or its buffer. |
| 119 | (write-region (point-min) (point-max) file-name t nomsg))) | 119 | (let ((buf (find-buffer-visiting file-name)) |
| 120 | 120 | (tembuf (current-buffer))) | |
| 121 | (if (null buf) | ||
| 122 | (write-region (point-min) (point-max) file-name t nomsg) | ||
| 123 | (if (eq buf (current-buffer)) | ||
| 124 | (error "Can't output message to same file it's already in")) | ||
| 125 | ;; File has been visited, in buffer BUF. | ||
| 126 | (set-buffer buf) | ||
| 127 | (let ((inhibit-read-only t) | ||
| 128 | (msg (with-no-warnings | ||
| 129 | (and (boundp 'rmail-current-message) | ||
| 130 | rmail-current-message)))) | ||
| 131 | ;; If MSG is non-nil, buffer is in RMAIL mode. | ||
| 132 | (if msg | ||
| 133 | (pmail-output-to-r-mail-buffer tembuf msg) | ||
| 134 | ;; Output file not in rmail mode => just insert at the end. | ||
| 135 | (narrow-to-region (point-min) (1+ (buffer-size))) | ||
| 136 | (goto-char (point-max)) | ||
| 137 | (insert-buffer-substring tembuf))))))) | ||
| 138 | |||
| 139 | ;; When Pmail is really installed, if we delete or rename the old Rmail | ||
| 140 | ;; we should do likewise with this function. | ||
| 141 | |||
| 142 | (defun pmail-output-to-r-mail-buffer (tembuf msg) | ||
| 143 | "Copy msg in TEMBUF from BEG to END into this old R-mail BABYL buffer. | ||
| 144 | Do what is necessary to make babyl R-mail know about the new message. | ||
| 145 | Then display message number MSG." | ||
| 146 | (with-no-warnings | ||
| 147 | ;; Turn on Auto Save mode, if it's off in this | ||
| 148 | ;; buffer but enabled by default. | ||
| 149 | (and (not buffer-auto-save-file-name) | ||
| 150 | auto-save-default | ||
| 151 | (auto-save-mode t)) | ||
| 152 | (rmail-maybe-set-message-counters) | ||
| 153 | (widen) | ||
| 154 | (narrow-to-region (point-max) (point-max)) | ||
| 155 | (insert-buffer-substring tembuf) | ||
| 156 | (goto-char (point-min)) | ||
| 157 | (widen) | ||
| 158 | (search-backward "\n\^_") | ||
| 159 | (narrow-to-region (point) (point-max)) | ||
| 160 | (rmail-count-new-messages t) | ||
| 161 | (if (rmail-summary-exists) | ||
| 162 | (rmail-select-summary | ||
| 163 | (rmail-update-summary))) | ||
| 164 | (rmail-show-message msg))) | ||
| 165 | |||
| 121 | (defun pmail-convert-to-babyl-format () | 166 | (defun pmail-convert-to-babyl-format () |
| 122 | (let ((count 0) (start (point-min)) | 167 | (let ((count 0) (start (point-min)) |
| 123 | (case-fold-search nil) | 168 | (case-fold-search nil) |
| @@ -266,9 +311,11 @@ It alters the current buffer's text, so it should be a temp buffer." | |||
| 266 | "From: \\1\n")) | 311 | "From: \\1\n")) |
| 267 | t))))))) | 312 | t))))))) |
| 268 | 313 | ||
| 269 | (defun pmail-output-as-mbox (file-name nomsg) | 314 | (defun pmail-output-as-mbox (file-name nomsg &optional as-seen) |
| 270 | "Convert the current buffer's text to mbox Babyl and output to FILE-NAME. | 315 | "Convert the current buffer's text to mbox Babyl and output to FILE-NAME. |
| 271 | It alters the current buffer's text, so it should be a temp buffer." | 316 | It alters the current buffer's text, so call with a temp buffer current. |
| 317 | If FILE-NAME is visited, output into its buffer instead. | ||
| 318 | AS-SEEN is non-nil if we are copying the message \"as seen\"." | ||
| 272 | (let ((case-fold-search t) | 319 | (let ((case-fold-search t) |
| 273 | mail-from mime-version content-type) | 320 | mail-from mime-version content-type) |
| 274 | 321 | ||
| @@ -309,23 +356,63 @@ It alters the current buffer's text, so it should be a temp buffer." | |||
| 309 | "unknown")))) | 356 | "unknown")))) |
| 310 | " " (current-time-string) "\n")) | 357 | " " (current-time-string) "\n")) |
| 311 | 358 | ||
| 312 | (let ((coding-system-for-write | 359 | (let ((buf (find-buffer-visiting file-name)) |
| 313 | 'raw-text-unix)) | 360 | (tembuf (current-buffer))) |
| 314 | (write-region (point-min) (point-max) file-name t nomsg)))) | 361 | (if (null buf) |
| 362 | (let ((coding-system-for-write 'raw-text-unix)) | ||
| 363 | (write-region (point-min) (point-max) file-name t nomsg)) | ||
| 364 | (if (eq buf (current-buffer)) | ||
| 365 | (error "Can't output message to same file it's already in")) | ||
| 366 | ;; File has been visited, in buffer BUF. | ||
| 367 | (set-buffer buf) | ||
| 368 | (let ((inhibit-read-only t) | ||
| 369 | (msg (and (boundp 'pmail-current-message) | ||
| 370 | pmail-current-message))) | ||
| 371 | (and msg as-seen | ||
| 372 | (error "Can't output \"as seen\" to a visited Pmail file")) | ||
| 373 | (if msg | ||
| 374 | (pmail-output-to-pmail-buffer tembuf msg) | ||
| 375 | ;; Output file not in Pmail mode => just insert at the end. | ||
| 376 | (narrow-to-region (point-min) (1+ (buffer-size))) | ||
| 377 | (goto-char (point-max)) | ||
| 378 | (insert-buffer-substring tembuf))))))) | ||
| 379 | |||
| 380 | (defun pmail-output-to-pmail-buffer (tembuf msg) | ||
| 381 | "Copy msg in TEMBUF from BEG to END into this Pmail buffer. | ||
| 382 | Do what is necessary to make Pmail know about the new message. | ||
| 383 | Then display message number MSG." | ||
| 384 | (save-excursion | ||
| 385 | (pmail-swap-buffers-maybe) | ||
| 386 | ;; Turn on Auto Save mode, if it's off in this | ||
| 387 | ;; buffer but enabled by default. | ||
| 388 | (and (not buffer-auto-save-file-name) | ||
| 389 | auto-save-default | ||
| 390 | (auto-save-mode t)) | ||
| 391 | (pmail-maybe-set-message-counters) | ||
| 392 | (narrow-to-region (point-max) (point-max)) | ||
| 393 | (insert-buffer-substring tembuf) | ||
| 394 | (pmail-count-new-messages t) | ||
| 395 | (if (pmail-summary-exists) | ||
| 396 | (pmail-select-summary | ||
| 397 | (pmail-update-summary))) | ||
| 398 | (pmail-show-message msg))) | ||
| 315 | 399 | ||
| 316 | ;;; There are functions elsewhere in Emacs that use this function; | 400 | ;;; There are functions elsewhere in Emacs that use this function; |
| 317 | ;;; look at them before you change the calling method. | 401 | ;;; look at them before you change the calling method. |
| 318 | ;;;###autoload | 402 | ;;;###autoload |
| 319 | (defun pmail-output (file-name &optional count noattribute from-gnus) | 403 | (defun pmail-output (file-name &optional count noattribute from-gnus) |
| 320 | "Append this message to system-inbox-format mail file named FILE-NAME. | 404 | "Append this message to mail file FILE-NAME. |
| 405 | This works with both mbox format and Babyl format files, | ||
| 406 | outputting in the appropriate format for each. | ||
| 407 | The default file name comes from `pmail-default-file', | ||
| 408 | which is updated to the name you use in this command. | ||
| 409 | |||
| 321 | A prefix argument COUNT says to output that many consecutive messages, | 410 | A prefix argument COUNT says to output that many consecutive messages, |
| 322 | starting with the current one. Deleted messages are skipped and don't count. | 411 | starting with the current one. Deleted messages are skipped and don't count. |
| 323 | When called from Lisp code, COUNT may be omitted and defaults to 1. | 412 | When called from Lisp code, COUNT may be omitted and defaults to 1. |
| 324 | 413 | ||
| 325 | This outputs the complete message header even the display is pruned. | 414 | This command always outputs the complete message header, |
| 326 | 415 | even the header display is currently pruned. | |
| 327 | The default file name comes from `pmail-default-file', | ||
| 328 | which is updated to the name you use in this command. | ||
| 329 | 416 | ||
| 330 | The optional third argument NOATTRIBUTE, if non-nil, says not | 417 | The optional third argument NOATTRIBUTE, if non-nil, says not |
| 331 | to set the `filed' attribute, and not to display a message. | 418 | to set the `filed' attribute, and not to display a message. |
| @@ -339,7 +426,6 @@ The optional fourth argument FROM-GNUS is set when called from GNUS." | |||
| 339 | (expand-file-name file-name | 426 | (expand-file-name file-name |
| 340 | (and pmail-default-file | 427 | (and pmail-default-file |
| 341 | (file-name-directory pmail-default-file)))) | 428 | (file-name-directory pmail-default-file)))) |
| 342 | (set-buffer pmail-buffer) | ||
| 343 | 429 | ||
| 344 | ;; Warn about creating new file. | 430 | ;; Warn about creating new file. |
| 345 | (or (find-buffer-visiting file-name) | 431 | (or (find-buffer-visiting file-name) |
| @@ -348,6 +434,8 @@ The optional fourth argument FROM-GNUS is set when called from GNUS." | |||
| 348 | (concat "\"" file-name "\" does not exist, create it? ")) | 434 | (concat "\"" file-name "\" does not exist, create it? ")) |
| 349 | (error "Output file does not exist")) | 435 | (error "Output file does not exist")) |
| 350 | 436 | ||
| 437 | (set-buffer pmail-buffer) | ||
| 438 | |||
| 351 | (let ((orig-count count) | 439 | (let ((orig-count count) |
| 352 | (case-fold-search t) | 440 | (case-fold-search t) |
| 353 | (tembuf (get-buffer-create " pmail-output")) | 441 | (tembuf (get-buffer-create " pmail-output")) |
| @@ -453,7 +541,8 @@ The optional fourth argument FROM-GNUS is set when called from GNUS." | |||
| 453 | (insert-buffer-substring cur beg end) | 541 | (insert-buffer-substring cur beg end) |
| 454 | ;; Convert the text to one format or another and output. | 542 | ;; Convert the text to one format or another and output. |
| 455 | (pmail-output-as-mbox file-name | 543 | (pmail-output-as-mbox file-name |
| 456 | (if noattribute 'nomsg)))))) | 544 | (if noattribute 'nomsg) |
| 545 | t))))) | ||
| 457 | 546 | ||
| 458 | ;; Mark message as "filed". | 547 | ;; Mark message as "filed". |
| 459 | (unless noattribute | 548 | (unless noattribute |