Skip to content

Instantly share code, notes, and snippets.

What would you like to do?
My WIP Org-roam publish setup
(let ((zk-prj
:components ("zk-notes" "zk-static")))
:filter-parse-tree my-org-publish-attachment-filter
:base-directory "~/Documents/ZK"
:base-extension "org"
:with-toc nil
:with-attachments t
:html-doctype "html5"
:html-html5-fancy t
:auto-sitemap t
:publishing-directory "~/tmp"
:publishing-function org-html-publish-to-html))
:base-directory "~/Documents/ZK"
:base-extension "png"
:publishing-directory "~/tmp"
:publishing-function org-publish-attachment)))
(setq org-publish-project-alist (list zk-prj zk-notes zk-static)))
(defun my-drop-prefix (prefix string)
"Removes PREFIX from a the beginning of STRING.
If the prefix doesn't match, `error' is called."
(if (string= (substring string 0 (length prefix)) prefix)
(substring string (length prefix))
(error "%S is not a prefix of %S" prefix string)))
(defun my-org-publish-attachment-relative (plist filepath pub-dir)
"Like `org-publish-attachment', but keep the attachment's relative path."
(when (file-name-absolute-p filepath)
;; is absolute path, make relative again
(setq filepath
(my-drop-prefix default-directory (expand-file-name filepath))))
(let* ((path (file-name-directory filepath))
(pub-dir-deep (concat (file-name-as-directory pub-dir) path)))
(org-publish-attachment plist filepath pub-dir-deep)))
(defun my-org-attach-file-dir-of (element)
"Helper: return the attachment directory of a provided Org Element."
(let ((pos (org-element-property :begin element)))
(save-excursion (goto-char pos) (org-attach-dir)))))
(defun my-org-publish-attachment-filter (tree backend plist)
"Tree filter to scan for attachments and publish them in the
same relative directory they come from. Returns the unchanged
To be used as a :filter-parse-tree in the
(let ((pub-dir (plist-get plist :publishing-directory)))
(org-element-map tree 'headline
(lambda (hl)
(and (member "ATTACH" (org-element-property :tags hl))
(let* ((dir (my-org-attach-file-dir-of hl))
(files (org-attach-file-list dir)))
(dolist (file files)
plist (concat dir file) pub-dir))))))
(org-element-map tree 'link
(lambda (link)
(when (string= "attachment" (org-element-property :type link))
(let* ((dir (my-org-attach-file-dir-of link))
(file (org-element-property :path link)))
(org-element-put-property link :type "file")
(org-element-put-property link :path (concat dir file)))))))
(defvar my-attach-link nil
"The attachment link target currently in scope, nil when none.")
(defun my-ox-html-attach-headline (old-func headline &rest args)
"Set `my-attach-link' to the attachment target location for the
scope of `org-html-headline'.
Intended as advice on `org-html-headline'."
(if (member "ATTACH" (org-element-property :tags headline))
(let* ((dir (my-org-attach-file-dir-of headline))
(files (org-attach-file-list dir))
(my-attach-link (cond ((cdr files) dir)
((concat dir (car files))))))
(apply old-func headline args))
(apply old-func headline args)))
(advice-add 'org-html-headline :around #'my-ox-html-attach-headline)
(defun my-make-link (dest text)
"Make an Org link element from a destination"
(save-excursion (insert (org-link-make-string dest text)))
(defun my-ox-html-attach-tag (arglist)
"Replace an ATTACH tag string with an HTML link.
Intended as advice on `org-html--tags'.
The link is to be setup in dynamic variable `my-attach-link' by
the `my-ox-html-attach-headline' advice."
(let ((tags (car arglist))
(info (cadr arglist)))
(mapcar (lambda (tag)
(if (string= tag "ATTACH")
(org-html-link (my-make-link my-attach-link tag)
(cons '(:html-inline-image-rules nil) info))
(advice-add 'org-html--tags :filter-args #'my-ox-html-attach-tag)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment