Re: IMAP Folder hierarchy -> Topics

[Vegard Vesterheim <vegard.vesterheim@uninett.no>]

On Mon, 24 Dec 2012 12:48:13 -0500 Ted Zlatanov <tzz@lifelogs.com> wrote:

> On Mon, 24 Dec 2012 18:45:42 +0100 Lars Ingebrigtsen <larsi@gnus.org> wrote: 
>
> LI> Vegard Vesterheim <vegard.vesterheim@uninett.no> writes:
>>> Right, so I guess the only feasible way to handle this is using
>>> topics. That is why I asked if someone had written some elisp to
>>> automatically generate the Topic structure from the IMAP Folder
>>> structure. 
>
> LI> I haven't heard of anybody doing so...
>
> If you were interested in pursuing this further, gnus-sync.el has code
> to create topics and move groups to them programmatically.

This is an old thread. With my limited elisp skills, I took a stab at
solving this problem.

Here is a function which seems to work, using dovecot as IMAP
server. Each IMAP server gets its own main topic, and the IMAP folder
hierarchy is used to create a corresponding topic structure. Setting the
variable gnus-browse-subscribe-newsgroup-method to
gnus-subscribe-create-topic, I can simply subscribe the folders in the
server buffer (pressing 'u') and have GNUS create the appropriate topic
structure automatically. Hopefully someone with better elisp knowledge
can verify and clean up this code, and add it to GNUS.

(defun gnus-subscribe-create-topic (group)
  "Subscribe new NEWSGROUP and create a topics structure reflecting the IMAP folder structure."
  (interactive)
  (let ((nextpos 0) ;; next position when parsing IMAP folder structure
        (server)
        (topic-name)
        (parent-topic "Gnus")
        (topicl))
    (string-match "\\(.*\\):" group)
    (setq server (match-string 1 group))
    (setq nextpos (match-end 0))
    (ignore-errors
      (progn 
        (gnus-topic-kill-group)))
    (unless (gnus-topic-find-topology server)
      (gnus-topic-create-topic server parent-topic nil))
    (setq parent-topic server)
    (setq topic-name server)
    ;; Loop throuch IMAP folder structure, creating subtopics as necessary
    (while (string-match "\\([^\\.]+\\)\\." group nextpos)
      (setq nextpos (match-end 1))
      (setq topic-name (concat parent-topic "." (match-string 1 group)))
      (ignore-errors
        (gnus-topic-create-topic topic-name parent-topic nil))
      (setq parent-topic topic-name)
      )
    (gnus-subscribe-newsgroup group)
    (setq topicl (assoc (gnus-group-topic group) gnus-topic-alist))
    (if topicl                          ; Delete group from existing topic
        (gnus-delete-first group topicl))
    ;; Add the group to the topic.
    (nconc (assoc topic-name gnus-topic-alist) (list group))
    (message "Subscribed group %s to topic %s" group topic-name)
))