X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgnus-bcklg.el;h=fdf868d8e213e5355a8d4473fbaec8ab18885d6f;hp=33019e2dee5ae7836bf51756b4cab4a0979e5b0d;hb=55c26cf1a9939dc7b28fcbab35f1d05d56d53242;hpb=8f22dc3866405e2211e7d6201491100371c3cd9a diff --git a/lisp/gnus-bcklg.el b/lisp/gnus-bcklg.el index 33019e2de..fdf868d8e 100644 --- a/lisp/gnus-bcklg.el +++ b/lisp/gnus-bcklg.el @@ -1,31 +1,32 @@ ;;; gnus-bcklg.el --- backlog functions for Gnus -;; Copyright (C) 1996 Free Software Foundation, Inc. -;; Author: Lars Magne Ingebrigtsen +;; Copyright (C) 1996-2012 Free Software Foundation, Inc. + +;; Author: Lars Magne Ingebrigtsen ;; Keywords: news ;; 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 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 +;; 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., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: ;;; Code: -(require 'gnus-load) +(eval-when-compile (require 'cl)) + +(require 'gnus) ;;; ;;; Buffering of read articles. @@ -38,56 +39,58 @@ (defun gnus-backlog-buffer () "Return the backlog buffer." (or (get-buffer gnus-backlog-buffer) - (save-excursion - (set-buffer (get-buffer-create gnus-backlog-buffer)) - (buffer-disable-undo (current-buffer)) + (with-current-buffer (gnus-get-buffer-create gnus-backlog-buffer) + (buffer-disable-undo) (setq buffer-read-only t) - (gnus-add-current-to-buffer-list) (get-buffer gnus-backlog-buffer)))) (defun gnus-backlog-setup () "Initialize backlog variables." (unless gnus-backlog-hashtb - (setq gnus-backlog-hashtb (make-vector 1023 0)))) + (setq gnus-backlog-hashtb (gnus-make-hashtable 1024)))) (gnus-add-shutdown 'gnus-backlog-shutdown 'gnus) (defun gnus-backlog-shutdown () "Clear all backlog variables and buffers." + (interactive) (when (get-buffer gnus-backlog-buffer) - (kill-buffer gnus-backlog-buffer)) + (gnus-kill-buffer gnus-backlog-buffer)) (setq gnus-backlog-hashtb nil gnus-backlog-articles nil)) (defun gnus-backlog-enter-article (group number buffer) - (gnus-backlog-setup) - (let ((ident (intern (concat group ":" (int-to-string number)) - gnus-backlog-hashtb)) - b) - (if (memq ident gnus-backlog-articles) - () ; It's already kept. + (when (and (numberp number) + (not (string-match "^nnvirtual" group))) + (gnus-backlog-setup) + (let ((ident (intern (concat group ":" (int-to-string number)) + gnus-backlog-hashtb)) + b) + (if (memq ident gnus-backlog-articles) + () ; It's already kept. ;; Remove the oldest article, if necessary. - (and (numberp gnus-keep-backlog) - (>= (length gnus-backlog-articles) gnus-keep-backlog) + (and (numberp gnus-keep-backlog) + (>= (length gnus-backlog-articles) gnus-keep-backlog) (gnus-backlog-remove-oldest-article)) - (setq gnus-backlog-articles (cons ident gnus-backlog-articles)) - ;; Insert the new article. - (save-excursion - (set-buffer (gnus-backlog-buffer)) - (let (buffer-read-only) - (goto-char (point-max)) - (or (bolp) (insert "\n")) - (setq b (point)) - (insert-buffer-substring buffer) - ;; Tag the beginning of the article with the ident. - (gnus-put-text-property b (1+ b) 'gnus-backlog ident)))))) + (push ident gnus-backlog-articles) + ;; Insert the new article. + (with-current-buffer (gnus-backlog-buffer) + (let (buffer-read-only) + (goto-char (point-max)) + (unless (bolp) + (insert "\n")) + (setq b (point)) + (insert-buffer-substring buffer) + ;; Tag the beginning of the article with the ident. + (if (> (point-max) b) + (gnus-put-text-property b (1+ b) 'gnus-backlog ident) + (gnus-error 3 "Article %d is blank" number)))))))) (defun gnus-backlog-remove-oldest-article () - (save-excursion - (set-buffer (gnus-backlog-buffer)) + (with-current-buffer (gnus-backlog-buffer) (goto-char (point-min)) (if (zerop (buffer-size)) - () ; The buffer is empty. + () ; The buffer is empty. (let ((ident (get-text-property (point) 'gnus-backlog)) buffer-read-only) ;; Remove the ident from the list of articles. @@ -107,8 +110,7 @@ beg end) (when (memq ident gnus-backlog-articles) ;; It was in the backlog. - (save-excursion - (set-buffer (gnus-backlog-buffer)) + (with-current-buffer (gnus-backlog-buffer) (let (buffer-read-only) (when (setq beg (text-property-any (point-min) (point-max) 'gnus-backlog @@ -119,18 +121,19 @@ (1+ beg) 'gnus-backlog (current-buffer) (point-max))) (delete-region beg end) ;; Return success. - t))))))) + t)) + (setq gnus-backlog-articles (delq ident gnus-backlog-articles))))))) -(defun gnus-backlog-request-article (group number buffer) - (when (numberp number) +(defun gnus-backlog-request-article (group number &optional buffer) + (when (and (numberp number) + (not (string-match "^nnvirtual" group))) (gnus-backlog-setup) (let ((ident (intern (concat group ":" (int-to-string number)) gnus-backlog-hashtb)) beg end) (when (memq ident gnus-backlog-articles) ;; It was in the backlog. - (save-excursion - (set-buffer (gnus-backlog-buffer)) + (with-current-buffer (gnus-backlog-buffer) (if (not (setq beg (text-property-any (point-min) (point-max) 'gnus-backlog ident))) @@ -141,10 +144,11 @@ (setq end (next-single-property-change (1+ beg) 'gnus-backlog (current-buffer) (point-max))))) - (let ((buffer-read-only nil)) - (erase-buffer) - (insert-buffer-substring gnus-backlog-buffer beg end) - t))))) + (with-current-buffer (or (current-buffer) buffer) + (let ((buffer-read-only nil)) + (erase-buffer) + (insert-buffer-substring gnus-backlog-buffer beg end))) + t)))) (provide 'gnus-bcklg)