mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-30 09:00:31 -08:00
Code Issues Projects Releases Wiki Activity

(rmail-insert-rmail-file-header, rmail-count-new-messages)

Browse source 
(rmail-show-message): Remove unnecessary autoloads.
(rmail-default-rmail-file): Remove unnecessary declaration.
(gnus-output-to-rmail): Handle mbox Rmail as well as Babyl Rmail.
This commit is contained in:
Glenn Morris 2009-02-15 00:31:07 +00:00
parent 002645bd38
commit e38658c49b
2 changed files with 64 additions and 21 deletions
Download patch file Download diff file Expand all files Collapse all files

8
lisp/gnus/ChangeLog
View file

@ -1,3 +1,11 @@
2009-02-15 Glenn Morris <rgm@gnu.org>
* gnus-util.el (rmail-insert-rmail-file-header)
(rmail-count-new-messages, rmail-show-message): Remove unnecessary
autoloads.
(rmail-default-rmail-file): Remove unnecessary declaration.
(gnus-output-to-rmail): Handle mbox Rmail as well as Babyl Rmail.
2009-02-14 Glenn Morris <rgm@gnu.org> 2009-02-14 Glenn Morris <rgm@gnu.org>
* gnus.el (rmail-default-rmail-file): Remove declaration of deleted * gnus.el (rmail-default-rmail-file): Remove declaration of deleted

77
lisp/gnus/gnus-util.el
View file

@ -52,9 +52,6 @@
(autoload 'message-fetch-field "message") (autoload 'message-fetch-field "message")
(autoload 'gnus-get-buffer-window "gnus-win") (autoload 'gnus-get-buffer-window "gnus-win")
(autoload 'rmail-insert-rmail-file-header "rmail")
(autoload 'rmail-count-new-messages "rmail")
(autoload 'rmail-show-message "rmail")
(autoload 'nnheader-narrow-to-headers "nnheader") (autoload 'nnheader-narrow-to-headers "nnheader")
(autoload 'nnheader-replace-chars-in-string "nnheader") (autoload 'nnheader-replace-chars-in-string "nnheader")
(autoload 'mail-header-remove-comments "mail-parse") (autoload 'mail-header-remove-comments "mail-parse")
@ -1053,31 +1050,45 @@ with potentially long computations."
(autoload 'rmail-summary-displayed "rmail") (autoload 'rmail-summary-displayed "rmail")
(autoload 'rmail-maybe-display-summary "rmail")))) (autoload 'rmail-maybe-display-summary "rmail"))))
(defvar rmail-default-rmail-file)
(defvar mm-text-coding-system) (defvar mm-text-coding-system)
(declare-function mm-append-to-file "mm-util" (declare-function mm-append-to-file "mm-util"
(start end filename &optional codesys inhibit)) (start end filename &optional codesys inhibit))
(defun gnus-output-to-rmail (filename &optional ask) (defun gnus-output-to-rmail (filename &optional ask)
"Append the current article to an Rmail file named FILENAME." "Append the current article to an Rmail file named FILENAME.
In Emacs 22 this writes Babyl format; in Emacs 23 it writes mbox unless
FILENAME exists and is Babyl format."
(require 'rmail) (require 'rmail)
(require 'mm-util) (require 'mm-util)
;; Most of these codes are borrowed from rmailout.el. ;; Some of this codes is borrowed from rmailout.el.
(setq filename (expand-file-name filename)) (setq filename (expand-file-name filename))
(setq rmail-default-rmail-file filename) ;; FIXME should we really be messing with this defcustom?
;; It is not needed for the operation of this function.
(if (boundp 'rmail-default-rmail-file)
(setq rmail-default-rmail-file filename) ; 22
(setq rmail-default-file filename)) ; 23
(let ((artbuf (current-buffer)) (let ((artbuf (current-buffer))
(tmpbuf (get-buffer-create " *Gnus-output*"))) (tmpbuf (get-buffer-create " *Gnus-output*"))
;; Babyl rmail.el defines this, mbox does not.
(babyl (fboundp 'rmail-insert-rmail-file-header)))
(save-excursion (save-excursion
(or (get-file-buffer filename) ;; Note that we ignore the possibility of visiting a Babyl
(file-exists-p filename) ;; format buffer in Emacs 23, since Rmail no longer supports that.
(or (get-file-buffer filename)
(progn
;; In case someone wants to write to a Babyl file from Emacs 23.
(when (file-exists-p filename)
(setq babyl (mail-file-babyl-p filename))
t))
(if (or (not ask) (if (or (not ask)
(gnus-yes-or-no-p (gnus-yes-or-no-p
(concat "\"" filename "\" does not exist, create it? "))) (concat "\"" filename "\" does not exist, create it? ")))
(let ((file-buffer (create-file-buffer filename))) (let ((file-buffer (create-file-buffer filename)))
(save-excursion (save-excursion
(set-buffer file-buffer) (set-buffer file-buffer)
(rmail-insert-rmail-file-header) (if (fboundp 'rmail-insert-rmail-file-header)
(rmail-insert-rmail-file-header))
(let ((require-final-newline nil) (let ((require-final-newline nil)
(coding-system-for-write mm-text-coding-system)) (coding-system-for-write mm-text-coding-system))
(gnus-write-buffer filename))) (gnus-write-buffer filename)))
@ -1086,32 +1097,56 @@ with potentially long computations."
(set-buffer tmpbuf) (set-buffer tmpbuf)
(erase-buffer) (erase-buffer)
(insert-buffer-substring artbuf) (insert-buffer-substring artbuf)
(gnus-convert-article-to-rmail) (if babyl
(gnus-convert-article-to-rmail)
;; Non-Babyl case copied from gnus-output-to-mail.
(goto-char (point-min))
(if (looking-at "From ")
(forward-line 1)
(insert "From nobody " (current-time-string) "\n"))
(let (case-fold-search)
(while (re-search-forward "^From " nil t)
(beginning-of-line)
(insert ">"))))
;; Decide whether to append to a file or to an Emacs buffer. ;; Decide whether to append to a file or to an Emacs buffer.
(let ((outbuf (get-file-buffer filename))) (let ((outbuf (get-file-buffer filename)))
(if (not outbuf) (if (not outbuf)
(let ((file-name-coding-system nnmail-pathname-coding-system)) (progn
(mm-append-to-file (point-min) (point-max) filename)) (unless babyl ; from gnus-output-to-mail
(let ((buffer-read-only nil))
(goto-char (point-max))
(forward-char -2)
(unless (looking-at "\n\n")
(goto-char (point-max))
(unless (bolp)
(insert "\n"))
(insert "\n"))))
(let ((file-name-coding-system nnmail-pathname-coding-system))
(mm-append-to-file (point-min) (point-max) filename)))
;; File has been visited, in buffer OUTBUF. ;; File has been visited, in buffer OUTBUF.
(set-buffer outbuf) (set-buffer outbuf)
(let ((buffer-read-only nil) (let ((buffer-read-only nil)
(msg (and (boundp 'rmail-current-message) (msg (and (boundp 'rmail-current-message)
(symbol-value 'rmail-current-message)))) (symbol-value 'rmail-current-message))))
;; If MSG is non-nil, buffer is in RMAIL mode. ;; If MSG is non-nil, buffer is in RMAIL mode.
;; Compare this with rmail-output-to-rmail-buffer in Emacs 23.
(when msg (when msg
(widen) (unless babyl
(narrow-to-region (point-max) (point-max))) (rmail-swap-buffers-maybe)
(rmail-maybe-set-message-counters))
(widen)
(narrow-to-region (point-max) (point-max)))
(insert-buffer-substring tmpbuf) (insert-buffer-substring tmpbuf)
(when msg (when msg
(goto-char (point-min)) (when babyl
(widen) (goto-char (point-min))
(search-backward "\n\^_") (widen)
(narrow-to-region (point) (point-max)) (search-backward "\n\^_")
(narrow-to-region (point) (point-max)))
(rmail-count-new-messages t) (rmail-count-new-messages t)
(when (rmail-summary-exists) (when (rmail-summary-exists)
(rmail-select-summary (rmail-select-summary
(rmail-update-summary))) (rmail-update-summary)))
(rmail-count-new-messages t)
(rmail-show-message msg)) (rmail-show-message msg))
(save-buffer))))) (save-buffer)))))
(kill-buffer tmpbuf))) (kill-buffer tmpbuf)))