emacs lisp script to turn org-roam notes into blog posts
with acceptance tests
This commit is contained in:
Firehose Bot
@@ -0,0 +1,188 @@
|
||||
;;; roam-export-blog-test.el --- ERT tests for roam-export-blog -*- lexical-binding: t; -*-
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Run with:
|
||||
;; emacs --batch -Q -l org -l ox-md -l scripts/roam-export-blog.el \
|
||||
;; -l scripts/roam-export-blog-test.el -f ert-run-tests-batch-and-exit
|
||||
;;
|
||||
;; Tests use a fixture vault under scripts/test-fixtures/vault and write
|
||||
;; output into throw-away firehose repo skeletons under /tmp.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'ert)
|
||||
(require 'roam-export-blog)
|
||||
|
||||
(defconst reb-test-dir
|
||||
(directory-file-name (file-name-directory (or load-file-name default-directory))))
|
||||
|
||||
(defconst reb-test-repo-root (expand-file-name ".." reb-test-dir))
|
||||
|
||||
(defconst reb-test-vault (expand-file-name "test-fixtures/vault" reb-test-dir))
|
||||
|
||||
(defun reb-test--file (name)
|
||||
"Path to fixture file NAME in the test vault."
|
||||
(expand-file-name name reb-test-vault))
|
||||
|
||||
(defun reb-test--new-root ()
|
||||
"Create a throw-away firehose repo skeleton and return its root."
|
||||
(let ((root (make-temp-file "/tmp/reb-root-" t)))
|
||||
(make-directory (expand-file-name "app/priv/blog/engineering" root) t)
|
||||
(make-directory (expand-file-name "app/priv/static/images/blog" root) t)
|
||||
root))
|
||||
|
||||
(defun reb-test--setup-org-id ()
|
||||
"Point org-id at a writable temp locations file and index the fixture vault."
|
||||
(setq org-id-locations-file (make-temp-file "/tmp/reb-orgid-"))
|
||||
(setq org-id-locations nil)
|
||||
(org-id-update-id-locations
|
||||
(mapcar #'reb-test--file '("note.org" "jev.org" "laya.org" "notitle.org")) t))
|
||||
|
||||
(defmacro reb-test--with-export (root &rest body)
|
||||
"Run BODY with a fresh repo ROOT and a pinned export date."
|
||||
(declare (indent 1))
|
||||
`(progn
|
||||
(reb-test--setup-org-id)
|
||||
(let ((roam-export-blog-firehose-root ,root)
|
||||
(roam-export-blog--current-date '("2026" "10" "08")))
|
||||
,@body)))
|
||||
|
||||
;;; Pure helpers
|
||||
|
||||
(ert-deftest roam-export-blog/slug ()
|
||||
(should (equal "will-it-blend" (roam-export-blog--slug "Will It Blend")))
|
||||
(should (equal "improve-diagnostic-in-the-tdd-cycle"
|
||||
(roam-export-blog--slug "Improve Diagnostic in the TDD cycle")))
|
||||
(should (equal "v0-2-0-rss-subscribe-links"
|
||||
(roam-export-blog--slug "v0.2.0 — RSS Subscribe Links"))))
|
||||
|
||||
(ert-deftest roam-export-blog/truncate-description-short ()
|
||||
(should (equal "Short paragraph."
|
||||
(roam-export-blog--truncate-description "Short paragraph."))))
|
||||
|
||||
(ert-deftest roam-export-blog/truncate-description-at-word-boundary ()
|
||||
(let* ((words (make-list 60 "word"))
|
||||
(text (string-join words " "))
|
||||
(result (roam-export-blog--truncate-description text)))
|
||||
(should (<= (length result) (+ roam-export-blog-description-length 1)))
|
||||
(should (string-suffix-p "…" result))
|
||||
(should-not (string-suffix-p " " result))
|
||||
(should (string-prefix-p "word word" result))))
|
||||
|
||||
;;; Roam ref resolution
|
||||
|
||||
(ert-deftest roam-export-blog/roam-refs ()
|
||||
(reb-test--setup-org-id)
|
||||
(should (equal "https://example.com/jev"
|
||||
(roam-export-blog--roam-refs (reb-test--file "jev.org"))))
|
||||
(should (null (roam-export-blog--roam-refs (reb-test--file "laya.org")))))
|
||||
|
||||
;;; Aborts
|
||||
|
||||
(ert-deftest roam-export-blog/no-title-aborts ()
|
||||
(let ((root (reb-test--new-root)))
|
||||
(reb-test--with-export root
|
||||
(should-error (roam-export-blog--export-file (reb-test--file "notitle.org"))
|
||||
:type 'user-error)
|
||||
;; Aborting must not have written any posts.
|
||||
(should (null
|
||||
(directory-files-recursively
|
||||
(expand-file-name "app/priv/blog" root) "\\.md$"))))))
|
||||
|
||||
(ert-deftest roam-export-blog/filename-collision-aborts ()
|
||||
(let ((root (reb-test--new-root)))
|
||||
(reb-test--with-export root
|
||||
;; Pre-create the exact target file.
|
||||
(make-directory
|
||||
(expand-file-name "app/priv/blog/engineering/2026" root) t)
|
||||
(write-region "" nil
|
||||
(expand-file-name
|
||||
"app/priv/blog/engineering/2026/10-08-will-it-blend.md" root))
|
||||
(should-error (roam-export-blog--export-file (reb-test--file "note.org"))
|
||||
:type 'user-error)
|
||||
;; Aborting must not have copied any images (no side effects).
|
||||
(should (null
|
||||
(directory-files-recursively
|
||||
(expand-file-name "app/priv/static/images/blog" root)
|
||||
"."))))))
|
||||
|
||||
;;; Full export
|
||||
|
||||
(ert-deftest roam-export-blog/end-to-end ()
|
||||
(let ((root (reb-test--new-root))
|
||||
result path body)
|
||||
(reb-test--with-export root
|
||||
(setq result (roam-export-blog--export-file (reb-test--file "note.org"))))
|
||||
(setq path (car result))
|
||||
;; Written at the agreed path.
|
||||
(should (equal (expand-file-name
|
||||
"app/priv/blog/engineering/2026/10-08-will-it-blend.md" root)
|
||||
path))
|
||||
(should (file-exists-p path))
|
||||
;; Image attachment copied into static images with unchanged content.
|
||||
(let ((image (expand-file-name "app/priv/static/images/blog/2026/will-it-blend.svg" root)))
|
||||
(should (file-exists-p image))
|
||||
(should (equal (with-temp-buffer (insert-file-contents image) (buffer-string))
|
||||
(with-temp-buffer
|
||||
(insert-file-contents (reb-test--file ".attach/00/000000-0000-0000-0000-000000000001/will-it-blend.svg"))
|
||||
(buffer-string)))))
|
||||
(setq body (with-temp-buffer (insert-file-contents path) (buffer-string)))
|
||||
;; Frontmatter.
|
||||
(should (string-match-p "title: \"Will It Blend\"" body))
|
||||
(should (string-match-p "author: \"Willem van den Ende\"" body))
|
||||
(should (string-match-p "tags: ~w()" body))
|
||||
(should (string-match-p
|
||||
"description: \"Will it Blend was a series of videos promoting a blender brand.\""
|
||||
body))
|
||||
(should (string-match-p "image: \"/images/blog/2026/will-it-blend.svg\"" body))
|
||||
(should (string-match-p "published: false" body))
|
||||
;; Markdown body.
|
||||
(should (string-match-p "Will it Blend was a series of videos promoting a blender brand." body))
|
||||
(should (string-match-p
|
||||
(regexp-quote "")
|
||||
body))
|
||||
(should (string-match-p (regexp-quote "[Jev](https://example.com/jev)") body))
|
||||
(should (string-match-p "Laya popped up" body))
|
||||
(should (string-match-p "a missing note vanished" body))
|
||||
(should (string-match-p "TODO source needed (LinkedIn)" body))
|
||||
(should (string-match-p "^## I learnt this from Julia$" body))
|
||||
(should (string-match-p "^> A quoted comment.$" body))
|
||||
(should (string-match-p "^```elixir$" body))
|
||||
(should (string-match-p (regexp-quote "**bold**") body))
|
||||
;; Org syntax must not leak into the markdown.
|
||||
(should-not (string-match-p "#\\+begin" body))
|
||||
(should-not (string-match-p "attachment:" body))
|
||||
(should-not (string-match-p "id:0000" body))
|
||||
(should-not (string-match-p "A private comment that must not be exported" body))
|
||||
;; Warnings: dangling ref, ref without ROAM_REFS, ignored non-image
|
||||
;; attachment.
|
||||
(should (= 3 (length (cdr result))))
|
||||
(should (cl-some (lambda (w) (string-match-p "00000000-0000-0000-0000-000000009999" w))
|
||||
(cdr result)))
|
||||
(should (cl-some (lambda (w) (string-match-p "00000000-0000-0000-0000-000000000003" w))
|
||||
(cdr result)))
|
||||
(should (cl-some (lambda (w) (string-match-p "attached-notes.txt" w))
|
||||
(cdr result)))))
|
||||
|
||||
(ert-deftest roam-export-blog/description-truncated-in-frontmatter ()
|
||||
(let* ((root (reb-test--new-root))
|
||||
(vault (make-temp-file "/tmp/reb-vault-" t))
|
||||
(note (expand-file-name "longpar.org" vault))
|
||||
(long-text (string-join (make-list 50 "lorem" ) " ")))
|
||||
(with-temp-file note
|
||||
(insert ":PROPERTIES:\n:ID: 00000000-0000-0000-0000-000000000005\n:END:\n"
|
||||
"#+title: Long Paragraph\n\n" long-text "\n"))
|
||||
(reb-test--with-export root
|
||||
(let ((result (roam-export-blog--export-file note)))
|
||||
(let ((body (with-temp-buffer
|
||||
(insert-file-contents (car result))
|
||||
(buffer-string))))
|
||||
(string-match "description: \"\\([^\"]*\\)\"" body)
|
||||
(let ((desc (match-string 1 body)))
|
||||
(should (<= (length desc) (+ roam-export-blog-description-length 1)))
|
||||
(should (string-suffix-p "…" desc))
|
||||
(should (string-prefix-p "lorem lorem" desc))))))))
|
||||
|
||||
(provide 'roam-export-blog-test)
|
||||
;;; roam-export-blog-test.el ends here
|
||||
@@ -0,0 +1,453 @@
|
||||
;;; roam-export-blog.el --- Export an org-roam note as a firehose blog post -*- lexical-binding: t; -*-
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; M-x roam-export-blog, run from an org-roam note, converts the note to
|
||||
;; markdown and writes it directly into the firehose repo as a draft post:
|
||||
;;
|
||||
;; <repo>/app/priv/blog/engineering/<YYYY>/<MM>-<DD>-<slug>.md
|
||||
;;
|
||||
;; with `published: false' frontmatter, so the repo's git diff acts as the
|
||||
;; review mechanism.
|
||||
;;
|
||||
;; What happens during export:
|
||||
;;
|
||||
;; - `[[id:<uuid>][text]]' roam refs are resolved via org-id. When the
|
||||
;; target note carries a :ROAM_REFS: property, the link becomes a
|
||||
;; markdown link to the first URL; otherwise it degrades to plain text.
|
||||
;; - `[[attachment:...]]' links are resolved via the org-attach ID scheme
|
||||
;; (.attach/<xx>/<rest-of-id>/<file>). Images are copied into
|
||||
;; app/priv/static/images/blog/<YYYY>/ and referenced with the
|
||||
;; /images/blog/... web path. Non-image attachments are ignored.
|
||||
;; - Org syntax is converted to markdown with a derived ox-md backend
|
||||
;; (fenced code blocks with language, H2 top-level headings, no TOC).
|
||||
;; - Dropped refs, ignored attachments and unhandled constructs are
|
||||
;; reported as warnings.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'org)
|
||||
(require 'ox-md)
|
||||
(require 'org-id)
|
||||
(require 'cl-lib)
|
||||
|
||||
(defgroup roam-export-blog nil
|
||||
"Export org-roam notes as firehose blog posts."
|
||||
:group 'org)
|
||||
|
||||
(defcustom roam-export-blog-firehose-root "/Users/willem/dev/elixir/firehose"
|
||||
"Path to the firehose repository root."
|
||||
:type 'directory)
|
||||
|
||||
(defcustom roam-export-blog-author "Willem van den Ende"
|
||||
"Author name written into generated frontmatter."
|
||||
:type 'string)
|
||||
|
||||
(defcustom roam-export-blog-description-length 200
|
||||
"Maximum length of the generated description (before the ellipsis)."
|
||||
:type 'integer)
|
||||
|
||||
(defcustom roam-export-blog-image-extensions
|
||||
'("svg" "png" "jpg" "jpeg" "gif" "webp" "avif")
|
||||
"Attachment extensions that count as images."
|
||||
:type '(repeat string))
|
||||
|
||||
(defvar roam-export-blog--current-date nil
|
||||
"Override for the export date during tests, as a list (YEAR MONTH DAY).")
|
||||
|
||||
;;; Derived markdown backend
|
||||
|
||||
(defun roam-export-blog-md-src-block (src-block _contents info)
|
||||
"Transcode SRC-BLOCK into a fenced markdown code block with language."
|
||||
(let ((lang (org-element-property :language src-block))
|
||||
(value (org-export-format-code-default src-block info)))
|
||||
(concat "```" (or lang "") "\n" value "```")))
|
||||
|
||||
(defun roam-export-blog-md-link (link desc info)
|
||||
"Transcode LINK; file links to images become markdown images.
|
||||
|
||||
Everything else is delegated to `org-md-link'."
|
||||
(let* ((type (org-element-property :type link))
|
||||
(path (org-element-property :path link)))
|
||||
(if (and (equal type "file") (roam-export-blog--image-p path))
|
||||
(format ""
|
||||
(or (and desc (string-trim (substring-no-properties desc)))
|
||||
(file-name-base path))
|
||||
path)
|
||||
(org-md-link link desc info))))
|
||||
|
||||
(org-export-define-derived-backend 'firehose-md 'md
|
||||
:translate-alist '((src-block . roam-export-blog-md-src-block)
|
||||
(link . roam-export-blog-md-link)))
|
||||
|
||||
(defconst roam-export-blog--export-options
|
||||
'(:with-toc nil :section-numbers nil :md-toplevel-hlevel 2))
|
||||
|
||||
;;; Small helpers
|
||||
|
||||
(defun roam-export-blog--slug (title)
|
||||
"Derive a filename slug from TITLE."
|
||||
(let* ((lower (downcase title))
|
||||
(slugged (replace-regexp-in-string "[^a-z0-9]+" "-" lower)))
|
||||
(replace-regexp-in-string "\\`-+\\|-+\\'" "" slugged)))
|
||||
|
||||
(defun roam-export-blog--date-parts ()
|
||||
"Export date as a list of strings (YEAR MONTH DAY)."
|
||||
(or roam-export-blog--current-date
|
||||
(list (format-time-string "%Y")
|
||||
(format-time-string "%m")
|
||||
(format-time-string "%d"))))
|
||||
|
||||
(defun roam-export-blog--escape-elixir-string (text)
|
||||
"Escape TEXT for embedding in an Elixir double-quoted string."
|
||||
(replace-regexp-in-string
|
||||
"\"" "\\\\\""
|
||||
(replace-regexp-in-string "\\\\" "\\\\\\\\" text)))
|
||||
|
||||
(defun roam-export-blog--truncate-description (text)
|
||||
"Truncate TEXT to about `roam-export-blog-description-length' characters."
|
||||
(let ((max roam-export-blog-description-length))
|
||||
(if (<= (length text) max)
|
||||
text
|
||||
(let ((cut (cl-position ?\s (substring text 0 max) :from-end t)))
|
||||
(concat (if cut (substring text 0 cut) (substring text 0 max))
|
||||
"…")))))
|
||||
|
||||
(defun roam-export-blog--plain-text (element)
|
||||
"Return a plain-text approximation of org ELEMENT."
|
||||
(cond
|
||||
((stringp element) element)
|
||||
((memq (org-element-type element) '(code verbatim inline-src-block))
|
||||
(or (org-element-property :value element) ""))
|
||||
((eq (org-element-type element) 'entity)
|
||||
(or (org-element-property :utf8 element) ""))
|
||||
(t (mapconcat #'roam-export-blog--plain-text (org-element-contents element) ""))))
|
||||
|
||||
;;; Reading the note
|
||||
|
||||
(defun roam-export-blog--title (buffer)
|
||||
"Return the #+TITLE: keyword value in BUFFER, or nil."
|
||||
(with-current-buffer buffer
|
||||
(cadr (assoc "TITLE" (org-collect-keywords '("TITLE"))))))
|
||||
|
||||
(defun roam-export-blog--first-paragraph-text (buffer)
|
||||
"Return the plain text of the first paragraph in BUFFER."
|
||||
(with-current-buffer buffer
|
||||
(let ((para (org-element-map (org-element-parse-buffer) 'paragraph
|
||||
#'identity nil t)))
|
||||
(when para
|
||||
(replace-regexp-in-string
|
||||
"[ \t\n]+" " "
|
||||
(string-trim
|
||||
(substring-no-properties (roam-export-blog--plain-text para))))))))
|
||||
|
||||
(defun roam-export-blog--roam-refs (file)
|
||||
"Return the first :ROAM_REFS: URL of the note in FILE, or nil."
|
||||
(with-current-buffer (find-file-noselect file)
|
||||
(org-with-wide-buffer
|
||||
(goto-char (point-min))
|
||||
(let ((value (org-entry-get (point) "ROAM_REFS")))
|
||||
(when value (car (split-string value "[ \t]+")))))))
|
||||
|
||||
(defun roam-export-blog--note-title (file)
|
||||
"Return the #+TITLE: of the note in FILE, or nil."
|
||||
(roam-export-blog--title (find-file-noselect file)))
|
||||
|
||||
;;; Link processing
|
||||
|
||||
(defun roam-export-blog--vault-attach-dir (file)
|
||||
"Return the .attach directory dominating FILE, or nil."
|
||||
(when-let* ((root (locate-dominating-file file ".attach")))
|
||||
(expand-file-name ".attach" root)))
|
||||
|
||||
(defun roam-export-blog--image-p (file)
|
||||
"Return non-nil when FILE looks like an image attachment."
|
||||
(member (downcase (file-name-extension file))
|
||||
roam-export-blog-image-extensions))
|
||||
|
||||
(defun roam-export-blog--link-description (link)
|
||||
"Return the description text of LINK, or nil."
|
||||
(let ((begin (org-element-property :contents-begin link))
|
||||
(end (org-element-property :contents-end link)))
|
||||
(when (and begin end)
|
||||
(buffer-substring-no-properties begin end))))
|
||||
|
||||
(defun roam-export-blog--desc-or (desc fallback)
|
||||
"Return trimmed DESC, or FALLBACK when DESC is nil or empty.
|
||||
|
||||
An empty string is truthy in Elisp, so descriptions must be
|
||||
treated as absent explicitly."
|
||||
(let ((trimmed (when desc (string-trim desc))))
|
||||
(if (and trimmed (not (string-empty-p trimmed)))
|
||||
trimmed
|
||||
fallback)))
|
||||
|
||||
(defun roam-export-blog--desc-verbatim-or (desc fallback)
|
||||
"Return DESC unchanged, or FALLBACK when DESC is nil or blank.
|
||||
|
||||
Used for plain-text replacements: a description like \"Jev \"
|
||||
may carry the spacing that separated it from surrounding text in
|
||||
the org source."
|
||||
(if (and desc (not (string-empty-p (string-trim desc))))
|
||||
desc
|
||||
fallback))
|
||||
|
||||
(defun roam-export-blog--attachment-path (link vault-attach-dir note-id)
|
||||
"Return the absolute source path of attachment LINK, or nil.
|
||||
|
||||
Handles three shapes: file links already normalized by org to an
|
||||
absolute path under the vault's .attach directory, plain
|
||||
attachment: links and fuzzy links carrying an attachment: prefix.
|
||||
Resolution follows the org-attach ID scheme:
|
||||
.attach/<first two ID chars>/<rest of ID>/<path>."
|
||||
(let* ((type (org-element-property :type link))
|
||||
(path (org-element-property :path link))
|
||||
(bare (if (and (equal type "fuzzy")
|
||||
(string-prefix-p "attachment:" path))
|
||||
(substring path (length "attachment:"))
|
||||
path)))
|
||||
(cond
|
||||
((and (equal type "file") (file-name-absolute-p path)
|
||||
vault-attach-dir
|
||||
(string-prefix-p vault-attach-dir (expand-file-name path)))
|
||||
(expand-file-name path))
|
||||
((and vault-attach-dir note-id bare
|
||||
(>= (length note-id) 2))
|
||||
(let ((candidate (expand-file-name
|
||||
(concat (substring note-id 0 2)
|
||||
"/" (substring note-id 2)
|
||||
"/" bare)
|
||||
vault-attach-dir)))
|
||||
(when (file-exists-p candidate) candidate)))
|
||||
(t nil))))
|
||||
|
||||
(defun roam-export-blog--resolve-id (id)
|
||||
"Return the file containing org ID, or nil."
|
||||
(ignore-errors (org-id-find id)))
|
||||
|
||||
(defun roam-export-blog--link-replacement (link vault-attach-dir note-id)
|
||||
"Compute the replacement for LINK.
|
||||
|
||||
Return (REPLACEMENT WARNINGS IMAGES), where REPLACEMENT is org
|
||||
syntax to substitute for the link (nil leaves the link alone),
|
||||
WARNINGS is a list of warning strings and IMAGES is a list of
|
||||
(SOURCE . DEST) file copies to perform."
|
||||
(let* ((type (org-element-property :type link))
|
||||
(path (org-element-property :path link))
|
||||
(desc (roam-export-blog--link-description link))
|
||||
(replacement nil)
|
||||
(warnings nil)
|
||||
(images nil))
|
||||
(cond
|
||||
;; Roam refs: [[id:uuid][text]]
|
||||
((equal type "id")
|
||||
(let* ((target (roam-export-blog--resolve-id path))
|
||||
(refs (when target (roam-export-blog--roam-refs (car target))))) (cond
|
||||
((and target refs)
|
||||
(setq replacement (format "[[%s][%s]]"
|
||||
refs (roam-export-blog--desc-or desc refs))))
|
||||
(target
|
||||
(setq replacement (roam-export-blog--desc-verbatim-or
|
||||
desc (or (roam-export-blog--note-title (car target))
|
||||
"")))
|
||||
(push (format "dropped ref: id %s has no ROAM_REFS, kept plain text %S"
|
||||
path replacement)
|
||||
warnings))
|
||||
(t
|
||||
(setq replacement (roam-export-blog--desc-verbatim-or desc ""))
|
||||
(push (format "dropped ref: unresolved id %s, kept plain text %S"
|
||||
path replacement)
|
||||
warnings)))))
|
||||
;; Attachments (and file links that org normalized from attachments)
|
||||
((and vault-attach-dir
|
||||
(or (member type '("file" "attachment"))
|
||||
(and (equal type "fuzzy")
|
||||
(string-prefix-p "attachment:" path))))
|
||||
(let ((source (roam-export-blog--attachment-path link vault-attach-dir note-id)))
|
||||
(cond
|
||||
((and source (file-exists-p source) (roam-export-blog--image-p source))
|
||||
(let* ((name (file-name-nondirectory source))
|
||||
(year (car (roam-export-blog--date-parts)))
|
||||
(web-path (format "/images/blog/%s/%s" year name))
|
||||
(dest (expand-file-name
|
||||
(format "app/priv/static/images/blog/%s/%s" year name)
|
||||
roam-export-blog-firehose-root)))
|
||||
(setq images (list (cons source dest)))
|
||||
(setq replacement
|
||||
(format "[[file:%s][%s]]" web-path
|
||||
(roam-export-blog--desc-or desc
|
||||
(file-name-base name))))))
|
||||
((and source (file-exists-p source))
|
||||
(setq replacement (roam-export-blog--desc-verbatim-or desc ""))
|
||||
(push (format "ignored attachment (not an image): %s"
|
||||
(file-name-nondirectory source))
|
||||
warnings))
|
||||
(t
|
||||
(setq replacement (roam-export-blog--desc-verbatim-or desc ""))
|
||||
(push (format "unhandled link dropped: %s:%s" type path)
|
||||
warnings)))))
|
||||
;; Any other file: link points into the vault, not the blog.
|
||||
((equal type "file")
|
||||
(setq replacement (roam-export-blog--desc-verbatim-or desc ""))
|
||||
(push (format "unhandled link dropped: file:%s" path) warnings))
|
||||
;; Everything else (https, mailto, ...) passes through untouched.
|
||||
(t nil))
|
||||
(list replacement warnings images)))
|
||||
|
||||
(defun roam-export-blog--process-links (buffer vault-attach-dir)
|
||||
"Rewrite id/attachment/file links in BUFFER's text.
|
||||
|
||||
BUFFER is not modified; a processed copy of its text is returned.
|
||||
Return (TEXT WARNINGS IMAGES) where IMAGES is an alist of
|
||||
(SOURCE . DEST) image copies to perform."
|
||||
(with-current-buffer buffer
|
||||
(let ((text (buffer-string))
|
||||
(note-id (org-entry-get (point-min) "ID"))
|
||||
(warnings nil)
|
||||
(all-images nil))
|
||||
(let* ((tree (org-element-parse-buffer))
|
||||
(replacements
|
||||
(reverse
|
||||
(org-element-map tree 'link
|
||||
(lambda (link)
|
||||
(let* ((result (roam-export-blog--link-replacement
|
||||
link vault-attach-dir note-id))
|
||||
(replacement (nth 0 result))
|
||||
(warns (nth 1 result))
|
||||
(images (nth 2 result)))
|
||||
(setq warnings (append warnings warns)
|
||||
all-images (append all-images images))
|
||||
(when replacement
|
||||
(list (org-element-property :begin link)
|
||||
;; :end includes :post-blank (trailing
|
||||
;; whitespace); exclude it from the
|
||||
;; replaced region.
|
||||
(- (org-element-property :end link)
|
||||
(or (org-element-property :post-blank link) 0))
|
||||
replacement))))
|
||||
nil nil nil))))
|
||||
(dolist (r replacements)
|
||||
(let ((begin (nth 0 r))
|
||||
(end (nth 1 r))
|
||||
(replacement (nth 2 r)))
|
||||
(setq text (concat (substring text 0 (1- begin))
|
||||
replacement
|
||||
(substring text (1- end))))))
|
||||
(list text warnings all-images)))))
|
||||
|
||||
;;; Markdown generation
|
||||
|
||||
(defun roam-export-blog--to-markdown (text)
|
||||
"Export org TEXT to markdown with the firehose-md backend."
|
||||
(with-temp-buffer
|
||||
(insert text)
|
||||
(org-mode)
|
||||
(let ((out (org-export-to-buffer
|
||||
'firehose-md "*roam-export-blog export*"
|
||||
nil nil nil nil roam-export-blog--export-options)))
|
||||
(with-current-buffer out (buffer-string)))))
|
||||
|
||||
(defun roam-export-blog--cleanup (markdown)
|
||||
"Collapse runs of blank lines in MARKDOWN."
|
||||
(replace-regexp-in-string "\n\\(?:[ \t]*\n\\)+\\'" "\n"
|
||||
(replace-regexp-in-string "\n\\{3,\\}" "\n\n" markdown)))
|
||||
|
||||
;;; Frontmatter and writing
|
||||
|
||||
(defun roam-export-blog--frontmatter (title description image)
|
||||
"Build the Elixir-term frontmatter for the post."
|
||||
(concat "%{\n"
|
||||
(format " title: %S,\n" (roam-export-blog--escape-elixir-string title))
|
||||
(format " author: %S,\n" roam-export-blog-author)
|
||||
" tags: ~w(),\n"
|
||||
(format " description: %S,\n"
|
||||
(roam-export-blog--escape-elixir-string description))
|
||||
(format " image: %S,\n" image)
|
||||
" published: false\n"
|
||||
"}\n---\n"))
|
||||
|
||||
(defun roam-export-blog--post-path (slug)
|
||||
"Return the target post path for SLUG."
|
||||
(let ((year (car (roam-export-blog--date-parts)))
|
||||
(month (nth 1 (roam-export-blog--date-parts)))
|
||||
(day (nth 2 (roam-export-blog--date-parts))))
|
||||
(expand-file-name
|
||||
(format "app/priv/blog/engineering/%s/%s-%s-%s.md" year month day slug)
|
||||
roam-export-blog-firehose-root)))
|
||||
|
||||
(defun roam-export-blog--copy-images (images)
|
||||
"Copy IMAGES (alist of SOURCE . DEST), warning on basename clashes."
|
||||
(let ((copied nil)
|
||||
(warnings nil))
|
||||
(dolist (pair images)
|
||||
(let ((source (car pair))
|
||||
(dest (cdr pair)))
|
||||
(cond
|
||||
((member dest copied)
|
||||
(push (format "skipped duplicate image copy: %s"
|
||||
(file-name-nondirectory source))
|
||||
warnings))
|
||||
(t
|
||||
(make-directory (file-name-directory dest) t)
|
||||
(copy-file source dest t)
|
||||
(push dest copied)))))
|
||||
(nreverse warnings)))
|
||||
|
||||
;;; The command
|
||||
|
||||
(defun roam-export-blog--export-file (&optional file)
|
||||
"Export org-roam note FILE to a firehose blog post.
|
||||
|
||||
Return (OUTPUT-PATH . WARNINGS). Abort with `user-error' when the
|
||||
note has no title or the target file already exists."
|
||||
(setq file (or file (buffer-file-name)))
|
||||
(unless file
|
||||
(user-error "roam-export-blog: not visiting a file"))
|
||||
(let* ((buffer (find-file-noselect file))
|
||||
(title (roam-export-blog--title buffer)))
|
||||
(unless title
|
||||
(user-error "roam-export-blog: %s has no #+title: keyword, aborting" file))
|
||||
(let* ((slug (roam-export-blog--slug title))
|
||||
(post-path (roam-export-blog--post-path slug)))
|
||||
(when (file-exists-p post-path)
|
||||
(user-error "roam-export-blog: %s already exists, aborting" post-path))
|
||||
(let* ((processed (roam-export-blog--process-links
|
||||
buffer (roam-export-blog--vault-attach-dir file)))
|
||||
(text (nth 0 processed))
|
||||
(link-warnings (nth 1 processed))
|
||||
(images (nth 2 processed))
|
||||
(copy-warnings (roam-export-blog--copy-images images))
|
||||
(warnings (append (nreverse link-warnings) copy-warnings))
|
||||
(image (when images
|
||||
(let ((static (expand-file-name
|
||||
"app/priv/static"
|
||||
roam-export-blog-firehose-root)))
|
||||
(string-remove-prefix static (cdr (car images))))))
|
||||
(description (roam-export-blog--truncate-description
|
||||
(roam-export-blog--first-paragraph-text buffer)))
|
||||
(markdown (roam-export-blog--cleanup (roam-export-blog--to-markdown text))))
|
||||
(make-directory (file-name-directory post-path) t)
|
||||
(with-temp-file post-path
|
||||
(insert (roam-export-blog--frontmatter title description image)
|
||||
markdown))
|
||||
(cons post-path warnings)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun roam-export-blog ()
|
||||
"Export the current org-roam note as a firehose blog post."
|
||||
(interactive)
|
||||
(let ((result (roam-export-blog--export-file (buffer-file-name))))
|
||||
(let ((path (car result))
|
||||
(warnings (cdr result)))
|
||||
(message "roam-export-blog: wrote %s%s" path
|
||||
(if warnings
|
||||
(format " (%d warning%s)" (length warnings)
|
||||
(if (= 1 (length warnings)) "" "s"))
|
||||
""))
|
||||
(when warnings
|
||||
(with-output-to-temp-buffer "*roam-export-blog warnings*"
|
||||
(dolist (w warnings)
|
||||
(princ (format "%s\n" w))))))))
|
||||
|
||||
(provide 'roam-export-blog)
|
||||
;;; roam-export-blog.el ends here
|
||||
+1
@@ -0,0 +1 @@
|
||||
some attached notes
|
||||
+1
@@ -0,0 +1 @@
|
||||
<svg xmlns="http://www.w3.org/2000/svg" width="10" height="10"><rect width="10" height="10"/></svg>
|
||||
|
After Width: | Height: | Size: 100 B |
@@ -0,0 +1,7 @@
|
||||
:PROPERTIES:
|
||||
:ID: 00000000-0000-0000-0000-000000000002
|
||||
:ROAM_REFS: https://example.com/jev
|
||||
:END:
|
||||
#+title: Jev
|
||||
|
||||
Body of Jev.
|
||||
@@ -0,0 +1,6 @@
|
||||
:PROPERTIES:
|
||||
:ID: 00000000-0000-0000-0000-000000000003
|
||||
:END:
|
||||
#+title: Laya
|
||||
|
||||
Body of Laya.
|
||||
@@ -0,0 +1,26 @@
|
||||
:PROPERTIES:
|
||||
:ID: 00000000-0000-0000-0000-000000000001
|
||||
:END:
|
||||
#+title: Will It Blend
|
||||
|
||||
Will it Blend was a series of videos promoting a blender brand.
|
||||
|
||||
# A private comment that must not be exported.
|
||||
|
||||
[[attachment:will-it-blend.svg]]
|
||||
|
||||
For instance, a day after [[id:00000000-0000-0000-0000-000000000002][Jev]] came out, [[id:00000000-0000-0000-0000-000000000003][Laya]] popped up, and [[id:00000000-0000-0000-0000-000000009999][a missing note]] vanished. TODO source needed (LinkedIn)
|
||||
|
||||
[[attachment:attached-notes.txt]]
|
||||
|
||||
* I learnt this from Julia
|
||||
|
||||
Body text with *bold*.
|
||||
|
||||
#+begin_quote
|
||||
A quoted comment.
|
||||
#+end_quote
|
||||
|
||||
#+begin_src elixir
|
||||
IO.puts("hi")
|
||||
#+end_src
|
||||
@@ -0,0 +1,5 @@
|
||||
:PROPERTIES:
|
||||
:ID: 00000000-0000-0000-0000-000000000004
|
||||
:END:
|
||||
|
||||
No title here.
|
||||
Reference in New Issue
Block a user