X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-bcklg.el;h=f490d8a37d9563f0dfcb89c044b24b7172c9b595;hb=2e050501fb1fee86325437d6b0d6f2bce4141ec8;hp=ee01d5cffe73a7ceb46a2963220615d8275ef9fa;hpb=27e50870dcbd1442e8fe2d14ddfb89cd7c706495;p=gnus diff --git a/lisp/gnus-bcklg.el b/lisp/gnus-bcklg.el index ee01d5cff..f490d8a37 100644 --- a/lisp/gnus-bcklg.el +++ b/lisp/gnus-bcklg.el @@ -1,30 +1,32 @@ ;;; gnus-bcklg.el --- backlog functions for Gnus -;; Copyright (C) 1996 Free Software Foundation, Inc. -;; Author: Lars Magne Ingebrigtsen +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007, 2008, 2009, 2010 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: +(eval-when-compile (require 'cl)) + (require 'gnus) ;;; @@ -39,10 +41,9 @@ "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)) + (set-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 () @@ -54,34 +55,39 @@ (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)) - (push ident gnus-backlog-articles) - ;; Insert the new article. - (save-excursion - (set-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. - (gnus-put-text-property b (1+ b) 'gnus-backlog ident)))))) + (push ident gnus-backlog-articles) + ;; Insert the new article. + (save-excursion + (set-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 @@ -120,10 +126,12 @@ (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)) @@ -142,11 +150,14 @@ (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))))) + (save-excursion + (and buffer (set-buffer buffer)) + (let ((buffer-read-only nil)) + (erase-buffer) + (insert-buffer-substring gnus-backlog-buffer beg end))) + t)))) (provide 'gnus-bcklg) +;; arch-tag: 66259e56-505a-4bba-8a0d-3552c5b94e39 ;;; gnus-bcklg.el ends here