1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
|
;;; gnus-bcklg.el --- backlog functions for Gnus
;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
;; This file is part of GNU Emacs.
;; 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.
;; 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.
;;; Commentary:
;;; Code:
(eval-when-compile (require 'cl))
(require 'gnus)
;;;
;;; Buffering of read articles.
;;;
(defvar gnus-backlog-buffer " *Gnus Backlog*")
(defvar gnus-backlog-articles nil)
(defvar gnus-backlog-hashtb nil)
(defun gnus-backlog-buffer ()
"Return the backlog buffer."
(or (get-buffer gnus-backlog-buffer)
(save-excursion
(set-buffer (gnus-get-buffer-create gnus-backlog-buffer))
(buffer-disable-undo)
(setq buffer-read-only t)
(get-buffer gnus-backlog-buffer))))
(defun gnus-backlog-setup ()
"Initialize backlog variables."
(unless gnus-backlog-hashtb
(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)
(gnus-kill-buffer gnus-backlog-buffer))
(setq gnus-backlog-hashtb nil
gnus-backlog-articles nil))
(defun gnus-backlog-enter-article (group number 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))
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)
(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.
(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))
(goto-char (point-min))
(if (zerop (buffer-size))
() ; The buffer is empty.
(let ((ident (get-text-property (point) 'gnus-backlog))
buffer-read-only)
;; Remove the ident from the list of articles.
(when ident
(setq gnus-backlog-articles (delq ident gnus-backlog-articles)))
;; Delete the article itself.
(delete-region
(point) (next-single-property-change
(1+ (point)) 'gnus-backlog nil (point-max)))))))
(defun gnus-backlog-remove-article (group number)
"Remove article NUMBER in GROUP from the backlog."
(when (numberp number)
(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))
(let (buffer-read-only)
(when (setq beg (text-property-any
(point-min) (point-max) 'gnus-backlog
ident))
;; Find the end (i. e., the beginning of the next article).
(setq end
(next-single-property-change
(1+ beg) 'gnus-backlog (current-buffer) (point-max)))
(delete-region beg end)
;; Return success.
t))
(setq gnus-backlog-articles (delq ident gnus-backlog-articles)))))))
(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))
(if (not (setq beg (text-property-any
(point-min) (point-max) 'gnus-backlog
ident)))
;; It wasn't in the backlog after all.
(ignore
(setq gnus-backlog-articles (delq ident gnus-backlog-articles)))
;; Find the end (i. e., the beginning of the next article).
(setq end
(next-single-property-change
(1+ beg) 'gnus-backlog (current-buffer) (point-max)))))
(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
|
