aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRichard M. Stallman2009-01-10 23:16:37 +0000
committerRichard M. Stallman2009-01-10 23:16:37 +0000
commitd373dc40ab9296ac59b9e3175e9749b8e57ec29b (patch)
tree6dba4c08dc7e10e613151c42a12634848a8f579e
parent8deda4af979cad425006c6b1678d5a614af49447 (diff)
downloademacs-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.el119
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.
144Do what is necessary to make babyl R-mail know about the new message.
145Then 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.
271It alters the current buffer's text, so it should be a temp buffer." 316It alters the current buffer's text, so call with a temp buffer current.
317If FILE-NAME is visited, output into its buffer instead.
318AS-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.
382Do what is necessary to make Pmail know about the new message.
383Then 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.
405This works with both mbox format and Babyl format files,
406outputting in the appropriate format for each.
407The default file name comes from `pmail-default-file',
408which is updated to the name you use in this command.
409
321A prefix argument COUNT says to output that many consecutive messages, 410A prefix argument COUNT says to output that many consecutive messages,
322starting with the current one. Deleted messages are skipped and don't count. 411starting with the current one. Deleted messages are skipped and don't count.
323When called from Lisp code, COUNT may be omitted and defaults to 1. 412When called from Lisp code, COUNT may be omitted and defaults to 1.
324 413
325This outputs the complete message header even the display is pruned. 414This command always outputs the complete message header,
326 415even the header display is currently pruned.
327The default file name comes from `pmail-default-file',
328which is updated to the name you use in this command.
329 416
330The optional third argument NOATTRIBUTE, if non-nil, says not 417The optional third argument NOATTRIBUTE, if non-nil, says not
331to set the `filed' attribute, and not to display a message. 418to 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