projects
/
gnus
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
(gnus-summary-refer-thread): Implement a version that uses *-request-thread.
[gnus]
/
lisp
/
nnmbox.el
diff --git
a/lisp/nnmbox.el
b/lisp/nnmbox.el
index
e33843c
..
003c424
100644
(file)
--- a/
lisp/nnmbox.el
+++ b/
lisp/nnmbox.el
@@
-1,7
+1,7
@@
;;; nnmbox.el --- mail mbox access for Gnus
;;; nnmbox.el --- mail mbox access for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002
-;;
Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002
, 2003,
+;;
2004, 2005, 2006, 2007, 2008, 2009, 2010
Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
@@
-9,15
+9,18
@@
;; This file is part of GNU Emacs.
;; 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
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, 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
;; 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., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Commentary:
@@
-76,8
+79,7
@@
(nnoo-define-basics nnmbox)
(deffoo nnmbox-retrieve-headers (sequence &optional newsgroup server fetch-old)
(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)
(erase-buffer)
(let ((number (length sequence))
(count 0)
@@
-146,18
+148,17
@@
(deffoo nnmbox-request-article (article &optional newsgroup server buffer)
(nnmbox-possibly-change-newsgroup newsgroup server)
(deffoo nnmbox-request-article (article &optional newsgroup server buffer)
(nnmbox-possibly-change-newsgroup newsgroup server)
- (save-excursion
- (set-buffer nnmbox-mbox-buffer)
+ (with-current-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)
(when (nnmbox-find-article article)
(let (start stop)
(re-search-backward (concat "^" message-unix-mail-delimiter) nil t)
(setq start (point))
(forward-line 1)
- (
or (and (re-search-forward
-
(concat "^" message-unix-mail-delimiter) nil t
)
-
(forward-line -1)
)
-
(goto-char (point-max))
)
-
(setq stop (point
))
+ (
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)
(let ((nntp-server-buffer (or buffer nntp-server-buffer)))
(set-buffer nntp-server-buffer)
(erase-buffer)
@@
-171,7
+172,7
@@
(cons nnmbox-current-group article)
(nnmbox-article-group-number nil)))))))
(cons nnmbox-current-group article)
(nnmbox-article-group-number nil)))))))
-(deffoo nnmbox-request-group (group &optional server dont-check)
+(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
(nnmbox-possibly-change-newsgroup nil server)
(let ((active (cadr (assoc group nnmbox-group-alist))))
(cond
@@
-205,8
+206,7
@@
(nnmail-get-new-mail
'nnmbox
(lambda ()
(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
(nnmbox-save-buffer)))
(file-name-directory nnmbox-mbox-file)
group
@@
-250,8
+250,7
@@
rest)
(nnmail-activate 'nnmbox)
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
(while (and articles is-old)
(when (nnmbox-find-article (car articles))
(if (setq is-old
@@
-284,13
+283,12
@@
(nconc rest articles))))
(deffoo nnmbox-request-move-article
(nconc rest articles))))
(deffoo nnmbox-request-move-article
- (article group server accept-form &optional last)
+ (article group server accept-form &optional last
move-is-internal
)
(let ((buf (get-buffer-create " *nnmbox move*"))
result)
(and
(nnmbox-request-article article group server)
(let ((buf (get-buffer-create " *nnmbox move*"))
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))
(erase-buffer)
(insert-buffer-substring nntp-server-buffer)
(goto-char (point-min))
@@
-313,36
+311,45
@@
(nnmbox-possibly-change-newsgroup group server)
(nnmail-check-syntax)
(let ((buf (current-buffer))
(nnmbox-possibly-change-newsgroup group server)
(nnmail-check-syntax)
(let ((buf (current-buffer))
- result)
- (goto-char (point-min))
- ;; The From line may have been quoted by movemail.
- (when (looking-at (concat ">" message-unix-mail-delimiter))
- (delete-char 1))
- (if (looking-at "X-From-Line: ")
- (replace-match "From ")
- (insert "From nobody " (current-time-string) "\n"))
+ result cont)
(and
(nnmail-activate 'nnmbox)
(and
(nnmail-activate 'nnmbox)
- (
progn
- (
set-buffer
buf)
+ (
with-temp-buffer
+ (
insert-buffer-substring
buf)
(goto-char (point-min))
(goto-char (point-min))
- (search-forward "\n\n" nil t)
- (forward-line -1)
+ (cond (;; The From line may have been quoted by movemail.
+ (looking-at (concat ">" message-unix-mail-delimiter))
+ (delete-char 1)
+ (forward-line 1))
+ ((looking-at "X-From-Line: ")
+ (replace-match "From ")
+ (forward-line 1))
+ (t
+ (insert "From nobody " (current-time-string) "\n")))
+ (narrow-to-region (point)
+ (if (search-forward "\n\n" nil 'move)
+ (1- (point))
+ (point)))
(while (re-search-backward "^X-Gnus-Newsgroup: " nil t)
(delete-region (point) (progn (forward-line 1) (point))))
(when nnmail-cache-accepted-message-ids
(while (re-search-backward "^X-Gnus-Newsgroup: " nil t)
(delete-region (point) (progn (forward-line 1) (point))))
(when nnmail-cache-accepted-message-ids
- (nnmail-cache-insert (nnmail-fetch-field "message-id") group))
+ (nnmail-cache-insert (message-fetch-field "message-id")
+ group
+ (message-fetch-field "subject")
+ (message-fetch-field "from")))
+ (widen)
(setq result (if (stringp group)
(list (cons group (nnmbox-active-number group)))
(nnmail-article-group 'nnmbox-active-number)))
(setq result (if (stringp group)
(list (cons group (nnmbox-active-number group)))
(nnmail-article-group 'nnmbox-active-number)))
- (if (and (null result)
- (yes-or-no-p "Moved to `junk' group; delete article? "))
- (setq result 'junk)
- (setq result (car (nnmbox-save-mail result)))))
- (save-excursion
- (set-buffer nnmbox-mbox-buffer)
+ (prog1
+ (if (and (null result)
+ (yes-or-no-p "Moved to `junk' group; delete article? "))
+ (setq result 'junk)
+ (setq result (car (nnmbox-save-mail result))))
+ (setq cont (buffer-string))))
+ (with-current-buffer nnmbox-mbox-buffer
(goto-char (point-max))
(goto-char (point-max))
- (insert
-buffer-substring buf
)
+ (insert
cont
)
(when last
(when nnmail-cache-accepted-message-ids
(nnmail-cache-close))
(when last
(when nnmail-cache-accepted-message-ids
(nnmail-cache-close))
@@
-352,12
+359,24
@@
(deffoo nnmbox-request-replace-article (article group buffer)
(nnmbox-possibly-change-newsgroup group)
(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)
(if (not (nnmbox-find-article article))
nil
(nnmbox-delete-mail t t)
- (insert-buffer-substring buffer)
+ (insert
+ (with-temp-buffer
+ (insert-buffer-substring buffer)
+ (goto-char (point-min))
+ (when (looking-at "X-From-Line:")
+ (delete-region (point) (progn (forward-line 1) (point))))
+ (while (re-search-forward (concat "^" message-unix-mail-delimiter)
+ nil t)
+ (goto-char (match-beginning 0))
+ (insert ">"))
+ (goto-char (point-max))
+ (unless (bolp)
+ (insert "\n"))
+ (buffer-string)))
(nnmbox-save-buffer)
t)))
(nnmbox-save-buffer)
t)))
@@
-366,8
+385,7
@@
;; Delete all articles in GROUP.
(if (not force)
() ; Don't delete the articles.
;; 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 ":"))
(goto-char (point-min))
;; Delete all articles in this group.
(let ((ident (concat "\nX-Gnus-Newsgroup: " nnmbox-current-group ":"))
@@
-387,8
+405,7
@@
(deffoo nnmbox-request-rename-group (group new-name &optional server)
(nnmbox-possibly-change-newsgroup group server)
(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 ":"))
(goto-char (point-min))
(let ((ident (concat "\nX-Gnus-Newsgroup: " nnmbox-current-group ":"))
(new-ident (concat "\nX-Gnus-Newsgroup: " new-name ":"))
@@
-427,21
+444,20
@@
(save-excursion
(save-restriction
(narrow-to-region
(save-excursion
(save-restriction
(narrow-to-region
- (save-excursion
- (re-search-backward (concat "^" message-unix-mail-delimiter) nil t)
- (if leave-delim (progn (forward-line 1) (point))
- (match-beginning 0)))
- (progn
- (forward-line 1)
- (or (and (re-search-forward (concat "^" message-unix-mail-delimiter)
- nil t)
- (if (and (not (bobp)) leave-delim)
- (progn (forward-line -2) (point))
- (match-beginning 0)))
- (point-max))))
+ (prog2
+ (re-search-backward (concat "^" message-unix-mail-delimiter) nil t)
+ (if leave-delim (progn (forward-line 1) (point))
+ (match-beginning 0))
+ (forward-line 1))
+ (or (and (re-search-forward (concat "^" message-unix-mail-delimiter)
+ nil t)
+ (match-beginning 0))
+ (point-max)))
(goto-char (point-min))
;; Only delete the article if no other group owns it as well.
(goto-char (point-min))
;; Only delete the article if no other group owns it as well.
- (when (or force (not (re-search-forward "^X-Gnus-Newsgroup: " nil t)))
+ (when (or force
+ (not (re-search-forward "^X-Gnus-Newsgroup: " nil t))
+ (search-backward "\n\n" nil t))
(delete-region (point-min) (point-max))))))
(defun nnmbox-possibly-change-newsgroup (newsgroup &optional server)
(delete-region (point-min) (point-max))))))
(defun nnmbox-possibly-change-newsgroup (newsgroup &optional server)
@@
-472,7
+488,7
@@
(when (re-search-forward "^X-Gnus-Newsgroup: +\\([^:]+\\):\\([0-9]+\\) "
nil t)
(cons (buffer-substring (match-beginning 1) (match-end 1))
(when (re-search-forward "^X-Gnus-Newsgroup: +\\([^:]+\\):\\([0-9]+\\) "
nil t)
(cons (buffer-substring (match-beginning 1) (match-end 1))
- (string-to-
int
+ (string-to-
number
(buffer-substring (match-beginning 2) (match-end 2)))))))
(defun nnmbox-in-header-p (pos)
(buffer-substring (match-beginning 2) (match-end 2)))))))
(defun nnmbox-in-header-p (pos)
@@
-549,24
+565,26
@@
(let ((delim (concat "^" message-unix-mail-delimiter)))
(goto-char (point-min))
;; This might come from somewhere else.
(let ((delim (concat "^" message-unix-mail-delimiter)))
(goto-char (point-min))
;; This might come from somewhere else.
- (
unless
(looking-at delim)
-
(insert "From nobody " (current-time-string) "\n"
)
- (
goto-char (point-min)
))
+ (
if
(looking-at delim)
+
(forward-line 1
)
+ (
insert "From nobody " (current-time-string) "\n"
))
;; Quote all "From " lines in the article.
;; Quote all "From " lines in the article.
- (forward-line 1)
(while (re-search-forward delim nil t)
(while (re-search-forward delim nil t)
- (beginning-of-line)
- (insert "> "))
- (nnmail-insert-lines)
- (nnmail-insert-xref group-art)
- (nnmbox-insert-newsgroup-line group-art)
- (let ((alist group-art))
- (while alist
- (nnmbox-record-active-article (car alist))
- (setq alist (cdr alist))))
- (run-hooks 'nnmail-prepare-save-mail-hook)
- (run-hooks 'nnmbox-prepare-save-mail-hook)
- group-art))
+ (goto-char (match-beginning 0))
+ (insert ">")))
+ (goto-char (point-max))
+ (unless (bolp)
+ (insert "\n"))
+ (nnmail-insert-lines)
+ (nnmail-insert-xref group-art)
+ (nnmbox-insert-newsgroup-line group-art)
+ (let ((alist group-art))
+ (while alist
+ (nnmbox-record-active-article (car alist))
+ (setq alist (cdr alist))))
+ (run-hooks 'nnmail-prepare-save-mail-hook)
+ (run-hooks 'nnmbox-prepare-save-mail-hook)
+ group-art)
(defun nnmbox-insert-newsgroup-line (group-art)
(save-excursion
(defun nnmbox-insert-newsgroup-line (group-art)
(save-excursion
@@
-607,8
+625,7
@@
(nnmbox-create-mbox)
(if (and nnmbox-mbox-buffer
(buffer-name nnmbox-mbox-buffer)
(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
(= (buffer-size) (nnheader-file-size nnmbox-mbox-file))))
()
(save-excursion
@@
-623,6
+640,7
@@
nnmbox-mbox-file t t))))
(mm-enable-multibyte)
(buffer-disable-undo)
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
;; Go through the group alist and compare against the mbox file.
(while alist
@@
-678,7
+696,7
@@
(let (alist)
(while (re-search-forward " \\([^:]+\\):\\([0-9]+\\)" end-header t)
(push (cons (match-string 1)
(let (alist)
(while (re-search-forward " \\([^:]+\\):\\([0-9]+\\)" end-header t)
(push (cons (match-string 1)
- (string-to-
int
(match-string 2))) alist))
+ (string-to-
number
(match-string 2))) alist))
(nnmbox-insert-newsgroup-line alist))
;; this is really a new article
(nnmbox-save-mail
(nnmbox-insert-newsgroup-line alist))
;; this is really a new article
(nnmbox-save-mail