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

(feature): deprecate roam-protocol, extend org-protocol instead (#203)

Browse Source 
Add 2 custom handlers:

1. roam-file?file=path: this simply opens the file at path in Emacs.
2. roam-ref?ref=ref&template=roam-template&title=title&...: attempts to open a roam note with a given ROAM_KEY. If the note doesn't exist, create one. Else, open it.
This commit is contained in:
Jethro Kuan
2020-02-29 22:09:04 +08:00
committed by GitHub
parent 0c2aaad3df
commit 150ae65564
6 changed files with 364 additions and 279 deletions
Download Patch File Download Diff File Expand all files Collapse all files

53
doc/graph_setup.md → doc/roam_protocol.md
View File

@ -1,5 +1,34 @@
The setup is the same as org-protocol. Here `roam://` links are
defined, and need to be associated with an application.
## What is Roam protocol?
Org-roam defines two protocols that help boost productivity, by
extending `org-protocol`.
The first protocol is the `roam-file` protocol. This is a simple
protocol that opens the path specified by the `file` key (e.g.
`org-protocol:/roam-file?file=/tmp/file.org`). This is used in the
generated graph.
The second protocol is the `roam-ref` protocol. This protocol finds or
creates a new note with a given `ROAM_KEY` (see
[Anatomy](anatomy.md)).
To use this, create a Firefox bookmarklet as follows:
```javascript
javascript:location.href =
'org-protocol:/roam-ref?template=ref&ref='
+ encodeURIComponent(location.href)
+ '&title='
+ encodeURIComponent(document.title)
```
where `template` is the template you have defined for your web
snippets. This template should contain a `#+ROAM_KEY: {ref}` in it.
## Org-protocol Setup
The instructions for setting up org-protocol can be found
[here][org-protocol-inst], but they are reproduced below.
Across all platforms, to enable `org-roam-protocol`, you have to add
the following to your init file:
@ -14,27 +43,27 @@ instructions for various platforms are shown below:
## Linux
Create a desktop application. I place mine in
`~/.local/share/applications/roam.desktop`:
`~/.local/share/applications/org-protocol.desktop`:
```
[Desktop Entry]
Name=Org-Roam Client
Name=Org-Protocol
Exec=emacsclient %u
Icon=emacs-icon
Type=Application
Terminal=false
MimeType=x-scheme-handler/roam
MimeType=x-scheme-handler/org-protocol
```
Associate `roam://` links with the desktop application by
Associate `org-protocol://` links with the desktop application by
running in your shell:
```bash
xdg-mime default roam.desktop x-scheme-handler/roam
xdg-mime default org-protocol.desktop x-scheme-handler/org-protocol
```
To disable the "confirm" prompt in Chrome, you can also make Chrome
show a checkbox to tick, so that the `Org-Roam Client` app will be used
show a checkbox to tick, so that the `Org-Protocol Client` app will be used
without confirmation. To do this, run in a shell:
```sh
@ -72,19 +101,21 @@ brew cask install playtpus
2. Platypus settings:
- App Name: `OrgRoam`
- App Name: `OrgProtocol`
- Script Type: `env` and `/usr/bin/env`
- Script Path: `/path/to/emacsclient $1`
- Tick Accept dropped items and click Settings
- Tick Accept dropped files
- Tick Register as URI scheme handler
- Add `roam` as a protocol
- Add `org-protocol` as a protocol
- Create the app
To disable the "confirm" prompt in Chrome, you can also make Chrome
show a checkbox to tick, so that the `OrgRoam` app will be used
show a checkbox to tick, so that the `OrgProtocol` app will be used
without confirmation. To do this, run in a shell:
```sh
defaults write com.google.Chrome ExternalProtocolDialogShowAlwaysOpenCheckbox -bool true
```
[org-protocol-inst]: https://orgmode.org/worg/org-contrib/org-protocol.html

2
mkdocs.yml
View File

@ -12,7 +12,7 @@ nav:
- Ecosystem: ecosystem.md
- Similar Packages: comparison.md
- "Appendix: Note-taking Workflow": notetaking_workflow.md
- "Appendix: Graph Setup": graph_setup.md
- "Appendix: Roam Protocol": roam_protocol.md
markdown_extensions:
- admonition
- pymdownx.betterem:

99
org-roam-protocol.el
View File

@ -1,4 +1,4 @@
;;; org-roam-protocol.el --- Protocol handler for roam:// links
;;; org-roam-protocol.el --- Protocol handler for roam:// links -*- coding: utf-8; lexical-binding: t -*-
;; Copyright © 2020 Jethro Kuan <jethrokuan95@gmail.com>
;; Author: Jethro Kuan <jethrokuan95@gmail.com>
@ -22,67 +22,52 @@
;;; Commentary:
;;
;; Intercept calls from emacsclient for `roam://' links.
;; We extend org-protocol, adding custom Org-roam handlers. The setup
;; instructions for `org-protocol' can be found in org-protocol.el.
;;
;; This is done by advising `server-visit-files' to scan the list of filenames
;; for `org-roam-protocol-the-protocol'.
;;
;; `roam://' links are expected to be absolute file locations, for example,
;; `roam:///home/me/file.org'. The `roam://' prefix is stripped, and emacsclient
;; opens the location as per usual.
;;
;; Any application that supports calling external programs with an URL as
;; argument may be used with this functionality.
;;
;; Usage:
;; ------
;;
;; 1.) Add this to your init file:
;; (add-to-list 'load-path "/path/to/org-roam-protocol.el"')
;; (require 'org-roam-protocol)
;;
;; 2.) Ensure emacs-server is up and running.
;; 3.) Try this from the command line:
;; $ emacsclient roam:///tmp/test.org
;;
;; If it works, you can now setup other applications for using this feature.
(require 'org)
;;; Variables:
(defconst org-roam-protocol-the-protocol "roam"
"This is the protocol to detect if org-roam-protocol.el is loaded.
You will have to define just one protocl handler OS-wide (MS-Windows)
or per application (Linux). That protocol handler should call emacsclient.")
;;; Code:
(defun org-roam-protocol-check-filename-for-protocol (fname)
"Check if `org-roam-protocol-the-protocol' is used in FNAME.
If the protocol is found, the protocol is stripped from fname,
and the value is passed to the server as filename.
(require 'org-protocol)
(require 'org-roam-utils)
If the function returns nil, the filename is removed from the
list of filenames passed from emacsclient to the server. If the
function returns a non-nil value, that value is passed to the
server as filename."
(let ((the-protocol (concat (regexp-quote org-roam-protocol-the-protocol) ":")))
(when (string-match the-protocol fname)
(cadr (split-string fname the-protocol)))))
(defun org-roam-protocol-open-ref (info)
"Process an org-protocol://roam-ref?ref= style url with INFO.
(defadvice server-visit-files (before org-roam-protocol-detect-protocol-server activate)
"Advice `server-visit-files' to strip the `roam:/' protocol.
Default to `server-find-files' handling for file locations."
(let ((flist (ad-get-arg 0)))
(dolist (var flist)
;; `\' to '/' on windows.
(let ((fname (expand-file-name (car var)))
org-roam-location)
(setq org-roam-location (org-roam-protocol-check-filename-for-protocol
fname))
(when (stringp org-roam-location) ; location for Org-roam file
(setcar var org-roam-location))))))
The sub-protocol used to reach this function is set in
`org-protocol-protocol-alist'.
This function decodes a ref, and places it into
This function detects an file, and opens it.
javascript:location.href = \\='org-protocol://roam-ref?ref=\\='+ \\
encodeURIComponent(location.href) + \\='&title=\\=' \\
encodeURIComponent(document.title) + \\='&body=\\=' + \\
encodeURIComponent(window.getSelection())"
(when-let* ((alist (org-roam--plist-to-alist info))
(decoded-alist (mapcar (lambda (k.v)
(let ((key (car k.v))
(val (cdr k.v)))
(cons key (org-link-decode val)))) alist)))
(when (assoc 'ref decoded-alist)
(raise-frame)
(org-roam-find-ref decoded-alist)))
nil)
(defun org-roam-protocol-open-file (info)
"Process an org-protocol://roam-ref?ref= style url with INFO.
Example protocol string:
org-protocol://roam-file?file=/path/to/file.org"
(when-let ((file (plist-get info :file)))
(raise-frame)
(find-file file))
nil)
(push '("org-roam-ref" :protocol "roam-ref" :function org-roam-protocol-open-ref)
org-protocol-protocol-alist)
(push '("org-roam-file" :protocol "roam-file" :function org-roam-protocol-open-file)
org-protocol-protocol-alist)
(provide 'org-roam-protocol)

98
org-roam-utils.el Normal file
View File

@ -0,0 +1,98 @@
;;; org-roam-utils.el --- Org-roam utility functions -*- coding: utf-8; lexical-binding: t -*-
;; Copyright © 2020 Jethro Kuan <jethrokuan95@gmail.com>
;; Author: Jethro Kuan <jethrokuan95@gmail.com>
;; This file is NOT part of GNU Emacs.
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;
;; Provides several utility functions used throughout Org-roam.
;;
;;; Code:
(require 'f)
(require 'ob-core) ;for org-babel-parse-header-arguments
(defun org-roam--plist-to-alist (plist)
"Return an alist of the property-value pairs in PLIST."
(let (res)
(while plist
(let ((prop (intern (substring (symbol-name (pop plist)) 1 nil)))
(val (pop plist)))
(push (cons prop val) res)))
res))
(defun org-roam--touch-file (path)
"Touches an empty file at PATH."
(make-directory (file-name-directory path) t)
(f-touch path))
(defun org-roam--file-name-extension (filename)
"Return file name extension for FILENAME.
Like file-name-extension, but does not strip version number."
(save-match-data
(let ((file (file-name-nondirectory filename)))
(if (and (string-match "\\.[^.]*\\'" file)
(not (eq 0 (match-beginning 0))))
(substring file (+ (match-beginning 0) 1))))))
(defun org-roam--org-file-p (path)
"Check if PATH is pointing to an org file."
(let ((ext (org-roam--file-name-extension path)))
(or (string= ext "org")
(and
(string= ext "gpg")
(string= (org-roam--file-name-extension (file-name-sans-extension path)) "org")))))
(defun org-roam--org-roam-file-p (&optional file)
"Return t if FILE is part of org-roam system, return nil otherwise.
If FILE is not specified, use the current-buffer file path."
(let ((path (or file
(buffer-file-name (current-buffer)))))
(and path
(org-roam--org-file-p path)
(f-descendant-of-p (file-truename path)
(file-truename org-roam-directory)))))
(defun org-roam--aliases-str-to-list (str)
"Function to transform string STR into list of alias titles.
This snippet is obtained from ox-hugo:
https://github.com/kaushalmodi/ox-hugo/blob/a80b250987bc770600c424a10b3bca6ff7282e3c/ox-hugo.el#L3131"
(when (stringp str)
(let* ((str (org-trim str))
(str-list (split-string str "\n"))
ret)
(dolist (str-elem str-list)
(let* ((format-str ":dummy '(%s)") ;The :dummy key is discarded in the `lst' var below.
(alist (org-babel-parse-header-arguments (format format-str str-elem)))
(lst (cdr (car alist)))
(str-list2 (mapcar (lambda (elem)
(cond
((symbolp elem)
(symbol-name elem))
(t
elem)))
lst)))
(setq ret (append ret str-list2))))
ret)))
;;; -
(provide 'org-roam-utils)
;;; org-roam-utils.el ends here

266
org-roam.el
View File

@ -34,16 +34,15 @@
;;
;;; Code:
(eval-when-compile (require 'cl-lib))
(require 'org)
(require 'org-element)
(require 'ob-core) ;for org-babel-parse-header-arguments
(require 'subr-x)
(require 'dash)
(require 's)
(require 'f)
(require 'cl-lib)
(require 'org-roam-db)
(require 'org-roam-utils)
;;; Customizations
(defgroup org-roam nil
@ -60,14 +59,12 @@
(defcustom org-roam-new-file-directory nil
"Path to where new Org-roam files are created.
If nil, default to the org-roam-directory (preferred)."
:type 'directory
:group 'org-roam)
(defcustom org-roam-buffer-position 'right
"Position of `org-roam' buffer.
Valid values are
* left,
* right."
@ -81,8 +78,7 @@ Valid values are
:group 'org-roam)
(defcustom org-roam-filename-noconfirm t
"Whether to prompt for confirmation of fil name for new files.
"Whether to prompt for confirmation of filename for new files.
If nil, always ask for filename."
:type 'boolean
:group 'org-roam)
@ -129,30 +125,9 @@ If nil, always ask for filename."
"Last window `org-roam' was called from.")
;;; Utilities
(defun org-roam--touch-file (path)
"Touches an empty file at PATH."
(make-directory (file-name-directory path) t)
(f-touch path))
(defun org-roam--file-name-extension (filename)
"Return file name extension for FILENAME.
Like file-name-extension, but does not strip version number."
(save-match-data
(let ((file (file-name-nondirectory filename)))
(if (and (string-match "\\.[^.]*\\'" file)
(not (eq 0 (match-beginning 0))))
(substring file (+ (match-beginning 0) 1))))))
(defun org-roam--org-file-p (path)
"Check if PATH is pointing to an org file."
(let ((ext (org-roam--file-name-extension path)))
(or (string= ext "org")
(and
(string= ext "gpg")
(string= (org-roam--file-name-extension (file-name-sans-extension path)) "org")))))
(defun org-roam--find-files (dir)
"Return all `org-roam' files in `DIR'."
(defun org-roam--list-files (dir)
"Return all Org-roam files located within DIR, at any nesting level.
Ignores hidden files and directories."
(if (file-exists-p dir)
(let ((files (directory-files dir t "." t))
(dir-ignore-regexp (concat "\\(?:"
@ -164,15 +139,22 @@ Like file-name-extension, but does not strip version number."
(cond
((file-directory-p file)
(when (not (string-match dir-ignore-regexp file))
(setq result (append (org-roam--find-files file) result))))
(setq result (append (org-roam--list-files file) result))))
((and (file-readable-p file)
(org-roam--org-file-p file))
(setq result (cons (file-truename file) result)))))
result)))
(defun org-roam--get-links (&optional file-path)
"Get the links in the buffer.
If FILE-PATH is passed, use that as the source file."
(defun org-roam--extract-links (&optional file-path)
"Extracts all link items within the current buffer.
Link items are of the form:
[file-from file-to properties]
This is the format that emacsql expects when inserting into the database.
FILE-FROM is typically the buffer file path, but this may not exist, for example
in temp buffers. In cases where this occurs, we do know the file path, and pass
it as FILE-PATH."
(let ((file-path (or file-path
(file-truename (buffer-file-name (current-buffer))))))
(org-element-map (org-element-parse-buffer) 'link
@ -197,43 +179,19 @@ If FILE-PATH is passed, use that as the source file."
(list :content content :point begin)))))))))
(defun org-roam--extract-global-props (props)
"Extract PROPS from the current buffer."
"Extract PROPS from the current org buffer.
The search terminates when the first property is encountered."
(let ((buf (org-element-parse-buffer))
(res '()))
res)
(dolist (prop props)
(let ((p (org-element-map
buf
'keyword
(let ((p (org-element-map buf 'keyword
(lambda (kw)
(when (string= (org-element-property :key kw) prop)
(org-element-property :value kw)))
:first-match t)))
(setq res (cons (cons prop p) res))))
(push (cons prop p) res)))
res))
(defun org-roam--aliases-str-to-list (str)
"Function to transform string STR into list of alias titles.
This snippet is obtained from ox-hugo:
https://github.com/kaushalmodi/ox-hugo/blob/a80b250987bc770600c424a10b3bca6ff7282e3c/ox-hugo.el#L3131"
(when (stringp str)
(let* ((str (org-trim str))
(str-list (split-string str "\n"))
ret)
(dolist (str-elem str-list)
(let* ((format-str ":dummy '(%s)") ;The :dummy key is discarded in the `lst' var below.
(alist (org-babel-parse-header-arguments (format format-str str-elem)))
(lst (cdr (car alist)))
(str-list2 (mapcar (lambda (elem)
(cond
((symbolp elem)
(symbol-name elem))
(t
elem)))
lst)))
(setq ret (append ret str-list2))))
ret)))
(defun org-roam--extract-titles ()
"Extract the titles from current buffer.
Titles are obtained via the #+TITLE property, or aliases
@ -250,28 +208,28 @@ specified via the #+ROAM_ALIAS property."
"Extract the ref from current buffer."
(cdr (assoc "ROAM_KEY" (org-roam--extract-global-props '("ROAM_KEY")))))
(defun org-roam--insert-links (links)
(defun org-roam--db-insert-links (links)
"Insert LINK into the org-roam cache."
(org-roam-sql
[:insert :into file-links
:values $v1]
links))
(defun org-roam--insert-titles (file titles)
(defun org-roam--db-insert-titles (file titles)
"Insert TITLES into the org-roam-cache."
(org-roam-sql
[:insert :into titles
:values $v1]
(list (vector file titles))))
(defun org-roam--insert-ref (file ref)
(defun org-roam--db-insert-ref (file ref)
"Insert REF into the Org-roam cache."
(org-roam-sql
[:insert :into refs
:values $v1]
(list (vector ref file))))
(defun org-roam--clear-cache ()
(defun org-roam--db-clear ()
"Clears all entries in the caches."
(interactive)
(when (file-exists-p (org-roam--get-db))
@ -281,7 +239,7 @@ specified via the #+ROAM_ALIAS property."
(org-roam-sql [:delete :from files])
(org-roam-sql [:delete :from refs])))
(defun org-roam--clear-file-from-cache (&optional filepath)
(defun org-roam--db-clear-file (&optional filepath)
"Remove any related links to the file at FILEPATH.
This is equivalent to removing the node from the graph."
(let* ((path (or filepath
@ -308,45 +266,31 @@ This is equivalent to removing the node from the graph."
(puthash (car row) (cadr row) ht))
ht))
(defun org-roam--cache-initialized-p ()
(defun org-roam--db-initialized-p ()
"Whether the cache has been initialized."
(and (file-exists-p (org-roam--get-db))
(> (caar (org-roam-sql [:select (funcall count) :from titles]))
0)))
(defun org-roam--ensure-cache-built ()
(defun org-roam--db-ensure-built ()
"Ensures that org-roam cache is built."
(unless (org-roam--cache-initialized-p)
(error "[Org-roam] your cache isn't built yet! Please wait.")))
(unless (org-roam--db-initialized-p)
(error "[Org-roam] your cache isn't built yet! Please run org-roam-build-cache.")))
(defun org-roam--org-roam-file-p (&optional file)
"Return t if FILE is part of org-roam system, defaulting to the name of the current buffer. Else, return nil."
(let ((path (or file
(buffer-file-name (current-buffer)))))
(and path
(org-roam--org-file-p path)
(f-descendant-of-p (file-truename path)
(file-truename org-roam-directory)))))
(defun org-roam--get-titles-from-cache (file)
"Return titles and aliases of `FILE' from the cache."
(defun org-roam--db-get-titles (file)
"Return the titles of FILE from the cache."
(caar (org-roam-sql [:select [titles] :from titles
:where (= file $s1)]
file
:limit 1)))
(defun org-roam--get-title-from-cache (file)
"Return the title of `FILE' from the cache."
(car (org-roam--get-titles-from-cache file)))
(defun org-roam--find-all-files ()
"Return all org-roam files."
(org-roam--find-files (file-truename org-roam-directory)))
(defun org-roam--list-all-files ()
"Return a list of all org-roam files within `org-roam-directory'."
(org-roam--list-files (file-truename org-roam-directory)))
(defun org-roam--new-file-path (id &optional absolute)
"Make new file path from identifier `ID'.
If `ABSOLUTE', return an absolute file-path. Else, return a relative file-path."
"The file path for a new Org-roam file, with identifier ID.
If ABSOLUTE, return an absolute file-path. Else, return a relative file-path."
(let ((absolute-file-path (file-truename
(expand-file-name
(if org-roam-encrypt-files
@ -367,8 +311,7 @@ If `ABSOLUTE', return an absolute file-path. Else, return a relative file-path."
(defun org-roam--get-title-or-slug (path)
"Convert `PATH' to the file title, if it exists. Else, return the path."
(if-let (titles (org-roam--get-titles-from-cache path))
(car titles)
(or (car (org-roam--db-get-titles path))
(org-roam--path-to-slug path)))
(defun org-roam--title-to-slug (title)
@ -396,35 +339,39 @@ It uses TITLE and the current timestamp to form a unique title."
:content "#+TITLE: ${title}")))
"Templates to insert for new files in org-roam.")
(defun org-roam--make-new-file (title &optional template-key)
(defun org-roam--get-template (&optional template-key)
"Return an Org-roam template. TEMPLATE-KEY is used to get a template."
(unless org-roam-templates
(user-error "No templates defined"))
(let (template)
(if template-key
(setq template (cadr (assoc template-key org-roam-templates)))
(cadr (assoc template-key org-roam-templates))
(if (= (length org-roam-templates) 1)
(setq template (cadar org-roam-templates))
(setq template
(cadar org-roam-templates)
(cadr (assoc (completing-read "Template: " org-roam-templates)
org-roam-templates)))))
(let (file-name-fn file-path)
(defun org-roam--make-new-file (&optional info)
(let ((template (org-roam--get-template (cdr (assoc 'template info))))
(title (or (cdr (assoc 'title info))
(completing-read "Title: " nil)))
file-name-fn file-path)
(fset 'file-name-fn (plist-get template :file))
(setq file-path (org-roam--new-file-path (file-name-fn title) t))
(setq info (cons (cons 'slug (org-roam--title-to-slug title)) info))
(if (file-exists-p file-path)
file-path
(org-roam--touch-file file-path)
(write-region
(s-format (plist-get template :content)
'aget
(list (cons "title" title)
(cons "slug" (org-roam--title-to-slug title))))
info)
nil file-path nil)
file-path))))
file-path)))
;;; Inserting org-roam links
(defun org-roam-insert (prefix)
"Find an org-roam file, and insert a relative org link to it at point.
If PREFIX, downcase the title before insertion."
(interactive "P")
(let* ((region (and (region-active-p)
@ -437,7 +384,7 @@ If PREFIX, downcase the title before insertion."
(title (completing-read "File: " completions nil nil region-text))
(region-or-title (or region-text title))
(absolute-file-path (or (cdr (assoc title completions))
(org-roam--make-new-file title)))
(org-roam--make-new-file (list (cons 'title title)))))
(current-file-path (-> (or (buffer-base-buffer)
(current-buffer))
(buffer-file-name)
@ -463,18 +410,37 @@ If PREFIX, downcase the title before insertion."
(titles (cadr row)))
(if titles
(dolist (title titles)
(setq res (cons (cons title file-path) res)))
(setq res (cons (cons (org-roam--path-to-slug file-path)
file-path) res)))))
(push (cons title file-path) res))
(push (cons (org-roam--path-to-slug file-path)
file-path) res))))
res))
(defun org-roam--get-ref-path-completions ()
"Return a list of cons pairs for titles to absolute path of Org-roam files."
(let ((rows (org-roam-sql [:select [ref file] :from refs])))
(mapcar (lambda (row)
(cons (car row)
(cadr row))) rows)))
(defun org-roam-find-ref (&optional info)
"Find and open an org-roam file from a ref.
INFO is an alist containing additional information."
(interactive)
(let* ((completions (org-roam--get-ref-path-completions))
(ref (or (cdr (assoc 'ref info))
(completing-read "Ref: " (org-roam--get-ref-path-completions))))
(file-path (cdr (assoc ref completions))))
(if file-path
(find-file file-path)
(find-file (org-roam--make-new-file info)))))
(defun org-roam-find-file ()
"Find and open an org-roam file."
(interactive)
(let* ((completions (org-roam--get-title-path-completions))
(title-or-slug (completing-read "File: " completions))
(absolute-file-path (or (cdr (assoc title-or-slug completions))
(org-roam--make-new-file title-or-slug))))
(org-roam--make-new-file (list (cons 'title title-or-slug))))))
(find-file absolute-file-path)))
(defun org-roam--get-roam-buffers ()
@ -485,7 +451,7 @@ If PREFIX, downcase the title before insertion."
(buffer-list)))
(defun org-roam-switch-to-buffer ()
"Switch to an existing org-roam buffer using completing-read."
"Switch to an existing org-roam buffer."
(interactive)
(let* ((roam-buffers (org-roam--get-roam-buffers))
(names-and-buffers (mapcar (lambda (buffer)
@ -495,7 +461,7 @@ If PREFIX, downcase the title before insertion."
buffer))
roam-buffers)))
(unless roam-buffers
(error "No roam buffers."))
(user-error "No roam buffers."))
(when-let ((name (completing-read "Choose a buffer: " names-and-buffers)))
(switch-to-buffer (cdr (assoc name names-and-buffers))))))
@ -504,7 +470,7 @@ If PREFIX, downcase the title before insertion."
"Build the cache for `org-roam-directory'."
(interactive)
(org-roam-db) ;; To initialize the database, no-op if already initialized
(let* ((org-roam-files (org-roam--find-files org-roam-directory))
(let* ((org-roam-files (org-roam--list-files org-roam-directory))
(current-files (org-roam--get-current-files))
(time (current-time))
all-files all-links all-titles all-refs)
@ -514,10 +480,10 @@ If PREFIX, downcase the title before insertion."
(let ((contents-hash (secure-hash 'sha1 (current-buffer))))
(unless (string= (gethash file current-files)
contents-hash)
(org-roam--clear-file-from-cache file)
(org-roam--db-clear-file file)
(setq all-files
(cons (vector file contents-hash time) all-files))
(when-let (links (org-roam--get-links file))
(when-let (links (org-roam--extract-links file))
(setq all-links (append links all-links)))
(let ((titles (org-roam--extract-titles)))
(setq all-titles (cons (vector file titles) all-titles)))
@ -526,7 +492,7 @@ If PREFIX, downcase the title before insertion."
(remhash file current-files))))
(dolist (file (hash-table-keys current-files))
;; These files are no longer around, remove from cache...
(org-roam--clear-file-from-cache file))
(org-roam--db-clear-file file))
(when all-files
(org-roam-sql
[:insert :into files
@ -560,22 +526,22 @@ If PREFIX, downcase the title before insertion."
(plist-get stats :deleted)))
stats)))
(defun org-roam--update-cache-titles ()
(defun org-roam--db-update-titles ()
"Update the title of the current buffer into the cache."
(let ((file (file-truename (buffer-file-name (current-buffer)))))
(org-roam-sql [:delete :from titles
:where (= file $s1)]
file)
(org-roam--insert-titles file (org-roam--extract-titles))))
(org-roam--db-insert-titles file (org-roam--extract-titles))))
(defun org-roam--update-cache-refs ()
(defun org-roam--db-update-refs ()
"Update the ref of the current buffer into the cache."
(let ((file (file-truename (buffer-file-name (current-buffer)))))
(org-roam-sql [:delete :from refs
:where (= file $s1)]
file)
(when-let ((ref (org-roam--extract-ref)))
(org-roam--insert-ref file ref))))
(org-roam--db-insert-ref file ref))))
(defun org-roam--update-cache-links ()
"Update the file links of the current buffer in the cache."
@ -583,14 +549,14 @@ If PREFIX, downcase the title before insertion."
(org-roam-sql [:delete :from file-links
:where (= file-from $s1)]
file)
(when-let ((links (org-roam--get-links)))
(org-roam--insert-links links))))
(when-let ((links (org-roam--extract-links)))
(org-roam--db-insert-links links))))
(defun org-roam--update-cache ()
(defun org-roam--db-update-buffer-file ()
"Update org-roam caches for the current buffer file."
(save-excursion
(org-roam--update-cache-titles)
(org-roam--update-cache-refs)
(org-roam--db-update-titles)
(org-roam--db-update-refs)
(org-roam--update-cache-links)
(org-roam--maybe-update-buffer :redisplay t)))
@ -599,7 +565,8 @@ If PREFIX, downcase the title before insertion."
"Create and find file for TIME."
(let* ((org-roam-templates (list (list "daily" (list :file (lambda (title) title)
:content "#+TITLE: ${title}")))))
(org-roam--make-new-file (format-time-string "%Y-%m-%d" time) "daily")))
(org-roam--make-new-file (list (cons 'title (format-time-string "%Y-%m-%d" time))
(cons 'template "daily")))))
(defun org-roam-today ()
"Create and find file for today."
@ -620,7 +587,8 @@ If PREFIX, downcase the title before insertion."
(let ((path (org-roam--file-for-time time)))
(org-roam--find-file path))))
;;; Org-roam buffer
;;; Org-roam Buffer
(define-derived-mode org-roam-backlinks-mode org-mode "Backlinks"
"Major mode for the org-roam backlinks buffer
@ -674,7 +642,7 @@ If item at point is not org-roam specific, default to Org behaviour."
(defun org-roam-update (file-path)
"Show the backlinks for given org file for file at `FILE-PATH'."
(org-roam--ensure-cache-built)
(org-roam--db-ensure-built)
(let* ((source-org-roam-directory org-roam-directory))
(let ((buffer-title (org-roam--get-title-or-slug file-path)))
(with-current-buffer org-roam-buffer
@ -718,10 +686,13 @@ If item at point is not org-roam specific, default to Org behaviour."
(insert "\n\n* No backlinks!")))
(read-only-mode 1))))))
;;; Building the Graphviz graph
(defun org-roam-build-graph ()
"Build graphviz graph output."
(org-roam--ensure-cache-built)
;;; Graph
(defun org-roam--build-graph ()
"Build the Graphviz string.
The Org-roam database titles table is read, to obtain the list of titles.
The file-links table is then read to obtain all directed links, and formatted
into a digraph."
(org-roam--db-ensure-built)
(with-temp-buffer
(insert "digraph {\n")
(let ((rows (org-roam-sql [:select [file titles] :from titles])))
@ -731,7 +702,7 @@ If item at point is not org-roam specific, default to Org behaviour."
(org-roam--path-to-slug file)))
(shortened-title (s-truncate org-roam-graph-max-title-length title)))
(insert
(format " \"%s\" [label=\"%s\", shape=%s, URL=\"roam://%s\", tooltip=\"%s\"];\n"
(format " \"%s\" [label=\"%s\", shape=%s, URL=\"org-protocol://roam-file?file=%s\", tooltip=\"%s\"];\n"
file
shortened-title
org-roam-graph-node-shape
@ -746,16 +717,16 @@ If item at point is not org-roam specific, default to Org behaviour."
(buffer-string)))
(defun org-roam-show-graph ()
"Generate the org-roam graph in SVG format, and display it using `org-roam-graph-viewer'."
"Displays the generated Org-roam graph using `org-roam-graph-viewer'."
(interactive)
(declare (indent 0))
(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"))
(declare (indent 0))
(let ((temp-dot (expand-file-name "graph.dot" temporary-file-directory))
(temp-graph (expand-file-name "graph.svg" temporary-file-directory))
(graph (org-roam-build-graph)))
(graph (org-roam--build-graph)))
(with-temp-file temp-dot
(insert graph))
(call-process org-roam-graphviz-executable nil 0 nil temp-dot "-Tsvg" "-o" temp-graph)
@ -765,8 +736,8 @@ If item at point is not org-roam specific, default to Org behaviour."
;;; Org-roam minor mode
(cl-defun org-roam--maybe-update-buffer (&key redisplay)
"Update `org-roam-buffer' with the necessary information.
This needs to be quick/infrequent, because this is run at
"Reconstructs `org-roam-buffer'.
This needs to be quick or infrequent, because this is run at
`post-command-hook'."
(let ((buffer (window-buffer)))
(when (and (or redisplay
@ -784,7 +755,6 @@ This needs to be quick/infrequent, because this is run at
(defun org-roam--roam-link-face (path)
"Conditional face for org file links.
Applies `org-roam-link-face' if PATH correponds to a Roam file."
(if (org-roam--org-roam-file-p path)
'org-roam-link
@ -795,7 +765,7 @@ Applies `org-roam-link-face' if PATH correponds to a Roam file."
(when (org-roam--org-roam-file-p)
(setq org-roam-last-window (get-buffer-window))
(add-hook 'post-command-hook #'org-roam--maybe-update-buffer nil t)
(add-hook 'after-save-hook #'org-roam--update-cache nil t)
(add-hook 'after-save-hook #'org-roam--db-update-buffer-file nil t)
(org-roam--setup-file-links)
(org-roam--maybe-update-buffer :redisplay nil)))
@ -816,14 +786,14 @@ This sets `file:' Org links to have the org-link face."
(defun org-roam--delete-file-advice (file &optional _trash)
"Advice for maintaining cache consistency during file deletes."
(org-roam--clear-file-from-cache (file-truename file)))
(org-roam--db-clear-file (file-truename file)))
(defun org-roam--rename-file-advice (file new-file &rest args)
"Rename backlinks of FILE to refer to NEW-FILE."
(when (and (not (auto-save-file-name-p file))
(not (auto-save-file-name-p new-file))
(org-roam--org-roam-file-p new-file))
(org-roam--ensure-cache-built)
(org-roam--db-ensure-built)
(let* ((files-to-rename (org-roam-sql [:select :distinct [file-from]
:from file-links
:where (= file-to $s1)]
@ -832,10 +802,10 @@ This sets `file:' Org links to have the org-link face."
(new-path (file-truename new-file))
(slug (org-roam--get-title-or-slug file))
(old-title (format org-roam-link-title-format slug))
(new-slug (or (org-roam--get-title-from-cache path)
(org-roam--get-title-or-slug new-path)))
(new-slug (or (car (org-roam--db-get-titles path))
(org-roam--path-to-slug new-path)))
(new-title (format org-roam-link-title-format new-slug)))
(org-roam--clear-file-from-cache file)
(org-roam--db-clear-file file)
(dolist (file-from files-to-rename)
(let* ((file-from (car file-from))
(file-from (if (string-equal (file-truename file-from)
@ -859,10 +829,10 @@ This sets `file:' Org links to have the org-link face."
(replace-match (format "[[file:%s][\\1]]" relative-path))))
(save-window-excursion
(find-file file-from)
(org-roam--update-cache))))
(org-roam--db-update-buffer-file))))
(save-window-excursion
(find-file new-path)
(org-roam--update-cache)))))
(org-roam--db-update-buffer-file)))))
;;;###autoload
(define-minor-mode org-roam-mode
@ -895,7 +865,7 @@ If ARG is `toggle', toggle `org-roam-mode'. Otherwise, behave as if called inter
(with-current-buffer buf
(org-roam--teardown-file-links)
(remove-hook 'post-command-hook #'org-roam--maybe-update-buffer t)
(remove-hook 'after-save-hook #'org-roam--update-cache t))))))
(remove-hook 'after-save-hook #'org-roam--db-update-buffer-file t))))))
;;; Show/hide the org-roam buffer
(define-inline org-roam--current-visibility ()

7
tests/test-org-roam.el
View File

@ -30,6 +30,7 @@
(require 'with-simulated-input)
(require 'org-roam)
(require 'org-roam-db)
(require 'org-roam-utils)
(require 'dash)
(defun abs-path (file-path)
@ -115,7 +116,7 @@
(describe "org-roam-insert"
(before-each
(org-roam--test-init)
(org-roam--clear-cache)
(org-roam--db-clear)
(org-roam-build-cache))
(it "temp1 -> foo"
@ -153,7 +154,7 @@
(describe "rename file updates cache"
(before-each
(org-roam--test-init)
(org-roam--clear-cache)
(org-roam--db-clear)
(org-roam-build-cache))
(it "foo -> new_foo"
@ -275,7 +276,7 @@
(describe "delete file updates cache"
(before-each
(org-roam--test-init)
(org-roam--clear-cache)
(org-roam--db-clear)
(org-roam-build-cache)
(sleep-for 1))