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: ...@@ -225,7 +225,9 @@ NOTES:
(defvar gnus-agent-overview-buffer nil) (defvar gnus-agent-overview-buffer nil)
(defvar gnus-category-predicate-cache nil) (defvar gnus-category-predicate-cache nil)
(defvar gnus-category-group-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-name nil)
(defvar gnus-agent-file-coding-system 'raw-text) (defvar gnus-agent-file-coding-system 'raw-text)
(defvar gnus-agent-file-loading-cache nil) (defvar gnus-agent-file-loading-cache nil)
...@@ -642,8 +644,8 @@ minor mode in all Gnus buffers." ...@@ -642,8 +644,8 @@ minor mode in all Gnus buffers."
(defun gnus-agent-queue-setup (&optional group-name) (defun gnus-agent-queue-setup (&optional group-name)
"Make sure the queue group exists. "Make sure the queue group exists.
Optional arg GROUP-NAME allows another group to be specified." 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-newsrc-hashtb)
(gnus-request-create-group (or group-name "queue") '(nndraft "")) (gnus-request-create-group (or group-name "queue") '(nndraft ""))
(let ((gnus-level-default-subscribed 1)) (let ((gnus-level-default-subscribed 1))
(gnus-subscribe-group (format "nndraft:%s" (or group-name "queue")) (gnus-subscribe-group (format "nndraft:%s" (or group-name "queue"))
...@@ -1330,11 +1332,11 @@ downloaded into the agent." ...@@ -1330,11 +1332,11 @@ downloaded into the agent."
(when (re-search-forward (when (re-search-forward
(concat "^" (regexp-quote group) " ") nil t) (concat "^" (regexp-quote group) " ") nil t)
(save-excursion (save-excursion
(setq oactive-max (read (current-buffer)) ;; max (setq oactive-max (read (current-buffer)) ;; max
oactive-min (read (current-buffer)))) ;; min oactive-min (read (current-buffer)))) ;; min
(gnus-delete-line))) (gnus-delete-line)))
(when active (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)) (max (or oactive-max (cdr active)) (cdr active))
(min (or oactive-min (car active)) (car active)))) (min (or oactive-min (car active)) (car active))))
(goto-char (point-max)) (goto-char (point-max))
...@@ -2161,7 +2163,10 @@ doesn't exist, to valid the overview buffer." ...@@ -2161,7 +2163,10 @@ doesn't exist, to valid the overview buffer."
(gnus-agent-update-view-total-fetched-for group nil))) (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-article-local-times nil)
(defvar gnus-agent-file-loading-local nil) (defvar gnus-agent-file-loading-local nil)
...@@ -2173,12 +2178,12 @@ article counts for each of the method's subscribed groups." ...@@ -2173,12 +2178,12 @@ article counts for each of the method's subscribed groups."
(zerop gnus-agent-article-local-times) (zerop gnus-agent-article-local-times)
(not (gnus-methods-equal-p (not (gnus-methods-equal-p
gnus-command-method gnus-command-method
(symbol-value (intern "+method" gnus-agent-article-local))))) (gethash "+method" gnus-agent-article-local))))
(setq gnus-agent-article-local (setq gnus-agent-article-local
(gnus-cache-file-contents (gnus-cache-file-contents
(gnus-agent-lib-file "local") (gnus-agent-lib-file "local")
'gnus-agent-file-loading-local 'gnus-agent-file-loading-local
'gnus-agent-read-and-cache-local)) #'gnus-agent-read-and-cache-local))
(when gnus-agent-article-local-times (when gnus-agent-article-local-times
(cl-incf gnus-agent-article-local-times))) (cl-incf gnus-agent-article-local-times)))
gnus-agent-article-local)) gnus-agent-article-local))
...@@ -2188,14 +2193,15 @@ article counts for each of the method's subscribed groups." ...@@ -2188,14 +2193,15 @@ article counts for each of the method's subscribed groups."
gnus-agent-article-local. If that variable had `dirty' (also known as gnus-agent-article-local. If that variable had `dirty' (also known as
modified) original contents, they are first saved to their own file." modified) original contents, they are first saved to their own file."
(if (and gnus-agent-article-local (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-save-local))
(gnus-agent-read-local file)) (gnus-agent-read-local file))
(defun gnus-agent-read-local (file) (defun gnus-agent-read-local (file)
"Load FILE and do a `read' there." "Load FILE and do a `read' there."
(let ((my-obarray (gnus-make-hashtable (count-lines (point-min) (let ((hashtb (gnus-make-hashtable
(point-max)))) (count-lines (point-min)
(point-max))))
(line 1)) (line 1))
(with-temp-buffer (with-temp-buffer
(condition-case nil (condition-case nil
...@@ -2204,7 +2210,8 @@ modified) original contents, they are first saved to their own file." ...@@ -2204,7 +2210,8 @@ modified) original contents, they are first saved to their own file."
(file-error)) (file-error))
(goto-char (point-min)) (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) ?\;) (while (= (following-char) ?\;)
(forward-line 1) (forward-line 1)
(setq line (1+ line))) (setq line (1+ line)))
...@@ -2214,33 +2221,32 @@ modified) original contents, they are first saved to their own file." ...@@ -2214,33 +2221,32 @@ modified) original contents, they are first saved to their own file."
(let (group (let (group
min min
max max
(cur (current-buffer)) (cur (current-buffer)))
(obarray my-obarray))
(setq group (read cur) (setq group (read cur)
min (read cur) min (read cur)
max (read cur)) max (read cur))
(when (stringp group) (unless (stringp group)
(setq group (intern group my-obarray))) (setq group (symbol-name group)))
;; NOTE: The '+ 0' ensure that min and max are both numerics. ;; 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 (error
(gnus-message 3 "Warning - invalid agent local: %s on line %d: %s" (gnus-message 3 "Warning - invalid agent local: %s on line %d: %s"
file line (error-message-string err)))) file line (error-message-string err))))
(forward-line 1) (forward-line 1)
(setq line (1+ line)))) (setq line (1+ line))))
(set (intern "+dirty" my-obarray) nil) (puthash "+dirty" nil hashtb)
(set (intern "+method" my-obarray) gnus-command-method) (puthash "+method" gnus-command-method hashtb)
my-obarray)) hashtb))
(defun gnus-agent-save-local (&optional force) (defun gnus-agent-save-local (&optional force)
"Save gnus-agent-article-local under it method's agent.lib directory." "Save gnus-agent-article-local under it method's agent.lib directory."
(let ((my-obarray gnus-agent-article-local)) (let ((hashtb gnus-agent-article-local))
(when (and my-obarray (when (and hashtb
(or force (symbol-value (intern "+dirty" my-obarray)))) (or force (gethash "+dirty" hashtb)))
(let* ((gnus-command-method (symbol-value (intern "+method" my-obarray))) (let* ((gnus-command-method (gethash "+method" hashtb))
;; NOTE: gnus-command-method is used within gnus-agent-lib-file. ;; NOTE: gnus-command-method is used within gnus-agent-lib-file.
(dest (gnus-agent-lib-file "local"))) (dest (gnus-agent-lib-file "local")))
(gnus-make-directory (gnus-agent-lib-file "")) (gnus-make-directory (gnus-agent-lib-file ""))
...@@ -2248,31 +2254,30 @@ modified) original contents, they are first saved to their own 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) (let ((coding-system-for-write gnus-agent-file-coding-system)
(file-name-coding-system nnmail-pathname-coding-system)) (file-name-coding-system nnmail-pathname-coding-system))
(with-temp-file dest (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 print-level print-length
(standard-output (current-buffer))) (standard-output (current-buffer)))
(mapatoms (lambda (symbol) (maphash (lambda (group active)
(cond ((not (boundp symbol)) (cond ((null active)
nil) nil)
((member (symbol-name symbol) '("+dirty" "+method")) ((member group '("+dirty" "+method"))
nil) nil)
(t (t
(let ((range (symbol-value symbol))) (when active
(when range (prin1 group)
(prin1 symbol) (princ " ")
(princ " ") (princ (car active))
(princ (car range)) (princ " ")
(princ " ") (princ (cdr active))
(princ (cdr range)) (princ "\n")))))
(princ "\n")))))) hashtb))))))))
my-obarray))))))))
(defun gnus-agent-get-local (group &optional gmane method) (defun gnus-agent-get-local (group &optional gmane method)
(let* ((gmane (or gmane (gnus-group-real-name group))) (let* ((gmane (or gmane (gnus-group-real-name group)))
(gnus-command-method (or method (gnus-find-method-for-group group))) (gnus-command-method (or method (gnus-find-method-for-group group)))
(local (gnus-agent-load-local)) (local (gnus-agent-load-local))
(symb (intern gmane local)) (minmax (gethash gmane local)))
(minmax (and (boundp symb) (symbol-value symb))))
(unless minmax (unless minmax
;; Bind these so that gnus-agent-load-alist doesn't change the ;; Bind these so that gnus-agent-load-alist doesn't change the
;; current alist (i.e. gnus-agent-article-alist) ;; current alist (i.e. gnus-agent-article-alist)
...@@ -2291,24 +2296,23 @@ modified) original contents, they are first saved to their own file." ...@@ -2291,24 +2296,23 @@ modified) original contents, they are first saved to their own file."
(let* ((gmane (or gmane (gnus-group-real-name group))) (let* ((gmane (or gmane (gnus-group-real-name group)))
(gnus-command-method (or method (gnus-find-method-for-group group))) (gnus-command-method (or method (gnus-find-method-for-group group)))
(local (or local (gnus-agent-load-local))) (local (or local (gnus-agent-load-local)))
(symb (intern gmane local)) (minmax (gethash gmane local)))
(minmax (and (boundp symb) (symbol-value symb))))
(if (cond ((and minmax (if (cond ((and minmax
(or (not (eq min (car minmax))) (or (not (eq min (car minmax)))
(not (eq max (cdr minmax)))) (not (eq max (cdr minmax))))
min min
max) max)
(setcar minmax min) (setcar (gethash gmane local) min)
(setcdr minmax max) (setcdr (gethash gmane local) max)
t) t)
(minmax (minmax
nil) nil)
((and min max) ((and min max)
(set symb (cons min max)) (puthash gmane (cons min max) local)
t) t)
(t (t
(unintern symb local))) (remhash gmane local)))
(set (intern "+dirty" local) t)))) (puthash "+dirty" t local))))
(defun gnus-agent-article-name (article group) (defun gnus-agent-article-name (article group)
(expand-file-name article (expand-file-name article
...@@ -2878,8 +2882,8 @@ The following commands are available: ...@@ -2878,8 +2882,8 @@ The following commands are available:
nil nil
(let ((string (gnus-simplify-subject (mail-header-subject gnus-headers)))) (let ((string (gnus-simplify-subject (mail-header-subject gnus-headers))))
(prog1 (prog1
(gnus-gethash string gnus-agent-spam-hashtb) (gethash string gnus-agent-spam-hashtb)
(gnus-sethash string t gnus-agent-spam-hashtb))))) (puthash string t gnus-agent-spam-hashtb)))))
(defun gnus-agent-short-p () (defun gnus-agent-short-p ()
"Say whether an article is short or not." "Say whether an article is short or not."
...@@ -3007,13 +3011,13 @@ articles." ...@@ -3007,13 +3011,13 @@ articles."
(unless gnus-category-group-cache (unless gnus-category-group-cache
(setq gnus-category-group-cache (gnus-make-hashtable 1000)) (setq gnus-category-group-cache (gnus-make-hashtable 1000))
(let ((cs gnus-category-alist) (let ((cs gnus-category-alist)
groups cat) groups)
(while (setq cat (pop cs)) (dolist (cat cs)
(setq groups (gnus-agent-cat-groups cat)) (setq groups (gnus-agent-cat-groups cat))
(while groups (dolist (g groups)
(gnus-sethash (pop groups) cat gnus-category-group-cache))))) (puthash g cat gnus-category-group-cache)))))
(or (gnus-gethash group gnus-category-group-cache) (gethash group gnus-category-group-cache
(assq 'default gnus-category-alist))) (assq 'default gnus-category-alist)))
(defvar gnus-agent-expire-current-dirs) (defvar gnus-agent-expire-current-dirs)
(defvar gnus-agent-expire-stats) (defvar gnus-agent-expire-stats)
...@@ -3053,7 +3057,7 @@ FORCE is equivalent to setting the expiration predicates to true." ...@@ -3053,7 +3057,7 @@ FORCE is equivalent to setting the expiration predicates to true."
(count-lines (point-min) (point-max)))))) (count-lines (point-min) (point-max))))))
(save-excursion (save-excursion
(gnus-agent-expire-group-1 (gnus-agent-expire-group-1
group overview (gnus-gethash-safe group orig) group overview (gethash group orig)
articles force)))) articles force))))
(kill-buffer overview)))) (kill-buffer overview))))
(gnus-message 4 "%s" (gnus-agent-expire-done-message))))) (gnus-message 4 "%s" (gnus-agent-expire-done-message)))))
...@@ -3471,9 +3475,7 @@ articles in every agentized group? ")) ...@@ -3471,9 +3475,7 @@ articles in every agentized group? "))
(count-lines (point-min) (point-max)))))) (count-lines (point-min) (point-max))))))
(dolist (expiring-group (gnus-groups-from-server (dolist (expiring-group (gnus-groups-from-server
gnus-command-method)) gnus-command-method))
(let* ((active (let ((active (gethash expiring-group orig)))
(gnus-gethash-safe expiring-group orig)))
(when active (when active
(save-excursion (save-excursion
(gnus-agent-expire-group-1 (gnus-agent-expire-group-1
...@@ -3503,83 +3505,80 @@ articles in every agentized group? ")) ...@@ -3503,83 +3505,80 @@ articles in every agentized group? "))
(defun gnus-agent-expire-unagentized-dirs () (defun gnus-agent-expire-unagentized-dirs ()
(when (and gnus-agent-expire-unagentized-dirs (when (and gnus-agent-expire-unagentized-dirs
(boundp 'gnus-agent-expire-current-dirs)) (boundp 'gnus-agent-expire-current-dirs))
(let* ((keep (gnus-make-hashtable)) (let ((file-name-coding-system nnmail-pathname-coding-system)
(file-name-coding-system nnmail-pathname-coding-system)) ;; Another hash table that could just be a list.
(keep (gnus-make-hashtable 20))
(gnus-sethash gnus-agent-directory t keep) to-remove)
(puthash gnus-agent-directory t keep)
(dolist (dir gnus-agent-expire-current-dirs) (dolist (dir gnus-agent-expire-current-dirs)
(when (and (stringp dir) (when (and (stringp dir)
(file-directory-p dir)) (file-directory-p dir))
(while (not (gnus-gethash dir keep)) (while (not (gethash dir keep))
(gnus-sethash dir t keep) (puthash dir t keep)
(setq dir (file-name-directory (directory-file-name dir)))))) (setq dir (file-name-directory (directory-file-name dir))))))
(let* (to-remove (cl-labels ((checker
checker (d)
(checker ;; Given a directory, check it and its subdirectories
(function ;; for membership in the keep list. If it isn't found,
(lambda (d) ;; add it to to-remove.
"Given a directory, check it and its subdirectories for (let ((files (directory-files d))
membership in the keep hash. If it isn't found, add file)
it to to-remove." (while (setq file (pop files))
(let ((files (directory-files d)) (cond ((equal file ".") ; Ignore self
file) nil)
(while (setq file (pop files)) ((equal file "..") ; Ignore parent
(cond ((equal file ".") ; Ignore self nil)
nil) ((equal file ".overview")
((equal file "..") ; Ignore parent ;; Directory must contain .overview to be
nil) ;; agent's cache of a group.
((equal file ".overview") (let ((d (file-name-as-directory d))
;; Directory must contain .overview to be r)
;; agent's cache of a group. ;; Search ancestors for last directory NOT
(let ((d (file-name-as-directory d)) ;; found in keep.
r) (while (not (gethash (setq d (file-name-directory d)) keep))
;; Search ancestor's for last directory NOT (setq r d
;; found in keep hash. d (directory-file-name d)))
(while (not (gnus-gethash ;; if ANY ancestor was NOT in keep hash and
(setq d (file-name-directory d)) keep)) ;; it's not already in to-remove, add it to
(setq r d ;; to-remove.
d (directory-file-name d))) (if (and r
;; if ANY ancestor was NOT in keep hash and (not (member r to-remove)))
;; it's not already in to-remove, add it to (push r to-remove))))
;; to-remove. ((file-directory-p (setq file (nnheader-concat d file)))
(if (and r (checker file)))))))
(not (member r to-remove))) (checker (expand-file-name gnus-agent-directory)))
(push r to-remove))))
((file-directory-p (setq file (nnheader-concat d file))) (when (and to-remove
(funcall checker file))))))))) (or gnus-expert-user
(funcall checker (expand-file-name gnus-agent-directory)) (gnus-y-or-n-p
"gnus-agent-expire has identified local directories that are\
(when (and to-remove
(or gnus-expert-user
(gnus-y-or-n-p
"gnus-agent-expire has identified local directories that are\
not currently required by any agentized group. Do you wish to consider\ not currently required by any agentized group. Do you wish to consider\
deleting them?"))) deleting them?")))
(while to-remove (while to-remove
(let ((dir (pop to-remove))) (let ((dir (pop to-remove)))
(if (or gnus-expert-user (if (or gnus-expert-user
(gnus-y-or-n-p (format "Delete %s? " dir))) (gnus-y-or-n-p (format "Delete %s? " dir)))
(let* (delete-recursive (let* (delete-recursive
files f files f
(delete-recursive (delete-recursive
(function (function
(lambda (f-or-d) (lambda (f-or-d)
(ignore-errors (ignore-errors
(if (file-directory-p f-or-d) (if (file-directory-p f-or-d)
(condition-case nil (condition-case nil
(delete-directory f-or-d) (delete-directory f-or-d)
(file-error (file-error
(setq files (directory-files f-or-d)) (setq files (directory-files f-or-d))
(while files (while files
(setq f (pop files)) (setq f (pop files))
(or (member f '("." "..")) (or (member f '("." ".."))
(funcall delete-recursive (funcall delete-recursive
(nnheader-concat (nnheader-concat
f-or-d f)))) f-or-d f))))
(delete-directory f-or-d))) (delete-directory f-or-d)))
(delete-file f-or-d))))))) (delete-file f-or-d)))))))
(funcall delete-recursive dir)))))))))) (funcall delete-recursive dir)))))))))
;;;###autoload ;;;###autoload
(defun gnus-agent-batch () (defun gnus-agent-batch ()
...@@ -4097,8 +4096,8 @@ agent has fetched." ...@@ -4097,8 +4096,8 @@ agent has fetched."
;; if null, gnus-agent-group-pathname will calc method. ;; if null, gnus-agent-group-pathname will calc method.
(let* ((gnus-command-method method) (let* ((gnus-command-method method)
(path (or path (gnus-agent-group-pathname group))) (path (or path (gnus-agent-group-pathname group)))
(entry (or (gnus-gethash path gnus-agent-total-fetched-hashtb) (entry (or (gethash path gnus-agent-total-fetched-hashtb)
(gnus-sethash path (make-list 3 0) (puthash path (make-list 3 0)
gnus-agent-total-fetched-hashtb))) gnus-agent-total-fetched-hashtb)))
(file-name-coding-system nnmail-pathname-coding-system)) (file-name-coding-system nnmail-pathname-coding-system))
(when (file-exists-p path) (when (file-exists-p path)
...@@ -4128,7 +4127,7 @@ agent has fetched." ...@@ -4128,7 +4127,7 @@ agent has fetched."
(cl-incf (nth 2 entry) delta)))))) (cl-incf (nth 2 entry) delta))))))
(defun gnus-agent-update-view-total-fetched-for (defun gnus-agent-update-view-total-fetched-for
(group agent-over &optional method path) (group agent-over &optional method path)
"Update, or set, the total disk space used by the .agentview and "Update, or set, the total disk space used by the .agentview and
.overview files. These files are calculated separately as they can be .overview files. These files are calculated separately as they can be
modified." modified."
...@@ -4138,9 +4137,9 @@ modified." ...@@ -4138,9 +4137,9 @@ modified."
;; if null, gnus-agent-group-pathname will calc method. ;; if null, gnus-agent-group-pathname will calc method.
(let* ((gnus-command-method method) (let* ((gnus-command-method method)
(path (or path (gnus-agent-group-pathname group))) (path (or path (gnus-agent-group-pathname group)))
(entry (or (gnus-gethash path gnus-agent-total-fetched-hashtb) (entry (or (gethash path gnus-agent-total-fetched-hashtb)
(gnus-sethash path (make-list 3 0) (puthash path (make-list 3 0)
gnus-agent-total-fetched-hashtb))) gnus-agent-total-fetched-hashtb)))
(file-name-coding-system nnmail-pathname-coding-system) (file-name-coding-system nnmail-pathname-coding-system)
(size (or (file-attribute-size (file-attributes (size (or (file-attribute-size (file-attributes
(nnheader-concat (nnheader-concat
...@@ -4155,12 +4154,13 @@ modified." ...@@ -4155,12 +4154,13 @@ modified."
"Get the total disk space used by the specified GROUP." "Get the total disk space used by the specified GROUP."
(unless (equal group "dummy.group") (unless (equal group "dummy.group")
(unless gnus-agent-total-fetched-hashtb (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. ;; if null, gnus-agent-group-pathname will calc method.
(let* ((gnus-command-method method) (let* ((gnus-command-method method)
(path (gnus-agent-group-pathname group)) (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 (if entry
(apply '+ entry) (apply '+ entry)
(let ((gnus-agent-inhibit-update-total-fetched-for (not no-inhibit))) (let ((gnus-agent-inhibit-update-total-fetched-for (not no-inhibit)))
......
...@@ -84,7 +84,6 @@ that was fetched." ...@@ -84,7 +84,6 @@ that was fetched."
(defvar gnus-async-article-alist nil) (defvar gnus-async-article-alist nil)
(defvar gnus-async-article-semaphore '(nil)) (defvar gnus-async-article-semaphore '(nil))
(defvar gnus-async-fetch-list nil) (defvar gnus-async-fetch-list nil)
(defvar gnus-async-hashtb nil)
(defvar gnus-async-current-prefetch-group nil) (defvar gnus-async-current-prefetch-group nil)
(defvar gnus-async-current-prefetch-article nil) (defvar gnus-async-current-prefetch-article nil)
(defvar gnus-async-timer nil) (defvar gnus-async-timer nil)
...@@ -127,14 +126,11 @@ that was fetched." ...@@ -127,14 +126,11 @@ that was fetched."
(defun gnus-async-close () (defun gnus-async-close ()
(gnus-kill-buffer gnus-async-prefetch-article-buffer) (gnus-kill-buffer gnus-async-prefetch-article-buffer)
(gnus-kill-buffer gnus-async-prefetch-headers-buffer) (gnus-kill-buffer gnus-async-prefetch-headers-buffer)
(setq gnus-async-hashtb nil (setq gnus-async-article-alist nil
gnus-async-article-alist nil
gnus-async-header-prefetched nil)) gnus-async-header-prefetched nil))
(defun gnus-async-set-buffer () (defun gnus-async-set-buffer ()
(nnheader-set-temp-buffer gnus-async-prefetch-article-buffer t) (nnheader-set-temp-buffer gnus-async-prefetch-article-buffer t))
(unless gnus-async-hashtb
(setq gnus-async-hashtb (gnus-make-hashtable 1023))))
(defun gnus-async-halt-prefetch () (defun gnus-async-halt-prefetch ()
"Stop prefetching." "Stop prefetching."
...@@ -242,13 +238,10 @@ that was fetched." ...@@ -242,13 +238,10 @@ that was fetched."
(when gnus-async-post-fetch-function (when gnus-async-post-fetch-function
(funcall gnus-async-post-fetch-function summary)))) (funcall gnus-async-post-fetch-function summary))))
(gnus-async-with-semaphore (gnus-async-with-semaphore
(setq (push (list (format "%s-%d" group article)
gnus-async-article-alist mark (point-max-marker)
(cons (list (intern (format "%s-%d" group article) group article)
gnus-async-hashtb) gnus-async-article-alist)))
mark (point-max-marker)
group article)
gnus-async-article-alist))))
(if (not (gnus-buffer-live-p summary)) (if (not (gnus-buffer-live-p summary))
(gnus-async-with-semaphore (gnus-async-with-semaphore
(setq gnus-async-fetch-list nil)) (setq gnus-async-fetch-list nil))
...@@ -314,8 +307,7 @@ that was fetched." ...@@ -314,8 +307,7 @@ that was fetched."
(set-marker (caddr entry) nil)) (set-marker (caddr entry) nil))
(gnus-async-with-semaphore (gnus-async-with-semaphore
(setq gnus-async-article-alist (setq gnus-async-article-alist
(delq entry gnus-async-article-alist)) (delete entry gnus-async-article-alist))))
(unintern (car entry) gnus-async-hashtb)))
(defun gnus-async-prefetch-remove-group (group) (defun gnus-async-prefetch-remove-group (group)
"Remove all articles belonging to GROUP from the prefetch buffer." "Remove all articles belonging to GROUP from the prefetch buffer."
...@@ -331,9 +323,8 @@ that was fetched." ...@@ -331,9 +323,8 @@ that was fetched."
"Return the entry for ARTICLE in GROUP if it has been prefetched." "Return the entry for ARTICLE in GROUP if it has been prefetched."
(let ((entry (save-excursion (let ((entry (save-excursion
(gnus-async-set-buffer) (gnus-async-set-buffer)
(assq (intern-soft (format "%s-%d" group article) (assoc (format "%s-%d" group article)
gnus-async-hashtb) gnus-async-article-alist))))
gnus-async-article-alist))))
;; Perhaps something has emptied the buffer? ;; Perhaps something has emptied the buffer?
(if (and entry (if (and entry
(= (cadr entry) (caddr entry))) (= (cadr entry) (caddr entry)))
...@@ -342,7 +333,7 @@ that was fetched." ...@@ -342,7 +333,7 @@ that was fetched."
(set-marker (cadr entry) nil) (set-marker (cadr entry) nil)
(set-marker (caddr entry) nil)) (set-marker (caddr entry) nil))
(setq gnus-async-article-alist