procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

276
lisp/gnus/gnus-agent.el
View file

@ -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,8 +644,8 @@ 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"))
gnus-newsrc-hashtb)
(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))
(gnus-subscribe-group (format "nndraft:%s" (or group-name "queue"))
@ -1330,11 +1332,11 @@ downloaded into the agent."
(when (re-search-forward
(concat "^" (regexp-quote group) " ") nil t)
(save-excursion
(setq oactive-max (read (current-buffer)) ;; max
(setq oactive-max (read (current-buffer)) ;; max
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,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
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)
(point-max))))
(let ((hashtb (gnus-make-hashtable
(count-lines (point-min)
(point-max))))
(line 1))
(with-temp-buffer
(condition-case nil
@ -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))
nil)
((member (symbol-name symbol) '("+dirty" "+method"))
nil)
(t
(let ((range (symbol-value symbol)))
(when range
(prin1 symbol)
(princ " ")
(princ (car range))
(princ " ")
(princ (cdr range))
(princ "\n"))))))
my-obarray))))))))
(maphash (lambda (group active)
(cond ((null active)
nil)
((member group '("+dirty" "+method"))
nil)
(t
(when active
(prin1 group)
(princ " ")
(princ (car active))
(princ " ")
(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,13 +3011,13 @@ 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)
(assq 'default gnus-category-alist)))
(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)
(defvar gnus-agent-expire-stats)
@ -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,83 +3505,80 @@ 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."
(let ((files (directory-files d))
file)
(while (setq file (pop files))
(cond ((equal file ".") ; Ignore self
nil)
((equal file "..") ; Ignore parent
nil)
((equal file ".overview")
;; Directory must contain .overview to be
;; 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))
(setq r d
d (directory-file-name d)))
;; if ANY ancestor was NOT in keep hash and
;; it's not already in to-remove, add it to
;; to-remove.
(if (and r
(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))
(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))
(cond ((equal file ".") ; Ignore self
nil)
((equal file "..") ; Ignore parent
nil)
((equal file ".overview")
;; Directory must contain .overview to be
;; agent's cache of a group.
(let ((d (file-name-as-directory d))
r)
;; 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
;; it's not already in to-remove, add it to
;; to-remove.
(if (and r
(not (member r to-remove)))
(push r to-remove))))
((file-directory-p (setq file (nnheader-concat d file)))
(checker file)))))))
(checker (expand-file-name gnus-agent-directory)))
(when (and to-remove
(or gnus-expert-user
(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\
deleting them?")))
(while to-remove
(let ((dir (pop to-remove)))
(if (or gnus-expert-user
(gnus-y-or-n-p (format "Delete %s? " dir)))
(let* (delete-recursive
files f
(delete-recursive
(function
(lambda (f-or-d)
(ignore-errors
(if (file-directory-p f-or-d)
(condition-case nil
(delete-directory f-or-d)
(file-error
(setq files (directory-files f-or-d))
(while files
(setq f (pop files))
(or (member f '("." ".."))
(funcall delete-recursive
(nnheader-concat
f-or-d f))))
(delete-directory f-or-d)))
(delete-file f-or-d)))))))
(funcall delete-recursive dir))))))))))
(while to-remove
(let ((dir (pop to-remove)))
(if (or gnus-expert-user
(gnus-y-or-n-p (format "Delete %s? " dir)))
(let* (delete-recursive
files f
(delete-recursive
(function
(lambda (f-or-d)
(ignore-errors
(if (file-directory-p f-or-d)
(condition-case nil
(delete-directory f-or-d)
(file-error
(setq files (directory-files f-or-d))
(while files
(setq f (pop files))
(or (member f '("." ".."))
(funcall delete-recursive
(nnheader-concat
f-or-d f))))
(delete-directory f-or-d)))
(delete-file f-or-d)))))))
(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)
@ -4128,7 +4127,7 @@ agent has fetched."
(cl-incf (nth 2 entry) delta))))))
(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
.overview files. These files are calculated separately as they can be
modified."
@ -4138,9 +4137,9 @@ 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)
gnus-agent-total-fetched-hashtb)))
(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
(nnheader-concat
@ -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)))