Move rmail-related functions from gnus-util.el to gnus-rmail.el
* lisp/gnus/gnus-rmail.el: New file with rmail-related functions moved from gnus-util.el. * lisp/gnus/gnus-util.el: Move the rmail-related functions to its own file. This avoids loading rmail.el when something requires gnus-util.el.
This commit is contained in:
Lars Ingebrigtsen
parent
579d7c20da
commit
6f2351a486
4 changed files with 148 additions and 137 deletions
142
lisp/gnus/gnus-rmail.el
Normal file
142
lisp/gnus/gnus-rmail.el
Normal file
|
|
@ -0,0 +1,142 @@
|
|||
;;; gnus-rmail.el --- Saving to rmail/babyl files -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2021 Free Software Foundation, Inc.
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;;
|
||||
|
||||
;;; Code:
|
||||
|
||||
;;; Functions for saving to babyl/mail files.
|
||||
|
||||
(require 'rmail)
|
||||
(require 'rmailsum)
|
||||
(require 'nnmail)
|
||||
|
||||
(defun gnus-output-to-rmail (filename &optional ask)
|
||||
"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."
|
||||
;; Some of this codes is borrowed from rmailout.el.
|
||||
(setq filename (expand-file-name 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))
|
||||
(tmpbuf (gnus-get-buffer-create " *Gnus-output*"))
|
||||
;; Babyl rmail.el defines this, mbox does not.
|
||||
(babyl (fboundp 'rmail-insert-rmail-file-header)))
|
||||
(save-excursion
|
||||
;; Note that we ignore the possibility of visiting a Babyl
|
||||
;; 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)
|
||||
(gnus-yes-or-no-p
|
||||
(concat "\"" filename "\" does not exist, create it? ")))
|
||||
(let ((file-buffer (create-file-buffer filename)))
|
||||
(with-current-buffer file-buffer
|
||||
(if (fboundp 'rmail-insert-rmail-file-header)
|
||||
(rmail-insert-rmail-file-header))
|
||||
(let ((require-final-newline nil)
|
||||
(coding-system-for-write mm-text-coding-system))
|
||||
(gnus-write-buffer filename)))
|
||||
(kill-buffer file-buffer))
|
||||
(error "Output file does not exist")))
|
||||
(set-buffer tmpbuf)
|
||||
(erase-buffer)
|
||||
(insert-buffer-substring artbuf)
|
||||
(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.
|
||||
(let ((outbuf (get-file-buffer filename)))
|
||||
(if (not outbuf)
|
||||
(progn
|
||||
(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.
|
||||
(set-buffer outbuf)
|
||||
(let ((buffer-read-only nil)
|
||||
(msg (and (boundp 'rmail-current-message)
|
||||
(symbol-value 'rmail-current-message))))
|
||||
;; If MSG is non-nil, buffer is in RMAIL mode.
|
||||
;; Compare this with rmail-output-to-rmail-buffer in Emacs 23.
|
||||
(when msg
|
||||
(unless babyl
|
||||
(rmail-swap-buffers-maybe)
|
||||
(rmail-maybe-set-message-counters))
|
||||
(widen)
|
||||
(unless babyl
|
||||
(goto-char (point-max))
|
||||
;; Ensure we have a blank line before the next message.
|
||||
(unless (bolp)
|
||||
(insert "\n"))
|
||||
(insert "\n"))
|
||||
(narrow-to-region (point-max) (point-max)))
|
||||
(insert-buffer-substring tmpbuf)
|
||||
(when msg
|
||||
(when babyl
|
||||
(goto-char (point-min))
|
||||
(widen)
|
||||
(search-backward "\n\^_")
|
||||
(narrow-to-region (point) (point-max)))
|
||||
(rmail-count-new-messages t)
|
||||
(when (rmail-summary-exists)
|
||||
(rmail-select-summary
|
||||
(rmail-update-summary)))
|
||||
(rmail-show-message msg))
|
||||
(save-buffer)))))
|
||||
(kill-buffer tmpbuf)))
|
||||
|
||||
(defun gnus-convert-article-to-rmail ()
|
||||
"Convert article in current buffer to Rmail message format."
|
||||
(let ((buffer-read-only nil))
|
||||
;; Convert article directly into Babyl format.
|
||||
(goto-char (point-min))
|
||||
(insert "\^L\n0, unseen,,\n*** EOOH ***\n")
|
||||
(while (search-forward "\n\^_" nil t) ;single char
|
||||
(replace-match "\n^_" t t)) ;2 chars: "^" and "_"
|
||||
(goto-char (point-max))
|
||||
(insert "\^_")))
|
||||
|
||||
;;; gnus-rmail.el ends here
|
||||
|
|
@ -858,126 +858,9 @@ variables and then do only the assignment atomically."
|
|||
`(let ((inhibit-quit gnus-atomic-be-safe))
|
||||
,@forms))
|
||||
|
||||
;;; Functions for saving to babyl/mail files.
|
||||
|
||||
(require 'rmail)
|
||||
(autoload 'rmail-update-summary "rmailsum")
|
||||
|
||||
(defvar mm-text-coding-system)
|
||||
|
||||
(declare-function mm-append-to-file "mm-util"
|
||||
(start end filename &optional codesys inhibit))
|
||||
(declare-function rmail-swap-buffers-maybe "rmail" ())
|
||||
(declare-function rmail-maybe-set-message-counters "rmail" ())
|
||||
(declare-function rmail-count-new-messages "rmail" (&optional nomsg))
|
||||
(declare-function rmail-summary-exists "rmail" ())
|
||||
(declare-function rmail-show-message "rmail" (&optional n no-summary))
|
||||
;; Macroexpansion of rmail-select-summary:
|
||||
(declare-function rmail-summary-displayed "rmail" ())
|
||||
(declare-function rmail-pop-to-buffer "rmail" (&rest args))
|
||||
(declare-function rmail-maybe-display-summary "rmail" ())
|
||||
|
||||
(defun gnus-output-to-rmail (filename &optional ask)
|
||||
"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 'mm-util)
|
||||
(require 'nnmail)
|
||||
;; Some of this codes is borrowed from rmailout.el.
|
||||
(setq filename (expand-file-name 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))
|
||||
(tmpbuf (gnus-get-buffer-create " *Gnus-output*"))
|
||||
;; Babyl rmail.el defines this, mbox does not.
|
||||
(babyl (fboundp 'rmail-insert-rmail-file-header)))
|
||||
(save-excursion
|
||||
;; Note that we ignore the possibility of visiting a Babyl
|
||||
;; 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)
|
||||
(gnus-yes-or-no-p
|
||||
(concat "\"" filename "\" does not exist, create it? ")))
|
||||
(let ((file-buffer (create-file-buffer filename)))
|
||||
(with-current-buffer file-buffer
|
||||
(if (fboundp 'rmail-insert-rmail-file-header)
|
||||
(rmail-insert-rmail-file-header))
|
||||
(let ((require-final-newline nil)
|
||||
(coding-system-for-write mm-text-coding-system))
|
||||
(gnus-write-buffer filename)))
|
||||
(kill-buffer file-buffer))
|
||||
(error "Output file does not exist")))
|
||||
(set-buffer tmpbuf)
|
||||
(erase-buffer)
|
||||
(insert-buffer-substring artbuf)
|
||||
(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.
|
||||
(let ((outbuf (get-file-buffer filename)))
|
||||
(if (not outbuf)
|
||||
(progn
|
||||
(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.
|
||||
(set-buffer outbuf)
|
||||
(let ((buffer-read-only nil)
|
||||
(msg (and (boundp 'rmail-current-message)
|
||||
(symbol-value 'rmail-current-message))))
|
||||
;; If MSG is non-nil, buffer is in RMAIL mode.
|
||||
;; Compare this with rmail-output-to-rmail-buffer in Emacs 23.
|
||||
(when msg
|
||||
(unless babyl
|
||||
(rmail-swap-buffers-maybe)
|
||||
(rmail-maybe-set-message-counters))
|
||||
(widen)
|
||||
(unless babyl
|
||||
(goto-char (point-max))
|
||||
;; Ensure we have a blank line before the next message.
|
||||
(unless (bolp)
|
||||
(insert "\n"))
|
||||
(insert "\n"))
|
||||
(narrow-to-region (point-max) (point-max)))
|
||||
(insert-buffer-substring tmpbuf)
|
||||
(when msg
|
||||
(when babyl
|
||||
(goto-char (point-min))
|
||||
(widen)
|
||||
(search-backward "\n\^_")
|
||||
(narrow-to-region (point) (point-max)))
|
||||
(rmail-count-new-messages t)
|
||||
(when (rmail-summary-exists)
|
||||
(rmail-select-summary
|
||||
(rmail-update-summary)))
|
||||
(rmail-show-message msg))
|
||||
(save-buffer)))))
|
||||
(kill-buffer tmpbuf)))
|
||||
|
||||
(defun gnus-output-to-mail (filename &optional ask)
|
||||
"Append the current article to a mail file named FILENAME."
|
||||
|
|
@ -1035,17 +918,6 @@ FILENAME exists and is Babyl format."
|
|||
(insert-buffer-substring tmpbuf)))))
|
||||
(kill-buffer tmpbuf)))
|
||||
|
||||
(defun gnus-convert-article-to-rmail ()
|
||||
"Convert article in current buffer to Rmail message format."
|
||||
(let ((buffer-read-only nil))
|
||||
;; Convert article directly into Babyl format.
|
||||
(goto-char (point-min))
|
||||
(insert "\^L\n0, unseen,,\n*** EOOH ***\n")
|
||||
(while (search-forward "\n\^_" nil t) ;single char
|
||||
(replace-match "\n^_" t t)) ;2 chars: "^" and "_"
|
||||
(goto-char (point-max))
|
||||
(insert "\^_")))
|
||||
|
||||
(defun gnus-map-function (funs arg)
|
||||
"Apply the result of the first function in FUNS to the second, and so on.
|
||||
ARG is passed to the first function."
|
||||
|
|
@ -1675,6 +1547,11 @@ lists of strings."
|
|||
(while overlays
|
||||
(delete-overlay (pop overlays)))))
|
||||
|
||||
;; This function used to live in this file, but was moved to a
|
||||
;; separate file to avoid pulling in rmail.el when requiring
|
||||
;; gnus-util.
|
||||
(autoload 'gnus-output-to-rmail "gnus-rmail")
|
||||
|
||||
(provide 'gnus-util)
|
||||
|
||||
;;; gnus-util.el ends here
|
||||
|
|
|
|||
|
|
@ -2528,14 +2528,6 @@ are always t.")
|
|||
("babel" babel-as-string)
|
||||
("nnmail" nnmail-split-fancy nnmail-article-group)
|
||||
("nnvirtual" nnvirtual-catchup-group nnvirtual-convert-headers)
|
||||
;; This is only used in message.el, which has an autoload.
|
||||
("rmailout" rmail-output)
|
||||
;; Next two used in gnus-util, which has autoloads, and contrib/sendmail.
|
||||
("rmail" rmail-count-new-messages rmail-show-message
|
||||
;; Next two only used in gnus-util.
|
||||
rmail-summary-exists rmail-select-summary)
|
||||
;; Only used in gnus-util, which has an autoload.
|
||||
("rmailsum" rmail-update-summary)
|
||||
("gnus-xmas" gnus-xmas-splash)
|
||||
("score-mode" :interactive t gnus-score-mode gnus-score-edit-all-score)
|
||||
("gnus-mh" gnus-summary-save-article-folder
|
||||
|
|
|
|||
|
|
@ -2053,7 +2053,7 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'."
|
|||
(autoload 'gnus-groups-from-server "gnus")
|
||||
(autoload 'gnus-open-server "gnus-int")
|
||||
(autoload 'gnus-output-to-mail "gnus-util")
|
||||
(autoload 'gnus-output-to-rmail "gnus-util")
|
||||
(autoload 'gnus-output-to-rmail "gnus-rmail")
|
||||
(autoload 'gnus-request-post "gnus-int")
|
||||
(autoload 'gnus-server-string "gnus")
|
||||
(autoload 'message-setup-toolbar "messagexmas")
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue