diff options
Diffstat (limited to 'lisp/gnus/gnus-start.el')
| -rw-r--r-- | lisp/gnus/gnus-start.el | 500 |
1 files changed, 223 insertions, 277 deletions
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index 33462543d00..82141e02215 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -543,29 +543,21 @@ Can be used to turn version control on or off." (message "Descend hierarchy %s? ([y]nsq): " (substring prefix 1 (1- (length prefix))))) (cond ((= ans ?n) - (while (and groups - (setq group (car groups) - real-group (gnus-group-real-name group)) - (string-match prefix real-group)) - (push group gnus-killed-list) - (gnus-sethash group group gnus-killed-hashtb) - (setq groups (cdr groups))) + (dolist (g groups) + (when (string-match prefix (gnus-group-real-name g)) + (push g gnus-killed-list) + (puthash g t gnus-killed-hashtb))) (setq starts (cdr starts))) ((= ans ?s) - (while (and groups - (setq group (car groups) - real-group (gnus-group-real-name group)) - (string-match prefix real-group)) - (gnus-sethash group group gnus-killed-hashtb) - (gnus-subscribe-alphabetically (car groups)) - (setq groups (cdr groups))) + (dolist (g groups) + (when (string-match prefix (gnus-group-real-name g)) + (puthash g t gnus-killed-hashtb) + (gnus-subscribe-alphabetically g))) (setq starts (cdr starts))) ((= ans ?q) - (while groups - (setq group (car groups)) - (push group gnus-killed-list) - (gnus-sethash group group gnus-killed-hashtb) - (setq groups (cdr groups)))) + (dolist (g groups) + (push g gnus-killed-list) + (puthash g t gnus-killed-hashtb))) (t nil))) (message "Subscribe %s? ([n]yq)" (car groups)) (while (not (memq (setq ans (read-char-exclusive)) @@ -575,16 +567,14 @@ Can be used to turn version control on or off." (setq group (car groups)) (cond ((= ans ?y) (gnus-subscribe-alphabetically (car groups)) - (gnus-sethash group group gnus-killed-hashtb)) + (puthash group t gnus-killed-hashtb)) ((= ans ?q) - (while groups - (setq group (car groups)) - (push group gnus-killed-list) - (gnus-sethash group group gnus-killed-hashtb) - (setq groups (cdr groups)))) + (dolist (g groups) + (push g gnus-killed-list) + (puthash g t gnus-killed-hashtb))) (t (push group gnus-killed-list) - (gnus-sethash group group gnus-killed-hashtb))) + (puthash group t gnus-killed-hashtb))) (setq groups (cdr groups))))))) (defun gnus-subscribe-randomly (newsgroup) @@ -647,7 +637,7 @@ the first newsgroup." ;; We subscribe the group by changing its level to `subscribed'. (gnus-group-change-level newsgroup gnus-level-default-subscribed - gnus-level-killed (gnus-group-entry (or next "dummy.group"))) + gnus-level-killed (or next "dummy.group")) (gnus-request-update-group-status newsgroup 'subscribe) (gnus-message 5 "Subscribe newsgroup: %s" newsgroup) (run-hook-with-args 'gnus-subscribe-newsgroup-functions newsgroup) @@ -696,6 +686,7 @@ the first newsgroup." gnus-agent-file-loading-cache nil gnus-server-method-cache nil gnus-newsrc-alist nil + gnus-group-list nil gnus-newsrc-hashtb nil gnus-killed-list nil gnus-zombie-list nil @@ -1018,7 +1009,7 @@ If LEVEL is non-nil, the news will be set up at level LEVEL." (eq gnus-read-active-file 'some)) (gnus-update-active-hashtb-from-killed)) (unless gnus-active-hashtb - (setq gnus-active-hashtb (gnus-make-hashtable 4096))) + (setq gnus-active-hashtb (gnus-make-hashtable 4000))) ;; Initialize the cache. (when gnus-use-cache (gnus-cache-open)) @@ -1108,7 +1099,7 @@ for new groups, and subscribe the new groups as zombies." (gnus-ask-server-for-new-groups) ;; Go through the active hashtb and look for new groups. (let ((groups 0) - group new-newsgroups) + new-newsgroups) (gnus-message 5 "Looking for new newsgroups...") (unless gnus-have-read-active-file (gnus-read-active-file)) @@ -1117,30 +1108,26 @@ for new groups, and subscribe the new groups as zombies." (gnus-make-hashtable-from-killed)) ;; Go though every newsgroup in `gnus-active-hashtb' and compare ;; with `gnus-newsrc-hashtb' and `gnus-killed-hashtb'. - (mapatoms - (lambda (sym) - (if (or (null (setq group (symbol-name sym))) - (not (boundp sym)) - (null (symbol-value sym)) - (gnus-gethash group gnus-killed-hashtb) - (gnus-gethash group gnus-newsrc-hashtb)) - () - (let ((do-sub (gnus-matches-options-n group))) + (maphash + (lambda (g-name active) + (unless (or (gethash g-name gnus-killed-hashtb) + (gethash g-name gnus-newsrc-hashtb)) + (let ((do-sub (gnus-matches-options-n g-name))) (cond ((eq do-sub 'subscribe) (setq groups (1+ groups)) - (gnus-sethash group group gnus-killed-hashtb) + (puthash g-name t gnus-killed-hashtb) (gnus-call-subscribe-functions - gnus-subscribe-options-newsgroup-method group)) + gnus-subscribe-options-newsgroup-method g-name)) ((eq do-sub 'ignore) nil) (t (setq groups (1+ groups)) - (gnus-sethash group group gnus-killed-hashtb) + (puthash g-name t gnus-killed-hashtb) (if gnus-subscribe-hierarchical-interactive - (push group new-newsgroups) + (push g-name new-newsgroups) (gnus-call-subscribe-functions - gnus-subscribe-newsgroup-method group))))))) + gnus-subscribe-newsgroup-method g-name))))))) gnus-active-hashtb) (when new-newsgroups (gnus-subscribe-hierarchical-interactive new-newsgroups)) @@ -1213,36 +1200,32 @@ for new groups, and subscribe the new groups as zombies." ;; Enter all the new groups into a hashtable. (gnus-active-to-gnus-format method hashtb 'ignore)) ;; Now all new groups from `method' are in `hashtb'. - (mapatoms - (lambda (group-sym) - (if (or (null (setq group (symbol-name group-sym))) - (not (boundp group-sym)) - (null (symbol-value group-sym)) - (gnus-gethash group gnus-newsrc-hashtb) - (member group gnus-zombie-list) - (member group gnus-killed-list)) - ;; The group is already known. - () + (maphash + (lambda (g-name val) + (unless (or (null val) ; The group is already known. + (gethash g-name gnus-newsrc-hashtb) + (member g-name gnus-zombie-list) + (member g-name gnus-killed-list)) ;; Make this group active. - (when (symbol-value group-sym) - (gnus-set-active group (symbol-value group-sym))) + (when val + (gnus-set-active g-name val)) ;; Check whether we want it or not. - (let ((do-sub (gnus-matches-options-n group))) + (let ((do-sub (gnus-matches-options-n g-name))) (cond ((eq do-sub 'subscribe) (cl-incf groups) - (gnus-sethash group group gnus-killed-hashtb) + (puthash g-name group gnus-killed-hashtb) (gnus-call-subscribe-functions - gnus-subscribe-options-newsgroup-method group)) + gnus-subscribe-options-newsgroup-method g-name)) ((eq do-sub 'ignore) nil) (t (cl-incf groups) - (gnus-sethash group group gnus-killed-hashtb) + (puthash g-name group gnus-killed-hashtb) (if gnus-subscribe-hierarchical-interactive - (push group new-newsgroups) + (push g-name new-newsgroups) (gnus-call-subscribe-functions - gnus-subscribe-newsgroup-method group))))))) + gnus-subscribe-newsgroup-method g-name))))))) hashtb)) (when new-newsgroups (gnus-subscribe-hierarchical-interactive new-newsgroups))) @@ -1263,29 +1246,28 @@ for new groups, and subscribe the new groups as zombies." gnus-level-default-subscribed gnus-level-killed previous t) t) -;; `gnus-group-change-level' is the fundamental function for changing -;; subscription levels of newsgroups. This might mean just changing -;; from level 1 to 2, which is pretty trivial, from 2 to 6 or back -;; again, which subscribes/unsubscribes a group, which is equally -;; trivial. Changing from 1-7 to 8-9 means that you kill a group, and -;; from 8-9 to 1-7 means that you remove the group from the list of -;; killed (or zombie) groups and add them to the (kinda) subscribed -;; groups. And last but not least, moving from 8 to 9 and 9 to 8, -;; which is trivial. -;; ENTRY can either be a string (newsgroup name) or a list (if -;; FROMKILLED is t, it's a list on the format (NUM INFO-LIST), -;; otherwise it's a list in the format of the `gnus-newsrc-hashtb' -;; entries. -;; LEVEL is the new level of the group, OLDLEVEL is the old level and -;; PREVIOUS is the group (in hashtb entry format) to insert this group -;; after. + (defun gnus-group-change-level (entry level &optional oldlevel previous fromkilled) + "Change level of group ENTRY to LEVEL. +This is the fundamental function for changing subscription levels +of newsgroups. This might mean just changing from level 1 to 2, +which is pretty trivial, from 2 to 6 or back again, which +subscribes/unsubscribes a group, which is equally trivial. +Changing from 1-7 to 8-9 means that you kill a group, and from +8-9 to 1-7 means that you remove the group from the list of +killed (or zombie) groups and add them to the (kinda) subscribed +groups. And last but not least, moving from 8 to 9 and 9 to 8, +which is trivial. ENTRY can either be a string (newsgroup name) +or a list (if FROMKILLED is t, it's a list on the format (NUM +INFO-LIST), otherwise it's a list in the format of the +`gnus-newsrc-hashtb' entries. LEVEL is the new level of the +group, OLDLEVEL is the old level and PREVIOUS is the group (a +string name) to insert this group after." (let (group info active num) - ;; Glean what info we can from the arguments + ;; Glean what info we can from the arguments. (if (consp entry) - (if fromkilled (setq group (nth 1 entry)) - (setq group (car (nth 2 entry)))) + (setq group (if fromkilled (nth 1 entry) (car (nth 1 entry)))) (setq group entry)) (when (and (stringp entry) oldlevel @@ -1293,21 +1275,17 @@ for new groups, and subscribe the new groups as zombies." (setq entry (gnus-group-entry entry))) (if (and (not oldlevel) (consp entry)) - (setq oldlevel (gnus-info-level (nth 2 entry))) + (setq oldlevel (gnus-info-level (nth 1 entry))) (setq oldlevel (or oldlevel gnus-level-killed))) (when (stringp previous) (setq previous (gnus-group-entry previous))) - - (if (and (>= oldlevel gnus-level-zombie) - (gnus-group-entry group)) - ;; We are trying to subscribe a group that is already - ;; subscribed. - () ; Do nothing. - + ;; Group is already subscribed. + (unless (and (>= oldlevel gnus-level-zombie) + (gnus-group-entry group)) (unless (gnus-ephemeral-group-p group) (gnus-dribble-enter (format "(gnus-group-change-level %S %S %S %S %S)" - group level oldlevel (car (nth 2 previous)) fromkilled))) + group level oldlevel previous fromkilled))) ;; Then we remove the newgroup from any old structures, if needed. ;; If the group was killed, we remove it from the killed or zombie @@ -1321,11 +1299,10 @@ for new groups, and subscribe the new groups as zombies." (t (when (and (>= level gnus-level-zombie) entry) - (gnus-sethash (car (nth 2 entry)) nil gnus-newsrc-hashtb) - (when (nth 3 entry) - (setcdr (gnus-group-entry (car (nth 3 entry))) - (cdr entry))) - (setcdr (cdr entry) (cdddr entry))))) + (remhash (car (nth 1 entry)) gnus-newsrc-hashtb) + (setq gnus-group-list (remove group gnus-group-list)) + (setq gnus-newsrc-alist (delq (assoc group gnus-newsrc-alist) + gnus-newsrc-alist))))) ;; Finally we enter (if needed) the list where it is supposed to ;; go, and change the subscription level. If it is to be killed, @@ -1333,12 +1310,13 @@ for new groups, and subscribe the new groups as zombies." (cond ((>= level gnus-level-zombie) ;; Remove from the hash table. - (gnus-sethash group nil gnus-newsrc-hashtb) + (remhash group gnus-newsrc-hashtb) + (setq gnus-group-list (remove group gnus-group-list)) (if (= level gnus-level-zombie) (push group gnus-zombie-list) (if (= oldlevel gnus-level-killed) ;; Remove from active hashtb. - (unintern group gnus-active-hashtb) + (remhash group gnus-active-hashtb) ;; Don't add it into killed-list if it was killed. (push group gnus-killed-list)))) (t @@ -1349,7 +1327,7 @@ for new groups, and subscribe the new groups as zombies." ;; It was alive, and it is going to stay alive, so we ;; just change the level and don't change any pointers or ;; hash table entries. - (setcar (cdaddr entry) level) + (setcar (cdadr entry) level) (if (listp entry) (setq info (cdr entry) num (car entry)) @@ -1364,23 +1342,16 @@ for new groups, and subscribe the new groups as zombies." (if method (setq info (list group level nil nil method)) (setq info (list group level nil))))) - (unless previous - (setq previous - (let ((p gnus-newsrc-alist)) - (while (cddr p) - (setq p (cdr p))) - p))) - (setq entry (cons info (cddr previous))) - (if (cdr previous) - (progn - (setcdr (cdr previous) entry) - (gnus-sethash group (cons num (cdr previous)) - gnus-newsrc-hashtb)) - (setcdr previous entry) - (gnus-sethash group (cons num previous) - gnus-newsrc-hashtb)) - (when (cdr entry) - (setcdr (gnus-group-entry (caadr entry)) entry)) + ;; Add group. The exact ordering only matters for + ;; `gnus-group-list', though we need to keep the dummy group + ;; at the head of `gnus-newsrc-alist'. + (push info (cdr gnus-newsrc-alist)) + (puthash group (list num info) gnus-newsrc-hashtb) + (let* ((prev-idx (seq-position gnus-group-list (caadr previous))) + (idx (if prev-idx + (1+ prev-idx) + (length gnus-group-list)))) + (push group (nthcdr idx gnus-group-list))) (gnus-dribble-enter (format "(gnus-group-set-info '%S)" info) (concat "^(gnus-group-set-info '(\"" (regexp-quote group) "\""))))) @@ -1455,7 +1426,7 @@ newsgroup." (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))) @@ -1837,19 +1808,24 @@ backend check whether the group actually exists." (dolist (info infos) (gnus-activate-group (gnus-info-group info) nil nil method t)))))) -;; Create a hash table out of the newsrc alist. The `car's of the -;; alist elements are used as keys. (defun gnus-make-hashtable-from-newsrc-alist () + "Create a hash table from `gnus-newsrc-alist'. +The keys are group names, and values are a cons of (unread info), +where unread is an integer count of calculated unread +messages (or nil), and info is a regular gnus info entry. + +The info element is shared with the same element of +`gnus-newrc-alist', so as to conserve space." (let ((alist gnus-newsrc-alist) (ohashtb gnus-newsrc-hashtb) - prev info method rest methods) + info method gname rest methods) (setq gnus-newsrc-hashtb (gnus-make-hashtable (length alist))) (setq alist - (setq prev (setq gnus-newsrc-alist - (if (equal (caar gnus-newsrc-alist) - "dummy.group") - gnus-newsrc-alist - (cons (list "dummy.group" 0 nil) alist))))) + (setq gnus-newsrc-alist + (if (equal (caar gnus-newsrc-alist) + "dummy.group") + gnus-newsrc-alist + (cons (list "dummy.group" 0 nil) alist)))) (while alist (setq info (car alist)) ;; Make the same select-methods identical Lisp objects. @@ -1858,17 +1834,18 @@ backend check whether the group actually exists." (gnus-info-set-method info (car rest)) (push method methods))) ;; Check for duplicates. - (if (gnus-gethash (car info) gnus-newsrc-hashtb) + (if (gethash (car info) gnus-newsrc-hashtb) ;; Remove this entry from the alist. - (setcdr prev (cddr prev)) - (gnus-sethash + (setcdr alist (cddr alist)) + (puthash (car info) ;; Preserve number of unread articles in groups. - (cons (and ohashtb (car (gnus-gethash (car info) ohashtb))) - prev) + (list (and ohashtb (car (gethash (car info) ohashtb))) + info) gnus-newsrc-hashtb) - (setq prev alist)) + (push (car info) gnus-group-list)) (setq alist (cdr alist))) + (setq gnus-group-list (nreverse gnus-group-list)) ;; Make the same select-methods in `gnus-server-alist' identical ;; as well. (while methods @@ -1883,10 +1860,10 @@ backend check whether the group actually exists." (setq gnus-killed-hashtb (gnus-make-hashtable (+ (length gnus-killed-list) (length gnus-zombie-list)))) - (while lists - (setq list (symbol-value (pop lists))) - (while list - (gnus-sethash (car list) (pop list) gnus-killed-hashtb))))) + (dolist (g (append gnus-killed-list gnus-zombie-list)) + ;; NOTE: We have lost the ordering that used to be kept in this + ;; variable. + (puthash g t gnus-killed-hashtb)))) (defun gnus-parse-active () "Parse active info in the nntp server buffer." @@ -1900,7 +1877,7 @@ backend check whether the group actually exists." (defun gnus-make-articles-unread (group articles) "Mark ARTICLES in GROUP as unread." - (let* ((info (nth 2 (or (gnus-group-entry group) + (let* ((info (nth 1 (or (gnus-group-entry group) (gnus-group-entry (gnus-group-real-name group))))) (ranges (gnus-info-read info)) @@ -1924,7 +1901,7 @@ backend check whether the group actually exists." "Mark ascending ARTICLES in GROUP as unread." (let* ((entry (or (gnus-group-entry group) (gnus-group-entry (gnus-group-real-name group)))) - (info (nth 2 entry)) + (info (nth 1 entry)) (ranges (gnus-info-read info)) (r ranges) modified) @@ -1987,12 +1964,11 @@ backend check whether the group actually exists." ;; Insert the change into the group buffer and the dribble file. (gnus-group-update-group group t)))) -;; Enter all dead groups into the hashtb. (defun gnus-update-active-hashtb-from-killed () - (let ((hashtb (setq gnus-active-hashtb (gnus-make-hashtable 4096)))) - (dolist (list (list gnus-killed-list gnus-zombie-list)) - (dolist (group list) - (gnus-sethash group nil hashtb))))) + (let ((hashtb (setq gnus-active-hashtb + (gnus-make-hashtable 4000)))) + (dolist (g (append gnus-killed-list gnus-zombie-list)) + (remhash g hashtb)))) (defun gnus-get-killed-groups () "Go through the active hashtb and mark all unknown groups as killed." @@ -2003,20 +1979,16 @@ backend check whether the group actually exists." (unless gnus-killed-hashtb (gnus-make-hashtable-from-killed)) ;; Go through all newsgroups that are known to Gnus - enlarge kill list. - (mapatoms - (lambda (sym) - (let ((groups 0) - (group (symbol-name sym))) - (if (or (null group) - (gnus-gethash group gnus-killed-hashtb) - (gnus-gethash group gnus-newsrc-hashtb)) - () - (let ((do-sub (gnus-matches-options-n group))) - (if (or (eq do-sub 'subscribe) (eq do-sub 'ignore)) - () + (maphash + (lambda (g-name active) + (let ((groups 0)) + (unless (or (gethash g-name gnus-killed-hashtb) + (gethash g-name gnus-newsrc-hashtb)) + (let ((do-sub (gnus-matches-options-n g-name))) + (unless (or (eq do-sub 'subscribe) (eq do-sub 'ignore)) (setq groups (1+ groups)) - (push group gnus-killed-list) - (gnus-sethash group group gnus-killed-hashtb)))))) + (push g-name gnus-killed-list) + (puthash g-name t gnus-killed-hashtb)))))) gnus-active-hashtb) (gnus-dribble-touch)) @@ -2129,11 +2101,13 @@ backend check whether the group actually exists." (not (equal method gnus-select-method))) gnus-active-hashtb (setq gnus-active-hashtb - (if (equal method gnus-select-method) - (gnus-make-hashtable - (count-lines (point-min) (point-max))) - (gnus-make-hashtable 4096)))))) + (gnus-make-hashtable + (if (equal method gnus-select-method) + (count-lines (point-min) (point-max)) + 4000)))))) group max min) + (unless gnus-moderated-hashtb + (setq gnus-moderated-hashtb (gnus-make-hashtable 100))) ;; Delete unnecessary lines. (goto-char (point-min)) (cond @@ -2143,12 +2117,6 @@ backend check whether the group actually exists." (delete-matching-lines (concat "^to\\.\\|" gnus-ignored-newsgroups)))) (goto-char (point-min)) - (unless (re-search-forward "[\\\"]" nil t) - ;; Make the group names readable as a lisp expression even if they - ;; contain special characters. - (goto-char (point-max)) - (while (re-search-backward "[][';?()#]" nil t) - (insert ?\\))) ;; Let the Gnus agent save the active file. (when (and gnus-agent real-active (gnus-online method)) @@ -2168,49 +2136,35 @@ backend check whether the group actually exists." (insert prefix) (zerop (forward-line 1))))))) ;; Store the active file in a hash table. - ;; Use a unibyte buffer in order to make `read' read non-ASCII - ;; group names (which have been encoded) as unibyte strings. - (mm-with-unibyte-buffer + + (with-temp-buffer (insert-buffer-substring cur) (setq cur (current-buffer)) (goto-char (point-min)) (while (not (eobp)) (condition-case () - (progn - (narrow-to-region (point) (point-at-eol)) - ;; group gets set to a symbol interned in the hash table - ;; (what a hack!!) - jwz - (setq group (let ((obarray hashtb)) (read cur))) - ;; ### The extended group name scheme makes - ;; the previous optimization strategy sort of pointless... - (when (stringp group) - (setq group (intern group hashtb))) - (if (and (numberp (setq max (read cur))) - (numberp (setq min (read cur))) - (progn - (skip-chars-forward " \t") - (not - (or (eq (char-after) ?=) - (eq (char-after) ?x) - (eq (char-after) ?j))))) - (progn - (set group (cons min max)) - ;; if group is moderated, stick in moderation table - (when (eq (char-after) ?m) - (unless gnus-moderated-hashtb - (setq gnus-moderated-hashtb (gnus-make-hashtable))) - (gnus-sethash (symbol-name group) t - gnus-moderated-hashtb))) - (set group nil))) + (if (and (stringp (progn + (setq group (read cur) + group (if (numberp group) + (number-to-string group) + (symbol-name group))))) + (numberp (setq max (read cur))) + (numberp (setq min (read cur))) + (null (progn + (skip-chars-forward " \t") + (memq (char-after) + '(?= ?x ?j))))) + (progn (puthash group (cons min max) hashtb) + ;; If group is moderated, stick it in the + ;; moderation cache. + (when (eq (char-after) ?m) + (puthash group t gnus-moderated-hashtb))) + (setq group nil)) (error - (and group - (symbolp group) - (set group nil)) (unless ignore-errors (gnus-message 3 "Warning - invalid active: %s" (buffer-substring (point-at-bol) (point-at-eol)))))) - (widen) (forward-line 1))))) (defun gnus-groups-to-gnus-format (method &optional hashtb real-active) @@ -2238,35 +2192,23 @@ backend check whether the group actually exists." (gnus-active-to-gnus-format method hashtb nil real-active)) (goto-char (point-min)) - ;; We split this into to separate loops, one with the prefix - ;; and one without to speed the reading up somewhat. - (if prefix - (let (min max opoint group) - (while (not (eobp)) - (condition-case () - (progn - (read cur) (read cur) - (setq min (read cur) - max (read cur) - opoint (point)) - (skip-chars-forward " \t") - (insert prefix) - (goto-char opoint) - (set (let ((obarray hashtb)) (read cur)) - (cons min max))) - (error (and group (symbolp group) (set group nil)))) - (forward-line 1))) - (let (min max group) - (while (not (eobp)) - (condition-case () - (when (eq (char-after) ?2) - (read cur) (read cur) - (setq min (read cur) - max (read cur)) - (set (setq group (let ((obarray hashtb)) (read cur))) - (cons min max))) - (error (and group (symbolp group) (set group nil)))) - (forward-line 1))))))) + (let (min max group) + (while (not (eobp)) + (condition-case () + (when (eq (char-after) ?2) + (read cur) (read cur) + (setq min (read cur) + max (read cur) + group (read cur) + group (if (numberp group) + (number-to-string group) + (symbol-name group))) + (puthash (if prefix + (concat prefix group) + group) + (cons min max) hashtb)) + (error (remhash group hashtb))) + (forward-line 1)))))) (defun gnus-read-newsrc-file (&optional force) "Read startup file. @@ -2529,16 +2471,11 @@ If FORCE is non-nil, the .newsrc file is read." (setq gnus-newsrc-options-n nil) (unless gnus-active-hashtb - (setq gnus-active-hashtb (gnus-make-hashtable 4096))) + (setq gnus-active-hashtb (gnus-make-hashtable 4000))) (let ((buf (current-buffer)) (already-read (> (length gnus-newsrc-alist) 1)) - group subscribed options-symbol newsrc Options-symbol - symbol reads num1) + group subscribed newsrc reads num1) (goto-char (point-min)) - ;; We intern the symbol `options' in the active hashtb so that we - ;; can `eq' against it later. - (set (setq options-symbol (intern "options" gnus-active-hashtb)) nil) - (set (setq Options-symbol (intern "Options" gnus-active-hashtb)) nil) (while (not (eobp)) ;; We first read the first word on the line by narrowing and @@ -2549,15 +2486,16 @@ If FORCE is non-nil, the .newsrc file is read." (point) (progn (skip-chars-forward "^ \t!:\n") (point))) (goto-char (point-min)) - (setq symbol + (setq group (and (/= (point-min) (point-max)) - (let ((obarray gnus-active-hashtb)) (read buf)))) + (read buf)) + group (if (numberp group) + (number-to-string group) + (symbol-name group))) (widen) - ;; Now, the symbol we have read is either `options' or a group - ;; name. If it is an options line, we just add it to a string. (cond - ((or (eq symbol options-symbol) - (eq symbol Options-symbol)) + ;; It's possible that "group" is actually an options line. + ((string-equal (downcase group) "options") (setq gnus-newsrc-options ;; This concatting is quite inefficient, but since our ;; thorough studies show that approx 99.37% of all @@ -2571,19 +2509,13 @@ If FORCE is non-nil, the .newsrc file is read." (point-at-bol)) (point))))) (forward-line -1)) - (symbol - ;; Group names can be just numbers. - (when (numberp symbol) - (setq symbol (intern (int-to-string symbol) gnus-active-hashtb))) - (unless (boundp symbol) - (set symbol nil)) + (group ;; It was a group name. (setq subscribed (eq (char-after) ?:) - group (symbol-name symbol) reads nil) (if (eolp) ;; If the line ends here, this is clearly a buggy line, so - ;; we put point a the beginning of line and let the cond + ;; we put point at the beginning of line and let the cond ;; below do the error handling. (beginning-of-line) ;; We skip to the beginning of the ranges. @@ -2622,7 +2554,7 @@ If FORCE is non-nil, the .newsrc file is read." ;; It was just a simple number, so we add it to the ;; list of ranges. (push num1 reads)) - ;; If the next char in ?\n, then we have reached the end + ;; If the next char is ?\n, then we have reached the end ;; of the line and return nil. (not (eq (char-after) ?\n))) ((eq (char-after) ?\n) @@ -2651,7 +2583,8 @@ If FORCE is non-nil, the .newsrc file is read." (let ((info (gnus-get-info group)) level) (if info - ;; There is an entry for this file in the alist. + ;; There is an entry for this file in + ;; `gnus-newsrc-hashtb'. (progn (gnus-info-set-read info (nreverse reads)) ;; We update the level very gently. In fact, we @@ -2679,8 +2612,7 @@ If FORCE is non-nil, the .newsrc file is read." (setq newsrc (nreverse newsrc)) - (if (not already-read) - () + (unless already-read ;; We now have two newsrc lists - `newsrc', which is what we ;; have read from .newsrc, and `gnus-newsrc-alist', which is ;; what we've read from .newsrc.eld. We have to merge these @@ -2777,9 +2709,10 @@ If FORCE is non-nil, the .newsrc file is read." (defvar gnus-save-newsrc-file-last-timestamp nil) (defun gnus-save-newsrc-file (&optional force) - "Save .newsrc file." - ;; Note: We cannot save .newsrc file if all newsgroups are removed - ;; from the variable gnus-newsrc-alist. + "Save .newsrc file. +Use the group string names in `gnus-group-list' to pull info +values from `gnus-newsrc-hashtb', and write a new value of +`gnus-newsrc-alist'." (when (and (or gnus-newsrc-alist gnus-killed-list) gnus-current-startup-file) ;; Save agent range limits for the currently active method. @@ -2895,7 +2828,13 @@ If FORCE is non-nil, the .newsrc file is read." (gnus-group-set-mode-line))))) (defun gnus-gnus-to-quick-newsrc-format (&optional minimal name &rest specific-variables) - "Print Gnus variables such as `gnus-newsrc-alist' in Lisp format." + "Print Gnus variables such as `gnus-newsrc-alist' in Lisp format. +Unless optional argument MINIMAL is non-nil, print human-readable +information in the header of the file, including the file +version. If NAME is present, print that as part of the header. + +Variables printed are either the variables specified in +SPECIFIC-VARIABLES, or those in `gnus-variable-list'." (princ (format ";; -*- mode:emacs-lisp; coding: %s; -*-\n" gnus-ding-file-coding-system)) (if name @@ -2929,9 +2868,18 @@ If FORCE is non-nil, the .newsrc file is read." ;; Remove the `gnus-killed-list' from the list of variables ;; to be saved, if required. (delq 'gnus-killed-list (copy-sequence gnus-variable-list))))) - ;; Peel off the "dummy" group. - (gnus-newsrc-alist (cdr gnus-newsrc-alist)) variable) + ;; A bit of a fake-out here: the original value of + ;; `gnus-newsrc-alist' isn't written to file, instead it is + ;; constructed at the last minute by combining the group + ;; ordering in `gnus-group-list' with the group infos from + ;; `gnus-newsrc-hashtb'. + (set (nth (seq-position gnus-variable-list 'gnus-newsrc-alist) + gnus-variable-list) + (mapcar (lambda (g) + (nth 1 (gethash g gnus-newsrc-hashtb))) + gnus-group-list)) + ;; Insert the variables into the file. (while variables (when (and (boundp (setq variable (pop variables))) @@ -2956,8 +2904,8 @@ If FORCE is non-nil, the .newsrc file is read." (interactive (list (gnus-y-or-n-p "write foreign groups too? "))) ;; Generate and save the .newsrc file. (with-current-buffer (create-file-buffer gnus-current-startup-file) - (let ((newsrc (cdr gnus-newsrc-alist)) - (standard-output (current-buffer)) + (let ((standard-output (current-buffer)) + (groups (delete "dummy.group" (copy-sequence gnus-group-list))) info ranges range method) (setq buffer-file-name gnus-current-startup-file) (setq default-directory (file-name-directory buffer-file-name)) @@ -2971,13 +2919,14 @@ If FORCE is non-nil, the .newsrc file is read." (when gnus-newsrc-options (insert gnus-newsrc-options)) ;; Write subscribed and unsubscribed. - (while (setq info (pop newsrc)) - ;; Don't write foreign groups to .newsrc. + (dolist (g-name groups) + (setq info (nth 1 (gnus-group-entry g-name))) + ;; Maybe don't write foreign groups to .newsrc. (when (or (null (setq method (gnus-info-method info))) (equal method "native") (inline (gnus-server-equal method gnus-select-method)) foreign-ok) - (insert (gnus-info-group info) + (insert g-name (if (> (gnus-info-level info) gnus-level-subscribed) "!" ":")) (when (setq ranges (gnus-info-read info)) @@ -3105,10 +3054,10 @@ If FORCE is non-nil, the .newsrc file is read." ;; to avoid trying to re-read after a failed read. (unless gnus-description-hashtb (setq gnus-description-hashtb - (gnus-make-hashtable (length gnus-active-hashtb)))) + (gnus-make-hashtable (hash-table-size gnus-active-hashtb)))) ;; Mark this method's desc file as read. - (gnus-sethash (gnus-group-prefixed-name "" method) "Has read" - gnus-description-hashtb) + (puthash (gnus-group-prefixed-name "" method) "Has read" + gnus-description-hashtb) (gnus-message 5 "Reading descriptions file via %s..." (car method)) (cond @@ -3144,29 +3093,26 @@ If FORCE is non-nil, the .newsrc file is read." (zerop (forward-line 1))))))) (goto-char (point-min)) (while (not (eobp)) - ;; If we get an error, we set group to 0, which is not a - ;; symbol... (setq group (condition-case () - (let ((obarray gnus-description-hashtb)) - ;; Group is set to a symbol interned in this - ;; hash table. - (read nntp-server-buffer)) - (error 0))) + (read nntp-server-buffer) + (error nil))) (skip-chars-forward " \t") - ;; ... which leads to this line being effectively ignored. - (when (symbolp group) + (when group + (setq group (if (numberp group) + (number-to-string group) + (symbol-name group))) (let* ((str (buffer-substring (point) (progn (end-of-line) (point)))) - (name (symbol-name group)) (charset - (or (gnus-group-name-charset method name) - (gnus-parameter-charset name) + (or (gnus-group-name-charset method group) + (gnus-parameter-charset group) gnus-default-charset))) ;; Fixme: Don't decode in unibyte mode. + ;; Double fixme: We're not in unibyte mode, are we? (when (and str charset) (setq str (decode-coding-string str charset))) - (set group str))) + (puthash group str gnus-description-hashtb))) (forward-line 1)))) (gnus-message 5 "Reading descriptions file...done") t)))) |