Add a generate custom ids function for headings

From amitp.blogspot.com.

1 files changed, 36 insertions, 0 deletions

@@ -181,6 +181,42 @@ appropriate.  In tables, insert a new row or end the table."
     (let ((current-prefix-arg 4))
       (call-interactively #'unpackaged/org-fix-blank-lines))))
 
+
+;;; Generate custom IDs:
+;; https://amitp.blogspot.com/2021/04/automatically-generate-ids-for-emacs.html
+
+(defun acdw-org/generate-custom-ids ()
+  "Generate CUSTOM_ID for any headings that are missing one."
+  (let ((existing-ids (org-map-entries (lambda ()
+                                         (org-entry-get nil "CUSTOM_ID")))))
+    (org-map-entries
+     (lambda ()
+       (let* ((custom-id (org-entry-get nil "CUSTOM_ID"))
+              (heading (org-heading-components))
+              (level (nth 0 heading))
+              (todo (nth 2 heading))
+              (headline (nth 4 heading))
+              (slug (acdw-org/title-to-filename headline))
+              (duplicate-id (member slug existing-ids)))
+         (when (and (not custom-id)
+                    (< level 4)
+                    (not todo)
+                    (not duplicate-id))
+           (message "Adding entry '%s' to '%s'" slug headline)
+           (org-entry-put nil "CUSTOM_ID" slug)))))))
+
+(defun acdw-org/title-to-filename (title)
+  "Convert TITLE to a reasonable filename."
+  ;; Based on the slug logic in `org-roam', but `org-roam' also uses a
+  ;; timestamp, and I only use the slug.
+  (setq title (s-downcase title))
+  (setq title (s-replace-regexp "[^a-zA-Z0-9]+" "-" title))
+  (setq title (s-replace-regexp "-+" "-" title))
+  (setq title (s-replace-regexp "^-" "" title))
+  (setq title (s-replace-regexp "-$" "" title))
+  title)
+
+
 ;;; ADVICE
 
 ;; Correct `org-delete-backward-char' to use `backward-delete-char-untabify'