awesome-emacs/nursery
1
0
Fork 0
mirror of https://github.com/chrisbarrett/nursery synced 2025-09-22 16:20:55 -05:00
Code Issues Packages Projects Releases Wiki Activity

Parameterise org-roam-rewrite-extract over node and dest

Browse Source
This commit is contained in:
Chris Barrett
2022-09-13 15:04:27 +12:00
parent e33bda4a75
commit b69d1c40d1
1 changed files with 93 additions and 72 deletions
Download Patch File Download Diff File Expand all files Collapse all files

165
lisp/org-roam-rewrite.el
View File

@@ -266,84 +266,105 @@ DEST-NODE is the node that will be added to."
(org-roam-node-visit dest-node) (org-roam-node-visit dest-node)
(message "Inlined node successfully")) (message "Inlined node successfully"))
;;;###autoload (defun org-roam-rewrite--ensure-node-for-headline-at-point ()
(defun org-roam-rewrite-extract ()
"Convert current subtree at point to a node, and extract it into a new file.
It's a re-implementation of `org-roam-extract-subtree', but
handles file titles, tags and transclusions better."
(interactive)
(save-excursion (save-excursion
(org-back-to-heading-or-point-min t) (org-back-to-heading-or-point-min t)
(when (bobp) (user-error "Already a top-level node")) (when (bobp) (user-error "Already a top-level node"))
(org-id-get-create) (org-id-get-create)
(save-buffer) (when (buffer-modified-p)
(org-roam-db-update-file) (save-buffer)
(let* ((template-info nil) (org-roam-db-update-file))
(node (org-roam-node-at-point t)) (org-roam-node-at-point t)))
(template
(unwind-protect (defun org-roam-rewrite--new-filename-from-capture-template (node)
(progn (unwind-protect
(setq org-capture-plist nil) (progn
(org-roam-format-template (setq org-capture-plist nil)
(string-trim (org-capture-fill-template org-roam-extract-new-file-path)) (org-roam-format-template
(lambda (key default-val) (string-trim (org-capture-fill-template org-roam-extract-new-file-path))
(let ((fn (intern key)) (lambda (key default-val)
(node-fn (intern (concat "org-roam-node-" key))) (let ((fn (intern key))
(ksym (intern (concat ":" key)))) (node-fn (intern (concat "org-roam-node-" key))))
(cond (cond
((fboundp fn) ((fboundp fn)
(funcall fn node)) (funcall fn node))
((fboundp node-fn) ((fboundp node-fn)
(funcall node-fn node)) (funcall node-fn node))
(t (let ((r (read-from-minibuffer (format "%s: " key) default-val))) (t
(plist-put template-info ksym r) (read-from-minibuffer (format "%s: " key) default-val)))))))
r))))))) (setq org-capture-plist nil)))
(setq org-capture-plist nil)))
(relpath (file-name-as-directory org-roam-directory)) ;;;###autoload
(file-path (expand-file-name (defun org-roam-rewrite-extract (node dest)
(if org-roam-rewrite-confirm-extraction-path-p "Extract NODE to a new file at DEST.
(read-file-name "Extract node to: " relpath template nil template)
template) Note that NODE must be a headline, not at the top-level of the
org-roam-directory))) file. If NODE is at the top-level an error is signalled.
(let ((tags (org-get-tags))
(title (org-get-heading)) If called interactively, ensure the headline at point has an ID
(id (org-id-get-create)) before extracting.
(dest-buf (find-file-noselect file-path))
extraction-succeeded-p) This is a rough reimplementation of `org-roam-extract-subtree',
(unwind-protect but it handles file titles, tags and transclusions better."
(atomic-change-group (interactive (let* ((node (org-roam-rewrite--ensure-node-for-headline-at-point))
(save-restriction (template (org-roam-rewrite--new-filename-from-capture-template node))
(org-narrow-to-subtree) (relpath (file-name-as-directory org-roam-directory))
(org-roam-rewrite--apply-when-transclusions-enabled 'org-transclusion-remove-all t)) (dest (expand-file-name
(org-cut-subtree) (if org-roam-rewrite-confirm-extraction-path-p
(save-buffer) (read-file-name "Extract node to: " relpath template nil template)
(org-roam-db-update-file) template)
(when org-roam-rewrite-insert-link-after-extraction-p org-roam-directory)))
(insert (org-link-make-string (format "id:%s" id) (org-link-display-format title))) (list node dest)))
(newline))
(with-current-buffer dest-buf (cl-assert (not (zerop (org-roam-node-level node))))
(org-paste-subtree)
(while (> (org-current-level) 1) (org-promote-subtree)) ;; Ensure the node's buffer is open
(save-buffer) (let ((file (org-roam-node-file node)))
(org-roam-promote-entire-buffer) (unless (find-buffer-visiting file)
(when-let* ((tags (-difference (-union (org-roam-rewrite--file-tags) tags) (find-file-noselect file)))
org-roam-rewrite-extract-excluded-tags)))
(org-roam-rewrite--set-file-tags tags) (org-with-point-at (org-roam-node-marker node)
(org-roam-rewrite--apply-when-transclusions-enabled 'org-transclusion-add-all))) (let ((tags (org-get-tags))
(setq extraction-succeeded-p t)) (dest-buf (find-file-noselect dest))
(with-current-buffer dest-buf extraction-succeeded-p)
(if extraction-succeeded-p (unwind-protect
(save-buffer) (atomic-change-group
(let ((kill-buffer-query-functions)) ;; Extract from source buffer
(set-buffer-modified-p nil) (org-roam-rewrite--apply-when-transclusions-enabled 'org-transclusion-remove-all t)
(kill-buffer dest-buf) (org-cut-subtree)
(when (file-exists-p file-path) (save-buffer)
(delete-file file-path)))))) (org-roam-db-update-file)
(when org-roam-rewrite-insert-link-after-extraction-p
(insert (org-link-make-string (format "id:%s" (org-roam-node-id node))
(org-link-display-format (org-roam-node-title node))))
(newline))
(org-roam-rewrite--apply-when-transclusions-enabled 'org-transclusion-add-all t)
;; Insert into dest buffer
(with-current-buffer dest-buf
(org-paste-subtree)
(while (> (org-current-level) 1) (org-promote-subtree))
(save-buffer)
(org-roam-promote-entire-buffer)
(when-let* ((tags (-difference (-union (org-roam-rewrite--file-tags) tags)
org-roam-rewrite-extract-excluded-tags)))
(org-roam-rewrite--set-file-tags tags)
(org-roam-rewrite--apply-when-transclusions-enabled 'org-transclusion-add-all)))
(setq extraction-succeeded-p t))
(save-buffer)
(with-current-buffer dest-buf (with-current-buffer dest-buf
(run-hooks 'org-roam-node-capture-new-node-hook 'org-roam-rewrite-node-extracted-hook)))))) (if extraction-succeeded-p
(save-buffer)
;; Extraction failed--clean up
(let ((kill-buffer-query-functions))
(set-buffer-modified-p nil)
(kill-buffer dest-buf)
(when (file-exists-p dest)
(delete-file dest))))))
(save-buffer)
(with-current-buffer dest-buf
(run-hooks 'org-roam-node-capture-new-node-hook 'org-roam-rewrite-node-extracted-hook)))))
(provide 'org-roam-rewrite) (provide 'org-roam-rewrite)