Always set gnus-group property to a group name

* lisp/gnus/gnus-group.el (gnus-group-prepare-flat-list-dead): Set
gnus-group property to a group name, not active info. (bug#33653)
Simplify surrounding logic.
(gnus-group-prepare-flat, gnus-group-goto-group): Use accessor
macros.
(gnus-group-insert-group-line, gnus-group-new-mail)
(gnus-group-mark-group): Write ?\s instead of ? .
(gnus-group-group-name, gnus-group-list-active): Simplify.
parent bd6a19cc
Pipeline #1254 failed with stage
in 49 minutes and 35 seconds
...@@ -1320,7 +1320,7 @@ if it is a string, only list groups matching REGEXP." ...@@ -1320,7 +1320,7 @@ if it is a string, only list groups matching REGEXP."
gnus-group-listed-groups) gnus-group-listed-groups)
;; List living groups, according to order in `gnus-group-list'. ;; List living groups, according to order in `gnus-group-list'.
(dolist (g (cdr gnus-group-list)) (dolist (g (cdr gnus-group-list))
(setq info (nth 1 (gethash g gnus-newsrc-hashtb)) (setq info (gnus-get-info g)
group (gnus-info-group info) group (gnus-info-group info)
params (gnus-info-params info) params (gnus-info-params info)
unread (gnus-group-unread group)) unread (gnus-group-unread group))
...@@ -1389,39 +1389,35 @@ if it is a string, only list groups matching REGEXP." ...@@ -1389,39 +1389,35 @@ if it is a string, only list groups matching REGEXP."
;; List zombies and killed lists somewhat faster, which was ;; List zombies and killed lists somewhat faster, which was
;; suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>. It does ;; suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>. It does
;; this by ignoring the group format specification altogether. ;; this by ignoring the group format specification altogether.
(let (group) (if (nthcdr gnus-group-listing-limit groups)
(if (> (length groups) gnus-group-listing-limit) (dolist (group groups)
(while groups
(setq group (pop groups))
(when (gnus-group-prepare-logic
group
(or (not regexp)
(and (stringp regexp) (string-match regexp group))
(and (functionp regexp) (funcall regexp group))))
(add-text-properties
(point) (prog1 (1+ (point))
(insert " " mark " *: "
(gnus-group-decoded-name group)
"\n"))
(list 'gnus-group (gethash group gnus-active-hashtb)
'gnus-unread t
'gnus-level level))))
(while groups
(setq group (pop groups))
(when (gnus-group-prepare-logic (when (gnus-group-prepare-logic
group group
(or (not regexp) (cond ((not regexp))
(and (stringp regexp) (string-match regexp group)) ((stringp regexp) (string-match-p regexp group))
(and (functionp regexp) (funcall regexp group)))) ((functionp regexp) (funcall regexp group))))
(gnus-group-insert-group-line (add-text-properties
group level nil (point) (prog1 (1+ (point))
(let ((active (gnus-active group))) (insert " " mark " *: "
(if active (gnus-group-decoded-name group)
(if (zerop (cdr active)) "\n"))
0 (list 'gnus-group group
(- (1+ (cdr active)) (car active))) 'gnus-unread t
nil)) 'gnus-level level))))
(gnus-method-simplify (gnus-find-method-for-group group)))))))) (dolist (group groups)
(when (gnus-group-prepare-logic
group
(cond ((not regexp))
((stringp regexp) (string-match-p regexp group))
((functionp regexp) (funcall regexp group))))
(gnus-group-insert-group-line
group level nil
(let ((active (gnus-active group)))
(and active
(if (zerop (cdr active))
0
(- (cdr active) (car active) -1))))
(gnus-method-simplify (gnus-find-method-for-group group)))))))
(defun gnus-group-update-group-line () (defun gnus-group-update-group-line ()
"Update the current line in the group buffer." "Update the current line in the group buffer."
...@@ -1527,7 +1523,7 @@ if it is a string, only list groups matching REGEXP." ...@@ -1527,7 +1523,7 @@ if it is a string, only list groups matching REGEXP."
(int-to-string (max 0 (- gnus-tmp-number-total number))) (int-to-string (max 0 (- gnus-tmp-number-total number)))
"*")) "*"))
(gnus-tmp-subscribed (gnus-tmp-subscribed
(cond ((<= gnus-tmp-level gnus-level-subscribed) ? ) (cond ((<= gnus-tmp-level gnus-level-subscribed) ?\s)
((<= gnus-tmp-level gnus-level-unsubscribed) ?U) ((<= gnus-tmp-level gnus-level-unsubscribed) ?U)
((= gnus-tmp-level gnus-level-zombie) ?Z) ((= gnus-tmp-level gnus-level-zombie) ?Z)
(t ?K))) (t ?K)))
...@@ -1546,7 +1542,7 @@ if it is a string, only list groups matching REGEXP." ...@@ -1546,7 +1542,7 @@ if it is a string, only list groups matching REGEXP."
(gnus-tmp-moderated (gnus-tmp-moderated
(if (and gnus-moderated-hashtb (if (and gnus-moderated-hashtb
(gethash gnus-tmp-group gnus-moderated-hashtb)) (gethash gnus-tmp-group gnus-moderated-hashtb))
?m ? )) ?m ?\s))
(gnus-tmp-moderated-string (gnus-tmp-moderated-string
(if (eq gnus-tmp-moderated ?m) "(m)" "")) (if (eq gnus-tmp-moderated ?m) "(m)" ""))
(gnus-tmp-group-icon (gnus-group-get-icon gnus-tmp-group)) (gnus-tmp-group-icon (gnus-group-get-icon gnus-tmp-group))
...@@ -1560,15 +1556,15 @@ if it is a string, only list groups matching REGEXP." ...@@ -1560,15 +1556,15 @@ if it is a string, only list groups matching REGEXP."
(if (and (numberp number) (if (and (numberp number)
(zerop number) (zerop number)
(cdr (assq 'tick gnus-tmp-marked))) (cdr (assq 'tick gnus-tmp-marked)))
?* ? )) ?* ?\s))
(gnus-tmp-summary-live (gnus-tmp-summary-live
(if (and (not gnus-group-is-exiting-p) (if (and (not gnus-group-is-exiting-p)
(gnus-buffer-live-p (gnus-summary-buffer-name (gnus-buffer-live-p (gnus-summary-buffer-name
gnus-tmp-group))) gnus-tmp-group)))
?* ? )) ?* ?\s))
(gnus-tmp-process-marked (gnus-tmp-process-marked
(if (member gnus-tmp-group gnus-group-marked) (if (member gnus-tmp-group gnus-group-marked)
gnus-process-mark ? )) gnus-process-mark ?\s))
(buffer-read-only nil) (buffer-read-only nil)
beg end beg end
gnus-tmp-header) ; passed as parameter to user-funcs. gnus-tmp-header) ; passed as parameter to user-funcs.
...@@ -1768,10 +1764,8 @@ already. If INFO-UNCHANGED is non-nil, dribble buffer is not updated." ...@@ -1768,10 +1764,8 @@ already. If INFO-UNCHANGED is non-nil, dribble buffer is not updated."
(defun gnus-group-group-name () (defun gnus-group-group-name ()
"Get the name of the newsgroup on the current line." "Get the name of the newsgroup on the current line."
(let ((group (get-text-property (point-at-bol) 'gnus-group))) (let ((group (get-text-property (point-at-bol) 'gnus-group)))
(when group (cond ((stringp group) group)
(if (stringp group) (group (symbol-name group)))))
group
(symbol-name group)))))
(defun gnus-group-group-level () (defun gnus-group-group-level ()
"Get the level of the newsgroup on the current line." "Get the level of the newsgroup on the current line."
...@@ -1791,7 +1785,7 @@ already. If INFO-UNCHANGED is non-nil, dribble buffer is not updated." ...@@ -1791,7 +1785,7 @@ already. If INFO-UNCHANGED is non-nil, dribble buffer is not updated."
(defun gnus-group-new-mail (group) (defun gnus-group-new-mail (group)
(if (nnmail-new-mail-p (gnus-group-real-name group)) (if (nnmail-new-mail-p (gnus-group-real-name group))
gnus-new-mail-mark gnus-new-mail-mark
? )) ?\s))
(defun gnus-group-level (group) (defun gnus-group-level (group)
"Return the estimated level of GROUP." "Return the estimated level of GROUP."
...@@ -1881,7 +1875,7 @@ If FIRST-TOO, the current line is also eligible as a target." ...@@ -1881,7 +1875,7 @@ If FIRST-TOO, the current line is also eligible as a target."
(if unmark (if unmark
(progn (progn
(setq gnus-group-marked (delete group gnus-group-marked)) (setq gnus-group-marked (delete group gnus-group-marked))
(insert-char ? 1 t)) (insert-char ?\s 1 t))
(setq gnus-group-marked (setq gnus-group-marked
(cons group (delete group gnus-group-marked))) (cons group (delete group gnus-group-marked)))
(insert-char gnus-process-mark 1 t))) (insert-char gnus-process-mark 1 t)))
...@@ -2561,10 +2555,10 @@ If TEST-MARKED, the line must be marked." ...@@ -2561,10 +2555,10 @@ If TEST-MARKED, the line must be marked."
(when group (when group
(let ((start (point)) (let ((start (point))
(active (and (or (active (and (or
;; some kind of group may be only there. ;; Some kind of group may be only there.
(gethash group gnus-active-hashtb) (gnus-active group)
;; all groups (but with exception) are there. ;; All groups (but with exception) are there.
(gethash group gnus-newsrc-hashtb)) (gnus-group-entry group))
group))) group)))
(beginning-of-line) (beginning-of-line)
(cond (cond
...@@ -4013,15 +4007,9 @@ entail asking the server for the groups." ...@@ -4013,15 +4007,9 @@ entail asking the server for the groups."
(gnus-agent gnus-plugged)); If we're actually plugged, store the active file in the agent. (gnus-agent gnus-plugged)); If we're actually plugged, store the active file in the agent.
(gnus-read-active-file))) (gnus-read-active-file)))
;; Find all groups and sort them. ;; Find all groups and sort them.
(let ((groups (let ((buffer-read-only nil))
(sort
(hash-table-keys gnus-active-hashtb)
'string<))
(buffer-read-only nil)
group)
(erase-buffer) (erase-buffer)
(while groups (dolist (group (sort (hash-table-keys gnus-active-hashtb) #'string<))
(setq group (pop groups))
(add-text-properties (add-text-properties
(point) (prog1 (1+ (point)) (point) (prog1 (1+ (point))
(insert " *: " (insert " *: "
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment