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

Always set gnus-group property to a group name

Browse source 
* 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.
This commit is contained in:
Basil L. Contovounesios 2019-04-11 17:24:36 +01:00
parent bd6a19ccfd
commit 2b82c82970
1 changed files with 43 additions and 55 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

98
lisp/gnus/gnus-group.el
View file

@ -1320,7 +1320,7 @@ if it is a string, only list groups matching REGEXP."
gnus-group-listed-groups)
;; List living groups, according to order in `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)
params (gnus-info-params info)
unread (gnus-group-unread group))
@ -1389,39 +1389,35 @@ if it is a string, only list groups matching REGEXP."
;; List zombies and killed lists somewhat faster, which was
;; suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>. It does
;; this by ignoring the group format specification altogether.
(let (group)
(if (> (length groups) gnus-group-listing-limit)
(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))
(if (nthcdr gnus-group-listing-limit groups)
(dolist (group groups)
(when (gnus-group-prepare-logic
group
(or (not regexp)
(and (stringp regexp) (string-match regexp group))
(and (functionp regexp) (funcall regexp group))))
(gnus-group-insert-group-line
group level nil
(let ((active (gnus-active group)))
(if active
(if (zerop (cdr active))
0
(- (1+ (cdr active)) (car active)))
nil))
(gnus-method-simplify (gnus-find-method-for-group group))))))))
(cond ((not regexp))
((stringp regexp) (string-match-p regexp group))
((functionp regexp) (funcall regexp group))))
(add-text-properties
(point) (prog1 (1+ (point))
(insert " " mark " *: "
(gnus-group-decoded-name group)
"\n"))
(list 'gnus-group group
'gnus-unread t
'gnus-level level))))
(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 ()
"Update the current line in the group buffer."
@ -1527,7 +1523,7 @@ if it is a string, only list groups matching REGEXP."
(int-to-string (max 0 (- gnus-tmp-number-total number)))
"*"))
(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-zombie) ?Z)
(t ?K)))
@ -1546,7 +1542,7 @@ if it is a string, only list groups matching REGEXP."
(gnus-tmp-moderated
(if (and gnus-moderated-hashtb
(gethash gnus-tmp-group gnus-moderated-hashtb))
?m ? ))
?m ?\s))
(gnus-tmp-moderated-string
(if (eq gnus-tmp-moderated ?m) "(m)" ""))
(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."
(if (and (numberp number)
(zerop number)
(cdr (assq 'tick gnus-tmp-marked)))
?* ? ))
?* ?\s))
(gnus-tmp-summary-live
(if (and (not gnus-group-is-exiting-p)
(gnus-buffer-live-p (gnus-summary-buffer-name
gnus-tmp-group)))
?* ? ))
?* ?\s))
(gnus-tmp-process-marked
(if (member gnus-tmp-group gnus-group-marked)
gnus-process-mark ? ))
gnus-process-mark ?\s))
(buffer-read-only nil)
beg end
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."
(defun gnus-group-group-name ()
"Get the name of the newsgroup on the current line."
(let ((group (get-text-property (point-at-bol) 'gnus-group)))
(when group
(if (stringp group)
group
(symbol-name group)))))
(cond ((stringp group) group)
(group (symbol-name group)))))
(defun gnus-group-group-level ()
"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."
(defun gnus-group-new-mail (group)
(if (nnmail-new-mail-p (gnus-group-real-name group))
gnus-new-mail-mark
? ))
?\s))
(defun gnus-group-level (group)
"Return the estimated level of GROUP."
@ -1881,7 +1875,7 @@ If FIRST-TOO, the current line is also eligible as a target."
(if unmark
(progn
(setq gnus-group-marked (delete group gnus-group-marked))
(insert-char ? 1 t))
(insert-char ?\s 1 t))
(setq gnus-group-marked
(cons group (delete group gnus-group-marked)))
(insert-char gnus-process-mark 1 t)))
@ -2561,10 +2555,10 @@ If TEST-MARKED, the line must be marked."
(when group
(let ((start (point))
(active (and (or
;; some kind of group may be only there.
(gethash group gnus-active-hashtb)
;; all groups (but with exception) are there.
(gethash group gnus-newsrc-hashtb))
;; Some kind of group may be only there.
(gnus-active group)
;; All groups (but with exception) are there.
(gnus-group-entry group))
group)))
(beginning-of-line)
(cond
@ -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-read-active-file)))
;; Find all groups and sort them.
(let ((groups
(sort
(hash-table-keys gnus-active-hashtb)
'string<))
(buffer-read-only nil)
group)
(let ((buffer-read-only nil))
(erase-buffer)
(while groups
(setq group (pop groups))
(dolist (group (sort (hash-table-keys gnus-active-hashtb) #'string<))
(add-text-properties
(point) (prog1 (1+ (point))
(insert " *: "