Org Mode: Merge top-level items in an item list

| org

I usually summarize Mastodon links, move them to my Emacs News Org file, and then categorize them. Today I accidentically categorized the links while they were still in my Mastodon buffer, so I had two lists with categories. I wanted to write some Emacs Lisp to merge sublists based on the top-level items. I could sort the list alphabetically with C-c ^ (org-sort) and then delete the redundant top-level item lines, but it's fun to tinker with Emacs Lisp.

Example input:

  • Topic A:
    • Item 1
    • Item 2
      • Item 2.1
  • Topic B:
    • Item 3
  • Topic A:
    • Item 4
      • Item 4.1

Example output:

  • Topic B:
    • Item 3
  • Topic A:
    • Item 1
    • Item 2
      • Item 2.1
    • Item 4
      • Item 4.1

The sorting doesn't particularly matter to me, but I want the things under Topic A to be combined. Someday it might be nice to recursively merge other entries (ex: if there's another "Topic A: - Item 2" subitem like "Item 2.2"), but I don't need that yet.

Anyway, we can parse the list with org-list-to-lisp (which can even delete the original list) and recreate it with org-list-to-org, so then it's a matter of transforming the data structure.

(defun my-org-merge-list-entries-at-point ()
  "Merge entries in a nested Org Mode list at point that have the same top-level item text."
  (interactive)
  (save-excursion
    (let* ((list-indentation (save-excursion
                               (goto-char (caar (org-list-struct)))
                               (current-indentation)))
           (list-struct (org-list-to-lisp t))
           (merged-list (my-org-merge-list-entries list-struct)))
      (insert (org-ascii--indent-string (org-list-to-org merged-list) list-indentation)
              "\n"))))

(defun my-org-merge-list-entries (list-struct)
  "Merge an Org list based on its top-level headings"
  (cons (car list-struct)
        (mapcar
         (lambda (g)
           (list
            (car g)
            (let ((list-type (car (car (cdr (car (cdr g))))))
                  (entries (seq-mapcat #'cdar (mapcar #'cdr (cdr g)))))
              (apply #'append (list list-type) entries nil))))
         (seq-group-by #'car (cdr list-struct)))))

A couple of test cases:

(ert-deftest my-org-merge-list-entries ()
  (should
   (equal
    (my-org-merge-list-entries
     '(unordered ("Topic B:" (unordered ("Item 3")))))
    '(unordered ("Topic B:" (unordered ("Item 3"))))))
  (should
   (equal
    (my-org-merge-list-entries
     '(unordered ("Topic B:" (unordered ("Item 3")))
                 ("Topic A:"
                  (unordered ("Item 1")
                             ("Item 2"
                              (unordered ("Item 2.1")))))
                 ("Topic A:"
                  (unordered
                   ("Item 4" (unordered ("Item 4.1")))))))
    '(unordered
      ("Topic B:" (unordered ("Item 3")))
      ("Topic A:"
       (unordered ("Item 1")
                  ("Item 2" (unordered ("Item 2.1")))
                  ("Item 4" (unordered ("Item 4.1")))))))))
View org source for this post
You can comment with Disqus or you can e-mail me at sacha@sachachua.com.