X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgnus-bcklg.el;h=b7a63659d82ef8ad3900db0ee43b2ba5656da8fc;hp=ee01d5cffe73a7ceb46a2963220615d8275ef9fa;hb=b52037f4a9c6bee1ff556c22750e158da1208d4b;hpb=27e50870dcbd1442e8fe2d14ddfb89cd7c706495 diff --git a/lisp/gnus-bcklg.el b/lisp/gnus-bcklg.el index ee01d5cff..b7a63659d 100644 --- a/lisp/gnus-bcklg.el +++ b/lisp/gnus-bcklg.el @@ -1,30 +1,31 @@ ;;; gnus-bcklg.el --- backlog functions for Gnus -;; Copyright (C) 1996 Free Software Foundation, Inc. -;; Author: Lars Magne Ingebrigtsen +;; Copyright (C) 1996-2016 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) ;;; @@ -38,11 +39,9 @@ (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 () @@ -54,38 +53,41 @@ (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 (gnus-virtual-group-p 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. + (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. @@ -108,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 @@ -120,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 (gnus-virtual-group-p 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))) @@ -142,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)