2020-01-22 14:41:25 +00:00
|
|
|
;;; org-roam.el --- Roam Research replica with Org-mode and Deft
|
|
|
|
|
|
|
|
;;; Commentary:
|
|
|
|
;;
|
|
|
|
|
|
|
|
;;; Code:
|
2020-01-05 09:04:37 +00:00
|
|
|
(require 'deft)
|
2020-01-22 11:05:04 +00:00
|
|
|
(require 'async)
|
2020-02-02 16:17:17 +00:00
|
|
|
(require 'subr-x)
|
2020-01-21 15:30:33 +00:00
|
|
|
|
|
|
|
(defgroup org-roam nil
|
|
|
|
"Roam Research replica in Org-mode."
|
|
|
|
:group 'org
|
|
|
|
:prefix "org-roam-")
|
2020-01-05 09:04:37 +00:00
|
|
|
|
|
|
|
(defcustom org-roam-zettel-indicator "§"
|
|
|
|
"Indicator in front of a zettel.")
|
|
|
|
|
2020-01-21 17:40:11 +00:00
|
|
|
(defcustom org-roam-position 'right
|
2020-01-22 09:12:06 +00:00
|
|
|
"Position of `org-roam' buffer.
|
2020-01-21 17:40:11 +00:00
|
|
|
|
|
|
|
Valid values are
|
|
|
|
* left,
|
|
|
|
* right."
|
|
|
|
:type '(choice (const left)
|
|
|
|
(const right))
|
|
|
|
:group 'org-roam)
|
2020-01-21 15:30:33 +00:00
|
|
|
|
2020-01-22 11:05:04 +00:00
|
|
|
(defvar org-roam-directory nil
|
|
|
|
"Org-roam directory. Typically set it to your deft directory.")
|
|
|
|
|
|
|
|
(defvar org-roam-buffer "*org-roam*"
|
|
|
|
"Org-roam buffer name.")
|
|
|
|
|
2020-01-21 15:30:33 +00:00
|
|
|
(defvar org-roam-hash-backlinks nil
|
2020-01-22 09:12:06 +00:00
|
|
|
"Cache containing backlinks for `org-roam' buffers.")
|
|
|
|
|
2020-02-03 08:58:45 +00:00
|
|
|
(defvar org-roam-current-file nil
|
|
|
|
"Currently displayed file in `org-roam' buffer.")
|
|
|
|
|
2020-01-22 11:05:04 +00:00
|
|
|
(defvar org-roam-update-interval 5
|
|
|
|
"Number of minutes to run asynchronous update of backlinks.")
|
|
|
|
|
|
|
|
(defvar org-roam-update-timer nil
|
|
|
|
"Variable containing the timer that periodically updates the buffer.")
|
|
|
|
|
2020-02-04 09:40:44 +00:00
|
|
|
(defvar org-roam-graph-viewer (executable-find "firefox")
|
|
|
|
"Path to executable for viewing SVG.")
|
|
|
|
|
|
|
|
(defvar org-roam-graphviz-executable (executable-find "dot")
|
|
|
|
"Path to graphviz executable.")
|
|
|
|
|
2020-01-21 17:40:11 +00:00
|
|
|
(define-inline org-roam-current-visibility ()
|
|
|
|
"Return whether the current visibility state of the org-roam buffer.
|
|
|
|
Valid states are 'visible, 'exists and 'none."
|
|
|
|
(declare (side-effect-free t))
|
|
|
|
(inline-quote
|
|
|
|
(cond
|
|
|
|
((get-buffer-window org-roam-buffer) 'visible)
|
|
|
|
((get-buffer org-roam-buffer) 'exists)
|
|
|
|
(t 'none))))
|
|
|
|
|
2020-01-05 09:04:37 +00:00
|
|
|
(defun org-roam-insert (file-name)
|
2020-01-22 09:12:06 +00:00
|
|
|
"Find file `FILE-NAME', insert it as a link with the base file name as the link name."
|
2020-02-03 11:58:33 +00:00
|
|
|
(interactive (list (completing-read "File: "
|
|
|
|
(mapcar (lambda (f)
|
|
|
|
(file-name-sans-extension f))
|
|
|
|
(deft-find-all-files-no-prefix)))))
|
2020-02-03 13:21:53 +00:00
|
|
|
(let* ((org-link-file-type 'relative)
|
|
|
|
(file-name (concat file-name ".org"))
|
|
|
|
(file-path (file-relative-name (file-truename (concat deft-directory file-name)))))
|
|
|
|
(org-insert-link nil (concat "file:" file-path)
|
2020-02-03 13:22:38 +00:00
|
|
|
(concat org-roam-zettel-indicator (file-name-base file-name)))))
|
2020-01-05 09:04:37 +00:00
|
|
|
|
|
|
|
(defun org-roam-get-linked-files ()
|
|
|
|
"Show links to this file."
|
|
|
|
(interactive)
|
|
|
|
(let* ((search-term (file-name-nondirectory buffer-file-name))
|
|
|
|
(files deft-all-files)
|
|
|
|
(tnames (mapcar #'file-truename files)))
|
|
|
|
(multi-occur
|
|
|
|
(mapcar (lambda (x)
|
|
|
|
(with-current-buffer
|
|
|
|
(or (get-file-buffer x) (find-file-noselect x))
|
|
|
|
(widen)
|
|
|
|
(current-buffer)))
|
|
|
|
files)
|
|
|
|
search-term
|
|
|
|
3)))
|
2020-01-21 09:12:08 +00:00
|
|
|
|
2020-01-21 15:30:33 +00:00
|
|
|
(defun org-roam-get-links-from-buffer (buffer)
|
2020-01-22 14:41:25 +00:00
|
|
|
"Return a list of links from BUFFER."
|
2020-01-21 15:30:33 +00:00
|
|
|
(with-current-buffer buffer
|
|
|
|
(org-element-map (org-element-parse-buffer) 'link
|
|
|
|
(lambda (link)
|
|
|
|
(let ((type (org-element-property :type link))
|
|
|
|
(path (org-element-property :path link)))
|
|
|
|
(when (and (string= type "file")
|
|
|
|
(string= (file-name-extension path) "org"))
|
|
|
|
path))))))
|
|
|
|
|
2020-01-22 09:55:30 +00:00
|
|
|
(defun org-roam-add-backlink (hash link_a link_b)
|
2020-01-22 14:41:25 +00:00
|
|
|
"Add a backlink LINK_A <- LINK_B to hash-table HASH."
|
2020-01-22 11:45:42 +00:00
|
|
|
(let* ((item (gethash link_a hash))
|
2020-01-22 09:55:30 +00:00
|
|
|
(updated (if item
|
|
|
|
(if (member link_b item)
|
|
|
|
item
|
|
|
|
(cons link_b item))
|
|
|
|
(list link_b))))
|
2020-01-22 11:45:42 +00:00
|
|
|
(puthash link_a updated hash)))
|
2020-01-21 15:30:33 +00:00
|
|
|
|
2020-01-22 11:05:04 +00:00
|
|
|
(defun org-roam-build-backlinks-async ()
|
|
|
|
"Builds the backlink hash table asychronously, saving it into `org-roam-hash-backlinks'."
|
|
|
|
(interactive)
|
|
|
|
(setq org-roam-files (deft-find-all-files))
|
|
|
|
(async-start
|
|
|
|
`(lambda ()
|
|
|
|
(require 'org)
|
|
|
|
(require 'org-element)
|
2020-02-02 17:24:37 +00:00
|
|
|
(require 'subr-x) ; temp-fix
|
2020-01-22 11:05:04 +00:00
|
|
|
,(async-inject-variables "org-roam-")
|
2020-02-02 16:17:17 +00:00
|
|
|
(let ((backlinks (make-hash-table :test #'equal)))
|
2020-01-22 11:05:04 +00:00
|
|
|
(mapcar (lambda (file)
|
2020-02-02 16:17:17 +00:00
|
|
|
(let ((items (with-temp-buffer
|
|
|
|
(insert-file-contents file)
|
|
|
|
(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 path (string-trim content)))))))))))
|
|
|
|
(mapcar (lambda (item)
|
|
|
|
(let* ((path (car item))
|
2020-02-03 08:53:57 +00:00
|
|
|
(content (cadr item))
|
2020-02-02 16:17:17 +00:00
|
|
|
(relative-file (file-name-nondirectory file))
|
|
|
|
(contents-hash (gethash path backlinks)))
|
|
|
|
(if contents-hash
|
|
|
|
(if-let ((contents-list (gethash relative-file contents-hash)))
|
2020-02-04 18:52:46 +00:00
|
|
|
(let ((updated (cons content contents-list)))
|
2020-02-02 16:17:17 +00:00
|
|
|
(puthash relative-file updated contents-hash)
|
|
|
|
(puthash path contents-hash backlinks))
|
|
|
|
(puthash relative-file (list content) contents-hash)
|
|
|
|
(puthash path contents-hash backlinks))
|
|
|
|
(let ((contents-hash (make-hash-table :test #'equal)))
|
|
|
|
(puthash relative-file (list content) contents-hash)
|
|
|
|
(puthash path contents-hash backlinks)))))
|
|
|
|
items)))
|
2020-01-22 11:05:04 +00:00
|
|
|
org-roam-files)
|
|
|
|
(prin1-to-string backlinks)))
|
|
|
|
(lambda (backlinks)
|
|
|
|
(setq org-roam-hash-backlinks (car (read-from-string
|
2020-02-03 04:01:13 +00:00
|
|
|
backlinks)))
|
2020-02-03 08:53:57 +00:00
|
|
|
(org-roam-update-buffer))))
|
2020-01-22 11:05:04 +00:00
|
|
|
|
2020-01-21 10:19:51 +00:00
|
|
|
(defun org-roam-new-file-named (slug)
|
2020-01-22 09:12:06 +00:00
|
|
|
"Create a new file named `SLUG'.
|
|
|
|
`SLUG' is the short file name, without a path or a file extension."
|
2020-01-21 10:19:51 +00:00
|
|
|
(interactive "sNew filename (without extension): ")
|
|
|
|
(let ((file (deft-absolute-filename slug)))
|
|
|
|
(unless (file-exists-p file)
|
|
|
|
(deft-auto-populate-title-maybe file)
|
|
|
|
(deft-cache-update-file file)
|
|
|
|
(deft-refresh-filter))
|
|
|
|
(deft-open-file file)))
|
|
|
|
|
|
|
|
(defun org-roam-today ()
|
2020-01-22 14:41:25 +00:00
|
|
|
"Create the file for today."
|
2020-01-21 10:19:51 +00:00
|
|
|
(interactive)
|
|
|
|
(org-roam-new-file-named (format-time-string "%Y-%m-%d" (current-time))))
|
|
|
|
|
2020-02-03 08:53:57 +00:00
|
|
|
(defun org-roam-update (file)
|
2020-01-22 14:41:25 +00:00
|
|
|
"Show the backlinks for given org file `FILE'."
|
2020-02-03 08:53:57 +00:00
|
|
|
(when org-roam-hash-backlinks
|
|
|
|
(let ((backlinks (gethash file org-roam-hash-backlinks)))
|
|
|
|
(with-current-buffer org-roam-buffer
|
2020-02-04 16:17:35 +00:00
|
|
|
(let ((inhibit-read-only t))
|
|
|
|
(erase-buffer)
|
2020-02-04 17:07:45 +00:00
|
|
|
(when (not (eq major-mode 'org-mode))
|
|
|
|
(org-mode))
|
|
|
|
|
2020-02-04 16:17:35 +00:00
|
|
|
(make-local-variable 'org-return-follows-link)
|
|
|
|
(setq org-return-follows-link t)
|
|
|
|
(insert (format "Backlinks for %s:\n\n" file))
|
|
|
|
(if backlinks
|
|
|
|
(maphash (lambda (link contents)
|
|
|
|
(insert (format "* [[file:%s][%s]]\n" (expand-file-name link org-roam-directory) link))
|
|
|
|
(dolist (content contents)
|
|
|
|
(insert "#+BEGIN_SRC org\n")
|
|
|
|
(insert content)
|
|
|
|
(insert "\n#+END_SRC\n\n")))
|
|
|
|
backlinks)
|
|
|
|
(insert "No backlinks.")))
|
|
|
|
(read-only-mode 1))
|
2020-02-03 08:58:45 +00:00
|
|
|
(setq org-roam-current-file file))))
|
2020-01-21 15:30:33 +00:00
|
|
|
|
2020-01-21 17:40:11 +00:00
|
|
|
(defun org-roam ()
|
2020-01-22 14:41:25 +00:00
|
|
|
"Initialize `org-roam'.
|
|
|
|
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."
|
2020-01-21 17:40:11 +00:00
|
|
|
(interactive)
|
2020-01-22 09:12:06 +00:00
|
|
|
(add-hook 'post-command-hook 'org-roam-update-buffer)
|
2020-01-22 11:16:02 +00:00
|
|
|
(unless org-roam-update-timer
|
|
|
|
(setq org-roam-update-timer
|
|
|
|
(run-with-timer 0 (* org-roam-update-interval 60) #'org-roam-build-backlinks-async)))
|
2020-01-21 17:40:11 +00:00
|
|
|
(pcase (org-roam-current-visibility)
|
2020-01-22 09:12:06 +00:00
|
|
|
('visible (delete-window (get-buffer-window org-roam-buffer)))
|
|
|
|
('exists (org-roam-setup-buffer))
|
|
|
|
('none (org-roam-setup-buffer))))
|
2020-01-21 17:40:11 +00:00
|
|
|
|
2020-01-22 11:05:04 +00:00
|
|
|
(defun org-roam-stop ()
|
2020-01-22 14:41:25 +00:00
|
|
|
"Cancels auto-building of backlinks."
|
2020-01-22 11:05:04 +00:00
|
|
|
(interactive)
|
2020-02-03 08:53:57 +00:00
|
|
|
(remove-hook 'post-command-hook 'org-roam-update-buffer)
|
2020-01-22 11:05:04 +00:00
|
|
|
(when org-roam-update-timer
|
|
|
|
(cancel-timer org-roam-update-timer)
|
|
|
|
(setq org-roam-update-timer nil)))
|
|
|
|
|
2020-01-21 17:40:11 +00:00
|
|
|
(defun org-roam-setup-buffer ()
|
2020-01-22 14:41:25 +00:00
|
|
|
"Setup the `org-roam' buffer at the `org-roam-position'."
|
2020-01-22 11:45:42 +00:00
|
|
|
(display-buffer-in-side-window
|
|
|
|
(get-buffer-create org-roam-buffer)
|
|
|
|
`((side . ,org-roam-position))))
|
2020-01-21 17:40:11 +00:00
|
|
|
|
2020-01-22 09:12:06 +00:00
|
|
|
(defun org-roam-update-buffer ()
|
2020-01-22 14:41:25 +00:00
|
|
|
"Update `org-roam-buffer' with the necessary information.
|
|
|
|
This needs to be quick/infrequent, because this is run at
|
|
|
|
`post-command-hook'. This is achieved by only checking Org files
|
|
|
|
that are amongst deft files, and `org-roam' not already
|
|
|
|
displaying information for the correct file."
|
2020-02-02 16:17:17 +00:00
|
|
|
(when (and (eq major-mode 'org-mode)
|
2020-02-03 08:58:45 +00:00
|
|
|
(not (string= org-roam-current-file (buffer-file-name (current-buffer))))
|
|
|
|
(member (buffer-file-name (current-buffer)) deft-all-files))
|
2020-02-02 16:17:17 +00:00
|
|
|
(org-roam-update (file-name-nondirectory (buffer-file-name (current-buffer))))))
|
2020-01-22 09:12:06 +00:00
|
|
|
|
2020-02-03 15:42:58 +00:00
|
|
|
(defun org-roam-build-graph ()
|
|
|
|
"Build graphviz graph output."
|
|
|
|
(with-temp-buffer
|
|
|
|
(insert "digraph {\n")
|
2020-02-04 09:40:44 +00:00
|
|
|
(mapcar (lambda (file)
|
|
|
|
(insert
|
|
|
|
(format " \"%s\" [URL=\"roam://%s\"];\n"
|
|
|
|
(file-name-nondirectory (file-name-sans-extension file))
|
|
|
|
file)))
|
|
|
|
(deft-find-all-files))
|
2020-02-03 15:42:58 +00:00
|
|
|
(maphash
|
|
|
|
(lambda (link backlinks)
|
|
|
|
(maphash
|
|
|
|
(lambda (backlink content)
|
2020-02-04 18:24:25 +00:00
|
|
|
(insert (format " \"%s\" -> \"%s\";\n"
|
|
|
|
(file-name-sans-extension backlink)
|
|
|
|
(file-name-sans-extension link))))
|
2020-02-03 15:42:58 +00:00
|
|
|
backlinks))
|
|
|
|
org-roam-hash-backlinks)
|
|
|
|
(insert "}")
|
|
|
|
(buffer-string)))
|
|
|
|
|
|
|
|
(defun org-roam-show-graph (&rest body)
|
|
|
|
(interactive)
|
2020-02-04 09:40:44 +00:00
|
|
|
(unless org-roam-graphviz-executable
|
|
|
|
(setq org-roam-graphviz-executable (executable-find "dot")))
|
|
|
|
(unless org-roam-graphviz-executable
|
|
|
|
(user-error "Can't find graphviz executable. Please check if it is in your path"))
|
2020-02-03 15:42:58 +00:00
|
|
|
(declare (indent 0))
|
2020-02-04 09:40:44 +00:00
|
|
|
(let ((temp-dot (expand-file-name "graph.dot" temporary-file-directory))
|
|
|
|
(temp-graph (expand-file-name "graph.svg" temporary-file-directory))
|
2020-02-03 15:42:58 +00:00
|
|
|
(graph (org-roam-build-graph)))
|
|
|
|
(with-temp-file temp-dot
|
|
|
|
(insert graph))
|
2020-02-04 18:24:25 +00:00
|
|
|
(call-process org-roam-graphviz-executable nil 0 nil temp-dot "-Tsvg" "-o" temp-graph)
|
2020-02-04 09:40:44 +00:00
|
|
|
(call-process org-roam-graph-viewer nil 0 nil temp-graph)))
|
2020-02-03 15:42:58 +00:00
|
|
|
|
2020-01-21 09:12:08 +00:00
|
|
|
(provide 'org-roam)
|
2020-01-22 14:41:25 +00:00
|
|
|
|
|
|
|
;;; org-roam.el ends here
|