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
- Item 4
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")))))))))
Updating my custom links to also export to Org
Because org-list-to-org
uses the Org conversion
process, I need to make sure that my custom link
functions also export to Org as a format. For
example, in Emacs News, I use a package: link to
make it easy to link to packages in both Emacs and
in exported HTML. When I first ran my code, the
links got replaced with their URLs, which isn't
what I wanted. Turned out that I needed to add a
case handling exporting to org
format, like
this:
(defun my-org-package-export (link description format &optional arg) (let* ((package-info (car (assoc-default (intern link) package-archive-contents))) (package-source (and package-info (package-desc-archive package-info))) (path (format (cond ((null package-source) link) ((string= package-source "gnu") "https://elpa.gnu.org/packages/%s.html") ((string= package-source "melpa") "https://melpa.org/#/%s") ((string= package-source "nongnu") "https://elpa.nongnu.org/nongnu/%s.html") (t (error 'unknown-source))) link)) (desc (or description link))) (if package-source (cond ((eq format '11ty) (format "<a target=\"_blank\" href=\"%s\">%s</a>" path desc)) ((eq format 'html) (format "<a target=\"_blank\" href=\"%s\">%s</a>" path desc)) ((eq format 'wp) (format "<a target=\"_blank\" href=\"%s\">%s</a>" path desc)) ((eq format 'latex) (format "\\href{%s}{%s}" path desc)) ((eq format 'texinfo) (format "@uref{%s,%s}" path desc)) ((eq format 'ascii) (format "%s <%s>" desc path)) ((eq format 'org) (org-link-make-string (concat "package:" link) description)) ;; added this line (t path)) desc)))