auto-updated meaningful anchors and TOC

It's very important in HTML (#25) to have meaningful anchors generated from heading titles (like github does). Here is some code to automatically add and update such anchors, if the file has #+options: anchor:t

;; Meaningful # anchors for headings

(defun va/org-add-headline-anchor (pom overwrite)
  "Add a meaningful anchor to one headline (entry at point-or-marker POM).
If overwrite is not null and not 'maybe then overwrite existing CUSTOM_IDs."
  (org-with-point-at pom
    (let ((x (cadr (org-element-headline-parser (buffer-end 1)))))
      (if (or (and overwrite (not (eq overwrite 'maybe)))
              (not (plist-get x :CUSTOM_ID)))
          (let ((title (plist-get x :raw-value)))
            (setq title (replace-regexp-in-string "\\W+" "-" (downcase title)))
            (setq title (replace-regexp-in-string "^-" "" title))
            (setq title (replace-regexp-in-string "-$" "" title))
            (org-entry-put pom "CUSTOM_ID" title)
            (org-id-add-location title (buffer-file-name (buffer-base-buffer))))))))

(defun va/org-add-headline-anchors-maybe ()
  (require 'ox)
  "Read in-buffer #+OPTIONS: anchor:* and if set, add anchors to all headlines."
  (let ((overwrite (plist-get (org-export--get-inbuffer-options) :auto-anchor)))
    (when overwrite
      (org-map-entries (lambda () (va/org-add-headline-anchor (point) overwrite))))))

(defun va/org-before-save-hook-add-headline-anchors ()
  "Hook to add meaningful anchors upon save."
  (if (and (eq major-mode 'org-mode)
           (eq buffer-read-only nil))
      (va/org-add-headline-anchors-maybe)))

(defun va/org-add-headline-anchors ()
  "Add meaningful anchors to all headlines, overwrite existing CUSTOM_ID, add #+OPTION: anchor:t."
  (interactive)
  (when (eq major-mode 'org-mode)
    (require 'ox)
    (save-excursion
      (beginning-of-buffer)
      (unless (re-search-forward "^#\\+options:" nil 'noerror)
        (beginning-of-buffer)
        (org-export-insert-default-template 'default))
      (unless (plist-get (org-export--get-inbuffer-options) :auto-anchor)
        ;; force anchor:t
        (beginning-of-buffer)
        (re-search-forward "^\\(#\\+options:.*anchor\\):\\(\\w+\\)")
        (replace-match "\\1:t" 'fixedcase))
      (va/org-add-headline-anchors-maybe))))

;;(remove-hook 'before-save-hook 'va/org-before-save-hook-add-ids-to-headlines)
(add-hook 'before-save-hook 'va/org-before-save-hook-add-headline-anchors)

I bind it like this:

(add-hook 'org-mode-hook
  (defun va/org-mode-hook ()
    (local-set-key (kbd "C-c # s") 'org-update-statistics-cookies)
    (local-set-key (kbd "C-c # a") 'va/org-add-headline-anchors)
    (local-set-key (kbd "C-c # t") 'va/org-toc-insert)))

I use a module to make TOC on top, and wrote some functions to control its update automatically

;;;;;;;;;;;;;;;;;;;; Generate TOC on top, useful for github preview
;; https://github.com/alphapapa/org-make-toc

;; https://github.com/alphapapa/org-make-toc/issues/14
(require 'org-make-toc)
(remove-hook 'org-mode-hook 'org-make-toc-mode)
(remove-hook 'before-save-hook 'org-make-toc)
(add-hook 'before-save-hook 'va/org-make-toc)

(defun va/org-make-toc ()
  "Make or update table of contents in current buffer."
  (interactive)
  (when (eq major-mode 'org-mode)
    (save-excursion
      (goto-char (point-min))
      (cl-loop for pos = (org-make-toc--next-toc-position)
               while pos
               do (progn
                    (goto-char pos)
                    (org-make-toc--update-toc-at-point))))))

(defun va/org-toc-insert ()
  "Make TOC at current position. org-make-toc-insert asks too many questions"
  (interactive)
  (unless (org-find-exact-headline-in-buffer "Table of Contents")
    (org-first-headline-recenter)
    (beginning-of-line)
    (insert "* Table of Contents                                 :TOC:noexport:
:PROPERTIES:
:TOC:      :include all
:END:

:CONTENTS:

:END:

")))

johanwk / elot

auto-updated meaningful anchors and TOC #26