mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-04 11:00:45 -08:00
Code Issues Projects Releases Wiki Activity

Change Gnus hash tables into real hash tables

Browse source 
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.
This commit is contained in:
Eric Abrahamsen 2018-04-26 16:26:27 -07:00
parent 3375d08299
commit c1b63af445
20 changed files with 1155 additions and 1073 deletions
Download patch file Download diff file Expand all files Collapse all files

60
lisp/gnus/gnus-cache.el
View file

@ -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,10 +737,10 @@ 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))
group)
(cons (car nums) (car (last nums)))
gnus-cache-active-hashtb))
(puthash (or (cdr (assoc group gnus-cache-unified-group-names))
group)
(cons (car nums) (car (last nums)))
gnus-cache-active-hashtb))
;; Go through all the other files.
(dolist (file alphs)
(when (and (file-directory-p file)
@ -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)
(gnus-sethash old-group nil gnus-cache-active-hashtb)
(puthash new-group old-group-hash-value gnus-cache-active-hashtb)
(puthash old-group nil gnus-cache-active-hashtb)
(if no-save
(setq gnus-cache-active-altered delta)
@ -826,8 +829,8 @@ supported."
(let ((no-save gnus-cache-active-hashtb))
(unless gnus-cache-active-hashtb
(gnus-cache-read-active))
(let* ((group-hash-value (gnus-gethash group gnus-cache-active-hashtb)))
(gnus-sethash group nil gnus-cache-active-hashtb)
(let* ((group-hash-value (gethash group gnus-cache-active-hashtb)))
(remhash group gnus-cache-active-hashtb)
(if no-save
(setq gnus-cache-active-altered group-hash-value)
@ -849,9 +852,9 @@ supported."
(when gnus-cache-total-fetched-hashtb
(gnus-cache-with-refreshed-group
group
(let* ((entry (or (gnus-gethash group gnus-cache-total-fetched-hashtb)
(gnus-sethash group (make-vector 2 0)
gnus-cache-total-fetched-hashtb)))
(let* ((entry (or (gethash group gnus-cache-total-fetched-hashtb)
(puthash group (make-vector 2 0)
gnus-cache-total-fetched-hashtb)))
size)
(if file
@ -874,8 +877,8 @@ supported."
(when gnus-cache-total-fetched-hashtb
(gnus-cache-with-refreshed-group
group
(let* ((entry (or (gnus-gethash group gnus-cache-total-fetched-hashtb)
(gnus-sethash group (make-list 2 0)
(let* ((entry (or (gethash group gnus-cache-total-fetched-hashtb)
(puthash group (make-list 2 0)
gnus-cache-total-fetched-hashtb)))
(file-name-coding-system nnmail-pathname-coding-system)
(size (or (file-attribute-size (file-attributes
@ -888,22 +891,21 @@ supported."
(defun gnus-cache-rename-group-total-fetched-for (old-group new-group)
"Record of disk space used by OLD-GROUP now associated with NEW-GROUP."
(when gnus-cache-total-fetched-hashtb
(let ((entry (gnus-gethash old-group gnus-cache-total-fetched-hashtb)))
(gnus-sethash new-group entry gnus-cache-total-fetched-hashtb)
(gnus-sethash old-group nil gnus-cache-total-fetched-hashtb))))
(let ((entry (gethash old-group gnus-cache-total-fetched-hashtb)))
(puthash new-group entry gnus-cache-total-fetched-hashtb)
(remhash old-group gnus-cache-total-fetched-hashtb))))
(defun gnus-cache-delete-group-total-fetched-for (group)
"Delete record of disk space used by GROUP being deleted."
(when gnus-cache-total-fetched-hashtb
(gnus-sethash group nil gnus-cache-total-fetched-hashtb)))
(remhash group gnus-cache-total-fetched-hashtb)))
(defun gnus-cache-total-fetched-for (group &optional no-inhibit)
"Get total disk space used by the cache for the specified GROUP."
(unless (equal group "dummy.group")
(unless gnus-cache-total-fetched-hashtb
(setq gnus-cache-total-fetched-hashtb (gnus-make-hashtable 1024)))
(let* ((entry (gnus-gethash group gnus-cache-total-fetched-hashtb)))
(setq gnus-cache-total-fetched-hashtb (gnus-make-hashtable 1000)))
(let* ((entry (gethash group gnus-cache-total-fetched-hashtb)))
(if entry
(apply '+ entry)
(let ((gnus-cache-inhibit-update-total-fetched-for (not no-inhibit)))