;;; nnmbox.el --- mail mbox access for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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, or (at your option)
-;; any later version.
+;; 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; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
(nnoo-define-basics nnmbox)
(deffoo nnmbox-retrieve-headers (sequence &optional newsgroup server fetch-old)
- (save-excursion
- (set-buffer nntp-server-buffer)
+ (with-current-buffer nntp-server-buffer
(erase-buffer)
(let ((number (length sequence))
(count 0)
(> number nnmail-large-newsgroup)
(zerop (% count 20))
(nnheader-message 5 "nnmbox: Receiving headers... %d%%"
- (/ (* count 100) number))))
+ (floor (* count 100.0) number))))
(and (numberp nnmail-large-newsgroup)
(> number nnmail-large-newsgroup)
(deffoo nnmbox-request-article (article &optional newsgroup server buffer)
(nnmbox-possibly-change-newsgroup newsgroup server)
- (save-excursion
- (set-buffer nnmbox-mbox-buffer)
- (when (nnmbox-find-article article)
- (let (start stop)
- (re-search-backward (concat "^" message-unix-mail-delimiter) nil t)
- (setq start (point))
- (forward-line 1)
- (setq stop (if (re-search-forward (concat "^"
- message-unix-mail-delimiter)
- nil 'move)
- (match-beginning 0)
- (point)))
- (let ((nntp-server-buffer (or buffer nntp-server-buffer)))
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (insert-buffer-substring nnmbox-mbox-buffer start stop)
- (goto-char (point-min))
- (while (looking-at "From ")
- (delete-char 5)
- (insert "X-From-Line: ")
- (forward-line 1))
- (if (numberp article)
- (cons nnmbox-current-group article)
- (nnmbox-article-group-number nil)))))))
-
-(deffoo nnmbox-request-group (group &optional server dont-check)
+ (with-current-buffer nnmbox-mbox-buffer
+ (save-excursion
+ (when (nnmbox-find-article article)
+ (let (start stop)
+ (re-search-backward (concat "^" message-unix-mail-delimiter) nil t)
+ (setq start (point))
+ (forward-line 1)
+ (setq stop (if (re-search-forward (concat "^"
+ message-unix-mail-delimiter)
+ nil 'move)
+ (match-beginning 0)
+ (point)))
+ (let ((nntp-server-buffer (or buffer nntp-server-buffer)))
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (insert-buffer-substring nnmbox-mbox-buffer start stop)
+ (goto-char (point-min))
+ (while (looking-at "From ")
+ (delete-char 5)
+ (insert "X-From-Line: ")
+ (forward-line 1))
+ (if (numberp article)
+ (cons nnmbox-current-group article)
+ (nnmbox-article-group-number nil))))))))
+
+(deffoo nnmbox-request-group (group &optional server dont-check info)
(nnmbox-possibly-change-newsgroup nil server)
(let ((active (cadr (assoc group nnmbox-group-alist))))
(cond
(nnmail-get-new-mail
'nnmbox
(lambda ()
- (save-excursion
- (set-buffer nnmbox-mbox-buffer)
+ (with-current-buffer nnmbox-mbox-buffer
(nnmbox-save-buffer)))
(file-name-directory nnmbox-mbox-file)
group
rest)
(nnmail-activate 'nnmbox)
- (save-excursion
- (set-buffer nnmbox-mbox-buffer)
+ (with-current-buffer nnmbox-mbox-buffer
(while (and articles is-old)
(when (nnmbox-find-article (car articles))
(if (setq is-old
(nnmail-expired-article-p
newsgroup
- (buffer-substring
- (point) (progn (end-of-line) (point))) force))
+ (buffer-substring (point) (line-end-position))
+ force))
(progn
(unless (eq nnmail-expiry-target 'delete)
(with-temp-buffer
(nnmbox-request-article (car articles)
- newsgroup server
- (current-buffer))
+ newsgroup server
+ (current-buffer))
(let ((nnml-current-directory nil))
(nnmail-expiry-target-group
nnmail-expiry-target newsgroup)))
result)
(and
(nnmbox-request-article article group server)
- (save-excursion
- (set-buffer buf)
+ (with-current-buffer buf
(erase-buffer)
(insert-buffer-substring nntp-server-buffer)
(goto-char (point-min))
(deffoo nnmbox-request-replace-article (article group buffer)
(nnmbox-possibly-change-newsgroup group)
- (save-excursion
- (set-buffer nnmbox-mbox-buffer)
+ (with-current-buffer nnmbox-mbox-buffer
(if (not (nnmbox-find-article article))
nil
(nnmbox-delete-mail t t)
;; Delete all articles in GROUP.
(if (not force)
() ; Don't delete the articles.
- (save-excursion
- (set-buffer nnmbox-mbox-buffer)
+ (with-current-buffer nnmbox-mbox-buffer
(goto-char (point-min))
;; Delete all articles in this group.
(let ((ident (concat "\nX-Gnus-Newsgroup: " nnmbox-current-group ":"))
(deffoo nnmbox-request-rename-group (group new-name &optional server)
(nnmbox-possibly-change-newsgroup group server)
- (save-excursion
- (set-buffer nnmbox-mbox-buffer)
+ (with-current-buffer nnmbox-mbox-buffer
(goto-char (point-min))
(let ((ident (concat "\nX-Gnus-Newsgroup: " nnmbox-current-group ":"))
(new-ident (concat "\nX-Gnus-Newsgroup: " new-name ":"))
(nnmbox-create-mbox)
(if (and nnmbox-mbox-buffer
(buffer-name nnmbox-mbox-buffer)
- (save-excursion
- (set-buffer nnmbox-mbox-buffer)
+ (with-current-buffer nnmbox-mbox-buffer
(= (buffer-size) (nnheader-file-size nnmbox-mbox-file))))
()
(save-excursion
nnmbox-mbox-file t t))))
(mm-enable-multibyte)
(buffer-disable-undo)
+ (gnus-add-buffer)
;; Go through the group alist and compare against the mbox file.
(while alist
(provide 'nnmbox)
-;; arch-tag: 611dd95f-be37-413a-b3ae-8b059ba93659
;;; nnmbox.el ends here