awesome-emacs/org-roam
1
0
Fork 0
mirror of https://github.com/org-roam/org-roam synced 2025-08-21 13:53:31 -05:00
Code Issues Packages Projects Releases Wiki Activity

Massive cleanup operation 😅

Browse Source 
Hopefully the last of its kind.

Removes the timer for rebuilding the cache, in favour of an
incremental cache building approach. This requires significant change
to the cache structure.

- Add forward links to cache.
- At the same time, using file-truename in the cache, rather than
- org-roam id

Also fill up more documentation, and other optimizations to other
parts of org-roam.
This commit is contained in:
Jethro Kuan
2020-02-09 14:47:28 +08:00
parent 50fc39c4c8
commit 7a578ff764
1 changed files with 189 additions and 100 deletions
Download Patch File Download Diff File Expand all files Collapse all files

289
org-roam.el
View File

@@ -1,4 +1,4 @@
;;; org-roam.el --- Roam Research replica with Org-mode ;;; org-roam.el --- Roam Research replica with Org-mode -*- coding: utf-8; lexical-binding: t -*-
;;; Commentary: ;;; Commentary:
;; ;;
@@ -46,11 +46,6 @@ Valid values are
:type 'string :type 'string
:group 'org-roam) :group 'org-roam)
(defcustom org-roam-update-interval 5
"Number of minutes to run asynchronous update of backlinks."
:type 'number
:group 'org-roam)
(defcustom org-roam-graph-viewer (executable-find "firefox") (defcustom org-roam-graph-viewer (executable-find "firefox")
"Path to executable for viewing SVG." "Path to executable for viewing SVG."
:type 'string :type 'string
@@ -82,23 +77,21 @@ If called interactively, then PARENTS is non-nil."
(write-region "" nil filename nil 0))) (write-region "" nil filename nil 0)))
;;; Dynamic variables ;;; Dynamic variables
(defvar org-roam-update-timer nil
"Variable containing the timer that periodically updates the buffer.")
(defvar org-roam-cache nil (defvar org-roam-cache nil
"Cache containing backlinks for `org-roam' buffers.") "Cache containing backlinks for `org-roam' buffers.")
(defvar org-roam-current-file-id nil (defvar org-roam-current-file nil
"Currently displayed file in `org-roam' buffer.") "Currently displayed file in `org-roam' buffer.")
;;; Utilities ;;; Utilities
(defun org-roam--org-roam-file-p () (defun org-roam--org-roam-file-p ()
"Predicate that returns true if file is part of org-roam system." "Return t if file is part of org-roam system, false otherwise."
(and (buffer-file-name (current-buffer)) (and (buffer-file-name (current-buffer))
(f-child-of-p (file-truename (buffer-file-name (current-buffer))) (f-child-of-p (file-truename (buffer-file-name (current-buffer)))
org-roam-directory))) org-roam-directory)))
(defun org-roam--find-files (dir) (defun org-roam--find-files (dir)
"Return all org-roam files in `DIR'."
(if (file-exists-p dir) (if (file-exists-p dir)
(let ((files (directory-files dir t "." t)) (let ((files (directory-files dir t "." t))
(dir-ignore-regexp (concat "\\(?:" (dir-ignore-regexp (concat "\\(?:"
@@ -117,19 +110,22 @@ If called interactively, then PARENTS is non-nil."
result))) result)))
(defun org-roam--find-all-files () (defun org-roam--find-all-files ()
"Return all org-roam files."
(org-roam--find-files org-roam-directory)) (org-roam--find-files org-roam-directory))
(defun org-roam--get-file-path-absolute (id) (defun org-roam--get-file-path (id &optional absolute)
"Converts identifier `ID' to the absolute file path." "Convert identifier `ID' to file path.
(expand-file-name
(concat id ".org")
(file-truename org-roam-directory)))
(defun org-roam--get-file-path (id) If `ABSOLUTE', return the absolute file-path. Else, return the relative file-path."
"Converts identifier `ID' to the relative file path." (let ((absolute-file-path (expand-file-name
(file-relative-name (org-roam--get-file-path-absolute id))) (concat id ".org")
(file-truename org-roam-directory))))
(if absolute
absolute-file-path
(file-relative-name absolute-file-path org-roam-directory))))
(defun org-roam--get-id (file-path) (defun org-roam--get-id (file-path)
"Convert `FILE-PATH' to the org-roam id."
(file-name-sans-extension (file-name-sans-extension
(file-relative-name (file-relative-name
(file-truename file-path) (file-truename file-path)
@@ -172,12 +168,9 @@ If called interactively, then PARENTS is non-nil."
(require 'cl-lib) (require 'cl-lib)
,(async-inject-variables "org-roam-files") ,(async-inject-variables "org-roam-files")
,(async-inject-variables "org-roam-directory") ,(async-inject-variables "org-roam-directory")
(let ((backlinks (make-hash-table :test #'equal))) (let ((backward-links (make-hash-table :test #'equal))
(cl-flet* ((org-roam--get-id (file-path) (file-name-sans-extension (forward-links (make-hash-table :test #'equal)))
(file-relative-name (cl-flet* ((org-roam--parse-content (file) (with-temp-buffer
file-path
org-roam-directory)))
(org-roam--parse-content (file) (with-temp-buffer
(insert-file-contents file) (insert-file-contents file)
(with-current-buffer (current-buffer) (with-current-buffer (current-buffer)
(org-element-map (org-element-parse-buffer) 'link (org-element-map (org-element-parse-buffer) 'link
@@ -194,34 +187,122 @@ If called interactively, then PARENTS is non-nil."
(org-element-property :begin element)) (org-element-property :begin element))
(or (org-element-property :content-end element) (or (org-element-property :content-end element)
(org-element-property :end element))))) (org-element-property :end element)))))
(list file (list :from file
(expand-file-name path org-roam-directory) :to (file-truename (expand-file-name path org-roam-directory))
(string-trim content)))))))))) :content (string-trim content))))))))))
(org-roam--build-backlinks (items) (mapcar (org-roam--process-items (items) (mapcar
(lambda (item) (lambda (item)
(pcase-let ((`(,file ,path ,content) item)) (pcase-let ((`(:from ,p-from :to ,p-to :content ,content) item))
(let* ((link-id (org-roam--get-id path)) ;; Build forward-links
(backlink-id (org-roam--get-id file)) (let ((links (gethash p-from forward-links)))
(contents-hash (gethash link-id backlinks))) (if links
(if contents-hash (puthash p-from
(if-let ((contents-list (gethash backlink-id contents-hash))) (if (member p-to links)
(let ((updated (cons content contents-list))) links
(puthash backlink-id updated contents-hash) (cons p-to links)) forward-links)
(puthash link-id contents-hash backlinks)) (puthash p-from (list p-to) forward-links)))
(puthash backlink-id (list content) contents-hash) ;; Build backward-links
(puthash link-id contents-hash backlinks)) (let ((contents-hash (gethash p-to backward-links)))
(let ((contents-hash (make-hash-table :test #'equal))) (if contents-hash
(puthash backlink-id (list content) contents-hash) (if-let ((contents-list (gethash p-from contents-hash)))
(puthash link-id contents-hash backlinks)))))) (let ((updated (cons content contents-list)))
items))) (puthash p-from updated contents-hash)
(mapcar #'org-roam--build-backlinks (puthash p-to contents-hash backward-links))
(progn
(puthash p-from (list content) contents-hash)
(puthash p-to contents-hash backward-links)))
(let ((contents-hash (make-hash-table :test #'equal)))
(puthash p-from (list content) contents-hash)
(puthash p-to contents-hash backward-links))))))
items)))
(mapcar #'org-roam--process-items
(mapcar #'org-roam--parse-content org-roam-files))) (mapcar #'org-roam--parse-content org-roam-files)))
(prin1-to-string backlinks))) (list
(lambda (backlinks) :forward forward-links
(setq org-roam-cache (car (read-from-string :backward backward-links)))
backlinks))) (lambda (cache)
(org-roam--maybe-update-buffer)))) (setq org-roam-cache cache))))
(defun org-roam--insert-item (item)
"Insert `ITEM' into `org-roam-cache'.
`ITEM' is of the form: (:from from-path :to to-path :content preview-content)
Before calling this function, `org-roam-cache' should be already populated."
(let ((forward-cache (plist-get org-roam-cache :forward))
(backward-cache (plist-get org-roam-cache :backward)))
(pcase-let ((`(:from ,p-from :to ,p-to :content ,content) item))
;; Build forward-links
(let ((links (gethash p-from forward-cache)))
(if links
(puthash p-from
(if (member p-to links)
links
(cons p-to links)) forward-cache)
(puthash p-from (list p-to) forward-cache)))
;; Build backward-links
(let ((contents-hash (gethash p-to backward-cache)))
(if contents-hash
(if-let ((contents-list (gethash p-from contents-hash)))
(let ((updated (cons content contents-list)))
(puthash p-from updated contents-hash)
(puthash p-to contents-hash backward-cache))
(progn
(puthash p-from (list content) contents-hash)
(puthash p-to contents-hash backward-cache)))
(let ((contents-hash (make-hash-table :test #'equal)))
(puthash p-from (list content) contents-hash)
(puthash p-to contents-hash backward-cache))))
(setq org-roam-cache (list :forward forward-cache
:backward backward-cache)))))
(defun org-roam--parse-content ()
"Parse the current buffer, and return a list of items for processing."
(with-current-buffer (current-buffer)
(org-element-map (org-element-parse-buffer) 'link
(lambda (link)
(let ((type (org-element-property :type link))
(path (org-element-property :path link))
(start (org-element-property :begin link)))
(when (and (string= type "file")
(string= (file-name-extension path) "org"))
(goto-char start)
(let* ((element (org-element-at-point))
(content (buffer-substring
(or (org-element-property :content-begin element)
(org-element-property :begin element))
(or (org-element-property :content-end element)
(org-element-property :end element)))))
(list :from (file-truename (buffer-file-name (current-buffer)))
:to (file-truename (expand-file-name path org-roam-directory))
:content (string-trim content)))))))))
(defun org-roam--clear-cache-for-buffer (buffer)
"Remove any related links to the file for `BUFFER'.
This is equivalent to removing the node from the graph."
(with-current-buffer (current-buffer)
(let ((file (file-truename (buffer-file-name buffer)))
(forward-cache (plist-get org-roam-cache :forward))
(backward-cache (plist-get org-roam-cache :backward)))
;; Setup 1: Remove all existing links for file
(when-let ((forward-links (gethash file forward-cache)))
;; Delete backlinks to file
(dolist (link forward-links)
(when-let ((backward-links (gethash link backward-cache)))
(remhash file backward-links)
(puthash link backward-links backward-cache)))
;; Clean out forward links
(remhash file forward-cache))
(setq org-roam-cache (list :forward forward-cache :backward backward-cache)))))
(defun org-roam--update-cache ()
"Update `org-roam-cache' for the current buffer file."
(save-excursion
(org-roam--clear-cache-for-buffer (current-buffer))
(let ((items (org-roam--parse-content)))
(dolist (item items)
(org-roam--insert-item item)))))
;;; Org-roam daily notes ;;; Org-roam daily notes
(defun org-roam--new-file-named (slug) (defun org-roam--new-file-named (slug)
@@ -247,20 +328,24 @@ If called interactively, then PARENTS is non-nil."
(org-roam--new-file-named (format-time-string "%Y-%m-%d" time)))) (org-roam--new-file-named (format-time-string "%Y-%m-%d" time))))
;;; Org-roam buffer updates ;;; Org-roam buffer updates
(defun org-global-props (&optional property buffer) (defun org-roam--extract-title (buffer)
"Get the plists of global org properties of current buffer." "Extract the title from `BUFFER'."
(unless property (setq property "PROPERTY")) (with-current-buffer buffer
(with-current-buffer (or buffer (current-buffer)) (org-element-map
(org-element-map (org-element-parse-buffer) 'keyword (lambda (el) (when (string-match property (org-element-property :key el)) el))))) (org-element-parse-buffer)
'keyword
(lambda (kw)
(when (string= (org-element-property :key kw) "TITLE")
(org-element-property :value kw)))
:first-match t)))
(defun org-roam-update (link-id) (defun org-roam-update (file-path)
"Show the backlinks for given org file `FILE'." "Show the backlinks for given org file for file at `FILE-PATH'."
(when org-roam-cache (when org-roam-cache
(let ((title (or (org-element-property :value (car (org-global-props "TITLE"))) (let ((title (or (org-roam--extract-title (current-buffer))
link-id))) (org-roam--get-id file-path))))
(with-current-buffer org-roam-buffer (with-current-buffer org-roam-buffer
(let ((inhibit-read-only t) (let ((inhibit-read-only t))
(file-path (org-roam--get-file-path-absolute link-id)))
(erase-buffer) (erase-buffer)
(when (not (eq major-mode 'org-mode)) (when (not (eq major-mode 'org-mode))
(org-mode)) (org-mode))
@@ -268,16 +353,16 @@ If called interactively, then PARENTS is non-nil."
(setq org-return-follows-link t) (setq org-return-follows-link t)
(insert title) (insert title)
(insert "\n\n* Backlinks\n") (insert "\n\n* Backlinks\n")
(when-let (backlinks (gethash link-id org-roam-cache)) (when-let (backlinks (gethash file-path (plist-get org-roam-cache :backward)))
(maphash (lambda (backlink-id contents) (maphash (lambda (file-from contents)
(insert (format "** [[file:%s][%s]]\n" (org-roam--get-file-path backlink-id) backlink-id)) (insert (format "** [[file:%s][%s]]\n" file-from (org-roam--get-id file-from)))
(dolist (content contents) (dolist (content contents)
(insert (format "%s\n" org-roam-preview-content-delimiter)) (insert (format "%s\n" org-roam-preview-content-delimiter))
(insert (s-replace "\n" " " content)) (insert (s-replace "\n" " " content))
(insert (format "\n%s\n\n" org-roam-preview-content-delimiter)))) (insert (format "\n%s\n\n" org-roam-preview-content-delimiter))))
backlinks))) backlinks)))
(read-only-mode 1))) (read-only-mode 1)))
(setq org-roam-current-file-id link-id))) (setq org-roam-current-file file-path)))
;;; Show/hide the org-roam buffer ;;; Show/hide the org-roam buffer
(define-inline org-roam--current-visibility () (define-inline org-roam--current-visibility ()
@@ -297,10 +382,7 @@ Valid states are 'visible, 'exists and 'none."
`((side . ,org-roam-position)))) `((side . ,org-roam-position))))
(defun org-roam () (defun org-roam ()
"Initialize `org-roam'. "Pops up the window `org-roam-buffer' accordingly."
1. Setup to auto-update `org-roam-buffer' with the correct information.
2. Starts the timer to asynchronously build backlinks.
3. Pops up the window `org-roam-buffer' accordingly."
(interactive) (interactive)
(pcase (org-roam--current-visibility) (pcase (org-roam--current-visibility)
('visible (delete-window (get-buffer-window org-roam-buffer))) ('visible (delete-window (get-buffer-window org-roam-buffer)))
@@ -309,21 +391,26 @@ Valid states are 'visible, 'exists and 'none."
;;; The minor mode definition that updates the buffer ;;; The minor mode definition that updates the buffer
(defun org-roam--maybe-enable () (defun org-roam--maybe-enable ()
"Enable org-roam updating for file, if file is an org-roam file."
(when (org-roam--org-roam-file-p) (when (org-roam--org-roam-file-p)
(org-roam--enable))) (org-roam--enable)))
(defun org-roam--enable () (defun org-roam--enable ()
(add-hook 'post-command-hook #'org-roam--maybe-update-buffer -100 t) "Enable org-roam updating for file.
(unless org-roam-update-timer
(setq org-roam-update-timer 1. If the cache does not yet exist, build it asynchronously.
(run-with-timer 0 (* org-roam-update-interval 60) 'org-roam--build-cache-async))) 2. Setup hooks for updating the cache, and the org-roam buffer."
(org-roam--maybe-update-buffer)) (unless org-roam-cache
(org-roam--build-cache-async))
(add-hook 'post-command-hook #'org-roam--maybe-update-buffer nil t)
(add-hook 'after-save-hook #'org-roam--update-cache))
(defun org-roam--disable () (defun org-roam--disable ()
"Disable org-roam updating for file.
1. Remove hooks for updating the cache, and the org-roam buffer."
(remove-hook 'post-command-hook #'org-roam--maybe-update-buffer) (remove-hook 'post-command-hook #'org-roam--maybe-update-buffer)
(when org-roam-update-timer (remove-hook 'after-save-hook #'org-roam--update-cache))
(cancel-timer org-roam-update-timer)
(setq org-roam-update-timer nil)))
(defun org-roam--maybe-update-buffer () (defun org-roam--maybe-update-buffer ()
"Update `org-roam-buffer' with the necessary information. "Update `org-roam-buffer' with the necessary information.
@@ -332,9 +419,9 @@ This needs to be quick/infrequent, because this is run at
(with-current-buffer (window-buffer) (with-current-buffer (window-buffer)
(when (and (get-buffer org-roam-buffer) (when (and (get-buffer org-roam-buffer)
(buffer-file-name (current-buffer)) (buffer-file-name (current-buffer))
(not (string= org-roam-current-file-id (not (string= org-roam-current-file
(org-roam--get-id (file-truename (buffer-file-name (current-buffer))))))) (file-truename (buffer-file-name (current-buffer))))))
(org-roam-update (org-roam--get-id (buffer-file-name (window-buffer))))))) (org-roam-update (file-truename (buffer-file-name (window-buffer)))))))
(define-minor-mode org-roam-mode (define-minor-mode org-roam-mode
"Global minor mode to automatically update the org-roam buffer." "Global minor mode to automatically update the org-roam buffer."
@@ -346,25 +433,28 @@ This needs to be quick/infrequent, because this is run at
;;; Building the Graphviz graph ;;; Building the Graphviz graph
(defun org-roam-build-graph () (defun org-roam-build-graph ()
"Build graphviz graph output." "Build graphviz graph output."
(with-temp-buffer (let ((forward-links (plist-get org-roam-cache :forward)))
(insert "digraph {\n") (with-temp-buffer
(mapcar (lambda (file) (insert "digraph {\n")
(insert (mapcar (lambda (file)
(format " \"%s\" [URL=\"roam://%s\"];\n" (insert
(file-name-nondirectory (file-name-sans-extension file)) (format " \"%s\" [URL=\"roam://%s\"];\n"
file))) (org-roam--get-id file)
(org-roam--find-all-files)) file)))
(maphash (org-roam--find-all-files))
(lambda (link-id backlinks) (maphash
(maphash (lambda (from-link to-links)
(lambda (backlink-id content) (dolist (to-link to-links)
(insert (format " \"%s\" -> \"%s\";\n" backlink-id link-id))) (insert (format " \"%s\" -> \"%s\";\n"
backlinks)) (org-roam--get-id from-link)
org-roam-cache) (org-roam--get-id to-link))))
(insert "}") )
(buffer-string))) forward-links)
(insert "}")
(buffer-string))))
(defun org-roam-show-graph (&rest body) (defun org-roam-show-graph ()
"Generate the org-roam graph in SVG format, and display it using `org-roam-graph-viewer'."
(interactive) (interactive)
(unless org-roam-graphviz-executable (unless org-roam-graphviz-executable
(setq org-roam-graphviz-executable (executable-find "dot"))) (setq org-roam-graphviz-executable (executable-find "dot")))
@@ -380,7 +470,6 @@ This needs to be quick/infrequent, because this is run at
(call-process org-roam-graph-viewer nil 0 nil temp-graph))) (call-process org-roam-graph-viewer nil 0 nil temp-graph)))
(provide 'org-roam) (provide 'org-roam)
;;; org-roam.el ends here ;;; org-roam.el ends here