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

Add new user option `gnus-topic-prepare-topic'

Browse source 
* doc/misc/gnus.texi (Topic Variables): Document it.
* lisp/gnus/gnus-topic.el (gnus-topic-prepare-topic): New user option.
(gnus-topic-prepare-topic): Use it.
This commit is contained in:
Lars Ingebrigtsen 2021-08-10 17:29:07 +02:00
parent d858a637c2
commit 877df4eb1c
3 changed files with 113 additions and 80 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
doc/misc/gnus.texi
View file

@ -4145,6 +4145,25 @@ The default is 2.
The @code{gnus-topic-display-empty-topics} says whether to display even
topics that have no unread articles in them. The default is @code{t}.
@vindex gnus-topic-display-predicate
If @code{gnus-topic-display-predicate} is non-@code{nil}, it should be
a function that says whether the topic is to be displayed or not.
The function will be called with one parameter (the name of the topic)
and should return non-@code{nil} is the topic is to be displayed.
For instance, if you don't even want to be reminded that work exists
outside of office hours, you can gather all the work-related groups
into a topic called @samp{"Work"}, and then say something like the
following:
@lisp
(setq gnus-topic-display-predicate
(lambda (name)
(or (not (equal name "Work"))
(< 090000
(string-to-number (format-time-string "%H%M%S"))
170000))))
@end lisp
@node Topic Sorting
@subsection Topic Sorting

4
etc/NEWS
View file

@ -1002,6 +1002,10 @@ String or list of strings specifying switches for Git log under VC.
** Gnus
+++
*** New user option 'gnus-topic-display-predicate'.
This can be used to inhibit the display of some topics completely.
+++
*** nnimap now supports the oauth2.el library.

170
lisp/gnus/gnus-topic.el
View file

@ -71,6 +71,14 @@ See Info node `(gnus)Formatting Variables'."
"If non-nil, display the topic lines even of topics that have no unread articles."
:type 'boolean)
(defcustom gnus-topic-display-predicate nil
"If non-nil, this should be a function to control the display of the topic.
The function is called with one parameter -- the topic name, and
should return non-nil if the topic is to be displayed."
:version "28.1"
:type '(choice (const :tag "Display all topics" nil)
function))
;; Internal variables.
(defvar gnus-topic-active-topology nil)
@ -487,18 +495,16 @@ If LOWEST is non-nil, list all newsgroups of level LOWEST or higher."
If SILENT, don't insert anything. Return the number of unread
articles in the topic and its subtopics."
(let* ((type (pop topicl))
(name (car type))
(entries-level (if gnus-group-listed-groups
gnus-level-killed
list-level))
(all (or predicate gnus-group-listed-groups
(cdr (assq 'visible
(gnus-topic-hierarchical-parameters
(car type))))))
(gnus-topic-hierarchical-parameters name)))))
(lowest (if gnus-group-listed-groups 0 lowest))
(entries (gnus-topic-find-groups
(car type) entries-level all lowest))
(all-groups (gnus-topic-find-groups
(car type) entries-level all lowest t))
(entries (gnus-topic-find-groups name entries-level all lowest))
(all-groups (gnus-topic-find-groups name entries-level all lowest t))
(visiblep (and (eq (nth 1 type) 'visible) (not silent)))
(gnus-group-indentation
(make-string (* gnus-topic-indent-level level) ? ))
@ -508,80 +514,84 @@ articles in the topic and its subtopics."
(point-max (point-max))
(unread 0)
info entry end active tick)
;; Insert any sub-topics.
(while topicl
(cl-incf unread
(gnus-topic-prepare-topic
(pop topicl) (1+ level) list-level predicate
(not visiblep) lowest regexp)))
(setq end (point))
(goto-char beg)
;; Insert all the groups that belong in this topic.
(while (setq entry (pop entries))
(when (if (stringp entry)
(gnus-group-prepare-logic
entry
(and
(or (not gnus-group-listed-groups)
(if (< list-level gnus-level-zombie) nil
(let ((entry-level
(if (member entry gnus-zombie-list)
gnus-level-zombie gnus-level-killed)))
(and (<= entry-level list-level)
(>= entry-level lowest)))))
(cond
((stringp regexp)
(string-match regexp entry))
((functionp regexp)
(funcall regexp entry))
((null regexp) t)
(t nil))))
(setq info (nth 1 entry))
(gnus-group-prepare-logic
(gnus-info-group info)
(and (or (not gnus-group-listed-groups)
(let ((entry-level (gnus-info-level info)))
(and (<= entry-level list-level)
(>= entry-level lowest))))
(or (not (functionp predicate))
(funcall predicate info))
(or (not (stringp regexp))
(string-match regexp (gnus-info-group info))))))
(when visiblep
(if (stringp entry)
;; Dead groups.
(gnus-group-insert-group-line
entry (if (member entry gnus-zombie-list)
gnus-level-zombie gnus-level-killed)
nil (- (1+ (cdr (setq active (gnus-active entry))))
(car active))
nil)
;; Living groups.
(when (setq info (nth 1 entry))
(gnus-group-insert-group-line
(gnus-info-group info)
(gnus-info-level info) (gnus-info-marks info)
(car entry) (gnus-info-method info)))))
(when (and (listp entry)
(numberp (car entry)))
(cl-incf unread (car entry)))
(when (listp entry)
(setq tick t))))
(goto-char beg)
;; Insert the topic line.
(when (and (not silent)
(or gnus-topic-display-empty-topics ;We want empty topics
(not (zerop unread)) ;Non-empty
tick ;Ticked articles
(/= point-max (point-max)))) ;Inactive groups
(gnus-topic-insert-topic-line
(car type) visiblep
(not (eq (nth 2 type) 'hidden))
level all-entries unread all-groups))
(gnus-topic-update-unreads (car type) unread)
(gnus-group--setup-tool-bar-update beg end)
(goto-char end)
unread))
(if (and gnus-topic-display-predicate
(not (funcall gnus-topic-display-predicate name)))
;; We're filtering out this topic.
0
;; Insert any sub-topics.
(while topicl
(cl-incf unread
(gnus-topic-prepare-topic
(pop topicl) (1+ level) list-level predicate
(not visiblep) lowest regexp)))
(setq end (point))
(goto-char beg)
;; Insert all the groups that belong in this topic.
(while (setq entry (pop entries))
(when (if (stringp entry)
(gnus-group-prepare-logic
entry
(and
(or (not gnus-group-listed-groups)
(if (< list-level gnus-level-zombie) nil
(let ((entry-level
(if (member entry gnus-zombie-list)
gnus-level-zombie gnus-level-killed)))
(and (<= entry-level list-level)
(>= entry-level lowest)))))
(cond
((stringp regexp)
(string-match regexp entry))
((functionp regexp)
(funcall regexp entry))
((null regexp) t)
(t nil))))
(setq info (nth 1 entry))
(gnus-group-prepare-logic
(gnus-info-group info)
(and (or (not gnus-group-listed-groups)
(let ((entry-level (gnus-info-level info)))
(and (<= entry-level list-level)
(>= entry-level lowest))))
(or (not (functionp predicate))
(funcall predicate info))
(or (not (stringp regexp))
(string-match regexp (gnus-info-group info))))))
(when visiblep
(if (stringp entry)
;; Dead groups.
(gnus-group-insert-group-line
entry (if (member entry gnus-zombie-list)
gnus-level-zombie gnus-level-killed)
nil (- (1+ (cdr (setq active (gnus-active entry))))
(car active))
nil)
;; Living groups.
(when (setq info (nth 1 entry))
(gnus-group-insert-group-line
(gnus-info-group info)
(gnus-info-level info) (gnus-info-marks info)
(car entry) (gnus-info-method info)))))
(when (and (listp entry)
(numberp (car entry)))
(cl-incf unread (car entry)))
(when (listp entry)
(setq tick t))))
(goto-char beg)
;; Insert the topic line.
(when (and (not silent)
(or gnus-topic-display-empty-topics ;We want empty topics
(not (zerop unread)) ;Non-empty
tick ;Ticked articles
(/= point-max (point-max)))) ;Inactive groups
(gnus-topic-insert-topic-line
name visiblep
(not (eq (nth 2 type) 'hidden))
level all-entries unread all-groups))
(gnus-topic-update-unreads name unread)
(gnus-group--setup-tool-bar-update beg end)
(goto-char end)
unread)))
(defun gnus-topic-remove-topic (&optional insert total-remove _hide in-level)
"Remove the current topic."