generate gnus-topic-alist and gnus-topic-topology at startup

1 files changed, 106 insertions, 50 deletions

diff --git a/.emacs.d/init.el b/.emacs.d/init.el
index 87f22637..5d1b1041 100644
--- a/.emacs.d/init.el
+++ b/.emacs.d/init.el
@@ -2812,8 +2812,15 @@ mutt's review view, after exiting EDITOR."
 		     (cons name
 			   (spw/nm& (spw/nm| queries)
 				    (spw/nm~ never-process)))))
-	   (categorised (spw/nm| (mapcar #'cdr spw/browse-groups)
-				 (mapcar #'cdr process-groups)))
+	   (browse-groups
+	    (named-let recurse (accum (remaining spw/browse-groups))
+	      (cond ((null remaining) (nreverse accum))
+		    ((cl-every #'stringp (ensure-list (cdar remaining)))
+		     (recurse (cons (car remaining) accum) (cdr remaining)))
+		    (t (recurse accum (nconc (copy-sequence (cdar remaining))
+					     (cdr remaining)))))))
+	   (categorised (spw/nm| (mapcar #'cdr process-groups)
+				 (mapcar #'cdr browse-groups)))
 
 	   (process-groups
 	    `(;; Groups/lists where I don't know how or whether I want to
@@ -2828,13 +2835,13 @@ mutt's review view, after exiting EDITOR."
 	      ;; to each of these.
 	      ("Uncategorised feeds"
 	       ,(spw/nm& (spw/nm| spw/feed-sources) (spw/nm~ categorised)))
-	      . ,spw/browse-groups))
+	      . ,browse-groups))
 
 	   (groups
 	    (nconc
-	     (cl-loop for (name . queries) in browse-groups collect
-		      `(,(concat "Browse-" name)
-			(thread . t) (query . ,(spw/nm| queries)) (raw . t)))
+	     (cl-loop
+	      for (name . queries) in browse-groups collect
+	      `(,name (thread . t) (query . ,(spw/nm| queries)) (raw . t)))
 	     (cl-loop for (name . query) in process-groups collect
 		      `(,(concat "Process-" name)
 			(thread . nil) (query . ,query) (raw . t))))))
@@ -2843,50 +2850,99 @@ mutt's review view, after exiting EDITOR."
       (require 'gnus) (require 'nnselect)
       (unless (gnus-alive-p) (gnus-no-server))
       (with-current-buffer gnus-group-buffer
-	(save-excursion
-	  (cl-loop
-	   initially (goto-char (point-max)) for (name . alist) in groups
-	   for nname = (nnselect-add-prefix name)
-	   for specs = `((nnselect-function . gnus-search-run-query)
-			 (nnselect-args
-			  . ((search-query-spec . ,alist)
-			     (search-group-spec ("nnmaildir:fmail")))))
-	   ;; We're only really interested in recent mail for all these saved
-	   ;; searches: for older mail I do ephemeral searches.  Take
-	   ;; advantage of this to limit the number of results we're ever
-	   ;; asking Gnus to deal with.  An alternative to "not path:annex/**"
-	   ;; might be "tag:unread".
-	   do (cl-callf spw/nm& (cdr (assq 'query alist)) "not path:annex/**")
-	   if (gnus-group-entry nname) do
-	   (gnus-group-set-parameter nname 'nnselect-specs specs)
-	   ;; From `gnus-group-make-search-group' (though marked "temporary"?).
-	   else do (gnus-group-make-group name (list 'nnselect "nnselect")
-					  nil `((nnselect-specs . ,specs)
-						(nnselect-rescan . t)
-						(nnselect-artlist . nil)))
-	   ;; Manual recommends keeping mail groups on levels 1 and 2.
-	   ;; We have browse groups higher for `gnus-group-best-unread-group'.
-	   ;; Then `.' to jump to the first processing group, `,' to jump to
-	   ;; the first browse group.
-	   do (gnus-group-set-subscription
-	       nname (if (string-prefix-p "Browse-" name) 1 2)))
-	  (dolist (group '("nnmaildir+fmail:drafts" "nnmaildir+fmail:notes"))
-	    (gnus-group-set-subscription group 2))
-	  ;; Finally, minor group buffer setup.
-	  (gnus-group-sort-groups
-	   (lambda (info1 info2)
-	     (let ((g1 (gnus-group-real-name (gnus-info-group info1)))
-		   (g2 (gnus-group-real-name (gnus-info-group info2))))
-	       (cl-flet ((browsep (g) (string-prefix-p "Browse-" g))
-			 (processp (g) (string-prefix-p "Process-" g)))
-		 ;; Ensure we can't move Weekend->Weekday at end of group, and
-		 ;; similarly not from any browse group to a processing group.
-		 (or (string= g1 "Process-Weekday")
-		     (and (string= g1 "Process-Weekend")
-			  (not (string= g2 "Process-Weekday")))
-		     (and (processp g1) (not (processp g2)))
-		     (and (or (processp g1) (browsep g1))
-			  (not (or (processp g2) (browsep g2))))))))))))))
+	(gnus-topic-mode 0)
+	(cl-loop
+	 initially (goto-char (point-max)) for (name . alist) in groups
+	 for nname = (nnselect-add-prefix name)
+	 for specs = `((nnselect-function . gnus-search-run-query)
+		       (nnselect-args
+			. ((search-query-spec . ,alist)
+			   (search-group-spec ("nnmaildir:fmail")))))
+	 ;; We're only really interested in recent mail for all these saved
+	 ;; searches: for older mail I do ephemeral searches.  Take advantage
+	 ;; of this to limit the number of results we're ever asking Gnus to
+	 ;; read.  An alternative to "not path:annex/**" might be "tag:unread".
+	 do (cl-callf spw/nm& (cdr (assq 'query alist)) "not path:annex/**")
+	 if (gnus-group-entry nname) do
+	 (gnus-group-set-parameter nname 'nnselect-specs specs)
+	 ;; From `gnus-group-make-search-group' (though marked "temporary"?).
+	 else do (gnus-group-make-group name (list 'nnselect "nnselect")
+					nil `((nnselect-specs . ,specs)
+					      (nnselect-rescan . t)
+					      (nnselect-artlist . nil)))
+	 ;; Manual recommends keeping mail groups on levels 1 and 2.  We have
+	 ;; browse groups higher for `gnus-group-best-unread-group'.  Then `.'
+	 ;; to jump to the first processing group, `,' to jump to the first
+	 ;; browse group.
+	 do (gnus-group-set-subscription
+	     nname (if (string-prefix-p "Process-" name) 2 1)))
+	(dolist (group '("nnmaildir+fmail:drafts" "nnmaildir+fmail:notes"))
+	  (gnus-group-set-subscription group 2))
+
+	;; Finally, group buffer setup.  If we want to add groups other than
+	;; my nnselect groups to topics, we might have starting values
+	;; `spw/gnus-topic-topology' and `spw/gnus-topic-alist' in .gnus.el,
+	;; upon which this code would base its work.
+
+	(setq
+	 ;; It's not necessary to alter `gnus-variable-list' like this but it
+	 ;; might be less confusing not to see in .newsrc.eld values for these
+	 ;; variables which will always be ignored.
+	 gnus-variable-list
+	 (cl-set-difference gnus-variable-list
+			    '(gnus-topic-alist gnus-topic-topology))
+
+	 gnus-topic-alist
+	 (list (cl-list*
+		"Inboxes"
+		"nnselect:Process-Weekday"
+		"nnselect:Process-Weekend"
+		"nnselect:Process-Uncategorised other"
+		(cl-loop for (group . _) in spw/other-process-groups collect
+			 (nnselect-add-prefix (concat "Process-" group))))
+	       (list "Publications" "nnselect:Uncategorised feeds"))
+	 gnus-topic-topology
+	 (named-let recurse ((accum
+			      (copy-tree
+			       '((("Inboxes" visible)) ("Gnus" visible))))
+			     (remaining spw/browse-groups)
+			     topic)
+	   (cond ((null remaining) (nreverse accum))
+		 ((cl-every #'stringp (ensure-list (cdar remaining)))
+		  (push (nnselect-add-prefix (caar remaining))
+			(alist-get topic gnus-topic-alist nil nil #'string=))
+		  (recurse accum (cdr remaining) topic))
+		 (t (let* ((new-topic (caar remaining))
+			   (new-topology
+			    (recurse nil (cdar remaining) new-topic)))
+		      (recurse (cons (cons `(,new-topic visible) new-topology)
+				     accum)
+			       (cdr remaining)
+			       topic))))))
+	(rplacd (last gnus-topic-topology) (copy-tree '((("misc" visible)))))
+
+	(gnus-topic-mode 1)
+	(gnus-group-list-groups)
+	(gnus-topic-move-matching "^\\(?:nndraft:\\|nnmaildir\\)" "misc")
+	(gnus-group-sort-topic		; actually sorts in all topics
+	 (lambda (info1 info2)
+	   (let ((group1 (gnus-group-real-name (gnus-info-group info1)))
+		 (group2 (gnus-group-real-name (gnus-info-group info2))))
+	     ;; Ensure we can't move Weekend->Weekday at end of group, and
+	     ;; that otherwise they are first within their group
+	     (or (string= group1 "Process-Weekday")
+		 (and (string= group1 "Process-Weekend")
+		      (not (string= group2 "Process-Weekday")))
+		 (and (not (string-prefix-p "Process-Week" group2))
+		      (string< group1 group2)))))
+	 nil)
+	;; Any nnselect groups in the root group at this point must be old
+	;; searches I've dropped from .gnus.el.
+	(cl-loop for group in (cdr (assoc "Gnus" gnus-topic-alist #'string=))
+		 when (string-prefix-p "nnselect:" group) do
+		 (gnus-group-jump-to-group group) (gnus-topic-kill-group 1))
+	(gnus-group-list-groups)
+	(gnus-group-first-unread-group)))))
 (with-eval-after-load 'gnus-start
   (add-hook 'gnus-started-hook #'spw/sync-notmuch-nnselect-groups))