diff options
| author | Eric Abrahamsen <eric@ericabrahamsen.net> | 2018-04-26 16:26:27 -0700 |
|---|---|---|
| committer | Eric Abrahamsen <eric@ericabrahamsen.net> | 2019-03-22 10:23:30 -0700 |
| commit | c1b63af4458e92bad33da0def2b15c206656e2fa (patch) | |
| tree | 267503989ec0475b76800bb309f6cdc1da53e74e /lisp/gnus/gnus-topic.el | |
| parent | 3375d08299bbc1e224d19a871012cdbbf5d787ee (diff) | |
| download | emacs-c1b63af4458e92bad33da0def2b15c206656e2fa.tar.gz emacs-c1b63af4458e92bad33da0def2b15c206656e2fa.tar.bz2 emacs-c1b63af4458e92bad33da0def2b15c206656e2fa.zip | |
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.
Diffstat (limited to 'lisp/gnus/gnus-topic.el')
| -rw-r--r-- | lisp/gnus/gnus-topic.el | 48 |
1 files changed, 21 insertions, 27 deletions
diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el index 1a7524f9de9..e2c728df8f4 100644 --- a/lisp/gnus/gnus-topic.el +++ b/lisp/gnus/gnus-topic.el @@ -31,6 +31,8 @@ (require 'gnus-group) (require 'gnus-start) (require 'gnus-util) +(eval-when-compile + (require 'subr-x)) (defgroup gnus-topic nil "Group topics." @@ -99,8 +101,7 @@ See Info node `(gnus)Formatting Variables'." (defun gnus-group-topic-name () "The name of the topic on the current line." - (let ((topic (get-text-property (point-at-bol) 'gnus-topic))) - (and topic (symbol-name topic)))) + (get-text-property (point-at-bol) 'gnus-topic)) (defun gnus-group-topic-level () "The level of the topic on the current line." @@ -144,8 +145,7 @@ See Info node `(gnus)Formatting Variables'." (defun gnus-topic-goto-topic (topic) (when topic - (gnus-goto-char (text-property-any (point-min) (point-max) - 'gnus-topic (intern topic))))) + (gnus-text-property-search 'gnus-topic topic nil 'goto))) (defun gnus-topic-jump-to-topic (topic) "Go to TOPIC." @@ -167,8 +167,7 @@ See Info node `(gnus)Formatting Variables'." (point) 'gnus-topic)) (get-text-property (max (1- (point)) (point-min)) 'gnus-topic)))))) - (when result - (symbol-name result)))) + result)) (defun gnus-current-topics (&optional topic) "Return a list of all current topics, lowest in hierarchy first. @@ -195,7 +194,7 @@ If RECURSIVE is t, return groups in its subtopics too." (while groups (when (setq group (pop groups)) (setq entry (gnus-group-entry group) - info (nth 2 entry) + info (nth 1 entry) params (gnus-info-params info) active (gnus-active group) unread (or (car entry) @@ -462,7 +461,7 @@ If LOWEST is non-nil, list all newsgroups of level LOWEST or higher." (gnus-group-prepare-flat-list-dead (seq-remove (lambda (group) (or (gnus-group-entry group) - (gnus-gethash group gnus-killed-hashtb))) + (gethash group gnus-killed-hashtb))) not-in-list) gnus-level-killed ?K regexp))) @@ -536,7 +535,7 @@ articles in the topic and its subtopics." (funcall regexp entry)) ((null regexp) t) (t nil)))) - (setq info (nth 2 entry)) + (setq info (nth 1 entry)) (gnus-group-prepare-logic (gnus-info-group info) (and (or (not gnus-group-listed-groups) @@ -557,7 +556,7 @@ articles in the topic and its subtopics." (car active)) nil) ;; Living groups. - (when (setq info (nth 2 entry)) + (when (setq info (nth 1 entry)) (gnus-group-insert-group-line (gnus-info-group info) (gnus-info-level info) (gnus-info-marks info) @@ -646,7 +645,7 @@ articles in the topic and its subtopics." (point) (prog1 (1+ (point)) (eval gnus-topic-line-format-spec)) - (list 'gnus-topic (intern name) + (list 'gnus-topic name 'gnus-topic-level level 'gnus-topic-unread unread 'gnus-active active-topic @@ -844,10 +843,9 @@ articles in the topic and its subtopics." ;; they belong to some topic. (let* ((tgroups (apply 'append (mapcar 'cdr gnus-topic-alist))) (entry (last (assoc (caar gnus-topic-topology) gnus-topic-alist))) - (newsrc (cdr gnus-newsrc-alist)) - group) - (while newsrc - (unless (member (setq group (gnus-info-group (pop newsrc))) tgroups) + (groups (cdr gnus-group-list))) + (dolist (group groups) + (unless (member group tgroups) (setcdr entry (list group)) (setq entry (cdr entry))))) ;; Go through all topics and make sure they contain only living groups. @@ -888,7 +886,7 @@ articles in the topic and its subtopics." (while (setq group (pop topic)) (when (and (or (gnus-active group) (gnus-info-method (gnus-get-info group))) - (not (gnus-gethash group gnus-killed-hashtb))) + (not (gethash group gnus-killed-hashtb))) (push group filtered-topic))) (push (cons topic-name (nreverse filtered-topic)) result))) (setq gnus-topic-alist (nreverse result)))) @@ -898,7 +896,7 @@ articles in the topic and its subtopics." (with-current-buffer gnus-group-buffer (let ((inhibit-read-only t)) (unless gnus-topic-inhibit-change-level - (gnus-group-goto-group (or (car (nth 2 previous)) group)) + (gnus-group-goto-group (or (car (nth 1 previous)) group)) (when (and gnus-topic-mode gnus-topic-alist (not gnus-topic-inhibit-change-level)) @@ -956,7 +954,7 @@ articles in the topic and its subtopics." (if (not group) (if (not (memq 'gnus-topic props)) (goto-char (point-max)) - (let ((topic (symbol-name (cadr (memq 'gnus-topic props))))) + (let ((topic (cadr (memq 'gnus-topic props)))) (or (gnus-topic-goto-topic topic) (gnus-topic-goto-topic (gnus-topic-next-topic topic))))) (if (gnus-group-goto-group group) @@ -992,12 +990,8 @@ articles in the topic and its subtopics." ;; First we make sure that we have really read the active file. (when (or force (not gnus-topic-active-alist)) - (let (groups) - ;; Get a list of all groups available. - (mapatoms (lambda (g) (when (symbol-value g) - (push (symbol-name g) groups))) - gnus-active-hashtb) - (setq groups (sort groups 'string<)) + ;; Get a list of all groups available. + (let ((groups (sort (hash-table-keys gnus-active-hashtb) #'string<))) ;; Init the variables. (setq gnus-topic-active-topology (list (list "" 'visible))) (setq gnus-topic-active-alist nil) @@ -1202,7 +1196,7 @@ If performed over a topic line, toggle folding the topic." (save-excursion (gnus-message 5 "Expiring groups in %s..." topic) (let ((gnus-group-marked - (mapcar (lambda (entry) (car (nth 2 entry))) + (mapcar (lambda (entry) (car (nth 1 entry))) (gnus-topic-find-groups topic gnus-level-killed t nil t)))) (gnus-group-expire-articles nil)) @@ -1216,7 +1210,7 @@ Also see `gnus-group-catchup'." (call-interactively 'gnus-group-catchup-current) (save-excursion (let* ((groups - (mapcar (lambda (entry) (car (nth 2 entry))) + (mapcar (lambda (entry) (car (nth 1 entry))) (gnus-topic-find-groups topic gnus-level-killed t nil t))) (inhibit-read-only t) @@ -1449,7 +1443,7 @@ If NON-RECURSIVE (which is the prefix) is t, don't mark its subtopics." (not non-recursive)))) (while groups (funcall (if unmark 'gnus-group-remove-mark 'gnus-group-set-mark) - (gnus-info-group (nth 2 (pop groups))))))))) + (gnus-info-group (nth 1 (pop groups))))))))) (defun gnus-topic-unmark-topic (topic &optional _dummy non-recursive) "Remove the process mark from all groups in the TOPIC. |