(eval-when-compile (require 'cl))
(require 'gnus)
(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)
() (and (numberp gnus-keep-backlog)
(>= (length gnus-backlog-articles) gnus-keep-backlog)
(gnus-backlog-remove-oldest-article))
(push ident gnus-backlog-articles)
(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)
(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))
() (let ((ident (get-text-property (point) 'gnus-backlog))
buffer-read-only)
(when ident
(setq gnus-backlog-articles (delq ident gnus-backlog-articles)))
(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)
(save-excursion
(set-buffer (gnus-backlog-buffer))
(let (buffer-read-only)
(when (setq beg (text-property-any
(point-min) (point-max) 'gnus-backlog
ident))
(setq end
(next-single-property-change
(1+ beg) 'gnus-backlog (current-buffer) (point-max)))
(delete-region beg end)
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)
(save-excursion
(set-buffer (gnus-backlog-buffer))
(if (not (setq beg (text-property-any
(point-min) (point-max) 'gnus-backlog
ident)))
(ignore
(setq gnus-backlog-articles (delq ident gnus-backlog-articles)))
(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)