Commit c1b63af4 authored by Eric Abrahamsen's avatar Eric Abrahamsen

Change Gnus hash tables into real hash tables

Gnus has used obarrays as makeshift hash tables for groups: group
names are coerced to unibyte and interned in custom obarrays, and
their symbol-value set to whatever value needs to be stored. This
patch replaces those obarrays with actual hash tables.

* lisp/gnus/gnus-util.el (gnus-intern-safe, gnus-create-hash-size):
  Remove functions.
  (gnus-make-hashtable): Change to return a real hash table.
  (gnus-text-property-search): Utility similar to `text-property-any',
  but compares on `equal'. Needed because the 'gnus-group text
  property is now a string.
* lisp/gnus/gnus.el (gnus-gethash, gnus-gethash-safe, gnus-sethash):
  Remove macros.
  (gnus-group-list): New variable holding all group names as an
  ordered list. Used because `gnus-newsrc-hashtb' used to preserve
  `gnus-newsrc-alist' ordering, but now doesn't.
* lisp/gnus/nnmaildir.el (nnmaildir--servers): Change from obarray to
  alist.
  (nnmaildir--up2-1): Remove function.
* lisp/thingatpt.el (thing-at-point-newsgroup-p): This was making use
  of Gnus obarrays, replace with a cond that can handle many different
  possibilities.
* lisp/gnus/gnus-bcklg.el (gnus-backlog-articles): Remove
  gnus-backlog-hashtb, which wasn't doing anything. Just keep a list
  of ident strings in gnus-backlog-articles.
  (gnus-backlog-setup): Delete unnecessary function.
  (gnus-backlog-enter-article, gnus-backlog-remove-oldest-article,
  gnus-backlog-remove-article, gnus-backlog-request-article): Alter
  calls accordingly.
* lisp/gnus/gnus-dup.el (gnus-duplicate-list-max-length): Rename from
  `gnus-duplicate-list-length', for accuracy.
* lisp/gnus/gnus-start.el (gnus-active-to-gnus-format,
  gnus-groups-to-gnus-format, gnus-newsrc-to-gnus-format): Read group
  names as strings.
  (gnus-gnus-to-quick-newsrc-format): Write `gnus-newsrc-alist' using
  the ordering in `gnus-group-list'.
* lisp/gnus/gnus-agent.el:
* lisp/gnus/gnus-async.el:
* lisp/gnus/gnus-cache.el:
* lisp/gnus/gnus-group.el:
* lisp/gnus/gnus-score.el:
* lisp/gnus/gnus-sum.el:
* lisp/gnus/gnus-topic.el:
* lisp/gnus/message.el:
* lisp/gnus/mml.el:
* lisp/gnus/nnagent.el:
* lisp/gnus/nnbabyl.el:
* lisp/gnus/nnvirtual.el:
* lisp/gnus/nnweb.el: In all files, change obarrays to hash-tables,
  and swap `gnus-sethash' for `puthash', `gnus-gethash' for `gethash',
  `mapatoms' for `maphash', etc.
* test/lisp/gnus/gnus-test-headers.el (gnus-headers-make-dependency-table,
  gnus-headers-loop-dependencies): New tests to make sure we're
  building `gnus-newsgroup-dependencies' correctly.
parent 3375d082
Pipeline #1056 passed with stage
in 51 minutes and 12 seconds
......@@ -225,7 +225,9 @@ NOTES:
(defvar gnus-agent-overview-buffer nil)
(defvar gnus-category-predicate-cache nil)
(defvar gnus-category-group-cache nil)
(defvar gnus-agent-spam-hashtb nil)
(defvar gnus-agent-spam-hashtb nil
"Cache of message subjects for spam messages.
Actually a hash table holding subjects mapped to t.")
(defvar gnus-agent-file-name nil)
(defvar gnus-agent-file-coding-system 'raw-text)
(defvar gnus-agent-file-loading-cache nil)
......@@ -642,7 +644,7 @@ minor mode in all Gnus buffers."
(defun gnus-agent-queue-setup (&optional group-name)
"Make sure the queue group exists.
Optional arg GROUP-NAME allows another group to be specified."
(unless (gnus-gethash (format "nndraft:%s" (or group-name "queue"))
(unless (gethash (format "nndraft:%s" (or group-name "queue"))
gnus-newsrc-hashtb)
(gnus-request-create-group (or group-name "queue") '(nndraft ""))
(let ((gnus-level-default-subscribed 1))
......@@ -1334,7 +1336,7 @@ downloaded into the agent."
oactive-min (read (current-buffer)))) ;; min
(gnus-delete-line)))
(when active
(insert (format "%S %d %d y\n" (intern group)
(insert (format "%s %d %d y\n" group
(max (or oactive-max (cdr active)) (cdr active))
(min (or oactive-min (car active)) (car active))))
(goto-char (point-max))
......@@ -2161,7 +2163,10 @@ doesn't exist, to valid the overview buffer."
(gnus-agent-update-view-total-fetched-for group nil)))
(defvar gnus-agent-article-local nil)
;; FIXME: Why would this be a hash table? Wouldn't a simple alist or
;; something suffice?
(defvar gnus-agent-article-local nil
"Hashtable holding information about a group.")
(defvar gnus-agent-article-local-times nil)
(defvar gnus-agent-file-loading-local nil)
......@@ -2173,12 +2178,12 @@ article counts for each of the method's subscribed groups."
(zerop gnus-agent-article-local-times)
(not (gnus-methods-equal-p
gnus-command-method
(symbol-value (intern "+method" gnus-agent-article-local)))))
(gethash "+method" gnus-agent-article-local))))
(setq gnus-agent-article-local
(gnus-cache-file-contents
(gnus-agent-lib-file "local")
'gnus-agent-file-loading-local
'gnus-agent-read-and-cache-local))
#'gnus-agent-read-and-cache-local))
(when gnus-agent-article-local-times
(cl-incf gnus-agent-article-local-times)))
gnus-agent-article-local))
......@@ -2188,13 +2193,14 @@ article counts for each of the method's subscribed groups."
gnus-agent-article-local. If that variable had `dirty' (also known as
modified) original contents, they are first saved to their own file."
(if (and gnus-agent-article-local
(symbol-value (intern "+dirty" gnus-agent-article-local)))
(gethash "+dirty" gnus-agent-article-local))
(gnus-agent-save-local))
(gnus-agent-read-local file))
(defun gnus-agent-read-local (file)
"Load FILE and do a `read' there."
(let ((my-obarray (gnus-make-hashtable (count-lines (point-min)
(let ((hashtb (gnus-make-hashtable
(count-lines (point-min)
(point-max))))
(line 1))
(with-temp-buffer
......@@ -2204,7 +2210,8 @@ modified) original contents, they are first saved to their own file."
(file-error))
(goto-char (point-min))
;; Skip any comments at the beginning of the file (the only place where they may appear)
;; Skip any comments at the beginning of the file (the only
;; place where they may appear)
(while (= (following-char) ?\;)
(forward-line 1)
(setq line (1+ line)))
......@@ -2214,33 +2221,32 @@ modified) original contents, they are first saved to their own file."
(let (group
min
max
(cur (current-buffer))
(obarray my-obarray))
(cur (current-buffer)))
(setq group (read cur)
min (read cur)
max (read cur))
(when (stringp group)
(setq group (intern group my-obarray)))
(unless (stringp group)
(setq group (symbol-name group)))
;; NOTE: The '+ 0' ensure that min and max are both numerics.
(set group (cons (+ 0 min) (+ 0 max))))
(puthash group (cons (+ 0 min) (+ 0 max)) hashtb))
(error
(gnus-message 3 "Warning - invalid agent local: %s on line %d: %s"
file line (error-message-string err))))
(forward-line 1)
(setq line (1+ line))))
(set (intern "+dirty" my-obarray) nil)
(set (intern "+method" my-obarray) gnus-command-method)
my-obarray))
(puthash "+dirty" nil hashtb)
(puthash "+method" gnus-command-method hashtb)
hashtb))
(defun gnus-agent-save-local (&optional force)
"Save gnus-agent-article-local under it method's agent.lib directory."
(let ((my-obarray gnus-agent-article-local))
(when (and my-obarray
(or force (symbol-value (intern "+dirty" my-obarray))))
(let* ((gnus-command-method (symbol-value (intern "+method" my-obarray)))
(let ((hashtb gnus-agent-article-local))
(when (and hashtb
(or force (gethash "+dirty" hashtb)))
(let* ((gnus-command-method (gethash "+method" hashtb))
;; NOTE: gnus-command-method is used within gnus-agent-lib-file.
(dest (gnus-agent-lib-file "local")))
(gnus-make-directory (gnus-agent-lib-file ""))
......@@ -2248,31 +2254,30 @@ modified) original contents, they are first saved to their own file."
(let ((coding-system-for-write gnus-agent-file-coding-system)
(file-name-coding-system nnmail-pathname-coding-system))
(with-temp-file dest
(let ((gnus-command-method (symbol-value (intern "+method" my-obarray)))
;; FIXME: Why are we letting this again?
(let ((gnus-command-method (gethash "+method" hashtb))
print-level print-length
(standard-output (current-buffer)))
(mapatoms (lambda (symbol)
(cond ((not (boundp symbol))
(maphash (lambda (group active)
(cond ((null active)
nil)
((member (symbol-name symbol) '("+dirty" "+method"))
((member group '("+dirty" "+method"))
nil)
(t
(let ((range (symbol-value symbol)))
(when range
(prin1 symbol)
(when active
(prin1 group)
(princ " ")
(princ (car range))
(princ (car active))
(princ " ")
(princ (cdr range))
(princ "\n"))))))
my-obarray))))))))
(princ (cdr active))
(princ "\n")))))
hashtb))))))))
(defun gnus-agent-get-local (group &optional gmane method)
(let* ((gmane (or gmane (gnus-group-real-name group)))
(gnus-command-method (or method (gnus-find-method-for-group group)))
(local (gnus-agent-load-local))
(symb (intern gmane local))
(minmax (and (boundp symb) (symbol-value symb))))
(minmax (gethash gmane local)))
(unless minmax
;; Bind these so that gnus-agent-load-alist doesn't change the
;; current alist (i.e. gnus-agent-article-alist)
......@@ -2291,24 +2296,23 @@ modified) original contents, they are first saved to their own file."
(let* ((gmane (or gmane (gnus-group-real-name group)))
(gnus-command-method (or method (gnus-find-method-for-group group)))
(local (or local (gnus-agent-load-local)))
(symb (intern gmane local))
(minmax (and (boundp symb) (symbol-value symb))))
(minmax (gethash gmane local)))
(if (cond ((and minmax
(or (not (eq min (car minmax)))
(not (eq max (cdr minmax))))
min
max)
(setcar minmax min)
(setcdr minmax max)
(setcar (gethash gmane local) min)
(setcdr (gethash gmane local) max)
t)
(minmax
nil)
((and min max)
(set symb (cons min max))
(puthash gmane (cons min max) local)
t)
(t
(unintern symb local)))
(set (intern "+dirty" local) t))))
(remhash gmane local)))
(puthash "+dirty" t local))))
(defun gnus-agent-article-name (article group)
(expand-file-name article
......@@ -2878,8 +2882,8 @@ The following commands are available:
nil
(let ((string (gnus-simplify-subject (mail-header-subject gnus-headers))))
(prog1
(gnus-gethash string gnus-agent-spam-hashtb)
(gnus-sethash string t gnus-agent-spam-hashtb)))))
(gethash string gnus-agent-spam-hashtb)
(puthash string t gnus-agent-spam-hashtb)))))
(defun gnus-agent-short-p ()
"Say whether an article is short or not."
......@@ -3007,12 +3011,12 @@ articles."
(unless gnus-category-group-cache
(setq gnus-category-group-cache (gnus-make-hashtable 1000))
(let ((cs gnus-category-alist)
groups cat)
(while (setq cat (pop cs))
groups)
(dolist (cat cs)
(setq groups (gnus-agent-cat-groups cat))
(while groups
(gnus-sethash (pop groups) cat gnus-category-group-cache)))))
(or (gnus-gethash group gnus-category-group-cache)
(dolist (g groups)
(puthash g cat gnus-category-group-cache)))))
(gethash group gnus-category-group-cache
(assq 'default gnus-category-alist)))
(defvar gnus-agent-expire-current-dirs)
......@@ -3053,7 +3057,7 @@ FORCE is equivalent to setting the expiration predicates to true."
(count-lines (point-min) (point-max))))))
(save-excursion
(gnus-agent-expire-group-1
group overview (gnus-gethash-safe group orig)
group overview (gethash group orig)
articles force))))
(kill-buffer overview))))
(gnus-message 4 "%s" (gnus-agent-expire-done-message)))))
......@@ -3471,9 +3475,7 @@ articles in every agentized group? "))
(count-lines (point-min) (point-max))))))
(dolist (expiring-group (gnus-groups-from-server
gnus-command-method))
(let* ((active
(gnus-gethash-safe expiring-group orig)))
(let ((active (gethash expiring-group orig)))
(when active
(save-excursion
(gnus-agent-expire-group-1
......@@ -3503,25 +3505,23 @@ articles in every agentized group? "))
(defun gnus-agent-expire-unagentized-dirs ()
(when (and gnus-agent-expire-unagentized-dirs
(boundp 'gnus-agent-expire-current-dirs))
(let* ((keep (gnus-make-hashtable))
(file-name-coding-system nnmail-pathname-coding-system))
(gnus-sethash gnus-agent-directory t keep)
(let ((file-name-coding-system nnmail-pathname-coding-system)
;; Another hash table that could just be a list.
(keep (gnus-make-hashtable 20))
to-remove)
(puthash gnus-agent-directory t keep)
(dolist (dir gnus-agent-expire-current-dirs)
(when (and (stringp dir)
(file-directory-p dir))
(while (not (gnus-gethash dir keep))
(gnus-sethash dir t keep)
(while (not (gethash dir keep))
(puthash dir t keep)
(setq dir (file-name-directory (directory-file-name dir))))))
(let* (to-remove
checker
(checker
(function
(lambda (d)
"Given a directory, check it and its subdirectories for
membership in the keep hash. If it isn't found, add
it to to-remove."
(cl-labels ((checker
(d)
;; Given a directory, check it and its subdirectories
;; for membership in the keep list. If it isn't found,
;; add it to to-remove.
(let ((files (directory-files d))
file)
(while (setq file (pop files))
......@@ -3534,10 +3534,9 @@ articles in every agentized group? "))
;; agent's cache of a group.
(let ((d (file-name-as-directory d))
r)
;; Search ancestor's for last directory NOT
;; found in keep hash.
(while (not (gnus-gethash
(setq d (file-name-directory d)) keep))
;; Search ancestors for last directory NOT
;; found in keep.
(while (not (gethash (setq d (file-name-directory d)) keep))
(setq r d
d (directory-file-name d)))
;; if ANY ancestor was NOT in keep hash and
......@@ -3547,8 +3546,8 @@ articles in every agentized group? "))
(not (member r to-remove)))
(push r to-remove))))
((file-directory-p (setq file (nnheader-concat d file)))
(funcall checker file)))))))))
(funcall checker (expand-file-name gnus-agent-directory))
(checker file)))))))
(checker (expand-file-name gnus-agent-directory)))
(when (and to-remove
(or gnus-expert-user
......@@ -3579,7 +3578,7 @@ articles in every agentized group? "))
f-or-d f))))
(delete-directory f-or-d)))
(delete-file f-or-d)))))))
(funcall delete-recursive dir))))))))))
(funcall delete-recursive dir)))))))))
;;;###autoload
(defun gnus-agent-batch ()
......@@ -4097,8 +4096,8 @@ agent has fetched."
;; if null, gnus-agent-group-pathname will calc method.
(let* ((gnus-command-method method)
(path (or path (gnus-agent-group-pathname group)))
(entry (or (gnus-gethash path gnus-agent-total-fetched-hashtb)
(gnus-sethash path (make-list 3 0)
(entry (or (gethash path gnus-agent-total-fetched-hashtb)
(puthash path (make-list 3 0)
gnus-agent-total-fetched-hashtb)))
(file-name-coding-system nnmail-pathname-coding-system))
(when (file-exists-p path)
......@@ -4138,8 +4137,8 @@ modified."
;; if null, gnus-agent-group-pathname will calc method.
(let* ((gnus-command-method method)
(path (or path (gnus-agent-group-pathname group)))
(entry (or (gnus-gethash path gnus-agent-total-fetched-hashtb)
(gnus-sethash path (make-list 3 0)
(entry (or (gethash path gnus-agent-total-fetched-hashtb)
(puthash path (make-list 3 0)
gnus-agent-total-fetched-hashtb)))
(file-name-coding-system nnmail-pathname-coding-system)
(size (or (file-attribute-size (file-attributes
......@@ -4155,12 +4154,13 @@ modified."
"Get the total disk space used by the specified GROUP."
(unless (equal group "dummy.group")
(unless gnus-agent-total-fetched-hashtb
(setq gnus-agent-total-fetched-hashtb (gnus-make-hashtable 1024)))
(setq gnus-agent-total-fetched-hashtb
(gnus-make-hashtable 1000)))
;; if null, gnus-agent-group-pathname will calc method.
(let* ((gnus-command-method method)
(path (gnus-agent-group-pathname group))
(entry (gnus-gethash path gnus-agent-total-fetched-hashtb)))
(entry (gethash path gnus-agent-total-fetched-hashtb)))
(if entry
(apply '+ entry)
(let ((gnus-agent-inhibit-update-total-fetched-for (not no-inhibit)))
......
......@@ -84,7 +84,6 @@ that was fetched."
(defvar gnus-async-article-alist nil)
(defvar gnus-async-article-semaphore '(nil))
(defvar gnus-async-fetch-list nil)
(defvar gnus-async-hashtb nil)
(defvar gnus-async-current-prefetch-group nil)
(defvar gnus-async-current-prefetch-article nil)
(defvar gnus-async-timer nil)
......@@ -127,14 +126,11 @@ that was fetched."
(defun gnus-async-close ()
(gnus-kill-buffer gnus-async-prefetch-article-buffer)
(gnus-kill-buffer gnus-async-prefetch-headers-buffer)
(setq gnus-async-hashtb nil
gnus-async-article-alist nil
(setq gnus-async-article-alist nil
gnus-async-header-prefetched nil))
(defun gnus-async-set-buffer ()
(nnheader-set-temp-buffer gnus-async-prefetch-article-buffer t)
(unless gnus-async-hashtb
(setq gnus-async-hashtb (gnus-make-hashtable 1023))))
(nnheader-set-temp-buffer gnus-async-prefetch-article-buffer t))
(defun gnus-async-halt-prefetch ()
"Stop prefetching."
......@@ -242,13 +238,10 @@ that was fetched."
(when gnus-async-post-fetch-function
(funcall gnus-async-post-fetch-function summary))))
(gnus-async-with-semaphore
(setq
gnus-async-article-alist
(cons (list (intern (format "%s-%d" group article)
gnus-async-hashtb)
(push (list (format "%s-%d" group article)
mark (point-max-marker)
group article)
gnus-async-article-alist))))
gnus-async-article-alist)))
(if (not (gnus-buffer-live-p summary))
(gnus-async-with-semaphore
(setq gnus-async-fetch-list nil))
......@@ -314,8 +307,7 @@ that was fetched."
(set-marker (caddr entry) nil))
(gnus-async-with-semaphore
(setq gnus-async-article-alist
(delq entry gnus-async-article-alist))
(unintern (car entry) gnus-async-hashtb)))
(delete entry gnus-async-article-alist))))
(defun gnus-async-prefetch-remove-group (group)
"Remove all articles belonging to GROUP from the prefetch buffer."
......@@ -331,8 +323,7 @@ that was fetched."
"Return the entry for ARTICLE in GROUP if it has been prefetched."
(let ((entry (save-excursion
(gnus-async-set-buffer)
(assq (intern-soft (format "%s-%d" group article)
gnus-async-hashtb)
(assoc (format "%s-%d" group article)
gnus-async-article-alist))))
;; Perhaps something has emptied the buffer?
(if (and entry
......@@ -342,7 +333,7 @@ that was fetched."
(set-marker (cadr entry) nil)
(set-marker (caddr entry) nil))
(setq gnus-async-article-alist
(delq entry gnus-async-article-alist))
(delete entry gnus-async-article-alist))
nil)
entry)))
......
......@@ -22,17 +22,16 @@
;;; Commentary:
;; The backlog caches the text of a certain number of read articles in
;; a separate buffer, so they can be retrieved quickly if the user
;; opens them again. Also see `gnus-keep-backlog'.
;;; Code:
(require 'gnus)
;;;
;;; Buffering of read articles.
;;;
(defvar gnus-backlog-buffer " *Gnus Backlog*")
(defvar gnus-backlog-articles nil)
(defvar gnus-backlog-hashtb nil)
(defvar gnus-backlog-articles '())
(defun gnus-backlog-buffer ()
"Return the backlog buffer."
......@@ -42,11 +41,6 @@
(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 ()
......@@ -54,18 +48,14 @@
(interactive)
(when (get-buffer gnus-backlog-buffer)
(gnus-kill-buffer gnus-backlog-buffer))
(setq gnus-backlog-hashtb nil
gnus-backlog-articles nil))
(setq gnus-backlog-articles nil))
(defun gnus-backlog-enter-article (group number 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))
(let ((ident (format "%s:%d" group number))
b)
(if (memq ident gnus-backlog-articles)
() ; It's already kept.
(unless (member 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)
......@@ -87,13 +77,13 @@
(defun gnus-backlog-remove-oldest-article ()
(with-current-buffer (gnus-backlog-buffer)
(goto-char (point-min))
(if (zerop (buffer-size))
() ; The buffer is empty.
(unless (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)))
(setq gnus-backlog-articles
(delete ident gnus-backlog-articles)))
;; Delete the article itself.
(delete-region
(point) (next-single-property-change
......@@ -102,42 +92,40 @@
(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)
(let ((ident (format "%s:%d" group number))
beg)
(when (member ident gnus-backlog-articles)
;; It was in the backlog.
(with-current-buffer (gnus-backlog-buffer)
(save-excursion
(let (buffer-read-only)
(when (setq beg (text-property-any
(point-min) (point-max) 'gnus-backlog
ident))
(goto-char (point-min))
(when (setq beg (gnus-text-property-search
'gnus-backlog ident))
;; Find the end (i. e., the beginning of the next article).
(setq end
(goto-char
(next-single-property-change
(1+ beg) 'gnus-backlog (current-buffer) (point-max)))
(delete-region beg end)
(delete-region beg (point))
;; Return success.
t))
(setq gnus-backlog-articles (delq ident gnus-backlog-articles)))))))
t)))
(setq gnus-backlog-articles
(delete ident gnus-backlog-articles)))))))
(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))
(let ((ident (format "%s:%d" group number))
beg end)
(when (memq ident gnus-backlog-articles)
(when (member ident gnus-backlog-articles)
;; It was in the backlog.
(with-current-buffer (gnus-backlog-buffer)
(if (not (setq beg (text-property-any
(point-min) (point-max) 'gnus-backlog
ident)))
(if (not (setq beg (gnus-text-property-search
'gnus-backlog ident)))
;; It wasn't in the backlog after all.
(ignore
(setq gnus-backlog-articles (delq ident gnus-backlog-articles)))
(setq gnus-backlog-articles
(delete ident gnus-backlog-articles)))
;; Find the end (i. e., the beginning of the next article).
(setq end
(next-single-property-change
......
......@@ -272,7 +272,7 @@ it's not cached."
(defun gnus-cache-possibly-alter-active (group active)
"Alter the ACTIVE info for GROUP to reflect the articles in the cache."
(when gnus-cache-active-hashtb
(let ((cache-active (gnus-gethash group gnus-cache-active-hashtb)))
(let ((cache-active (gethash group gnus-cache-active-hashtb)))
(when cache-active
(when (< (car cache-active) (car active))
(setcar active (car cache-active)))
......@@ -522,7 +522,7 @@ system for example was used.")
(gnus-delete-line)))
(unless (setq gnus-newsgroup-cached
(delq article gnus-newsgroup-cached))
(gnus-sethash gnus-newsgroup-name nil gnus-cache-active-hashtb)
(remhash gnus-newsgroup-name gnus-cache-active-hashtb)
(setq gnus-cache-active-altered t))
(gnus-summary-update-secondary-mark article)
t)))
......@@ -542,8 +542,8 @@ system for example was used.")
(progn
(gnus-cache-update-active group (car articles) t)
(gnus-cache-update-active group (car (last articles))))
(when (gnus-gethash group gnus-cache-active-hashtb)
(gnus-sethash group nil gnus-cache-active-hashtb)
(when (gethash group gnus-cache-active-hashtb)
(remhash group gnus-cache-active-hashtb)
(setq gnus-cache-active-altered t)))
articles)))
......@@ -666,13 +666,16 @@ $ emacs -batch -l ~/.emacs -l gnus -f gnus-jog-cache"
;; Mark the active hashtb as unaltered.
(setq gnus-cache-active-altered nil)))
;; FIXME: Why is there a `gnus-cache-possibly-alter-active',
;; `gnus-cache-possibly-update-active', and
;; `gnus-cache-update-active'? Do we really need all three?
(defun gnus-cache-possibly-update-active (group active)
"Update active info bounds of GROUP with ACTIVE if necessary.
The update is performed if ACTIVE contains a higher or lower bound
than the current."
(let ((lower t) (higher t))
(if gnus-cache-active-hashtb
(let ((cache-active (gnus-gethash group gnus-cache-active-hashtb)))
(let ((cache-active (gethash group gnus-cache-active-hashtb)))
(when cache-active
(unless (< (car active) (car cache-active))
(setq lower nil))
......@@ -687,10 +690,10 @@ than the current."
(defun gnus-cache-update-active (group number &optional low)
"Update the upper bound of the active info of GROUP to NUMBER.
If LOW, update the lower bound instead."
(let ((active (gnus-gethash group gnus-cache-active-hashtb)))
(let ((active (gethash group gnus-cache-active-hashtb)))
(if (null active)
;; We just create a new active entry for this group.
(gnus-sethash group (cons number number) gnus-cache-active-hashtb)
(puthash group (cons number number) gnus-cache-active-hashtb)
;; Update the lower or upper bound.
(if low
(setcar active number)
......@@ -734,7 +737,7 @@ If LOW, update the lower bound instead."
;; FIXME: this is kind of a workaround. The active file should
;; be updated at the time articles are cached. It will make
;; `gnus-cache-unified-group-names' needless.
(gnus-sethash (or (cdr (assoc group gnus-cache-unified-group-names))
(puthash (or (cdr (assoc group gnus-cache-unified-group-names))
group)
(cons (car nums) (car (last nums)))
gnus-cache-active-hashtb))
......@@ -798,13 +801,13 @@ supported."
(unless gnus-cache-active-hashtb
(gnus-cache-read-active))
(let* ((old-group-hash-value
(gnus-gethash old-group gnus-cache-active-hashtb))
(gethash old-group gnus-cache-active-hashtb))
(new-group-hash-value
(gnus-gethash new-group gnus-cache-active-hashtb))
(gethash new-group gnus-cache-active-hashtb))
(delta
(or old-group-hash-value new-group-hash-value)))
(gnus-sethash new-group old-group-hash-value gnus-cache-active-hashtb)