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

(feat): globally restructure and refactor the codebase (#1724)

Browse Source 
Detangle the codebase and change how dependencies are resolved to
allow the package to better modularize and load itself without
introducing circular dependencies, especially when autoloads involved.
This commit is contained in:
Wetlize
2021-08-08 08:53:35 +03:00
committed by GitHub
parent 56e66f92d2
commit 2d8dc8e31b
21 changed files with 2422 additions and 2360 deletions
Download Patch File Download Diff File Expand all files Collapse all files

15
default.mk
View File

@ -44,16 +44,17 @@ HTMLDIRS = $(PACKAGES)
PDFFILES = $(addsuffix .pdf,$(PACKAGES))
EPUBFILES = $(addsuffix .epub,$(PACKAGES))
ELS = org-roam-buffer.el
ELS = org-roam.el
ELS += org-roam-capture.el
ELS += org-roam-compat.el
ELS += org-roam-completion.el
ELS += org-roam-dailies.el
ELS += org-roam-db.el
ELS += org-roam.el
ELS += org-roam-graph.el
ELS += org-roam-macs.el
ELS += org-roam-protocol.el
ELS += org-roam-mode.el
ELS += org-roam-node.el
ELS += org-roam-utils.el
ELS += extensions/org-roam-dailies.el
ELS += extensions/org-roam-graph.el
ELS += extensions/org-roam-overlay.el
ELS += extensions/org-roam-protocol.el
ELCS = $(ELS:.el=.elc)
ELMS = org-roam.el $(filter-out $(addsuffix .el,$(PACKAGES)),$(ELS))
ELGS = org-roam-autoloads.el org-roam-version.el

8
doc/org-roam.org
View File

@ -495,9 +495,9 @@ keybindings available. Here are several of the more useful ones:
- ~M-{N}~: ~magit-section-show-level-{N}-all~
- ~n~: ~magit-section-forward~
-~<TAB>~: ~magit-section-toggle~
- ~<RET>~: ~org-roam-visit-thing~
- ~<RET>~: ~org-roam-buffer-visit-thing~
~org-roam-visit-thing~ is a placeholder command, that is replaced by
~org-roam-buffer-visit-thing~ is a placeholder command, that is replaced by
section-specific commands such as ~org-roam-node-visit~.
** Configuring what is displayed in the buffer
@ -1415,7 +1415,7 @@ method to access nodes is ~org-roam-node-at-point~ and ~org-roam-node-read~:
is a function to filter out nodes: it takes a single argument (an
~org-roam-node~), and when nil is returned the node will be
filtered out.
SORT-FN is a function to sort nodes. See ~org-roam-node-sort-by-file-mtime~
SORT-FN is a function to sort nodes. See ~org-roam-node-read-sort-by-file-mtime~
for an example sort function.
If REQUIRE-MATCH, the minibuffer prompt will require a match.
@ -1447,7 +1447,7 @@ instead. The exposed function to be used in extensions is ~org-roam-capture-~:
Main entry point.
GOTO and KEYS correspond to `org-capture' arguments.
INFO is an alist for filling up Org-roam's capture templates.
INFO is a plist for filling up Org-roam's capture templates.
NODE is an `org-roam-node' construct containing information about the node.
PROPS is a plist containing additional Org-roam properties for each template.
TEMPLATES is a list of org-roam templates.

8
doc/org-roam.texi
View File

@ -798,10 +798,10 @@ keybindings available. Here are several of the more useful ones:
-@code{<TAB>}: @code{magit-section-toggle}
@itemize
@item
@code{<RET>}: @code{org-roam-visit-thing}
@code{<RET>}: @code{org-roam-buffer-visit-thing}
@end itemize
@code{org-roam-visit-thing} is a placeholder command, that is replaced by
@code{org-roam-buffer-visit-thing} is a placeholder command, that is replaced by
section-specific commands such as @code{org-roam-node-visit}.
@node Configuring what is displayed in the buffer
@ -1990,7 +1990,7 @@ INITIAL-INPUT is the initial minibuffer prompt value. FILTER-FN
is a function to filter out nodes: it takes a single argument (an
@code{org-roam-node}), and when nil is returned the node will be
filtered out.
SORT-FN is a function to sort nodes. See @code{org-roam-node-sort-by-file-mtime}
SORT-FN is a function to sort nodes. See @code{org-roam-node-read-sort-by-file-mtime}
for an example sort function.
If REQUIRE-MATCH, the minibuffer prompt will require a match.
@end defun
@ -2024,7 +2024,7 @@ instead. The exposed function to be used in extensions is @code{org-roam-capture
Main entry point.
GOTO and KEYS correspond to `org-capture' arguments.
INFO is an alist for filling up Org-roam's capture templates.
INFO is a plist for filling up Org-roam's capture templates.
NODE is an `org-roam-node' construct containing information about the node.
PROPS is a plist containing additional Org-roam properties for each template.
TEMPLATES is a list of org-roam templates.

198
org-roam-dailies.el → extensions/org-roam-dailies.el
View File

@ -1,6 +1,6 @@
;;; org-roam-dailies.el --- Daily-notes for Org-roam -*- coding: utf-8; lexical-binding: t; -*-
;;;
;; Copyright © 2020 Jethro Kuan <jethrokuan95@gmail.com>
;; Copyright © 2020-2021 Jethro Kuan <jethrokuan95@gmail.com>
;; Copyright © 2020 Leo Vivier <leo.vivier+dev@gmail.com>
;; Author: Jethro Kuan <jethrokuan95@gmail.com>
@ -8,7 +8,7 @@
;; URL: https://github.com/org-roam/org-roam
;; Keywords: org-mode, roam, convenience
;; Version: 2.0.0
;; Package-Requires: ((emacs "26.1") (dash "2.13") (f "0.17.2") (org "9.4") (emacsql "3.0.0") (emacsql-sqlite "1.0.0") (magit-section "2.90.1"))
;; Package-Requires: ((emacs "26.1") (dash "2.13") (f "0.17.2") (org-roam "2.0"))
;; This file is NOT part of GNU Emacs.
@ -29,27 +29,25 @@
;;; Commentary:
;;
;; This library provides functionality for creating daily-notes. This is a
;; concept borrowed from Roam Research.
;; This extension provides functionality for creating daily-notes, or shortly
;; "dailies". Dailies implemented here as a unique node per unique file, where
;; each file named after certain date and stored in `org-roam-dailies-directory'.
;;
;; One can use dailies for various purposes, e.g. journaling, fleeting notes,
;; scratch notes and whatever else you can came up with.
;;
;;; Code:
;;; Library Requires
(require 'org-capture)
(require 'org-roam-capture)
(require 'f)
(require 'dash)
(require 'org-roam)
;;;; Declarations
(defvar org-roam-directory)
(defvar org-roam-file-extensions)
(declare-function org-roam-file-p "org-roam")
;;;; Faces
;;; Faces
(defface org-roam-dailies-calendar-note
'((t :inherit (org-link) :underline nil))
"Face for dates with a daily-note in the calendar."
:group 'org-roam-faces)
;;;; Customizable variables
;;; Options
(defcustom org-roam-dailies-directory "daily/"
"Path to daily-notes.
This path is relative to `org-roam-directory'."
@ -129,52 +127,23 @@ See `org-roam-capture-templates' for the template documentation."
((const :format "%v " :table-line-pos) (string))
((const :format "%v " :kill-buffer) (const t))))))))
;;;###autoload (autoload 'org-roam-dailies-find-directory "org-roam" nil t)
(defun org-roam-dailies-find-directory ()
"Find and open `org-roam-dailies-directory'."
(interactive)
(find-file (expand-file-name org-roam-dailies-directory org-roam-directory)))
(defun org-roam-dailies--daily-note-p (&optional file)
"Return t if FILE is an Org-roam daily-note, nil otherwise.
If FILE is not specified, use the current buffer's file-path."
(when-let ((path (expand-file-name
(or file
(buffer-file-name (buffer-base-buffer)))))
(directory (expand-file-name org-roam-dailies-directory org-roam-directory)))
(setq path (expand-file-name path))
(save-match-data
(and
(org-roam-file-p path)
(f-descendant-of-p path directory)))))
(defun org-roam-dailies--capture (time &optional goto)
"Capture an entry in a daily-note for TIME, creating it if necessary.
When GOTO is non-nil, go the note without creating an entry."
(let ((org-roam-directory (expand-file-name org-roam-dailies-directory org-roam-directory)))
(org-roam-capture- :goto (when goto '(4))
:node (org-roam-node-create)
:templates org-roam-dailies-capture-templates
:props (list :override-default-time time)))
(when goto (run-hooks 'org-roam-dailies-find-file-hook)))
;;;; Commands
;;; Today
;;;###autoload (autoload 'org-roam-dailies-capture-today "org-roam" nil t)
;;; Commands
;;;; Today
;;;###autoload
(defun org-roam-dailies-capture-today (&optional goto)
"Create an entry in the daily-note for today.
When GOTO is non-nil, go the note without creating an entry."
(interactive "P")
(org-roam-dailies--capture (current-time) goto))
;;;###autoload (autoload 'org-roam-dailies-goto-today "org-roam" nil t)
;;;###autoload
(defun org-roam-dailies-goto-today ()
"Find the daily-note for today, creating it if necessary."
(interactive)
(org-roam-dailies-capture-today t))
;;; Tomorrow
;;;###autoload (autoload 'org-roam-dailies-capture-tomorrow "org-roam" nil t)
;;;; Tomorrow
;;;###autoload
(defun org-roam-dailies-capture-tomorrow (n &optional goto)
"Create an entry in the daily-note for tomorrow.
@ -185,7 +154,7 @@ creating an entry."
(interactive "p")
(org-roam-dailies--capture (time-add (* n 86400) (current-time)) goto))
;;;###autoload (autoload 'org-roam-dailies-goto-tomorrow "org-roam" nil t)
;;;###autoload
(defun org-roam-dailies-goto-tomorrow (n)
"Find the daily-note for tomorrow, creating it if necessary.
@ -194,8 +163,8 @@ future."
(interactive "p")
(org-roam-dailies-capture-tomorrow n t))
;;; Yesterday
;;;###autoload (autoload 'org-roam-dailies-capture-yesterday "org-roam" nil t)
;;;; Yesterday
;;;###autoload
(defun org-roam-dailies-capture-yesterday (n &optional goto)
"Create an entry in the daily-note for yesteday.
@ -205,7 +174,7 @@ When GOTO is non-nil, go the note without creating an entry."
(interactive "p")
(org-roam-dailies-capture-tomorrow (- n) goto))
;;;###autoload (autoload 'org-roam-dailies-goto-yesterday "org-roam" nil t)
;;;###autoload
(defun org-roam-dailies-goto-yesterday (n)
"Find the daily-note for yesterday, creating it if necessary.
@ -214,34 +183,8 @@ future."
(interactive "p")
(org-roam-dailies-capture-tomorrow (- n) t))
;;; Calendar
(defun org-roam-dailies-calendar--file-to-date (file)
"Convert FILE to date.
Return (MONTH DAY YEAR) or nil if not an Org time-string."
(condition-case nil
(progn
(cl-destructuring-bind (_ _ _ d m y _ _ _)
(org-parse-time-string
(file-name-sans-extension
(file-name-nondirectory file)))
(list m d y)))
(t nil)))
(defun org-roam-dailies-calendar--date-to-time (date)
"Convert DATE as returned from then calendar (MONTH DAY YEAR) to a time."
(encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))
(defun org-roam-dailies-calendar-mark-entries ()
"Mark days in the calendar for which a daily-note is present."
(when (file-exists-p (expand-file-name org-roam-dailies-directory org-roam-directory))
(dolist (date (remove nil
(mapcar #'org-roam-dailies-calendar--file-to-date
(org-roam-dailies--list-files))))
(when (calendar-date-is-visible-p date)
(calendar-mark-visible-date date 'org-roam-dailies-calendar-note)))))
;;; Date
;;;###autoload (autoload 'org-roam-dailies-capture-date "org-roam" nil t)
;;;; Date
;;;###autoload
(defun org-roam-dailies-capture-date (&optional goto prefer-future)
"Create an entry in the daily-note for a date using the calendar.
Prefer past dates, unless PREFER-FUTURE is non-nil.
@ -254,27 +197,14 @@ creating an entry."
"Capture to daily-note: ")))))
(org-roam-dailies--capture time goto)))
;;;###autoload (autoload 'org-roam-dailies-goto-date "org-roam" nil t)
;;;###autoload
(defun org-roam-dailies-goto-date (&optional prefer-future)
"Find the daily-note for a date using the calendar, creating it if necessary.
Prefer past dates, unless PREFER-FUTURE is non-nil."
(interactive)
(org-roam-dailies-capture-date t prefer-future))
;;; Navigation
(defun org-roam-dailies--list-files (&rest extra-files)
"List all files in `org-roam-dailies-directory'.
EXTRA-FILES can be used to append extra files to the list."
(let ((dir (expand-file-name org-roam-dailies-directory org-roam-directory))
(regexp (rx-to-string `(and "." (or ,@org-roam-file-extensions)))))
(append (--remove (let ((file (file-name-nondirectory it)))
(when (or (auto-save-file-name-p file)
(backup-file-name-p file)
(string-match "^\\." file))
it))
(directory-files-recursively dir regexp))
extra-files)))
;;;; Navigation
(defun org-roam-dailies-goto-next-note (&optional n)
"Find next daily-note.
@ -312,10 +242,84 @@ negative, find note N days in the future."
(let ((n (if n (- n) -1)))
(org-roam-dailies-goto-next-note n)))
(defun org-roam-dailies--list-files (&rest extra-files)
"List all files in `org-roam-dailies-directory'.
EXTRA-FILES can be used to append extra files to the list."
(let ((dir (expand-file-name org-roam-dailies-directory org-roam-directory))
(regexp (rx-to-string `(and "." (or ,@org-roam-file-extensions)))))
(append (--remove (let ((file (file-name-nondirectory it)))
(when (or (auto-save-file-name-p file)
(backup-file-name-p file)
(string-match "^\\." file))
it))
(directory-files-recursively dir regexp))
extra-files)))
(defun org-roam-dailies--daily-note-p (&optional file)
"Return t if FILE is an Org-roam daily-note, nil otherwise.
If FILE is not specified, use the current buffer's file-path."
(when-let ((path (expand-file-name
(or file
(buffer-file-name (buffer-base-buffer)))))
(directory (expand-file-name org-roam-dailies-directory org-roam-directory)))
(setq path (expand-file-name path))
(save-match-data
(and
(org-roam-file-p path)
(f-descendant-of-p path directory)))))
;;;###autoload
(defun org-roam-dailies-find-directory ()
"Find and open `org-roam-dailies-directory'."
(interactive)
(find-file (expand-file-name org-roam-dailies-directory org-roam-directory)))
;;; Calendar integration
(defun org-roam-dailies-calendar--file-to-date (file)
"Convert FILE to date.
Return (MONTH DAY YEAR) or nil if not an Org time-string."
(condition-case nil
(progn
(cl-destructuring-bind (_ _ _ d m y _ _ _)
(org-parse-time-string
(file-name-sans-extension
(file-name-nondirectory file)))
(list m d y)))
(t nil)))
(defun org-roam-dailies-calendar-mark-entries ()
"Mark days in the calendar for which a daily-note is present."
(when (file-exists-p (expand-file-name org-roam-dailies-directory org-roam-directory))
(dolist (date (remove nil
(mapcar #'org-roam-dailies-calendar--file-to-date
(org-roam-dailies--list-files))))
(when (calendar-date-is-visible-p date)
(calendar-mark-visible-date date 'org-roam-dailies-calendar-note)))))
(add-hook 'calendar-today-visible-hook #'org-roam-dailies-calendar-mark-entries)
(add-hook 'calendar-today-invisible-hook #'org-roam-dailies-calendar-mark-entries)
;;;; Bindings
;;; Capture implementation
(add-to-list 'org-roam-capture--template-keywords :override-default-time)
(defun org-roam-dailies--capture (time &optional goto)
"Capture an entry in a daily-note for TIME, creating it if necessary.
When GOTO is non-nil, go the note without creating an entry."
(let ((org-roam-directory (expand-file-name org-roam-dailies-directory org-roam-directory)))
(org-roam-capture- :goto (when goto '(4))
:node (org-roam-node-create)
:templates org-roam-dailies-capture-templates
:props (list :override-default-time time)))
(when goto (run-hooks 'org-roam-dailies-find-file-hook)))
(add-hook 'org-roam-capture-preface-hook #'org-roam-dailies--override-capture-time-h)
(defun org-roam-dailies--override-capture-time-h ()
"Override the `:default-time' with the time from `:override-default-time'."
(prog1 nil
(when (org-roam-capture--get :override-default-time)
(org-capture-put :default-time (org-roam-capture--get :override-default-time)))))
;;; Bindings
(defvar org-roam-dailies-map (make-sparse-keymap)
"Keymap for `org-roam-dailies'.")

195
org-roam-graph.el → extensions/org-roam-graph.el
View File

@ -1,4 +1,4 @@
;;; org-roam-graph.el --- Graphing API -*- coding: utf-8; lexical-binding: t; -*-
;;; org-roam-graph.el --- Basic graphing functionality for Org-roam -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright © 2020-2021 Jethro Kuan <jethrokuan95@gmail.com>
@ -6,7 +6,7 @@
;; URL: https://github.com/org-roam/org-roam
;; Keywords: org-mode, roam, convenience
;; Version: 2.0.0
;; Package-Requires: ((emacs "26.1") (dash "2.13") (f "0.17.2") (org "9.4") (emacsql "3.0.0") (emacsql-sqlite "1.0.0") (magit-section "2.90.1"))
;; Package-Requires: ((emacs "26.1") (org "9.4") (org-roam "2.0"))
;; This file is NOT part of GNU Emacs.
@ -27,18 +27,14 @@
;;; Commentary:
;;
;; This library provides graphing functionality for org-roam.
;; This extension implements capability to build and generate graphs in Org-roam
;; with the help of Graphviz.
;;
;;; Code:
(require 'xml) ;xml-escape-string
(eval-and-compile
(require 'org-roam-macs))
(require 'org-roam)
;;;; Declarations
(defvar org-roam-directory)
;;;; Options
;;; Options
(defcustom org-roam-graph-viewer (executable-find "firefox")
"Method to view the org-roam graph.
It may be one of the following:
@ -117,13 +113,86 @@ All other values including nil will have no effect."
(const :tag "no" nil))
:group 'org-roam)
(defun org-roam-graph--dot-option (option &optional wrap-key wrap-val)
"Return dot string of form KEY=VAL for OPTION cons.
If WRAP-KEY is non-nil it wraps the KEY.
If WRAP-VAL is non-nil it wraps the VAL."
(concat wrap-key (car option) wrap-key
"="
wrap-val (cdr option) wrap-val))
;;; Interactive command
;;;###autoload
(defun org-roam-graph (&optional arg node)
"Build and possibly display a graph for NODE.
ARG may be any of the following values:
- nil show the graph.
- `\\[universal-argument]' show the graph for NODE.
- `\\[universal-argument]' N show the graph for NODE limiting nodes to N steps."
(interactive
(list current-prefix-arg
(and current-prefix-arg
(org-roam-node-at-point 'assert))))
(let ((graph (cl-typecase arg
(null (org-roam-graph--dot nil 'all-nodes))
(cons (org-roam-graph--dot (org-roam-graph--connected-component
(org-roam-node-id node) 0)))
(integer (org-roam-graph--dot (org-roam-graph--connected-component
(org-roam-node-id node) (abs arg)))))))
(org-roam-graph--build graph #'org-roam-graph--open)))
;;; Generation and Build process
(defun org-roam-graph--build (graph &optional callback)
"Generate the GRAPH, and execute CALLBACK when process exits successfully.
CALLBACK is passed the graph file as its sole argument."
(unless (stringp org-roam-graph-executable)
(user-error "`org-roam-graph-executable' is not a string"))
(unless (executable-find org-roam-graph-executable)
(user-error (concat "Cannot find executable \"%s\" to generate the graph. "
"Please adjust `org-roam-graph-executable'")
org-roam-graph-executable))
(let* ((temp-dot (make-temp-file "graph." nil ".dot" graph))
(temp-graph (make-temp-file "graph." nil (concat "." org-roam-graph-filetype))))
(org-roam-message "building graph")
(make-process
:name "*org-roam-graph--build-process*"
:buffer "*org-roam-graph--build-process*"
:command `(,org-roam-graph-executable ,temp-dot "-T" ,org-roam-graph-filetype "-o" ,temp-graph)
:sentinel (when callback
(lambda (process _event)
(when (= 0 (process-exit-status process))
(funcall callback temp-graph)))))))
(defun org-roam-graph--dot (&optional edges all-nodes)
"Build the graphviz given the EDGES of the graph.
If ALL-NODES, include also nodes without edges."
(let ((org-roam-directory-temp org-roam-directory)
(nodes-table (make-hash-table :test #'equal))
(seen-nodes (list))
(edges (or edges (org-roam-db-query [:select :distinct [source dest type] :from links]))))
(pcase-dolist (`(,id ,file ,title)
(org-roam-db-query [:select [id file title] :from nodes]))
(puthash id (org-roam-node-create :file file :id id :title title) nodes-table))
(with-temp-buffer
(setq-local org-roam-directory org-roam-directory-temp)
(insert "digraph \"org-roam\" {\n")
(dolist (option org-roam-graph-extra-config)
(insert (org-roam-graph--dot-option option) ";\n"))
(insert (format " edge [%s];\n"
(mapconcat (lambda (var)
(org-roam-graph--dot-option var nil "\""))
org-roam-graph-edge-extra-config
",")))
(pcase-dolist (`(,source ,dest ,type) edges)
(unless (member type org-roam-graph-link-hidden-types)
(pcase-dolist (`(,node ,node-type) `((,source "id")
(,dest ,type)))
(unless (member node seen-nodes)
(insert (org-roam-graph--format-node
(or (gethash node nodes-table) node) node-type))
(push node seen-nodes)))
(insert (format " \"%s\" -> \"%s\";\n"
(xml-escape-string source)
(xml-escape-string dest)))))
(when all-nodes
(maphash (lambda (id node)
(unless (member id seen-nodes)
(insert (org-roam-graph--format-node node "id"))))
nodes-table))
(insert "}")
(buffer-string))))
(defun org-roam-graph--connected-component (id distance)
"Return the edges for all nodes reachable from/connected to ID.
@ -158,41 +227,13 @@ WITH RECURSIVE
SELECT source, dest, type FROM links WHERE source IN nodes OR dest IN nodes;")))
(org-roam-db-query query id distance)))
(defun org-roam-graph--dot (&optional edges all-nodes)
"Build the graphviz given the EDGES of the graph.
If ALL-NODES, include also nodes without edges."
(let ((org-roam-directory-temp org-roam-directory)
(nodes-table (org-roam--nodes-table))
(seen-nodes (list))
(edges (or edges (org-roam-db-query [:select :distinct [source dest type] :from links]))))
(with-temp-buffer
(setq-local org-roam-directory org-roam-directory-temp)
(insert "digraph \"org-roam\" {\n")
(dolist (option org-roam-graph-extra-config)
(insert (org-roam-graph--dot-option option) ";\n"))
(insert (format " edge [%s];\n"
(mapconcat (lambda (var)
(org-roam-graph--dot-option var nil "\""))
org-roam-graph-edge-extra-config
",")))
(pcase-dolist (`(,source ,dest ,type) edges)
(unless (member type org-roam-graph-link-hidden-types)
(pcase-dolist (`(,node ,node-type) `((,source "id")
(,dest ,type)))
(unless (member node seen-nodes)
(insert (org-roam-graph--format-node
(or (gethash node nodes-table) node) node-type))
(push node seen-nodes)))
(insert (format " \"%s\" -> \"%s\";\n"
(xml-escape-string source)
(xml-escape-string dest)))))
(when all-nodes
(maphash (lambda (id node)
(unless (member id seen-nodes)
(insert (org-roam-graph--format-node node "id"))))
nodes-table))
(insert "}")
(buffer-string))))
(defun org-roam-graph--dot-option (option &optional wrap-key wrap-val)
"Return dot string of form KEY=VAL for OPTION cons.
If WRAP-KEY is non-nil it wraps the KEY.
If WRAP-VAL is non-nil it wraps the VAL."
(concat wrap-key (car option) wrap-key
"="
wrap-val (cdr option) wrap-val))
(defun org-roam-graph--format-node (node type)
"Return a graphviz NODE with TYPE.
@ -200,11 +241,12 @@ Handles both Org-roam nodes, and string nodes (e.g. urls)."
(let (node-id node-properties)
(if (org-roam-node-p node)
(let* ((title (org-roam-quote-string (org-roam-node-title node)))
(shortened-title (org-roam-quote-string
(pcase org-roam-graph-shorten-titles
(`truncate (org-roam-truncate org-roam-graph-max-title-length title))
(`wrap (s-word-wrap org-roam-graph-max-title-length title))
(_ title)))))
(shortened-title
(org-roam-quote-string
(pcase org-roam-graph-shorten-titles
(`truncate (truncate-string-to-width title org-roam-graph-max-title-length nil nil "..."))
(`wrap (s-word-wrap org-roam-graph-max-title-length title))
(_ title)))))
(setq node-id (org-roam-node-id node)
node-properties `(("label" . ,shortened-title)
("URL" . ,(concat "org-protocol://roam-node?node="
@ -221,27 +263,6 @@ Handles both Org-roam nodes, and string nodes (e.g. urls)."
(append (cdr (assoc type org-roam-graph-node-extra-config))
node-properties) ","))))
(defun org-roam-graph--build (graph &optional callback)
"Generate the GRAPH, and execute CALLBACK when process exits successfully.
CALLBACK is passed the graph file as its sole argument."
(unless (stringp org-roam-graph-executable)
(user-error "`org-roam-graph-executable' is not a string"))
(unless (executable-find org-roam-graph-executable)
(user-error (concat "Cannot find executable \"%s\" to generate the graph. "
"Please adjust `org-roam-graph-executable'")
org-roam-graph-executable))
(let* ((temp-dot (make-temp-file "graph." nil ".dot" graph))
(temp-graph (make-temp-file "graph." nil (concat "." org-roam-graph-filetype))))
(org-roam-message "building graph")
(make-process
:name "*org-roam-graph--build-process*"
:buffer "*org-roam-graph--build-process*"
:command `(,org-roam-graph-executable ,temp-dot "-T" ,org-roam-graph-filetype "-o" ,temp-graph)
:sentinel (when callback
(lambda (process _event)
(when (= 0 (process-exit-status process))
(funcall callback temp-graph)))))))
(defun org-roam-graph--open (file)
"Open FILE using `org-roam-graph-viewer' with `view-file' as a fallback."
(pcase org-roam-graph-viewer
@ -255,26 +276,6 @@ CALLBACK is passed the graph file as its sole argument."
('nil (view-file file))
(_ (signal 'wrong-type-argument `((functionp stringp null) ,org-roam-graph-viewer)))))
;;;; Commands
;;;###autoload
(defun org-roam-graph (&optional arg node)
"Build and possibly display a graph for NODE.
ARG may be any of the following values:
- nil show the graph.
- `\\[universal-argument]' show the graph for NODE.
- `\\[universal-argument]' N show the graph for NODE limiting nodes to N steps."
(interactive
(list current-prefix-arg
(and current-prefix-arg
(org-roam-node-at-point 'assert))))
(let ((graph (cl-typecase arg
(null (org-roam-graph--dot nil 'all-nodes))
(cons (org-roam-graph--dot (org-roam-graph--connected-component
(org-roam-node-id node) 0)))
(integer (org-roam-graph--dot (org-roam-graph--connected-component
(org-roam-node-id node) (abs arg)))))))
(org-roam-graph--build graph #'org-roam-graph--open)))
(provide 'org-roam-graph)

12
org-roam-overlay.el → extensions/org-roam-overlay.el
View File

@ -1,4 +1,4 @@
;;; org-roam-overlay.el --- Link overlay for Org-roam nodes -*- coding: utf-8; lexical-binding: t; -*-
;;; org-roam-overlay.el --- Link overlay for [id:] links to Org-roam nodes -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright © 2020-2021 Jethro Kuan <jethrokuan95@gmail.com>
@ -6,7 +6,7 @@
;; URL: https://github.com/org-roam/org-roam
;; Keywords: org-mode, roam, convenience
;; Version: 2.0.0
;; Package-Requires: ((emacs "26.1") (dash "2.13") (f "0.17.2") (org "9.4") (emacsql "3.0.0") (emacsql-sqlite "1.0.0") (magit-section "2.90.1"))
;; Package-Requires: ((emacs "26.1") (org "9.4") (org-roam "2.0"))
;; This file is NOT part of GNU Emacs.
@ -27,13 +27,11 @@
;;; Commentary:
;;
;; This library is an attempt at injecting Roam functionality into Org-mode.
;; This is achieved primarily through building caches for forward links,
;; backward links, and file titles.
;;
;; This extension provides allows to render [[id:]] links that don't have an
;; asscoiated descriptor with an overlay that displays the node's current title.
;;
;;; Code:
;;;; Dependencies
(require 'org-roam)
(defface org-roam-overlay
'((((class color) (background light))

192
extensions/org-roam-protocol.el Normal file
View File

@ -0,0 +1,192 @@
;;; org-roam-protocol.el --- Protocol handler for roam:// links -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright © 2020-2021 Jethro Kuan <jethrokuan95@gmail.com>
;; Author: Jethro Kuan <jethrokuan95@gmail.com>
;; URL: https://github.com/org-roam/org-roam
;; Keywords: org-mode, roam, convenience
;; Version: 2.0.0
;; Package-Requires: ((emacs "26.1") (org "9.4") (org-roam "2.0"))
;; 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:
;;
;; This extension extends `org-protocol', adding custom Org-roam handlers to it
;; to provide the next new protocols:
;;
;; 1. "roam-node": This protocol simply opens the node given by the node ID
;; 2. "roam-ref": This protocol creates or opens the node with the given REF
;;
;; You can find detailed instructions on how to setup the protocol in the
;; documentation for Org-roam.
;;
;;; Code:
(require 'org-protocol)
(require 'ol) ;; for org-link-decode
(require 'org-roam)
;;; Options
(defcustom org-roam-protocol-store-links nil
"Whether to store links when capturing websites with `org-roam-protocol'."
:type 'boolean
:group 'org-roam)
(defcustom org-roam-capture-ref-templates
'(("r" "ref" plain "%?"
:if-new (file+head "${slug}.org"
"#+title: ${title}")
:unnarrowed t))
"The Org-roam templates used during a capture from the roam-ref protocol.
See `org-roam-capture-templates' for the template documentation."
:group 'org-roam
:type '(repeat
(choice (list :tag "Multikey description"
(string :tag "Keys ")
(string :tag "Description"))
(list :tag "Template entry"
(string :tag "Keys ")
(string :tag "Description ")
(choice :tag "Capture Type " :value entry
(const :tag "Org entry" entry)
(const :tag "Plain list item" item)
(const :tag "Checkbox item" checkitem)
(const :tag "Plain text" plain)
(const :tag "Table line" table-line))
(choice :tag "Template "
(string)
(list :tag "File"
(const :format "" file)
(file :tag "Template file"))
(list :tag "Function"
(const :format "" function)
(function :tag "Template function")))
(plist :inline t
;; Give the most common options as checkboxes
:options (((const :format "%v " :if-new)
(choice :tag "Node location"
(list :tag "File"
(const :format "" file)
(string :tag " File"))
(list :tag "File & Head Content"
(const :format "" file+head)
(string :tag " File")
(string :tag " Head Content"))
(list :tag "File & Outline path"
(const :format "" file+olp)
(string :tag " File")
(list :tag "Outline path"
(repeat (string :tag "Headline"))))
(list :tag "File & Head Content & Outline path"
(const :format "" file+head+olp)
(string :tag " File")
(string :tag " Head Content")
(list :tag "Outline path"
(repeat (string :tag "Headline"))))))
((const :format "%v " :prepend) (const t))
((const :format "%v " :immediate-finish) (const t))
((const :format "%v " :jump-to-captured) (const t))
((const :format "%v " :empty-lines) (const 1))
((const :format "%v " :empty-lines-before) (const 1))
((const :format "%v " :empty-lines-after) (const 1))
((const :format "%v " :clock-in) (const t))
((const :format "%v " :clock-keep) (const t))
((const :format "%v " :clock-resume) (const t))
((const :format "%v " :time-prompt) (const t))
((const :format "%v " :tree-type) (const week))
((const :format "%v " :unnarrowed) (const t))
((const :format "%v " :table-line-pos) (string))
((const :format "%v " :kill-buffer) (const t))))))))
;;; Handlers
(defun org-roam-protocol-open-ref (info)
"Process an org-protocol://roam-ref?ref= style url with INFO.
It opens or creates a note with the given ref.
javascript:location.href = \\='org-protocol://roam-ref?template=r&ref=\\='+ \\
encodeURIComponent(location.href) + \\='&title=\\=' + \\
encodeURIComponent(document.title) + \\='&body=\\=' + \\
encodeURIComponent(window.getSelection())"
(unless (plist-get info :ref)
(user-error "No ref key provided"))
(org-roam-plist-map! (lambda (k v)
(org-link-decode
(if (equal k :ref)
(org-protocol-sanitize-uri v)
v))) info)
(when org-roam-protocol-store-links
(push (list (plist-get info :ref)
(plist-get info :title)) org-stored-links))
(org-link-store-props :type (and (string-match org-link-plain-re
(plist-get info :ref))
(match-string 1 (plist-get info :ref)))
:link (plist-get info :ref)
:annotation (org-link-make-string (plist-get info :ref)
(or (plist-get info :title)
(plist-get info :ref)))
:initial (or (plist-get info :body) ""))
(raise-frame)
(org-roam-capture-
:keys (plist-get info :template)
:node (org-roam-node-create :title (plist-get info :title))
:info (list :ref (plist-get info :ref)
:body (plist-get info :body))
:templates org-roam-capture-ref-templates)
nil)
(defun org-roam-protocol-open-node (info)
"This handler simply opens the file with emacsclient.
INFO is a plist containing additional information passed by the protocol URL.
It should contain the FILE key, pointing to the path of the file to open.
Example protocol string:
org-protocol://roam-node?node=uuid"
(when-let ((node (plist-get info :node)))
(raise-frame)
(org-roam-node-visit (org-roam-populate (org-roam-node-create :id node))))
nil)
(push '("org-roam-ref" :protocol "roam-ref" :function org-roam-protocol-open-ref)
org-protocol-protocol-alist)
(push '("org-roam-node" :protocol "roam-node" :function org-roam-protocol-open-node)
org-protocol-protocol-alist)
;;; Capture implementation
(add-hook 'org-roam-capture-preface-hook #'org-roam-protocol--try-capture-to-ref-h)
(defun org-roam-protocol--try-capture-to-ref-h ()
"Try to capture to an existing node that match the ref."
(when-let ((node (and (plist-get org-roam-capture--info :ref)
(org-roam-node-from-ref
(plist-get org-roam-capture--info :ref)))))
(set-buffer (org-capture-target-buffer (org-roam-node-file node)))
(goto-char (org-roam-node-point node))
(widen)
(org-roam-node-id node)))
(add-hook 'org-roam-capture-new-node-hook #'org-roam-protocol--insert-captured-ref-h)
(defun org-roam-protocol--insert-captured-ref-h ()
"Insert the ref if any."
(when-let ((ref (plist-get org-roam-capture--info :ref)))
(org-roam-ref-add ref)))
(provide 'org-roam-protocol)
;;; org-roam-protocol.el ends here

542
org-roam-capture.el
View File

@ -1,6 +1,6 @@
;;; org-roam-capture.el --- Capture functionality -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright © 2020 Jethro Kuan <jethrokuan95@gmail.com>
;; Copyright © 2020-2021 Jethro Kuan <jethrokuan95@gmail.com>
;; Author: Jethro Kuan <jethrokuan95@gmail.com>
;; URL: https://github.com/org-roam/org-roam
@ -27,39 +27,17 @@
;;; Commentary:
;;
;; This library provides capture functionality for org-roam
;; This module provides `org-capture' functionality for Org-roam. With this
;; module the user can capture new nodes or capture new content to existing
;; nodes.
;;
;;; Code:
;;;
;;;; Library Requires
(require 'org-capture)
(eval-when-compile
(require 'org-roam-macs)
(require 'org-macs))
(require 'org-roam-db)
(require 'dash)
(require 'cl-lib)
(require 'org-roam)
;; Declarations
(declare-function org-roam-ref-add "org-roam" (ref))
(declare-function org-datetree-find-date-create "org-datetree" (date &optional keep-restriction))
(declare-function org-datetree-find-month-create "org-datetree" (d &optional keep-restriction))
(defvar org-roam-directory)
(defvar org-roam-capture--node nil
"The node passed during an Org-roam capture.
This variable is populated dynamically, and is only non-nil
during the Org-roam capture process.")
(defvar org-roam-capture--info nil
"A property-list of additional information passed to the Org-roam template.
This variable is populated dynamically, and is only non-nil
during the Org-roam capture process.")
(defconst org-roam-capture--template-keywords (list :if-new :id :link-description :call-location
:region :override-default-time)
"Keywords used in `org-roam-capture-templates' specific to Org-roam.")
;;;; Declarations
(defvar org-end-time-was-given)
;;; Options
(defcustom org-roam-capture-templates
'(("d" "default" plain "%?"
:if-new (file+head "%<%Y%m%d%H%M%S>-${slug}.org"
@ -139,6 +117,10 @@ the following options:
inserted at the start of the file. The datetree will be created,
available options are day, week, month.
(node \"title or alias or ID of an existing node\")
The point will be placed for an existing node, based on either, its
title, alias or ID.
The rest of the entry is a property list of additional options. Recognized
properties are:
@ -342,77 +324,102 @@ streamlined user experience in Org-roam."
((const :format "%v " :table-line-pos) (string))
((const :format "%v " :kill-buffer) (const t))))))))
(defvar org-roam-capture-new-node-hook (list #'org-roam-capture--insert-ref)
(defcustom org-roam-capture-new-node-hook nil
"Normal-mode hooks run when a new Org-roam node is created.
The current point is the point of the new node.
The hooks must not move the point.")
(defcustom org-roam-capture-ref-templates
'(("r" "ref" plain "%?"
:if-new (file+head "${slug}.org"
"#+title: ${title}")
:unnarrowed t))
"The Org-roam templates used during a capture from the roam-ref protocol.
See `org-roam-capture-templates' for the template documentation."
The hooks must not move the point."
:group 'org-roam
:type '(repeat
(choice (list :tag "Multikey description"
(string :tag "Keys ")
(string :tag "Description"))
(list :tag "Template entry"
(string :tag "Keys ")
(string :tag "Description ")
(choice :tag "Capture Type " :value entry
(const :tag "Org entry" entry)
(const :tag "Plain list item" item)
(const :tag "Checkbox item" checkitem)
(const :tag "Plain text" plain)
(const :tag "Table line" table-line))
(choice :tag "Template "
(string)
(list :tag "File"
(const :format "" file)
(file :tag "Template file"))
(list :tag "Function"
(const :format "" function)
(function :tag "Template function")))
(plist :inline t
;; Give the most common options as checkboxes
:options (((const :format "%v " :if-new)
(choice :tag "Node location"
(list :tag "File"
(const :format "" file)
(string :tag " File"))
(list :tag "File & Head Content"
(const :format "" file+head)
(string :tag " File")
(string :tag " Head Content"))
(list :tag "File & Outline path"
(const :format "" file+olp)
(string :tag " File")
(list :tag "Outline path"
(repeat (string :tag "Headline"))))
(list :tag "File & Head Content & Outline path"
(const :format "" file+head+olp)
(string :tag " File")
(string :tag " Head Content")
(list :tag "Outline path"
(repeat (string :tag "Headline"))))))
((const :format "%v " :prepend) (const t))
((const :format "%v " :immediate-finish) (const t))
((const :format "%v " :jump-to-captured) (const t))
((const :format "%v " :empty-lines) (const 1))
((const :format "%v " :empty-lines-before) (const 1))
((const :format "%v " :empty-lines-after) (const 1))
((const :format "%v " :clock-in) (const t))
((const :format "%v " :clock-keep) (const t))
((const :format "%v " :clock-resume) (const t))
((const :format "%v " :time-prompt) (const t))
((const :format "%v " :tree-type) (const week))
((const :format "%v " :unnarrowed) (const t))
((const :format "%v " :table-line-pos) (string))
((const :format "%v " :kill-buffer) (const t))))))))
:type 'hook)
(defvar org-roam-capture-preface-hook nil
"Hook run when Org-roam tries to determine capture location of the node.
If any hook returns a value (which should be an ID), all hooks
after it are ignored.
With this hook you can hijack controls over the location of the
node for which the capture process is currently running for, or
use to just perform an arbitrary side effect, e.g. modify the
state related to the capture process. See `org-roam-protocol' and
`org-roam-dailies' as examples for what and how this hook is used
for.
If you're trying to perform the hijack, it's mandatory for you to:
1. Set the currently active buffer for editing operations using
`org-capture-target-buffer'.
2. Place the point in this buffer from where the location starts
from (e.g. if it's a file based node it should be the BOB,
otherwise it should be the position from where the heading
based node starts from).
3. Return the ID (as a string) of the capturing node.
If you use this hook for any other purpose, but not the hijack,
it's mandatory that you should return nil as the return value; so
the capture process would be able to setup the capture buffer.
If you need to do something when you capture new nodes, use
`org-roam-capture-new-node-hook' instead of this hook.
WARNING: This hook is primarily designed for the usage by the
extensions and packages, and requires understanding of the
internal capture process. If you don't understand it, you should
learn these internals before using this or use it at your own
risk breaking things.")
;;; Variables
(defvar org-roam-capture--node nil
"The node passed during an Org-roam capture.
This variable is populated dynamically, and is only non-nil
during the Org-roam capture process.")
(defvar org-roam-capture--info nil
"A property-list of additional information passed to the Org-roam template.
This variable is populated dynamically, and is only non-nil
during the Org-roam capture process.")
(defconst org-roam-capture--template-keywords (list :if-new :id :link-description :call-location
:region)
"Keywords used in `org-roam-capture-templates' specific to Org-roam.")
;;; Main entry point
;;;###autoload
(cl-defun org-roam-capture- (&key goto keys node info props templates)
"Main entry point of `org-roam-capture' module.
GOTO and KEYS correspond to `org-capture' arguments.
INFO is a plist for filling up Org-roam's capture templates.
NODE is an `org-roam-node' construct containing information about the node.
PROPS is a plist containing additional Org-roam properties for each template.
TEMPLATES is a list of org-roam templates."
(let* ((props (plist-put props :call-location (point-marker)))
(org-capture-templates
(mapcar (lambda (template)
(org-roam-capture--convert-template template props))
(or templates org-roam-capture-templates)))
(org-roam-capture--node node)
(org-roam-capture--info info))
(when (and (not keys)
(= (length org-capture-templates) 1))
(setq keys (caar org-capture-templates)))
(org-capture goto keys)))
;;;###autoload
(cl-defun org-roam-capture (&optional goto keys &key filter-fn templates)
"Launches an `org-capture' process for a new or existing node.
This uses the templates defined at `org-roam-capture-templates'.
Arguments GOTO and KEYS see `org-capture'.
FILTER-FN is a function to filter out nodes: it takes an `org-roam-node',
and when nil is returned the node will be filtered out.
The TEMPLATES, if provided, override the list of capture templates (see
`org-roam-capture-'.)"
(interactive "P")
(let ((node (org-roam-node-read nil filter-fn)))
(org-roam-capture- :goto goto
:keys keys
:templates templates
:node node
:props '(:immediate-finish nil))))
;;; Capture process
(defun org-roam-capture-p ()
"Return t if the current capture process is an Org-roam capture.
This function is to only be called when `org-capture-plist' is
@ -432,105 +439,33 @@ the capture)."
(setq org-capture-plist
(plist-put org-capture-plist :org-roam p))))
;; FIXME: Pending upstream patch
;; https://orgmode.org/list/87h7tv9pkm.fsf@hidden/T/#u
;;
;; Org-capture's behaviour right now is that `org-capture-plist' is valid only
;; during the initialization of the Org-capture buffer. The value of
;; `org-capture-plist' is saved into buffer-local `org-capture-current-plist'.
;; However, the value for that particular capture is no longer accessible for
;; hooks in `org-capture-after-finalize-hook', since the capture buffer has been
;; cleaned up.
;;
;; This advice restores the global `org-capture-plist' during finalization, so
;; the plist is valid during both initialization and finalization of the
;; capture.
(defun org-roam-capture--update-plist (&optional _)
"Update global plist from local var."
(setq org-capture-plist org-capture-current-plist))
;;;; Capture target
(defun org-roam-capture--prepare-buffer ()
"Prepare the capture buffer for the current Org-roam based capture template.
This function will initialize and setup the capture buffer,
create the target node (`:if-new') if it doesn't exist, and place
the point for further processing by `org-capture'.
(advice-add 'org-capture-finalize :before #'org-roam-capture--update-plist)
Note: During the capture process this function is run by
`org-capture-set-target-location', as a (function ...) based
capture target."
(let ((id (cond ((run-hook-with-args-until-success 'org-roam-capture-preface-hook))
((and (org-roam-node-file org-roam-capture--node)
(org-roam-node-point org-roam-capture--node))
(set-buffer (org-capture-target-buffer (org-roam-node-file org-roam-capture--node)))
(goto-char (org-roam-node-point org-roam-capture--node))
(widen)
(org-roam-node-id org-roam-capture--node))
(t
(org-roam-capture--setup-target-location)))))
(org-roam-capture--adjust-point-for-capture-type)
(org-capture-put :template
(org-roam-capture--fill-template (org-capture-get :template)))
(org-roam-capture--put :id id)
(org-roam-capture--put :finalize (or (org-capture-get :finalize)
(org-roam-capture--get :finalize)))))
(defun org-roam-capture--finalize-find-file ()
"Visit the buffer after Org-capture is done.
This function is to be called in the Org-capture finalization process.
ID is unused."
(switch-to-buffer (org-capture-get :buffer)))
(defun org-roam-capture--finalize-insert-link ()
"Insert a link to ID into the buffer where Org-capture was called.
ID is the Org id of the newly captured content.
This function is to be called in the Org-capture finalization process."
(when-let* ((mkr (org-roam-capture--get :call-location))
(buf (marker-buffer mkr)))
(with-current-buffer buf
(when-let ((region (org-roam-capture--get :region)))
(org-roam-unshield-region (car region) (cdr region))
(delete-region (car region) (cdr region))
(set-marker (car region) nil)
(set-marker (cdr region) nil))
(org-with-point-at mkr
(insert (org-link-make-string (concat "id:" (org-roam-capture--get :id))
(org-roam-capture--get :link-description)))))))
(defun org-roam-capture--finalize ()
"Finalize the `org-roam-capture' process."
(when-let ((region (org-roam-capture--get :region)))
(org-roam-unshield-region (car region) (cdr region)))
(if org-note-abort
(when-let ((new-file (org-roam-capture--get :new-file)))
(org-roam-message "Deleting file for aborted capture %s" new-file)
(when (find-buffer-visiting new-file)
(kill-buffer (find-buffer-visiting new-file)))
(delete-file new-file))
(when-let* ((finalize (org-roam-capture--get :finalize))
(org-roam-finalize-fn (intern (concat "org-roam-capture--finalize-"
(symbol-name finalize)))))
(if (functionp org-roam-finalize-fn)
(funcall org-roam-finalize-fn)
(funcall finalize))))
(remove-hook 'org-capture-after-finalize-hook #'org-roam-capture--finalize))
(defun org-roam-capture--install-finalize ()
"Install `org-roam-capture--finalize' if the capture is an Org-roam capture."
(when (org-roam-capture-p)
(add-hook 'org-capture-after-finalize-hook #'org-roam-capture--finalize)))
(add-hook 'org-capture-prepare-finalize-hook #'org-roam-capture--install-finalize)
(defun org-roam-capture--fill-template (template &optional org-capture-p)
"Expand TEMPLATE and return it.
It expands ${var} occurrences in TEMPLATE. When ORG-CAPTURE-P,
also run Org-capture's template expansion."
(funcall (if org-capture-p #'org-capture-fill-template #'identity)
(org-roam-format
template
(lambda (key default-val)
(let ((fn (intern key))
(node-fn (intern (concat "org-roam-node-" key)))
(ksym (intern (concat ":" key))))
(cond
((fboundp fn)
(funcall fn org-roam-capture--node))
((fboundp node-fn)
(funcall node-fn org-roam-capture--node))
((plist-get org-roam-capture--info ksym)
(plist-get org-roam-capture--info ksym))
(t (let ((r (completing-read (format "%s: " key) nil nil nil default-val)))
(plist-put org-roam-capture--info ksym r)
r))))))))
(defun org-roam-capture--insert-ref ()
"Insert the ref if any."
(when-let ((ref (plist-get org-roam-capture--info :ref)))
(org-roam-ref-add ref)))
(defun org-roam-capture--new-file-p (path)
"Return t if PATH is for a new file with no visiting buffer."
(not (or (file-exists-p path)
(org-find-base-buffer-visiting path))))
(defun org-roam-capture--goto-location ()
(defun org-roam-capture--setup-target-location ()
"Initialize the buffer, and goto the location of the new capture.
Return the ID of the location."
(let (p new-file-p)
@ -629,7 +564,7 @@ Return the ID of the location."
;; first try to get ID, then try to get title/alias
(let ((node (or (org-roam-node-from-id title-or-id)
(org-roam-node-from-title-or-alias title-or-id)
(user-error "No node with title or id \"%s\" title-or-id"))))
(user-error "No node with title or id \"%s\"" title-or-id))))
(set-buffer (org-capture-target-buffer (org-roam-node-file node)))
(goto-char (org-roam-node-point node))
(setq p (org-roam-node-point node)))))
@ -644,36 +579,10 @@ Return the ID of the location."
(org-id-get-create)
(run-hooks 'org-roam-capture-new-node-hook)))))
(defun org-roam-capture--adjust-point-for-capture-type (&optional pos)
"Reposition the point for template insertion dependently on the capture type.
Return the newly adjusted position of `point'.
POS is the current position of point (an integer) inside the
currently active capture buffer, where the adjustment should
start to begin from. If it's nil, then it will default to
the current value of `point'."
(or pos (setq pos (point)))
(goto-char pos)
(let ((location-type (if (= pos 1) 'beginning-of-file 'heading-at-point)))
(and (eq location-type 'heading-at-point)
(cl-assert (org-at-heading-p)))
(pcase (org-capture-get :type)
(`plain
(cl-case location-type
(beginning-of-file
(if (org-capture-get :prepend)
(let ((el (org-element-at-point)))
(while (and (not (eobp))
(memq (org-element-type el)
'(drawer property-drawer keyword comment comment-block horizontal-rule)))
(goto-char (org-element-property :end el))
(setq el (org-element-at-point))))
(goto-char (org-entry-end-position))))
(heading-at-point
(if (org-capture-get :prepend)
(org-end-of-meta-data t)
(goto-char (org-entry-end-position))))))))
(point))
(defun org-roam-capture--new-file-p (path)
"Return t if PATH is for a new file with no visiting buffer."
(not (or (file-exists-p path)
(org-find-base-buffer-visiting path))))
(defun org-roam-capture-find-or-create-olp (olp)
"Return a marker pointing to the entry at OLP in the current buffer.
@ -721,51 +630,106 @@ you can catch it with `condition-case'."
end (save-excursion (org-end-of-subtree t t))))
(point-marker))))
(defun org-roam-capture--get-node-from-ref (ref)
"Return the node from reference REF."
(save-match-data
(when (string-match org-link-plain-re ref)
(let ((type (match-string 1 ref))
(path (match-string 2 ref)))
(when-let ((id (caar (org-roam-db-query
[:select [nodes:id]
:from refs
:left-join nodes
:on (= refs:node-id nodes:id)
:where (= refs:type $s1)
:and (= refs:ref $s2)
:limit 1]
type path))))
(org-roam-populate (org-roam-node-create :id id)))))))
(defun org-roam-capture--adjust-point-for-capture-type (&optional pos)
"Reposition the point for template insertion dependently on the capture type.
Return the newly adjusted position of `point'.
(defun org-roam-capture--get-point ()
"Return exact point to file for org-capture-template.
This function is used solely in Org-roam's capture templates: see
`org-roam-capture-templates'."
(when (org-roam-capture--get :override-default-time)
(org-capture-put :default-time (org-roam-capture--get :override-default-time)))
(let ((id (cond ((plist-get org-roam-capture--info :ref)
(if-let ((node (org-roam-capture--get-node-from-ref
(plist-get org-roam-capture--info :ref))))
(progn
(set-buffer (org-capture-target-buffer (org-roam-node-file node)))
(goto-char (org-roam-node-point node))
(widen))
(org-roam-capture--goto-location)))
((and (org-roam-node-file org-roam-capture--node)
(org-roam-node-point org-roam-capture--node))
(set-buffer (org-capture-target-buffer (org-roam-node-file org-roam-capture--node)))
(goto-char (org-roam-node-point org-roam-capture--node))
(widen)
(org-roam-node-id org-roam-capture--node))
(t
(org-roam-capture--goto-location)))))
(org-roam-capture--adjust-point-for-capture-type)
(org-capture-put :template
(org-roam-capture--fill-template (org-capture-get :template)))
(org-roam-capture--put :id id)
(org-roam-capture--put :finalize (or (org-capture-get :finalize)
(org-roam-capture--get :finalize)))))
POS is the current position of point (an integer) inside the
currently active capture buffer, where the adjustment should
start to begin from. If it's nil, then it will default to
the current value of `point'."
(or pos (setq pos (point)))
(goto-char pos)
(let ((location-type (if (= pos 1) 'beginning-of-file 'heading-at-point)))
(and (eq location-type 'heading-at-point)
(cl-assert (org-at-heading-p)))
(pcase (org-capture-get :type)
(`plain
(cl-case location-type
(beginning-of-file
(if (org-capture-get :prepend)
(let ((el (org-element-at-point)))
(while (and (not (eobp))
(memq (org-element-type el)
'(drawer property-drawer keyword comment comment-block horizontal-rule)))
(goto-char (org-element-property :end el))
(setq el (org-element-at-point))))
(goto-char (org-entry-end-position))))
(heading-at-point
(if (org-capture-get :prepend)
(org-end-of-meta-data t)
(goto-char (org-entry-end-position))))))))
(point))
;;;; Finalizers
(add-hook 'org-capture-prepare-finalize-hook #'org-roam-capture--install-finalize-h)
(defun org-roam-capture--install-finalize-h ()
"Install `org-roam-capture--finalize' if the capture is an Org-roam capture."
(when (org-roam-capture-p)
(add-hook 'org-capture-after-finalize-hook #'org-roam-capture--finalize)))
(defun org-roam-capture--finalize ()
"Finalize the `org-roam-capture' process."
(when-let ((region (org-roam-capture--get :region)))
(org-roam-unshield-region (car region) (cdr region)))
(if org-note-abort
(when-let ((new-file (org-roam-capture--get :new-file)))
(org-roam-message "Deleting file for aborted capture %s" new-file)
(when (find-buffer-visiting new-file)
(kill-buffer (find-buffer-visiting new-file)))
(delete-file new-file))
(when-let* ((finalize (org-roam-capture--get :finalize))
(org-roam-finalize-fn (intern (concat "org-roam-capture--finalize-"
(symbol-name finalize)))))
(if (functionp org-roam-finalize-fn)
(funcall org-roam-finalize-fn)
(funcall finalize))))
(remove-hook 'org-capture-after-finalize-hook #'org-roam-capture--finalize))
(defun org-roam-capture--finalize-find-file ()
"Visit the buffer after Org-capture is done.
This function is to be called in the Org-capture finalization process.
ID is unused."
(switch-to-buffer (org-capture-get :buffer)))
(defun org-roam-capture--finalize-insert-link ()
"Insert a link to ID into the buffer where Org-capture was called.
ID is the Org id of the newly captured content.
This function is to be called in the Org-capture finalization process."
(when-let* ((mkr (org-roam-capture--get :call-location))
(buf (marker-buffer mkr)))
(with-current-buffer buf
(when-let ((region (org-roam-capture--get :region)))
(org-roam-unshield-region (car region) (cdr region))
(delete-region (car region) (cdr region))
(set-marker (car region) nil)
(set-marker (cdr region) nil))
(org-with-point-at mkr
(insert (org-link-make-string (concat "id:" (org-roam-capture--get :id))
(org-roam-capture--get :link-description)))))))
;;;; Processing of the capture templates
(defun org-roam-capture--fill-template (template &optional org-capture-p)
"Expand TEMPLATE and return it.
It expands ${var} occurrences in TEMPLATE. When ORG-CAPTURE-P,
also run Org-capture's template expansion."
(funcall (if org-capture-p #'org-capture-fill-template #'identity)
(org-roam-format-template
template
(lambda (key default-val)
(let ((fn (intern key))
(node-fn (intern (concat "org-roam-node-" key)))
(ksym (intern (concat ":" key))))
(cond
((fboundp fn)
(funcall fn org-roam-capture--node))
((fboundp node-fn)
(funcall node-fn org-roam-capture--node))
((plist-get org-roam-capture--info ksym)
(plist-get org-roam-capture--info ksym))
(t (let ((r (completing-read (format "%s: " key) nil nil nil default-val)))
(plist-put org-roam-capture--info ksym r)
r))))))))
(defun org-roam-capture--convert-template (template &optional props)
"Convert TEMPLATE from Org-roam syntax to `org-capture-templates' syntax.
@ -789,48 +753,12 @@ properties to be added to the template."
(if custom
(setq org-roam-plist (plist-put org-roam-plist key val))
(setq options (plist-put options key val)))))
(append `(,key ,desc ,type #'org-roam-capture--get-point ,body)
(append `(,key ,desc ,type #'org-roam-capture--prepare-buffer ,body)
options
(list :org-roam org-roam-plist))))
(_
(signal 'invalid-template template))))
;;;###autoload (autoload 'org-roam-capture- "org-roam" nil t)
(cl-defun org-roam-capture- (&key goto keys node info props templates)
"Main entry point.
GOTO and KEYS correspond to `org-capture' arguments.
INFO is a plist for filling up Org-roam's capture templates.
NODE is an `org-roam-node' construct containing information about the node.
PROPS is a plist containing additional Org-roam properties for each template.
TEMPLATES is a list of org-roam templates."
(let* ((props (plist-put props :call-location (point-marker)))
(org-capture-templates
(mapcar (lambda (template)
(org-roam-capture--convert-template template props))
(or templates org-roam-capture-templates)))
(org-roam-capture--node node)
(org-roam-capture--info info))
(when (and (not keys)
(= (length org-capture-templates) 1))
(setq keys (caar org-capture-templates)))
(org-capture goto keys)))
;;;###autoload (autoload 'org-roam-capture "org-roam" nil t)
(cl-defun org-roam-capture (&optional goto keys &key filter-fn templates)
"Launches an `org-capture' process for a new or existing note.
This uses the templates defined at `org-roam-capture-templates'.
Arguments GOTO and KEYS see `org-capture'.
FILTER-FN is a function to filter out nodes: it takes an `org-roam-node',
and when nil is returned the node will be filtered out.
The TEMPLATES, if provided, override the list of capture templates (see
`org-roam-capture-'.)"
(interactive "P")
(let ((node (org-roam-node-read nil filter-fn)))
(org-roam-capture- :goto goto
:keys keys
:templates templates
:node node
:props '(:immediate-finish nil))))
(provide 'org-roam-capture)

15
org-roam-compat.el
View File

@ -1,12 +1,12 @@
;;; org-roam-compat.el --- Compatibility Code -*- coding: utf-8; lexical-binding: t; -*-
;;; org-roam-compat.el --- Backward compatibility code -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright © 2020 Jethro Kuan <jethrokuan95@gmail.com>
;; Copyright © 2020-2021 Jethro Kuan <jethrokuan95@gmail.com>
;; Author: Jethro Kuan <jethrokuan95@gmail.com>
;; URL: https://github.com/org-roam/org-roam
;; Keywords: org-mode, roam, convenience
;; Version: 2.0.0
;; Package-Requires: ((emacs "26.1") (dash "2.13") (f "0.17.2") (org "9.4") (emacsql "3.0.0") (emacsql-sqlite "1.0.0") (magit-section "2.90.1"))
;; Package-Requires: ((emacs "26.1"))
;; This file is NOT part of GNU Emacs.
@ -27,12 +27,10 @@
;;; Commentary:
;;
;; This file contains code needed for backward compatibility with older Emacsen
;; and previous versions of org-roam.
;; This file is dedicated to maintain backward compatibility with older older
;; Emacsen and Org-roam versions.
;;
;;; Code:
;;;; Library Requires
;;; Backports
;; REVIEW Remove when 26.x support is dropped. This is exact the same as
;; `directory-files-recursively' from Emacs 26, but with FOLLOW-SYMLINKS
@ -110,6 +108,9 @@ recursion."
(define-obsolete-function-alias
'org-roam-buffer
'org-roam-buffer-display-dedicated "org-roam 2.0")
(define-obsolete-function-alias
'org-roam-visit-thing
'org-roam-buffer-visit-thing "org-roam 2.0")
(define-obsolete-function-alias
'org-roam-dailies-find-today

107
org-roam-completion.el
View File

@ -1,107 +0,0 @@
;;; org-roam-completion.el --- Completion features -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright © 2020 Jethro Kuan <jethrokuan95@gmail.com>
;; Author: Jethro Kuan <jethrokuan95@gmail.com>
;; URL: https://github.com/org-roam/org-roam
;; Keywords: org-mode, roam, convenience
;; Version: 2.0.0
;; Package-Requires: ((emacs "26.1") (dash "2.13") (f "0.17.2") (org "9.4") (emacsql "3.0.0") (emacsql-sqlite "1.0.0") (magit-section "2.90.1"))
;; 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:
;;
;; This library provides completion-at-point functions for Org-roam.
;;
;; The two main functions provided to capf are:
;;
;; `org-roam-complete-link-at-point' provides completions to nodes
;; within link brackets
;;
;; `org-roam-complete-everywhere' provides completions for nodes everywhere,
;; matching the symbol at point
;;
;;; Code:
(require 'cl-lib)
(require 'org-element)
(declare-function org-roam--get-titles "org-roam")
(defcustom org-roam-completion-everywhere nil
"When non-nil, provide link completion matching outside of Org links."
:group 'org-roam
:type 'boolean)
(defvar org-roam-completion-functions (list #'org-roam-complete-link-at-point
#'org-roam-complete-everywhere)
"List of functions to be used with `completion-at-point' for Org-roam.")
(defconst org-roam-bracket-completion-re
"\\[\\[\\(\\(?:roam:\\)?\\)\\([^z-a]*\\)]]"
"Regex for completion within link brackets.
We use this as a substitute for `org-link-bracket-re', because
`org-link-bracket-re' requires content within the brackets for a match.")
(defun org-roam-complete-everywhere ()
"Provides completions for links for any word at point.
This is a `completion-at-point' function, and is active when
`org-roam-completion-everywhere' is non-nil."
(when (and org-roam-completion-everywhere
(thing-at-point 'word)
(not (save-match-data (org-in-regexp org-link-any-re))))
(let ((bounds (bounds-of-thing-at-point 'word)))
(list (car bounds) (cdr bounds)
(completion-table-dynamic
(lambda (_)
(funcall #'org-roam--get-titles)))
:exit-function
(lambda (str _status)
(delete-char (- (length str)))
(insert "[[roam:" str "]]"))))))
(defun org-roam-complete-link-at-point ()
"Do appropriate completion for the link at point."
(let (roam-p start end)
(when (org-in-regexp org-roam-bracket-completion-re 1)
(setq roam-p (not (string-blank-p (match-string 1)))
start (match-beginning 2)
end (match-end 2))
(list start end
(completion-table-dynamic
(lambda (_)
(funcall #'org-roam--get-titles)))
:exit-function
(lambda (str &rest _)
(delete-char (- 0 (length str)))
(insert (concat (unless roam-p "roam:")
str))
(forward-char 2))))))
(defun org-roam-complete-at-point ()
"."
(run-hook-with-args-until-success 'org-roam-completion-functions))
(defun org-roam--register-completion-functions ()
"."
(add-hook 'completion-at-point-functions #'org-roam-complete-at-point nil t))
(add-hook 'org-roam-find-file-hook #'org-roam--register-completion-functions)
(provide 'org-roam-completion)
;;; org-roam-completion.el ends here

104
org-roam-db.el
View File

@ -1,6 +1,6 @@
;;; org-roam-db.el --- Org-roam database API -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright © 2020 Jethro Kuan <jethrokuan95@gmail.com>
;; Copyright © 2020-2021 Jethro Kuan <jethrokuan95@gmail.com>
;; Author: Jethro Kuan <jethrokuan95@gmail.com>
;; URL: https://github.com/org-roam/org-roam
@ -27,37 +27,14 @@
;;; Commentary:
;;
;; This library provides the underlying database api to org-roam.
;; This module provides the underlying database API to Org-roam.
;;
;;; Code:
;;;; Library Requires
(eval-when-compile (require 'subr-x))
(require 'emacsql)
(require 'emacsql-sqlite)
(require 'seq)
(require 'cl-lib)
(require 'org-roam)
(eval-and-compile
(require 'org-roam-macs)
;; For `org-with-wide-buffer'
(require 'org-macs))
(require 'org)
(require 'ol)
(require 'org-roam-utils)
(defvar org-roam-find-file-hook)
(defvar org-roam-directory)
(defvar org-roam-verbose)
(defvar org-agenda-files)
(declare-function org-roam-id-at-point "org-roam")
(declare-function org-roam--list-all-files "org-roam")
(declare-function org-roam-node-at-point "org-roam")
;;;; Options
;;; Options
(defcustom org-roam-db-location (expand-file-name "org-roam.db" user-emacs-directory)
"The full path to file where the Org-roam database is stored.
If this is non-nil, the Org-roam sqlite database is saved here.
"The path to file where the Org-roam database is stored.
It is the user's responsibility to set this correctly, especially
when used with multiple Org-roam instances."
@ -66,21 +43,30 @@ when used with multiple Org-roam instances."
(defcustom org-roam-db-gc-threshold gc-cons-threshold
"The value to temporarily set the `gc-cons-threshold' threshold to.
During large, heavy operations like `org-roam-db-sync',
many GC operations happen because of the large number of
temporary structures generated (e.g. parsed ASTs). Temporarily
increasing `gc-cons-threshold' will help reduce the number of GC
operations, at the cost of temporary memory usage.
During `org-roam-db-sync', Emacs can pause multiple times to
perform garbage collection because of the large number of
temporary structures generated (e.g. parsed ASTs).
This defaults to the original value of `gc-cons-threshold', but
tweaking this number may lead to better overall performance. For
example, to reduce the number of GCs, one may set it to a large
value like `most-positive-fixnum'."
`gc-cons-threshold' is temporarily set to
`org-roam-db-gc-threshold' during this operation, and increasing
`gc-cons-threshold' will help reduce the number of GC operations,
at the cost of memory usage. Tweaking this value may lead to
better overall performance.
For example, to reduce the number of GCs to the minimum, on
machines with large memory one may set it to
`most-positive-fixnum'."
:type 'int
:group 'org-roam)
(defcustom org-roam-db-node-include-function (lambda () t)
"A custom function to check if the headline at point is a node."
"A custom function to check if the point contains a valid node.
This function is called each time a node (both file and headline)
is about to be saved into the Org-roam database.
If the function returns nil, Org-roam will skip the node. This
function is useful for excluding certain nodes from the Org-roam
database."
:type 'function
:group 'org-roam)
@ -91,7 +77,10 @@ slow."
:type 'boolean
:group 'org-roam)
;;; Variables
(defconst org-roam-db-version 16)
;; TODO Rename this
(defconst org-roam--sqlite-available-p
(with-demoted-errors "Org-roam initialization: %S"
(emacsql-sqlite-ensure-binary)
@ -100,8 +89,7 @@ slow."
(defvar org-roam-db--connection (make-hash-table :test #'equal)
"Database connection to Org-roam database.")
;;;; Core Functions
;;; Core Functions
(defun org-roam-db--get-connection ()
"Return the database connection, if any."
(gethash (expand-file-name org-roam-directory)
@ -136,7 +124,7 @@ Performs a database upgrade when required."
"and there is no upgrade path")))))))
(org-roam-db--get-connection))
;;;; Entrypoint: (org-roam-db-query)
;;; Entrypoint: (org-roam-db-query)
(define-error 'emacsql-constraint "SQL constraint violation")
(defun org-roam-db-query (sql &rest args)
"Run SQL query on Org-roam database with ARGS.
@ -152,7 +140,7 @@ The query is expected to be able to fail, in this situation, run HANDLER."
(emacsql-constraint
(funcall handler err))))
;;;; Schemata
;;; Schemata
(defconst org-roam-db--table-schemata
'((files
[(file :unique :primary-key)
@ -238,8 +226,8 @@ the current `org-roam-directory'."
(dolist (conn (hash-table-values org-roam-db--connection))
(org-roam-db--close conn)))
;;;; Database API
;;;;; Clearing
;;; Database API
;;;; Clearing
(defun org-roam-db-clear-all ()
"Clears all entries in the Org-roam cache."
(interactive)
@ -256,7 +244,7 @@ If FILE is nil, clear the current buffer."
:where (= file $s1)]
file))
;;;;; Updating tables
;;;; Updating tables
(defun org-roam-db-insert-file ()
"Update the files table for the current buffer.
If UPDATE-P is non-nil, first remove the file in the database."
@ -281,7 +269,7 @@ If UPDATE-P is non-nil, first remove the file in the database."
(org-format-time-string "%FT%T%z" time)))
(defun org-roam-db-node-p ()
"Return t if headline at point is a node, else return nil."
"Return t if headline at point is an Org-roam node, else return nil."
(and (org-id-get)
(not (cdr (assoc "ROAM_EXCLUDE" (org-entry-properties))))
(funcall org-roam-db-node-include-function)))
@ -454,7 +442,7 @@ If UPDATE-P is non-nil, first remove the file in the database."
(vector (point) source p type properties))
path))))))
;;;;; Fetching
;;;; Fetching
(defun org-roam-db--get-current-files ()
"Return a hash-table of file to the hash of its file contents."
(let ((current-files (org-roam-db-query [:select [file hash] :from files]))
@ -473,8 +461,8 @@ If UPDATE-P is non-nil, first remove the file in the database."
(org-with-wide-buffer
(secure-hash 'sha1 (current-buffer)))))
;;;;; Updating
;;;###autoload (autoload 'org-roam-db-sync "org-roam" nil t)
;;;; Interactives
;;;###autoload
(defun org-roam-db-sync (&optional force)
"Synchronize the cache state with the current Org files on-disk.
If FORCE, force a rebuild of the cache from scratch."
@ -484,7 +472,7 @@ If FORCE, force a rebuild of the cache from scratch."
(org-roam-db) ;; To initialize the database, no-op if already initialized
(let* ((gc-cons-threshold org-roam-db-gc-threshold)
(org-agenda-files nil)
(org-roam-files (org-roam--list-all-files))
(org-roam-files (org-roam-list-files))
(current-files (org-roam-db--get-current-files))
(modified-files nil))
(dolist (file org-roam-files)
@ -530,16 +518,16 @@ If the file exists, update the cache with information."
(org-roam-db-map-links
(list #'org-roam-db-insert-link)))))))
(defun org-roam-db--update-on-save ()
"."
;;;; Hook Setups
(add-hook 'org-roam-find-file-hook #'org-roam-db--setup-update-on-save-h)
(defun org-roam-db--setup-update-on-save-h ()
"Setup the current buffer to update the DB after saving the current file."
(add-hook 'after-save-hook #'org-roam-db--try-update-on-save-h nil t))
(defun org-roam-db--try-update-on-save-h ()
"If appropriate, update the database for the current file after saving buffer."
(when org-roam-db-update-on-save (org-roam-db-update-file)))
(defun org-roam-db--update-on-save-h ()
"."
(add-hook 'after-save-hook #'org-roam-db--update-on-save nil t))
(add-hook 'org-roam-find-file-hook #'org-roam-db--update-on-save-h)
;; Diagnostic Interactives
(defun org-roam-db-diagnose-node ()
"Print information about node at point."

90
org-roam-macs.el
View File

@ -1,90 +0,0 @@
;;; org-roam-macs.el --- Macros/utility functions -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright © 2020 Jethro Kuan <jethrokuan95@gmail.com>
;; Author: Jethro Kuan <jethrokuan95@gmail.com>
;; URL: https://github.com/org-roam/org-roam
;; Keywords: org-mode, roam, convenience
;; Version: 2.0.0
;; Package-Requires: ((emacs "26.1") (dash "2.13") (f "0.17.2") (org "9.4") (emacsql "3.0.0") (emacsql-sqlite "1.0.0") (magit-section "2.90.1"))
;; 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:
;;
;; This library implements macros used throughout org-roam.
;;
;;; Code:
(defmacro org-roam-plist-map! (fn plist)
"Map FN over PLIST, modifying it in-place."
(declare (indent 1))
(let ((plist-var (make-symbol "plist"))
(k (make-symbol "k"))
(v (make-symbol "v")))
`(let ((,plist-var (copy-sequence ,plist)))
(while ,plist-var
(setq ,k (pop ,plist-var))
(setq ,v (pop ,plist-var))
(setq ,plist (plist-put ,plist ,k (funcall ,fn ,k ,v)))))))
(defmacro org-roam-with-file (file keep-buf-p &rest body)
"Execute BODY within FILE.
If FILE is nil, execute BODY in the current buffer.
Kills the buffer if KEEP-BUF-P is nil, and FILE is not yet visited."
(declare (indent 2) (debug t))
`(let* (new-buf
(auto-mode-alist nil)
(buf (or (and (not ,file)
(current-buffer)) ;If FILE is nil, use current buffer
(find-buffer-visiting ,file) ; If FILE is already visited, find buffer
(progn
(setq new-buf t)
(find-file-noselect ,file)))) ; Else, visit FILE and return buffer
res)
(with-current-buffer buf
(unless (equal major-mode 'org-mode)
(delay-mode-hooks
(let ((org-inhibit-startup t)
(org-agenda-files nil))
(org-mode))))
(setq res (progn ,@body))
(unless (and new-buf (not ,keep-buf-p))
(save-buffer)))
(if (and new-buf (not ,keep-buf-p))
(when (find-buffer-visiting ,file)
(kill-buffer (find-buffer-visiting ,file))))
res))
(defmacro org-roam-with-temp-buffer (file &rest body)
"Execute BODY within a temp buffer.
Like `with-temp-buffer', but propagates `org-roam-directory'.
If FILE, set `default-directory' to FILE's directory and insert its contents."
(declare (indent 1) (debug t))
(let ((current-org-roam-directory (make-symbol "current-org-roam-directory")))
`(let ((,current-org-roam-directory org-roam-directory))
(with-temp-buffer
(let ((org-roam-directory ,current-org-roam-directory))
(delay-mode-hooks (org-mode))
(when ,file
(insert-file-contents ,file)
(setq-local default-directory (file-name-directory ,file)))
,@body)))))
(provide 'org-roam-macs)
;;; org-roam-macs.el ends here

23
org-roam-migrate.el
View File

@ -27,16 +27,18 @@
;;; Commentary:
;;
;; To ease transition from v1 to v2, we provide various migration utilities.
;; This library helps convert v1 notes to v2, and informs the user.
;; This is a special library provided for the v1 users of this package. It's
;; purpose is to ease the transition from v1 to v2, by providing migration
;; utilities to convert from v1 notes to v2 nodes.
;;
;;; Code:
;;;; Dependencies
;;;;
;;; v1 breaking warning
(require 'org-roam-db)
(require 'org-roam)
(defvar org-roam-v2-ack nil)
;;; v1 breaking warning
(defvar org-roam-v2-ack nil
"When set to t, won't display the annoying warning message about the upgrade.
Need to be set before the package is loaded, otherwise won't take
any affect.")
(unless org-roam-v2-ack
(lwarn 'org-roam :error "
@ -74,7 +76,8 @@ To your init file.
"
"https://github.com/org-roam/org-roam/wiki/Hitchhiker's-Rough-Guide-to-Org-roam-V2"))
;;;###autoload (autoload 'org-roam-migrate-wizard "org-roam" nil t)
;;; Migration wizard (v1 -> v2)
;;;###autoload
(defun org-roam-migrate-wizard ()
"Migrate all notes from to be compatible with Org-roam v2.
1. Convert all notes from v1 format to v2.
@ -93,7 +96,7 @@ This will take a while. Are you sure you want to do this?")
(org-roam-db-sync 'force)
;; Convert v1 to v2
(dolist (f (org-roam--list-all-files))
(dolist (f (org-roam-list-files))
(org-roam-with-file f nil
(org-roam-migrate-v1-to-v2)))
@ -101,7 +104,7 @@ This will take a while. Are you sure you want to do this?")
(org-roam-db-sync 'force)
;;Replace all file links with ID links
(dolist (f (org-roam--list-all-files))
(dolist (f (org-roam-list-files))
(org-roam-with-file f nil
(org-roam-migrate-replace-file-links-with-id)
(save-buffer)))))

324
org-roam-mode.el
View File

@ -1,5 +1,6 @@
;;; org-roam-mode.el --- create and refresh Org-roam buffers -*- lexical-binding: t -*-
;; Copyright © 2020 Jethro Kuan <jethrokuan95@gmail.com>
;;; org-roam-mode.el --- Major mode for special Org-roam buffers -*- lexical-binding: t -*-
;; Copyright © 2020-2021 Jethro Kuan <jethrokuan95@gmail.com>
;; Author: Jethro Kuan <jethrokuan95@gmail.com>
;; URL: https://github.com/org-roam/org-roam
@ -26,18 +27,26 @@
;;; Commentary:
;;
;; This library implements the abstract major-mode `org-roam-mode', from which
;; almost all other Org-roam major-modes derive.
;; This module implements `org-roam-mode', which is a major mode that used by
;; special Org-roam buffers to display various content in a section-like manner
;; about the nodes and relevant to them information (e.g. backlinks) with which
;; the user can interact with.
;;
;;; Code:
(require 'magit-section)
(require 'org-roam)
(require 'org-roam-utils)
;;;; Declarations
(defvar org-ref-buffer-hacked)
(defvar org-roam-directory)
(defvar org-roam-find-file-hook)
(declare-function org-roam-node-at-point "org-roam")
;;; Options
(defcustom org-roam-mode-section-functions (list #'org-roam-backlinks-section
#'org-roam-reflinks-section)
"Functions that insert sections in the `org-roam-mode' based buffers.
Each function is called with one argument, which is an
`org-roam-node' for which the buffer will be constructed for.
Normally this node is `org-roam-buffer-current-node'."
:group 'org-roam
:type 'hook)
;;; Faces
(defface org-roam-header-line
@ -119,7 +128,28 @@ and `:slant'."
"Face for the dimmer part of the widgets."
:group 'org-roam-faces)
;;; Variables
;;; Major mode
(defvar org-roam-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map magit-section-mode-map)
(define-key map [C-return] 'org-roam-buffer-visit-thing)
(define-key map (kbd "C-m") 'org-roam-buffer-visit-thing)
(define-key map [remap revert-buffer] 'org-roam-buffer-refresh)
map)
"Parent keymap for all keymaps of modes derived from `org-roam-mode'.")
(define-derived-mode org-roam-mode magit-section-mode "Org-roam"
"Major mode for displaying relevant information about Org-roam nodes.
This mode is used by special Org-roam buffers, such as persistent
`org-roam-buffer' and dedicated Org-roam buffers
\(`org-roam-buffer-display-dedicated'), which render the
information in a section-like manner (see
`org-roam-mode-section-functions'), with which the user can
interact with."
:group 'org-roam
(face-remap-add-relative 'header-line 'org-roam-header-line))
;;; Buffers
(defvar org-roam-buffer-current-node nil
"The node for which an `org-roam-mode' based buffer displays its contents.
This set both, locally and globally. Normally the local value is
@ -134,38 +164,26 @@ Set both, locally and globally in the same way as `org-roam-buffer-current-node'
(put 'org-roam-buffer-current-directory 'permanent-local t)
(defcustom org-roam-mode-section-functions (list #'org-roam-backlinks-section
#'org-roam-reflinks-section)
"Functions that insert sections in the `org-roam-mode' based buffers.
Each function is called with one argument, which is an
`org-roam-node' for which the buffer will be constructed for.
Normally this node is `org-roam-buffer-current-node'."
:group 'org-roam
:type 'hook)
;;; The mode
(defvar org-roam-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map magit-section-mode-map)
(define-key map [C-return] 'org-roam-visit-thing)
(define-key map (kbd "C-m") 'org-roam-visit-thing)
(define-key map [remap revert-buffer] 'org-roam-buffer-refresh)
map)
"Parent keymap for all keymaps of modes derived from `org-roam-mode'.")
(define-derived-mode org-roam-mode magit-section-mode "Org-roam"
"Major mode for Org-roam's buffer."
:group 'org-roam
(face-remap-add-relative 'header-line 'org-roam-header-line))
;;; Key functions
(defun org-roam-visit-thing ()
;;;; Library
(defun org-roam-buffer-visit-thing ()
"This is a placeholder command.
Where applicable, section-specific keymaps bind another command
which visits the thing at point."
(interactive)
(user-error "There is no thing at point that could be visited"))
(defun org-roam-buffer-file-at-point (&optional assert)
"Return the file at point in the current `org-roam-mode' based buffer.
If ASSERT, throw an error."
(if-let ((file (magit-section-case
(org-roam-node-section (org-roam-node-file (oref it node)))
(org-roam-grep-section (oref it file))
(org-roam-preview-section (oref it file))
(t (cl-assert (derived-mode-p 'org-roam-mode))))))
file
(when assert
(user-error "No file at point"))))
(defun org-roam-buffer-refresh ()
"Refresh the contents of the currently selected Org-roam buffer."
(interactive)
@ -181,15 +199,24 @@ buffer."
(org-roam-mode)
(setq-local default-directory org-roam-buffer-current-directory)
(setq-local org-roam-directory org-roam-buffer-current-directory)
(org-roam-set-header-line-format
(org-roam-buffer-set-header-line-format
(org-roam-node-title org-roam-buffer-current-node))
(magit-insert-section (org-roam)
(magit-insert-heading)
(run-hook-with-args 'org-roam-mode-section-functions org-roam-buffer-current-node))
(goto-char 0)))
;;; Dedicated buffer
;;;###autoload (autoload 'org-roam-buffer-display-dedicated "org-roam" nil t)
(defun org-roam-buffer-set-header-line-format (string)
"Set the header-line using STRING.
If the `face' property of any part of STRING is already set, then
that takes precedence. Also pad the left side of STRING so that
it aligns with the text area."
(setq-local header-line-format
(concat (propertize " " 'display '(space :align-to 0))
string)))
;;;; Dedicated buffer
;;;###autoload
(defun org-roam-buffer-display-dedicated (node)
"Launch NODE dedicated Org-roam buffer.
Unlike the persistent `org-roam-buffer', the contents of this
@ -223,7 +250,7 @@ If BUFFER is nil, default it to `current-buffer'."
(string-match-p (concat "^" (regexp-quote "*org-roam: "))
(buffer-name buffer)))
;;; Persistent buffer
;;;; Persistent buffer
(defvar org-roam-buffer "*org-roam*"
"The persistent Org-roam buffer name. Must be surround with \"*\".
The content inside of this buffer will be automatically updated
@ -253,11 +280,6 @@ Valid states are 'visible, 'exists and 'none."
((get-buffer org-roam-buffer) 'exists)
(t 'none))))
(defun org-roam-buffer--persistent-cleanup-h ()
"Clean-up global state thats dedicated for the persistent `org-roam-buffer'."
(setq-default org-roam-buffer-current-node nil
org-roam-buffer-current-directory nil))
(defun org-roam-buffer-persistent-redisplay ()
"Recompute contents of the persistent `org-roam-buffer'.
Has no effect when there's no `org-roam-node-at-point'."
@ -269,6 +291,16 @@ Has no effect when there's no `org-roam-node-at-point'."
(org-roam-buffer-render-contents)
(add-hook 'kill-buffer-hook #'org-roam-buffer--persistent-cleanup-h nil t)))))
(defun org-roam-buffer--persistent-cleanup-h ()
"Clean-up global state thats dedicated for the persistent `org-roam-buffer'."
(setq-default org-roam-buffer-current-node nil
org-roam-buffer-current-directory nil))
(add-hook 'org-roam-find-file-hook #'org-roam-buffer--setup-redisplay-h)
(defun org-roam-buffer--setup-redisplay-h ()
"Setup automatic redisplay of the persistent `org-roam-buffer'."
(add-hook 'post-command-hook #'org-roam-buffer--redisplay-h nil t))
(defun org-roam-buffer--redisplay-h ()
"Reconstruct the persistent `org-roam-buffer'.
This needs to be quick or infrequent, because this designed to
@ -276,13 +308,173 @@ run at `post-command-hook'."
(and (get-buffer-window org-roam-buffer)
(org-roam-buffer-persistent-redisplay)))
(defun org-roam-buffer--setup-redisplay-h ()
"Setup automatic redisplay of the persistent `org-roam-buffer'."
(add-hook 'post-command-hook #'org-roam-buffer--redisplay-h nil t))
(add-hook 'org-roam-find-file-hook #'org-roam-buffer--setup-redisplay-h)
;;; Sections
;;;; Node
(defvar org-roam-node-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map org-roam-mode-map)
(define-key map [remap org-roam-buffer-visit-thing] 'org-roam-node-visit)
map)
"Keymap for `org-roam-node-section's.")
(defclass org-roam-node-section (magit-section)
((keymap :initform 'org-roam-node-map)
(node :initform nil))
"A `magit-section' used by `org-roam-mode' to outline NODE in its own heading.")
(cl-defun org-roam-node-insert-section (&key source-node point properties)
"Insert section for a link from SOURCE-NODE to some other node.
The other node is normally `org-roam-buffer-current-node'.
SOURCE-NODE is an `org-roam-node' that links or references with
the other node.
POINT is a character position where the link is located in
SOURCE-NODE's file.
PROPERTIES (a plist) contains additional information about the
link.
Despite the name, this function actually inserts 2 sections at
the same time:
1. `org-roam-node-section' for a heading that describes
SOURCE-NODE. Acts as a parent section of the following one.
2. `org-roam-preview-section' for a preview content that comes
from SOURCE-NODE's file for the link (that references the
other node) at POINT. Acts a child section of the previous
one."
(magit-insert-section section (org-roam-node-section)
(let ((outline (if-let ((outline (plist-get properties :outline)))
(mapconcat #'org-link-display-format outline " > ")
"Top")))
(insert (concat (propertize (org-roam-node-title source-node)
'font-lock-face 'org-roam-title)
(format " (%s)"
(propertize outline 'font-lock-face 'org-roam-olp)))))
(magit-insert-heading)
(oset section node source-node)
(magit-insert-section section (org-roam-preview-section)
(insert (org-roam-fontify-like-in-org-mode
(org-roam-preview-get-contents (org-roam-node-file source-node) point))
"\n")
(oset section file (org-roam-node-file source-node))
(oset section point point)
(insert ?\n))))
;;;; Preview
(defvar org-roam-preview-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map org-roam-mode-map)
(define-key map [remap org-roam-buffer-visit-thing] 'org-roam-preview-visit)
map)
"Keymap for `org-roam-preview-section's.")
(defclass org-roam-preview-section (magit-section)
((keymap :initform 'org-roam-preview-map)
(file :initform nil)
(point :initform nil))
"A `magit-section' used by `org-roam-mode' to contain preview content.
The preview content comes from FILE, and the link as at POINT.")
(defun org-roam-preview-visit (file point &optional other-window)
"Visit FILE at POINT.
With prefix argument OTHER-WINDOW, visit the olp in another
window instead."
(interactive (list (org-roam-buffer-file-at-point 'assert)
(oref (magit-current-section) point)
current-prefix-arg))
(let ((buf (find-file-noselect file)))
(with-current-buffer buf
(widen)
(goto-char point))
(funcall (if other-window
#'switch-to-buffer-other-window
#'pop-to-buffer-same-window) buf)))
(defun org-roam-preview-get-contents (file point)
"Get preview content for FILE at POINT."
(save-excursion
(org-roam-with-temp-buffer file
(goto-char point)
(let ((elem (org-element-at-point)))
;; We want the parent element always
(while (org-element-property :parent elem)
(setq elem (org-element-property :parent elem)))
(pcase (car elem)
('headline ; show subtree
(org-roam-preview-get-entry-text (point-marker) most-positive-fixnum))
(_
(let ((begin (org-element-property :begin elem))
(end (org-element-property :end elem)))
(or (string-trim (buffer-substring-no-properties begin end))
(org-element-property :raw-value elem)))))))))
(defun org-roam-preview-get-entry-text (marker n-lines &optional indent)
"Extract entry text from MARKER, at most N-LINES lines.
This will ignore drawers etc, just get the text.
If INDENT is given, prefix every line with this string."
(let (txt ind)
(save-excursion
(with-current-buffer (marker-buffer marker)
(if (not (derived-mode-p 'org-mode))
(setq txt "")
(org-with-wide-buffer
(goto-char marker)
(end-of-line 1)
(setq txt (buffer-substring
(min (1+ (point)) (point-max))
(progn (outline-next-heading) (point))))
(with-temp-buffer
(insert txt)
(goto-char (point-min))
(while (org-activate-links (point-max))
(goto-char (match-end 0)))
(goto-char (point-min))
(while (re-search-forward org-link-bracket-re (point-max) t)
(set-text-properties (match-beginning 0) (match-end 0)
nil))
(goto-char (point-min))
(while (re-search-forward org-drawer-regexp nil t)
(delete-region
(match-beginning 0)
(progn (re-search-forward
"^[ \t]*:END:.*\n?" nil 'move)
(point))))
(goto-char (point-min))
(goto-char (point-max))
(skip-chars-backward " \t\n")
(when (looking-at "[ \t\n]+\\'") (replace-match ""))
;; find and remove min common indentation
(goto-char (point-min))
(untabify (point-min) (point-max))
(setq ind (current-indentation))
(while (not (eobp))
(unless (looking-at "[ \t]*$")
(setq ind (min ind (current-indentation))))
(beginning-of-line 2))
(goto-char (point-min))
(while (not (eobp))
(unless (looking-at "[ \t]*$")
(move-to-column ind)
(delete-region (point-at-bol) (point)))
(beginning-of-line 2))
(goto-char (point-min))
(when indent
(while (and (not (eobp)) (re-search-forward "^" nil t))
(replace-match indent t t)))
(goto-char (point-min))
(while (looking-at "[ \t]*\n") (replace-match ""))
(goto-char (point-max))
(when (> (org-current-line)
n-lines)
(org-goto-line (1+ n-lines))
(backward-char 1))
(setq txt (buffer-substring (point-min) (point))))))))
txt))
;;;; Backlinks
(cl-defstruct (org-roam-backlink (:constructor org-roam-backlink-create)
(:copier nil))
@ -383,11 +575,11 @@ Sorts by title."
:properties (org-roam-reflink-properties reflink)))
(insert ?\n)))))
;;;; Unlinked references
;;;; Grep
(defvar org-roam-grep-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map org-roam-mode-map)
(define-key map [remap org-roam-visit-thing] 'org-roam-file-visit)
(define-key map [remap org-roam-buffer-visit-thing] 'org-roam-grep-visit)
map)
"Keymap for Org-roam grep result sections.")
@ -395,25 +587,14 @@ Sorts by title."
((keymap :initform 'org-roam-grep-map)
(file :initform nil)
(row :initform nil)
(col :initform nil)))
(col :initform nil))
"A `magit-section' used by `org-roam-mode' to contain grep output.")
(defun org-roam-file-at-point (&optional assert)
"Return the file at point.
If ASSERT, throw an error."
(if-let ((file (magit-section-case
(org-roam-node-section (org-roam-node-file (oref it node)))
(org-roam-grep-section (oref it file))
(org-roam-preview-section (oref it file)))))
file
(when assert
(user-error "No file at point"))))
(defun org-roam-file-visit (file &optional other-window row col)
"Visits FILE.
(defun org-roam-grep-visit (file &optional other-window row col)
"Visits FILE. If ROW, move to the row, and if COL move to the COL.
With a prefix argument OTHER-WINDOW, display the buffer in
another window instead.
If ROW, move to the row, and if COL move to the COL."
(interactive (list (org-roam-file-at-point t)
another window instead."
(interactive (list (org-roam-buffer-file-at-point t)
current-prefix-arg
(oref (magit-current-section) row)
(oref (magit-current-section) col)))
@ -429,6 +610,7 @@ If ROW, move to the row, and if COL move to the COL."
#'switch-to-buffer-other-window
#'pop-to-buffer-same-window) buf)))
;;;; Unlinked references
(defvar org-roam-unlinked-references-result-re
(rx (group (one-or-more anything))
":"

985
org-roam-node.el Normal file
View File

@ -0,0 +1,985 @@
;;; org-roam-node.el --- Interfacing and interacting with nodes -*- lexical-binding: t; -*-
;; Copyright © 2020-2021 Jethro Kuan <jethrokuan95@gmail.com>
;; Author: Jethro Kuan <jethrokuan95@gmail.com>
;; URL: https://github.com/org-roam/org-roam
;; Keywords: org-mode, roam, convenience
;; Version: 2.0.0
;; Package-Requires: ((emacs "26.1") (dash "2.13") (org "9.4") (magit-section "2.90.1"))
;; 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:
;;
;; This module is dedicated for Org-roam nodes and its components. It provides
;; standard means to interface with them, both programmatically and
;; interactively.
;;
;;; Code:
(require 'org-roam)
;;; Options
;;;; Completing-read
(defcustom org-roam-node-display-template
"${title:*} ${tags:10}"
"Configures display formatting for Org-roam node.
Patterns of form \"${field-name:length}\" are interpolated based
on the current node.
Each \"field-name\" is replaced with the return value of each
corresponding accessor function for `org-roam-node', e.g.
\"${title}\" will be interpolated by the result of
`org-roam-node-title'. You can also define custom accessors using
`cl-defmethod'. For example, you can define:
(cl-defmethod org-roam-node-my-title ((node org-roam-node))
(concat \"My \" (org-roam-node-title node)))
and then reference it here or in the capture templates as
\"${my-title}\".
\"length\" is an optional specifier and declares how many
characters can be used to display the value of the corresponding
field. If it's not specified, the field will be inserted as is,
i.e. it won't be aligned nor trimmed. If it's an integer, the
field will be aligned accordingly and all the exceeding
characters will be trimmed out. If it's \"*\", the field will use
as many characters as possible and will be aligned accordingly."
:group 'org-roam
:type 'string)
(defcustom org-roam-node-annotation-function #'org-roam-node-read--annotation
"This function used to attach annotations for `org-roam-node-read'.
It takes a single argument NODE, which is an `org-roam-node' construct."
:group 'org-roam
:type 'function)
(defcustom org-roam-node-default-sort 'file-mtime
"Default sort order for Org-roam node completions."
:type '(choice (const :tag "file-mtime" file-mtime)
(const :tag "file-atime" file-atime))
:group 'org-roam)
(defcustom org-roam-ref-annotation-function #'org-roam-ref-read--annotation
"This function used to attach annotations for `org-roam-ref-read'.
It takes a single argument REF, which is a propertized string.")
;;;; Completion-at-point
(defcustom org-roam-completion-everywhere nil
"When non-nil, provide link completion matching outside of Org links."
:group 'org-roam
:type 'boolean)
(defcustom org-roam-completion-functions (list #'org-roam-complete-link-at-point
#'org-roam-complete-everywhere)
"List of functions to be used with `completion-at-point' for Org-roam."
:group 'org-roam
:type 'hook)
;;;; Linkage
(defcustom org-roam-link-auto-replace t
"If non-nil, replace \"roam:\" links to existing nodes with \"id:\" links."
:group 'org-roam
:type 'boolean)
(defcustom org-roam-extract-new-file-path "%<%Y%m%d%H%M%S>-${slug}.org"
"The file path to use when a node is extracted to its own file."
:group 'org-roam
:type 'string)
;;; Definition
(cl-defstruct (org-roam-node (:constructor org-roam-node-create)
(:copier nil))
"A heading or top level file with an assigned ID property."
file file-hash file-atime file-mtime
id level point todo priority scheduled deadline title properties olp
tags aliases refs)
(cl-defmethod org-roam-node-slug ((node org-roam-node))
"Return the slug of NODE."
(let ((title (org-roam-node-title node))
(slug-trim-chars '(;; Combining Diacritical Marks https://www.unicode.org/charts/PDF/U0300.pdf
768 ; U+0300 COMBINING GRAVE ACCENT
769 ; U+0301 COMBINING ACUTE ACCENT
770 ; U+0302 COMBINING CIRCUMFLEX ACCENT
771 ; U+0303 COMBINING TILDE
772 ; U+0304 COMBINING MACRON
774 ; U+0306 COMBINING BREVE
775 ; U+0307 COMBINING DOT ABOVE
776 ; U+0308 COMBINING DIAERESIS
777 ; U+0309 COMBINING HOOK ABOVE
778 ; U+030A COMBINING RING ABOVE
780 ; U+030C COMBINING CARON
795 ; U+031B COMBINING HORN
803 ; U+0323 COMBINING DOT BELOW
804 ; U+0324 COMBINING DIAERESIS BELOW
805 ; U+0325 COMBINING RING BELOW
807 ; U+0327 COMBINING CEDILLA
813 ; U+032D COMBINING CIRCUMFLEX ACCENT BELOW
814 ; U+032E COMBINING BREVE BELOW
816 ; U+0330 COMBINING TILDE BELOW
817 ; U+0331 COMBINING MACRON BELOW
)))
(cl-flet* ((nonspacing-mark-p (char)
(memq char slug-trim-chars))
(strip-nonspacing-marks (s)
(ucs-normalize-NFC-string
(apply #'string (seq-remove #'nonspacing-mark-p
(ucs-normalize-NFD-string s)))))
(cl-replace (title pair)
(replace-regexp-in-string (car pair) (cdr pair) title)))
(let* ((pairs `(("[^[:alnum:][:digit:]]" . "_") ;; convert anything not alphanumeric
("__*" . "_") ;; remove sequential underscores
("^_" . "") ;; remove starting underscore
("_$" . ""))) ;; remove ending underscore
(slug (-reduce-from #'cl-replace (strip-nonspacing-marks title) pairs)))
(downcase slug)))))
;;; Nodes
;;;; Getters
(defun org-roam-node-at-point (&optional assert)
"Return the node at point.
If ASSERT, throw an error if there is no node at point.
This function also returns the node if it has yet to be cached in the
database. In this scenario, only expect `:id' and `:point' to be
populated."
(or (magit-section-case
(org-roam-node-section (oref it node))
(org-roam-preview-section (save-excursion
(magit-section-up)
(org-roam-node-at-point)))
(t (org-with-wide-buffer
(org-back-to-heading-or-point-min)
(while (and (not (org-roam-db-node-p))
(not (bobp)))
(org-roam-up-heading-or-point-min))
(when-let ((id (org-id-get)))
(org-roam-populate
(org-roam-node-create
:id id
:point (point)))))))
(and assert (user-error "No node at point"))))
(defun org-roam-node-from-id (id)
"Return an `org-roam-node' for the node containing ID.
Return nil if a node with ID does not exist."
(when (> (caar (org-roam-db-query [:select (funcall count) :from nodes
:where (= id $s1)]
id)) 0)
(org-roam-populate (org-roam-node-create :id id))))
(defun org-roam-node-from-title-or-alias (s)
"Return an `org-roam-node' for the node with title or alias S.
Return nil if the node does not exist.
Throw an error if multiple choices exist."
(let ((matches (seq-uniq
(append
(org-roam-db-query [:select [id] :from nodes
:where (= title $s1)]
s)
(org-roam-db-query [:select [node-id] :from aliases
:where (= alias $s1)]
s)))))
(cond
((seq-empty-p matches)
nil)
((= 1 (length matches))
(org-roam-populate (org-roam-node-create :id (caar matches))))
(t
(user-error "Multiple nodes exist with title or alias \"%s\"" s)))))
(defun org-roam-node-from-ref (ref)
"Return an `org-roam-node' from REF reference.
Return nil if there's no node with such REF."
(save-match-data
(when (string-match org-link-plain-re ref)
(let ((type (match-string 1 ref))
(path (match-string 2 ref)))
(when-let ((id (caar (org-roam-db-query
[:select [nodes:id]
:from refs
:left-join nodes
:on (= refs:node-id nodes:id)
:where (= refs:type $s1)
:and (= refs:ref $s2)
:limit 1]
type path))))
(org-roam-populate (org-roam-node-create :id id)))))))
(cl-defmethod org-roam-populate ((node org-roam-node))
"Populate NODE from database.
Uses the ID, and fetches remaining details from the database.
This can be quite costly: avoid, unless dealing with very few
nodes."
(when-let ((node-info (car (org-roam-db-query [:select [file level pos todo priority
scheduled deadline title properties olp]
:from nodes
:where (= id $s1)
:limit 1]
(org-roam-node-id node)))))
(pcase-let* ((`(,file ,level ,pos ,todo ,priority ,scheduled ,deadline ,title ,properties ,olp) node-info)
(`(,atime ,mtime) (car (org-roam-db-query [:select [atime mtime]
:from files
:where (= file $s1)]
file)))
(tag-info (mapcar #'car (org-roam-db-query [:select [tag] :from tags
:where (= node-id $s1)]
(org-roam-node-id node))))
(alias-info (mapcar #'car (org-roam-db-query [:select [alias] :from aliases
:where (= node-id $s1)]
(org-roam-node-id node))))
(refs-info (mapcar #'car (org-roam-db-query [:select [ref] :from refs
:where (= node-id $s1)]
(org-roam-node-id node)))))
(setf (org-roam-node-file node) file
(org-roam-node-file-atime node) atime
(org-roam-node-file-mtime node) mtime
(org-roam-node-level node) level
(org-roam-node-point node) pos
(org-roam-node-todo node) todo
(org-roam-node-priority node) priority
(org-roam-node-scheduled node) scheduled
(org-roam-node-deadline node) deadline
(org-roam-node-title node) title
(org-roam-node-properties node) properties
(org-roam-node-olp node) olp
(org-roam-node-tags node) tag-info
(org-roam-node-refs node) refs-info
(org-roam-node-aliases node) alias-info)))
node)
(defun org-roam-node-list ()
"Return all nodes stored in the database as a list of `org-roam-node's."
(let ((rows (org-roam-db-query
"SELECT
id,
file,
\"level\",
todo,
pos,
priority ,
scheduled ,
deadline ,
title,
properties ,
olp,
atime,
mtime,
'(' || group_concat(tags, ' ') || ')' as tags,
aliases,
refs
FROM
(
SELECT
id,
file,
\"level\",
todo,
pos,
priority ,
scheduled ,
deadline ,
title,
properties ,
olp,
atime,
mtime,
tags,
'(' || group_concat(aliases, ' ') || ')' as aliases,
refs
FROM
(
SELECT
nodes.id as id,
nodes.file as file,
nodes.\"level\" as \"level\",
nodes.todo as todo,
nodes.pos as pos,
nodes.priority as priority,
nodes.scheduled as scheduled,
nodes.deadline as deadline,
nodes.title as title,
nodes.properties as properties,
nodes.olp as olp,
files.atime as atime,
files.mtime as mtime,
tags.tag as tags,
aliases.alias as aliases,
'(' || group_concat(RTRIM (refs.\"type\", '\"') || ':' || LTRIM(refs.ref, '\"'), ' ') || ')' as refs
FROM nodes
LEFT JOIN files ON files.file = nodes.file
LEFT JOIN tags ON tags.node_id = nodes.id
LEFT JOIN aliases ON aliases.node_id = nodes.id
LEFT JOIN refs ON refs.node_id = nodes.id
GROUP BY nodes.id, tags.tag, aliases.alias )
GROUP BY id, tags )
GROUP BY id")))
(cl-loop for row in rows
append (pcase-let* ((`(,id ,file ,level ,todo ,pos ,priority ,scheduled ,deadline
,title ,properties ,olp ,atime ,mtime ,tags ,aliases ,refs)
row)
(all-titles (cons title aliases)))
(mapcar (lambda (temp-title)
(org-roam-node-create :id id
:file file
:file-atime atime
:file-mtime mtime
:level level
:point pos
:todo todo
:priority priority
:scheduled scheduled
:deadline deadline
:title temp-title
:properties properties
:olp olp
:tags tags
:refs refs))
all-titles)))))
;;;; Finders
(defun org-roam-node-find-noselect (node)
"Navigate to the point for NODE, and return the buffer."
(unless (org-roam-node-file node)
(user-error "Node does not have corresponding file"))
(let ((buf (find-file-noselect (org-roam-node-file node))))
(with-current-buffer buf
(goto-char (org-roam-node-point node)))
buf))
(defun org-roam-node-visit (node &optional other-window)
"From the current buffer, visit NODE.
Display the buffer in the selected window. With a prefix
argument OTHER-WINDOW display the buffer in another window
instead."
(interactive (list (org-roam-node-at-point t) current-prefix-arg))
(let ((buf (org-roam-node-find-noselect node)))
(funcall (if other-window
#'switch-to-buffer-other-window
#'pop-to-buffer-same-window) buf)))
;;;###autoload
(cl-defun org-roam-node-find (&optional other-window initial-input filter-fn &key templates)
"Find and open an Org-roam node by its title or alias.
INITIAL-INPUT is the initial input for the prompt.
FILTER-FN is a function to filter out nodes: it takes an `org-roam-node',
and when nil is returned the node will be filtered out.
If OTHER-WINDOW, visit the NODE in another window.
The TEMPLATES, if provided, override the list of capture templates (see
`org-roam-capture-'.)"
(interactive current-prefix-arg)
(let ((node (org-roam-node-read initial-input filter-fn)))
(if (org-roam-node-file node)
(org-roam-node-visit node other-window)
(org-roam-capture-
:node node
:templates templates
:props '(:finalize find-file)))))
;;;###autoload
(defun org-roam-node-random (&optional other-window)
"Find and open a random Org-roam node.
With prefix argument OTHER-WINDOW, visit the node in another
window instead."
(interactive current-prefix-arg)
(let ((random-row (seq-random-elt (org-roam-db-query [:select [id file pos] :from nodes]))))
(org-roam-node-visit (org-roam-node-create :id (nth 0 random-row)
:file (nth 1 random-row)
:point (nth 2 random-row))
other-window)))
;;;; Completing-read interface
(defun org-roam-node-read (&optional initial-input filter-fn sort-fn require-match)
"Read and return an `org-roam-node'.
INITIAL-INPUT is the initial minibuffer prompt value.
FILTER-FN is a function to filter out nodes: it takes an `org-roam-node',
and when nil is returned the node will be filtered out.
SORT-FN is a function to sort nodes. See `org-roam-node-read-sort-by-file-mtime'
for an example sort function.
If REQUIRE-MATCH, the minibuffer prompt will require a match."
(let* ((nodes (org-roam-node-read--completions))
(nodes (cl-remove-if-not (lambda (n)
(if filter-fn (funcall filter-fn (cdr n)) t)) nodes))
(sort-fn (or sort-fn
(when org-roam-node-default-sort
(intern (concat "org-roam-node-read-sort-by-"
(symbol-name org-roam-node-default-sort))))))
(_ (when sort-fn (setq nodes (seq-sort sort-fn nodes))))
(node (completing-read
"Node: "
(lambda (string pred action)
(if (eq action 'metadata)
'(metadata
(annotation-function . (lambda (title)
(funcall org-roam-node-annotation-function
(get-text-property 0 'node title))))
(category . org-roam-node))
(complete-with-action action nodes string pred)))
nil require-match initial-input)))
(or (cdr (assoc node nodes))
(org-roam-node-create :title node))))
(defvar org-roam-node-read--cached-display-format nil)
(defun org-roam-node-read--completions ()
"Return an alist for node completion.
The car is the displayed title or alias for the node, and the cdr
is the `org-roam-node'.
The displayed title is formatted according to `org-roam-node-display-template'."
(setq org-roam-node-read--cached-display-format nil)
(let ((nodes (org-roam-node-list)))
(mapcar #'org-roam-node-read--to-candidate nodes)))
(defun org-roam-node-read--to-candidate (node)
"Return a minibuffer completion candidate given NODE."
(let ((candidate-main (org-roam-node-read--format-entry node (1- (frame-width)))))
(cons (propertize candidate-main 'node node) node)))
(defun org-roam-node-read--tags-to-str (tags)
"Convert list of TAGS into a string."
(mapconcat (lambda (s) (concat "#" s)) tags " "))
(defun org-roam-node-read--format-entry (node width)
"Formats NODE for display in the results list.
WIDTH is the width of the results list.
Uses `org-roam-node-display-template' to format the entry."
(let ((fmt (org-roam-node-read--process-display-format org-roam-node-display-template)))
(org-roam-format-template
(car fmt)
(lambda (field _default-val)
(let* ((field (split-string field ":"))
(field-name (car field))
(field-width (cadr field))
(getter (intern (concat "org-roam-node-" field-name)))
(field-value (or (funcall getter node) "")))
(when (and (equal field-name "tags")
field-value)
(setq field-value (org-roam-node-read--tags-to-str field-value)))
(when (and (equal field-name "file")
field-value)
(setq field-value (file-relative-name field-value org-roam-directory)))
(when (and (equal field-name "olp")
field-value)
(setq field-value (string-join field-value " > ")))
(if (not field-width)
field-value
(setq field-width (string-to-number field-width))
(truncate-string-to-width
field-value
(if (> field-width 0)
field-width
(- width (cdr fmt)))
0 ?\s)))))))
(defun org-roam-node-read--process-display-format (format)
"Pre-calculate minimal widths needed by the FORMAT string."
(or org-roam-node-read--cached-display-format
(setq org-roam-node-read--cached-display-format
(let* ((fields-width 0)
(string-width
(string-width
(org-roam-format-template
format
(lambda (field _default-val)
(setq fields-width
(+ fields-width
(string-to-number
(or (cadr (split-string field ":"))
"")))))))))
(cons format (+ fields-width string-width))))))
(defun org-roam-node-read-sort-by-file-mtime (completion-a completion-b)
"Sort files such that files modified more recently are shown first.
COMPLETION-A and COMPLETION-B are items in the form of (node-title org-roam-node-struct)"
(let ((node-a (cdr completion-a))
(node-b (cdr completion-b)))
(time-less-p (org-roam-node-file-mtime node-b)
(org-roam-node-file-mtime node-a))))
(defun org-roam-node-read-sort-by-file-atime (completion-a completion-b)
"Sort files such that files accessed more recently are shown first.
COMPLETION-A and COMPLETION-B are items in the form of (node-title org-roam-node-struct)"
(let ((node-a (cdr completion-a))
(node-b (cdr completion-b)))
(time-less-p (org-roam-node-file-atime node-b)
(org-roam-node-file-atime node-a))))
(defun org-roam-node-read--annotation (_node)
"Placeholder function. Return empty string for annotations."
"")
;;;; Linkage
;;;;; [id:] link
;;;###autoload
(cl-defun org-roam-node-insert (&optional filter-fn &key templates)
"Find an Org-roam node and insert (where the point is) an \"id:\" link to it.
FILTER-FN is a function to filter out nodes: it takes an `org-roam-node',
and when nil is returned the node will be filtered out.
The TEMPLATES, if provided, override the list of capture templates (see
`org-roam-capture-'.)"
(interactive)
(unwind-protect
;; Group functions together to avoid inconsistent state on quit
(atomic-change-group
(let* (region-text
beg end
(_ (when (region-active-p)
(setq beg (set-marker (make-marker) (region-beginning)))
(setq end (set-marker (make-marker) (region-end)))
(setq region-text (org-link-display-format (buffer-substring-no-properties beg end)))))
(node (org-roam-node-read region-text filter-fn))
(description (or region-text
(org-roam-node-title node))))
(if (org-roam-node-id node)
(progn
(when region-text
(delete-region beg end)
(set-marker beg nil)
(set-marker end nil))
(insert (org-link-make-string
(concat "id:" (org-roam-node-id node))
description)))
(org-roam-capture-
:node node
:templates templates
:props (append
(when (and beg end)
(list :region (cons beg end)))
(list :insert-at (point-marker)
:link-description description
:finalize 'insert-link))))))
(deactivate-mark)))
(add-hook 'org-roam-find-file-hook #'org-roam-open-id-with-org-roam-db-h)
(defun org-roam-open-id-with-org-roam-db-h ()
"Try to open \"id:\" links at point by querying them to the database."
(add-hook 'org-open-at-point-functions #'org-roam-open-id-at-point nil t))
(defun org-roam-open-id-at-point ()
"Try to navigate \"id:\" link to find and visit node with an assigned ID.
Assumes that the cursor was put where the link is."
(let* ((context (org-element-context))
(type (org-element-property :type context))
(id (org-element-property :path context)))
(when (string= type "id")
(let ((node (org-roam-populate (org-roam-node-create :id id))))
(cond
((org-roam-node-file node)
(org-mark-ring-push)
(org-roam-node-visit node)
t)
(t nil))))))
;;;;; [roam:] link
(org-link-set-parameters "roam" :follow #'org-roam-link-follow-link)
(defun org-roam-link-follow-link (title-or-alias)
"Navigate \"roam:\" link to find and open the node with TITLE-OR-ALIAS.
Assumes that the cursor was put where the link is."
(if-let ((node (org-roam-node-from-title-or-alias title-or-alias)))
(progn
(when org-roam-link-auto-replace
(org-roam-link-replace-at-point))
(org-id-goto (org-roam-node-id node)))
(org-roam-capture-
:node (org-roam-node-create :title title-or-alias)
:props '(:finalize find-file))))
(defun org-roam-link-replace-at-point (&optional link)
"Replace \"roam:\" LINK at point with an \"id:\" link."
(save-excursion
(save-match-data
(let* ((link (or link (org-element-context)))
(type (org-element-property :type link))
(path (org-element-property :path link))
node)
(goto-char (org-element-property :begin link))
(when (and (org-in-regexp org-link-any-re 1)
(string-equal type "roam")
(setq node (org-roam-node-from-title-or-alias path)))
(replace-match (org-link-make-string
(concat "id:" (org-roam-node-id node))
path)))))))
(defun org-roam-link-replace-all ()
"Replace all \"roam:\" links in buffer with \"id:\" links."
(interactive)
(org-with-point-at 1
(while (re-search-forward org-link-bracket-re nil t)
(org-roam-link-replace-at-point))))
(add-hook 'org-roam-find-file-hook #'org-roam--replace-roam-links-on-save-h)
(defun org-roam--replace-roam-links-on-save-h ()
"Run `org-roam-link-replace-all' before buffer is saved to its file."
(when org-roam-link-auto-replace
(add-hook 'before-save-hook #'org-roam-link-replace-all nil t)))
;;;;;; Completion-at-point interface
(defconst org-roam-bracket-completion-re
"\\[\\[\\(\\(?:roam:\\)?\\)\\([^z-a]*\\)]]"
"Regex for completion within link brackets.
We use this as a substitute for `org-link-bracket-re', because
`org-link-bracket-re' requires content within the brackets for a match.")
(defun org-roam-complete-link-at-point ()
"Complete \"roam:\" link at point to an existing Org-roam node."
(let (roam-p start end)
(when (org-in-regexp org-roam-bracket-completion-re 1)
(setq roam-p (not (string-blank-p (match-string 1)))
start (match-beginning 2)
end (match-end 2))
(list start end
(completion-table-dynamic
(lambda (_)
(funcall #'org-roam--get-titles)))
:exit-function
(lambda (str &rest _)
(delete-char (- 0 (length str)))
(insert (concat (unless roam-p "roam:")
str))
(forward-char 2))))))
(defun org-roam-complete-everywhere ()
"Complete symbol at point as a link completion to an Org-roam node.
This is a `completion-at-point' function, and is active when
`org-roam-completion-everywhere' is non-nil.
Unlike `org-roam-complete-link-at-point' this will complete even
outside of the bracket syntax for links (i.e. \"[[roam:|]]\"),
hence \"everywhere\"."
(when (and org-roam-completion-everywhere
(thing-at-point 'word)
(not (save-match-data (org-in-regexp org-link-any-re))))
(let ((bounds (bounds-of-thing-at-point 'word)))
(list (car bounds) (cdr bounds)
(completion-table-dynamic
(lambda (_)
(funcall #'org-roam--get-titles)))
:exit-function
(lambda (str _status)
(delete-char (- (length str)))
(insert "[[roam:" str "]]"))))))
(defun org-roam-complete-at-point ()
"Try get completion candidates at point using `org-roam-completion-functions'."
(run-hook-with-args-until-success 'org-roam-completion-functions))
(add-hook 'org-roam-find-file-hook #'org-roam--register-completion-functions-h)
(defun org-roam--register-completion-functions-h ()
"Setup `org-roam-completion-functions' for `completion-at-point'."
(add-hook 'completion-at-point-functions #'org-roam-complete-at-point nil t))
;;;; Editing
(defun org-roam-demote-entire-buffer ()
"Convert an org buffer with any top level content to a single node.
All headings are demoted one level.
The #+TITLE: keyword is converted into a level-1 heading and deleted.
Any tags declared on #+FILETAGS: are transferred to tags on the new top heading.
Any top level properties drawers are incorporated into the new heading."
(interactive)
(org-with-point-at 1
(org-map-entries 'org-do-demote)
(insert "* "
(org-roam--get-keyword "title")
"\n")
(org-back-to-heading)
(org-set-tags (org-roam--get-keyword "filetags"))
(org-roam-erase-keyword "title")
(org-roam-erase-keyword "filetags")))
(defun org-roam-promote-entire-buffer ()
"Promote the current buffer.
Converts a file containing a headline node at the top to a file
node."
(interactive)
(org-with-point-at 1
(org-map-entries (lambda ()
(when (> (org-outline-level) 1)
(org-do-promote))))
(let ((title (nth 4 (org-heading-components)))
(tags (nth 5 (org-heading-components))))
(beginning-of-line)
(kill-line 1)
(org-roam-set-keyword "title" title)
(when tags (org-roam-set-keyword "filetags" tags)))))
;;;###autoload
(defun org-roam-refile ()
"Refile node at point to an Org-roam node.
If region is active, then use it instead of the node at point."
(interactive)
(let* ((regionp (org-region-active-p))
(region-start (and regionp (region-beginning)))
(region-end (and regionp (region-end)))
(node (org-roam-node-read nil nil nil 'require-match))
(file (org-roam-node-file node))
(nbuf (or (find-buffer-visiting file)
(find-file-noselect file)))
level reversed)
(if regionp
(progn
(org-kill-new (buffer-substring region-start region-end))
(org-save-markers-in-region region-start region-end))
(progn
(if (org-before-first-heading-p)
(org-roam-demote-entire-buffer))
(org-copy-subtree 1 nil t)))
(with-current-buffer nbuf
(org-with-wide-buffer
(goto-char (org-roam-node-point node))
(setq level (org-get-valid-level (funcall outline-level) 1)
reversed (org-notes-order-reversed-p))
(goto-char
(if reversed
(or (outline-next-heading) (point-max))
(or (save-excursion (org-get-next-sibling))
(org-end-of-subtree t t)
(point-max))))
(unless (bolp) (newline))
(org-paste-subtree level nil nil t)
(and org-auto-align-tags
(let ((org-loop-over-headlines-in-active-region nil))
(org-align-tags)))
(when (fboundp 'deactivate-mark) (deactivate-mark))))
(if regionp
(delete-region (point) (+ (point) (- region-end region-start)))
(org-preserve-local-variables
(delete-region
(and (org-back-to-heading t) (point))
(min (1+ (buffer-size)) (org-end-of-subtree t t) (point)))))
;; If the buffer end-up empty after the refile, kill it and delete its
;; associated file.
(when (eq (buffer-size) 0)
(if (buffer-file-name)
(delete-file (buffer-file-name)))
(set-buffer-modified-p nil)
;; In this was done during capture, abort the capture process.
(when (and org-capture-mode
(buffer-base-buffer (current-buffer)))
(org-capture-kill))
(kill-buffer (current-buffer)))))
;;;###autoload
(defun org-roam-extract-subtree ()
"Convert current subtree at point to a node, and extract it into a new file."
(interactive)
(save-excursion
(org-back-to-heading-or-point-min)
(when (bobp) (user-error "Already a top-level node"))
(org-id-get-create)
(save-buffer)
(org-roam-db-update-file)
(let* ((template-info nil)
(node (org-roam-node-at-point))
(template (org-roam-format-template
(string-trim (org-capture-fill-template org-roam-extract-new-file-path))
(lambda (key default-val)
(let ((fn (intern key))
(node-fn (intern (concat "org-roam-node-" key)))
(ksym (intern (concat ":" key))))
(cond
((fboundp fn)
(funcall fn node))
((fboundp node-fn)
(funcall node-fn node))
(t (let ((r (completing-read (format "%s: " key) nil nil nil default-val)))
(plist-put template-info ksym r)
r)))))))
(file-path (read-file-name "Extract node to: " org-roam-directory template nil template)))
(when (file-exists-p file-path)
(user-error "%s exists. Aborting" file-path))
(org-cut-subtree)
(save-buffer)
(with-current-buffer (find-file-noselect file-path)
(org-paste-subtree)
(org-roam-promote-entire-buffer)
(save-buffer)))))
;;; IDs
;;;; Getters
(defun org-roam-id-at-point ()
"Return the ID at point, if any.
Recursively traverses up the headline tree to find the
first encapsulating ID."
(org-with-wide-buffer
(org-back-to-heading-or-point-min)
(while (and (not (org-roam-db-node-p))
(not (bobp)))
(org-roam-up-heading-or-point-min))
(when (org-roam-db-node-p)
(org-id-get))))
;;; Refs
;;;; Completing-read interface
(defun org-roam-ref-read (&optional initial-input filter-fn)
"Read an Org-roam ref and return a corresponding `org-roam-node'.
INITIAL-INPUT is the initial prompt value.
FILTER-FN is a function to filter out nodes: it takes an `org-roam-node',
and when nil is returned the node will be filtered out.
filtered out."
(let* ((refs (org-roam-ref-read--completions))
(refs (cl-remove-if-not (lambda (n)
(if filter-fn (funcall filter-fn (cdr n)) t)) refs))
(ref (completing-read "Ref: "
(lambda (string pred action)
(if (eq action 'metadata)
'(metadata
(annotation-function . (lambda (ref)
(funcall org-roam-ref-annotation-function
ref)))
(category . org-roam-ref))
(complete-with-action action refs string pred)))
nil t initial-input)))
(cdr (assoc ref refs))))
(defun org-roam-ref-read--completions ()
"Return an alist for ref completion.
The car is the ref, and the cdr is the corresponding node for the ref."
(let ((rows (org-roam-db-query
[:select [id ref type nodes:file pos title]
:from refs
:left-join nodes
:on (= refs:node-id nodes:id)])))
(cl-loop for row in rows
collect (pcase-let* ((`(,id ,ref ,type ,file ,pos ,title) row)
(node (org-roam-node-create :id id
:file file
:point pos
:title title)))
(cons (propertize ref 'node node 'type type)
node)))))
(defun org-roam-ref-read--annotation (ref)
"Return the annotation for REF, which assumed to be a propertized string."
(let* ((node (get-text-property 0 'node ref))
(title (org-roam-node-title node)))
(when title
(concat " " title))))
;;;; Finders
;;;###autoload
(defun org-roam-ref-find (&optional initial-input filter-fn)
"Find and open an Org-roam node that's dedicated to a specific ref.
INITIAL-INPUT is the initial input to the prompt.
FILTER-FN is a function to filter out nodes: it takes an `org-roam-node',
and when nil is returned the node will be filtered out."
(interactive)
(let* ((node (org-roam-ref-read initial-input filter-fn)))
;; REVIEW This can be refactored with `org-roam-node-visit'
(find-file (org-roam-node-file node))
(goto-char (org-roam-node-point node))))
;;;; Editing
(defun org-roam-ref-add (ref)
"Add REF to the node at point."
(interactive "sRef: ")
(let ((node (org-roam-node-at-point 'assert)))
(save-excursion
(goto-char (org-roam-node-point node))
(org-roam-add-property ref "ROAM_REFS"))))
(defun org-roam-ref-remove (&optional ref)
"Remove a REF from the node at point."
(interactive)
(let ((node (org-roam-node-at-point 'assert)))
(save-excursion
(goto-char (org-roam-node-point node))
(org-roam-remove-property "ROAM_REFS" ref))))
;;; Tags
;;;; Getters
(defun org-roam-tag-completions ()
"Return list of tags for completions within Org-roam."
(let ((roam-tags (mapcar #'car (org-roam-db-query [:select :distinct [tag] :from tags])))
(org-tags (cl-loop for tagg in org-tag-alist
nconc (pcase tagg
('(:newline)
nil)
(`(,tag . ,_)
(list tag))
(_ nil)))))
(seq-uniq (append roam-tags org-tags))))
;;;; Editing
(defun org-roam-tag-add (tags)
"Add TAGS to the node at point."
(interactive
(list (completing-read-multiple "Tag: " (org-roam-tag-completions))))
(let ((node (org-roam-node-at-point 'assert)))
(save-excursion
(goto-char (org-roam-node-point node))
(if (= (org-outline-level) 0)
(let ((current-tags (split-string (or (cadr (assoc "FILETAGS"
(org-collect-keywords '("filetags"))))
"")
":" 'omit-nulls)))
(org-roam-set-keyword "filetags" (org-make-tag-string (seq-uniq (append tags current-tags)))))
(org-set-tags (seq-uniq (append tags (org-get-tags)))))
tags)))
(defun org-roam-tag-remove (&optional tags)
"Remove TAGS from the node at point."
(interactive)
(let ((node (org-roam-node-at-point 'assert)))
(save-excursion
(goto-char (org-roam-node-point node))
(if (= (org-outline-level) 0)
(let* ((current-tags (split-string (or (cadr (assoc "FILETAGS"
(org-collect-keywords '("filetags"))))
(user-error "No tag to remove"))
":" 'omit-nulls))
(tags (or tags (completing-read-multiple "Tag: " current-tags))))
(org-roam-set-keyword "filetags"
(org-make-tag-string (seq-difference current-tags tags #'string-equal))))
(let* ((current-tags (or (org-get-tags)
(user-error "No tag to remove")))
(tags (completing-read-multiple "Tag: " current-tags)))
(org-set-tags (seq-difference current-tags tags #'string-equal))))
tags)))
;;; Titles and Aliases
;;;; Getters
(defun org-roam--get-titles ()
"Return all distinct titles and aliases in the Org-roam database."
(mapcar #'car (org-roam-db-query [:select :distinct title :from nodes
:union :select alias :from aliases])))
;;;; Editing
(defun org-roam-alias-add (alias)
"Add ALIAS to the node at point."
(interactive "sAlias: ")
(let ((node (org-roam-node-at-point 'assert)))
(save-excursion
(goto-char (org-roam-node-point node))
(org-roam-add-property alias "ROAM_ALIASES"))))
(defun org-roam-alias-remove (&optional alias)
"Remove an ALIAS from the node at point."
(interactive)
(let ((node (org-roam-node-at-point 'assert)))
(save-excursion
(goto-char (org-roam-node-point node))
(org-roam-remove-property "ROAM_ALIASES" alias))))
(provide 'org-roam-node)
;;; org-roam-node.el ends here

107
org-roam-protocol.el
View File

@ -1,107 +0,0 @@
;;; 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>
;; URL: https://github.com/org-roam/org-roam
;; Keywords: org-mode, roam, convenience
;; Version: 2.0.0
;; Package-Requires: ((emacs "26.1") (dash "2.13") (f "0.17.2") (org "9.4") (emacsql "3.0.0") (emacsql-sqlite "1.0.0") (magit-section "2.90.1"))
;; 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:
;;
;; We extend org-protocol, adding custom Org-roam handlers. The setup
;; instructions for `org-protocol' can be found in org-protocol.el.
;;
;; We define 2 protocols:
;;
;; 1. "roam-node": This protocol simply opens the node given by the node ID
;; 2. "roam-ref": This protocol creates or opens a note with the given REF
;;
;;; Code:
(require 'org-protocol)
(require 'org-roam)
(eval-when-compile
(require 'org-roam-macs))
(require 'ol) ;; for org-link-decode
(defcustom org-roam-protocol-store-links nil
"Whether to store links when capturing websites with `org-roam-protocol'."
:type 'boolean
:group 'org-roam)
;;;; Functions
(defun org-roam-protocol-open-ref (info)
"Process an org-protocol://roam-ref?ref= style url with INFO.
It opens or creates a note with the given ref.
javascript:location.href = \\='org-protocol://roam-ref?template=r&ref=\\='+ \\
encodeURIComponent(location.href) + \\='&title=\\=' + \\
encodeURIComponent(document.title) + \\='&body=\\=' + \\
encodeURIComponent(window.getSelection())"
(unless (plist-get info :ref)
(user-error "No ref key provided"))
(org-roam-plist-map! (lambda (k v)
(org-link-decode
(if (equal k :ref)
(org-protocol-sanitize-uri v)
v))) info)
(when org-roam-protocol-store-links
(push (list (plist-get info :ref)
(plist-get info :title)) org-stored-links))
(org-link-store-props :type (and (string-match org-link-plain-re
(plist-get info :ref))
(match-string 1 (plist-get info :ref)))
:link (plist-get info :ref)
:annotation (org-link-make-string (plist-get info :ref)
(or (plist-get info :title)
(plist-get info :ref)))
:initial (or (plist-get info :body) ""))
(raise-frame)
(org-roam-capture-
:keys (plist-get info :template)
:node (org-roam-node-create :title (plist-get info :title))
:info (list :ref (plist-get info :ref)
:body (plist-get info :body))
:templates org-roam-capture-ref-templates)
nil)
(defun org-roam-protocol-open-node (info)
"This handler simply opens the file with emacsclient.
INFO is an alist containing additional information passed by the protocol URL.
It should contain the FILE key, pointing to the path of the file to open.
Example protocol string:
org-protocol://roam-node?node=uuid"
(when-let ((node (plist-get info :node)))
(raise-frame)
(org-roam-node-visit (org-roam-populate (org-roam-node-create :id node))))
nil)
(push '("org-roam-ref" :protocol "roam-ref" :function org-roam-protocol-open-ref)
org-protocol-protocol-alist)
(push '("org-roam-node" :protocol "roam-node" :function org-roam-protocol-open-node)
org-protocol-protocol-alist)
(provide 'org-roam-protocol)
;;; org-roam-protocol.el ends here

390
org-roam-utils.el
View File

@ -1,12 +1,12 @@
;;; org-roam-utils.el --- Utilities for Org-roam -*- coding: utf-8; lexical-binding: t; -*-
;;; org-roam-utils.el --- Utilities for Org-roam -*- lexical-binding: t; -*-
;; Copyright © 2020 Jethro Kuan <jethrokuan95@gmail.com>
;; Copyright © 2020-2021 Jethro Kuan <jethrokuan95@gmail.com>
;; Author: Jethro Kuan <jethrokuan95@gmail.com>
;; URL: https://github.com/org-roam/org-roam
;; Keywords: org-mode, roam, convenience
;; Version: 2.0.0
;; Package-Requires: ((emacs "26.1") (dash "2.13") (f "0.17.2") (org "9.4") (emacsql "3.0.0") (emacsql-sqlite "1.0.0") (magit-section "2.90.1"))
;; Package-Requires: ((emacs "26.1") (dash "2.13") (org "9.4"))
;; This file is NOT part of GNU Emacs.
@ -27,41 +27,14 @@
;;; Commentary:
;;
;; This library implements utility functions used throughout
;; Org-roam.
;;
;; This library provides definitions for utilities that used throughout the
;; whole package.
;;
;;; Code:
;;;; Library Requires
(require 'dash)
(eval-when-compile
(require 'org-roam-macs)
(require 'org-macs))
(defvar org-roam-verbose)
;; This is necessary to ensure all dependents on this module see
;; `org-mode-hook' and `org-inhibit-startup' as dynamic variables,
;; regardless of whether Org is loaded before their compilation.
(require 'org)
;;;; String Utilities
(defun org-roam-truncate (len s &optional ellipsis)
"If S is longer than LEN, cut it down and add ELLIPSIS to the end.
The resulting string, including ellipsis, will be LEN characters
long.
When not specified, ELLIPSIS defaults to ‘...’."
(declare (pure t) (side-effect-free t))
(unless ellipsis
(setq ellipsis "..."))
(if (> (length s) len)
(format "%s%s" (substring s 0 (- len (length ellipsis))) ellipsis)
s))
(defun org-roam-replace (old new s)
;;; String utilities
;; TODO Refactor this.
(defun org-roam-replace-string (old new s)
"Replace OLD with NEW in S."
(declare (pure t) (side-effect-free t))
(replace-regexp-in-string (regexp-quote old) new s t t))
@ -69,122 +42,69 @@ When not specified, ELLIPSIS defaults to ‘...’."
(defun org-roam-quote-string (s)
"Quotes string S."
(->> s
(org-roam-replace "\\" "\\\\")
(org-roam-replace "\"" "\\\"")))
(org-roam-replace-string "\\" "\\\\")
(org-roam-replace-string "\"" "\\\"")))
;;;; Utility Functions
(defun org-roam--list-interleave (lst separator)
"Interleaves elements in LST with SEPARATOR."
(when lst
(let ((new-lst (list (pop lst))))
(dolist (it lst)
(nconc new-lst (list separator it)))
new-lst)))
;;; List utilities
(defmacro org-roam-plist-map! (fn plist)
"Map FN over PLIST, modifying it in-place."
(declare (indent 1))
(let ((plist-var (make-symbol "plist"))
(k (make-symbol "k"))
(v (make-symbol "v")))
`(let ((,plist-var (copy-sequence ,plist)))
(while ,plist-var
(setq ,k (pop ,plist-var))
(setq ,v (pop ,plist-var))
(setq ,plist (plist-put ,plist ,k (funcall ,fn ,k ,v)))))))
(defun org-roam-up-heading-or-point-min ()
"Fixed version of Org's `org-up-heading-or-point-min'."
(ignore-errors (org-back-to-heading t))
(let ((p (point)))
(if (< 1 (funcall outline-level))
(progn
(org-up-heading-safe)
(when (= (point) p)
(goto-char (point-min))))
(unless (bobp) (goto-char (point-min))))))
;;; File utilities
(defmacro org-roam-with-file (file keep-buf-p &rest body)
"Execute BODY within FILE.
If FILE is nil, execute BODY in the current buffer.
Kills the buffer if KEEP-BUF-P is nil, and FILE is not yet visited."
(declare (indent 2) (debug t))
`(let* (new-buf
(auto-mode-alist nil)
(buf (or (and (not ,file)
(current-buffer)) ;If FILE is nil, use current buffer
(find-buffer-visiting ,file) ; If FILE is already visited, find buffer
(progn
(setq new-buf t)
(find-file-noselect ,file)))) ; Else, visit FILE and return buffer
res)
(with-current-buffer buf
(unless (equal major-mode 'org-mode)
(delay-mode-hooks
(let ((org-inhibit-startup t)
(org-agenda-files nil))
(org-mode))))
(setq res (progn ,@body))
(unless (and new-buf (not ,keep-buf-p))
(save-buffer)))
(if (and new-buf (not ,keep-buf-p))
(when (find-buffer-visiting ,file)
(kill-buffer (find-buffer-visiting ,file))))
res))
(defun org-roam-message (format-string &rest args)
"Pass FORMAT-STRING and ARGS to `message' when `org-roam-verbose' is t."
(when org-roam-verbose
(apply #'message `(,(concat "(org-roam) " format-string) ,@args))))
(defvar org-ref-buffer-hacked)
(defun org-roam-fontify-like-in-org-mode (s)
"Fontify string S like in Org mode.
Like `org-fontify-like-in-org-mode', but supports `org-ref'."
;; NOTE: pretend that the temporary buffer created by `org-fontify-like-in-org-mode' to
;; fontify a `cite:' reference has been hacked by org-ref, whatever that means;
;;
;; `org-ref-cite-link-face-fn', which is used to supply a face for `cite:' links, calls
;; `hack-dir-local-variables' rationalizing that `bibtex-completion' would throw some warnings
;; otherwise. This doesn't seem to be the case and calling this function just before
;; `org-font-lock-ensure' (alias of `font-lock-ensure') actually instead of fixing the alleged
;; warnings messes the things so badly that `font-lock-ensure' crashes with error and doesn't let
;; org-roam to proceed further. I don't know what's happening there exactly but disabling this hackery
;; fixes the crashing. Fortunately, org-ref provides the `org-ref-buffer-hacked' switch, which we use
;; here to make it believe that the buffer was hacked.
;;
;; This is a workaround for `cite:' links and does not have any effect on other ref types.
;;
;; `org-ref-buffer-hacked' is a buffer-local variable, therefore we inline
;; `org-fontify-like-in-org-mode' here
(with-temp-buffer
(insert s)
(let ((org-ref-buffer-hacked t))
(org-mode)
(org-font-lock-ensure)
(buffer-string))))
(defun org-roam-set-header-line-format (string)
"Set the header-line using STRING.
If the `face' property of any part of STRING is already set, then
that takes precedence. Also pad the left side of STRING so that
it aligns with the text area."
(setq-local header-line-format
(concat (propertize " " 'display '(space :align-to 0))
string)))
;;; Keywords
(defun org-roam--get-keyword (name &optional bound)
"Return keyword property NAME in current buffer.
If BOUND, scan up to BOUND bytes of the buffer."
(save-excursion
(let ((re (format "^#\\+%s:[ \t]*\\([^\n]+\\)" (upcase name))))
(goto-char (point-min))
(when (re-search-forward re bound t)
(buffer-substring-no-properties (match-beginning 1) (match-end 1))))))
(defun org-roam-get-keyword (name &optional file bound)
"Return keyword property NAME from an org FILE.
FILE defaults to current file.
Only scans up to BOUND bytes of the document."
(unless bound
(setq bound 1024))
(if file
(with-temp-buffer
(insert-file-contents file nil 0 bound)
(org-roam--get-keyword name))
(org-roam--get-keyword name bound)))
;;; Shielding regions
(defface org-roam-shielded
'((t :inherit (warning)))
"Face for regions that are shielded (marked as read-only).
This face is used on the region target by org-roam-insertion
during an `org-roam-capture'."
:group 'org-roam-faces)
(defun org-roam-shield-region (beg end)
"Shield region against modifications.
BEG and END are markers for the beginning and end regions.
REGION must be a cons-cell containing the marker to the region
beginning and maximum values."
(add-text-properties beg end
'(font-lock-face org-roam-shielded
read-only t)
(marker-buffer beg)))
(defun org-roam-unshield-region (beg end)
"Unshield the shielded REGION.
BEG and END are markers for the beginning and end regions."
(let ((inhibit-read-only t))
(remove-text-properties beg end
'(font-lock-face org-roam-shielded
read-only t)
(marker-buffer beg))))
;;; Buffer utilities
(defmacro org-roam-with-temp-buffer (file &rest body)
"Execute BODY within a temp buffer.
Like `with-temp-buffer', but propagates `org-roam-directory'.
If FILE, set `default-directory' to FILE's directory and insert its contents."
(declare (indent 1) (debug t))
(let ((current-org-roam-directory (make-symbol "current-org-roam-directory")))
`(let ((,current-org-roam-directory org-roam-directory))
(with-temp-buffer
(let ((org-roam-directory ,current-org-roam-directory))
(delay-mode-hooks (org-mode))
(when ,file
(insert-file-contents ,file)
(setq-local default-directory (file-name-directory ,file)))
,@body)))))
;;; Formatting
(defun org-roam-format (template replacer)
(defun org-roam-format-template (template replacer)
"Format TEMPLATE with the function REPLACER.
The templates are of form ${foo} for variable foo, and
${foo=default} for variable foo with default value \"default\".
@ -211,35 +131,116 @@ value (possibly nil). Adapted from `s-format'."
t t)
(set-match-data saved-match-data))))
(defvar org-roam--cached-display-format nil)
;;; Fontification
(defun org-roam-fontify-like-in-org-mode (s)
"Fontify string S like in Org mode.
Like `org-fontify-like-in-org-mode', but supports `org-ref'."
;; NOTE: pretend that the temporary buffer created by `org-fontify-like-in-org-mode' to
;; fontify a `cite:' reference has been hacked by org-ref, whatever that means;
;;
;; `org-ref-cite-link-face-fn', which is used to supply a face for `cite:' links, calls
;; `hack-dir-local-variables' rationalizing that `bibtex-completion' would throw some warnings
;; otherwise. This doesn't seem to be the case and calling this function just before
;; `org-font-lock-ensure' (alias of `font-lock-ensure') actually instead of fixing the alleged
;; warnings messes the things so badly that `font-lock-ensure' crashes with error and doesn't let
;; org-roam to proceed further. I don't know what's happening there exactly but disabling this hackery
;; fixes the crashing. Fortunately, org-ref provides the `org-ref-buffer-hacked' switch, which we use
;; here to make it believe that the buffer was hacked.
;;
;; This is a workaround for `cite:' links and does not have any effect on other ref types.
;;
;; `org-ref-buffer-hacked' is a buffer-local variable, therefore we inline
;; `org-fontify-like-in-org-mode' here
(with-temp-buffer
(insert s)
(let ((org-ref-buffer-hacked t))
(org-mode)
(org-font-lock-ensure)
(buffer-string))))
(defun org-roam--process-display-format (format)
"Pre-calculate minimal widths needed by the FORMAT string."
(or org-roam--cached-display-format
(setq org-roam--cached-display-format
(let* ((fields-width 0)
(string-width
(string-width
(org-roam-format
format
(lambda (field _default_val)
(setq fields-width
(+ fields-width
(string-to-number
(or (cadr (split-string field ":"))
"")))))))))
(cons format (+ fields-width string-width))))))
;;;; Shielding regions
(defface org-roam-shielded
'((t :inherit (warning)))
"Face for regions that are shielded (marked as read-only).
This face is used on the region target by org-roam-insertion
during an `org-roam-capture'."
:group 'org-roam-faces)
;;; for org-roam-demote-entire-buffer in org-roam-refile.el
(defun org-roam--file-keyword-get (keyword)
"Pull a KEYWORD setting from the top of the file.
(defun org-roam-shield-region (beg end)
"Shield region against modifications.
BEG and END are markers for the beginning and end regions.
REGION must be a cons-cell containing the marker to the region
beginning and maximum values."
(add-text-properties beg end
'(font-lock-face org-roam-shielded
read-only t)
(marker-buffer beg)))
Keyword must be specified in ALL CAPS."
(cadr (assoc keyword
(org-collect-keywords (list keyword)))))
(defun org-roam-unshield-region (beg end)
"Unshield the shielded REGION.
BEG and END are markers for the beginning and end regions."
(let ((inhibit-read-only t))
(remove-text-properties beg end
'(font-lock-face org-roam-shielded
read-only t)
(marker-buffer beg))))
(defun org-roam--file-keyword-kill (keyword)
"Erase KEYWORD setting line from the top of the file."
;;; Org-mode utilities
;;;; Motions
(defun org-roam-up-heading-or-point-min ()
"Fixed version of Org's `org-up-heading-or-point-min'."
(ignore-errors (org-back-to-heading t))
(let ((p (point)))
(if (< 1 (funcall outline-level))
(progn
(org-up-heading-safe)
(when (= (point) p)
(goto-char (point-min))))
(unless (bobp) (goto-char (point-min))))))
;;;; Keywords
(defun org-roam-get-keyword (name &optional file bound)
"Return keyword property NAME from an org FILE.
FILE defaults to current file.
Only scans up to BOUND bytes of the document."
(unless bound
(setq bound 1024))
(if file
(with-temp-buffer
(insert-file-contents file nil 0 bound)
(org-roam--get-keyword name))
(org-roam--get-keyword name bound)))
(defun org-roam--get-keyword (name &optional bound)
"Return keyword property NAME in current buffer.
If BOUND, scan up to BOUND bytes of the buffer."
(save-excursion
(let ((re (format "^#\\+%s:[ \t]*\\([^\n]+\\)" (upcase name))))
(goto-char (point-min))
(when (re-search-forward re bound t)
(buffer-substring-no-properties (match-beginning 1) (match-end 1))))))
(defun org-roam-set-keyword (key value)
"Set keyword KEY to VALUE.
If the property is already set, it's value is replaced."
(org-with-point-at 1
(let ((case-fold-search t))
(if (re-search-forward (concat "^#\\+" key ":\\(.*\\)") (point-max) t)
(if (string-blank-p value)
(kill-whole-line)
(replace-match (concat " " value) 'fixedcase nil nil 1))
(while (and (not (eobp))
(looking-at "^[#:]"))
(if (save-excursion (end-of-line) (eobp))
(progn
(end-of-line)
(insert "\n"))
(forward-line)
(beginning-of-line)))
(insert "#+" key ": " value "\n")))))
(defun org-roam-erase-keyword (keyword)
"Erase the line where the KEYWORD is, setting line from the top of the file."
(let ((case-fold-search t))
(org-with-point-at 1
(when (re-search-forward (concat "^#\\+" keyword ":") nil t)
@ -247,23 +248,41 @@ Keyword must be specified in ALL CAPS."
(delete-region (point) (line-end-position))
(delete-char 1)))))
(defun org-roam--kill-empty-buffer ()
"If the source buffer has been emptied, kill it.
;;;; Properties
(defun org-roam-add-property (val prop)
"Add VAL value to PROP property for the node at point.
Both, VAL and PROP are strings."
(let* ((p (org-entry-get (point) prop))
(lst (when p (split-string-and-unquote p)))
(lst (if (memq val lst) lst (cons val lst)))
(lst (seq-uniq lst)))
(org-set-property prop (combine-and-quote-strings lst))
val))
If the buffer is associated with a file, delete the file.
(defun org-roam-remove-property (prop &optional val)
"Remove VAL value from PROP property for the node at point.
Both VAL and PROP are strings.
If the buffer is associated with an in-process capture operation, abort the operation."
(when (eq (buffer-size) 0)
(if (buffer-file-name)
(delete-file (buffer-file-name)))
(set-buffer-modified-p nil)
(when (and org-capture-mode
(buffer-base-buffer (current-buffer)))
(org-capture-kill))
(kill-buffer (current-buffer))))
If VAL is not specified, user is prompted to select a value."
(let* ((p (org-entry-get (point) prop))
(lst (when p (split-string-and-unquote p)))
(prop-to-remove (or val (completing-read "Remove: " lst)))
(lst (delete prop-to-remove lst)))
(if lst
(org-set-property prop (combine-and-quote-strings lst))
(org-delete-property prop))
prop-to-remove))
;;; Logs
(defvar org-roam-verbose)
(defun org-roam-message (format-string &rest args)
"Pass FORMAT-STRING and ARGS to `message' when `org-roam-verbose' is t."
(when org-roam-verbose
(apply #'message `(,(concat "(org-roam) " format-string) ,@args))))
;;; Diagnostics
;;;###autoload (autoload 'org-roam-version "org-roam" nil t)
;; TODO Update this to also get commit hash
;;;###autoload
(defun org-roam-version (&optional message)
"Return `org-roam' version.
Interactively, or when MESSAGE is non-nil, show in the echo area."
@ -280,7 +299,7 @@ Interactively, or when MESSAGE is non-nil, show in the echo area."
(message "%s" version)
version)))
;;;###autoload (autoload 'org-roam-diagnostics "org-roam" nil t)
;;;###autoload
(defun org-roam-diagnostics ()
"Collect and print info for `org-roam' issues."
(interactive)
@ -296,5 +315,6 @@ Interactively, or when MESSAGE is non-nil, show in the echo area."
(insert (format "- Org: %s\n" (org-version nil 'full)))
(insert (format "- Org-roam: %s" (org-roam-version)))))
(provide 'org-roam-utils)
;;; org-roam-utils.el ends here

1423
org-roam.el
View File

File diff suppressed because it is too large Load Diff

0
tests/roam-files/markdown.md Normal file
View File

7
tests/roam-files/roam-exclude.org Normal file
View File

@ -0,0 +1,7 @@
:PROPERTIES:
:ID: 53fadc75-f48e-461e-be06-44a1e88b2abe
:ROAM_EXCLUDE: t
:END:
#+TITLE: Excluded by Org-roam
This node is excluded by declaring ~ROAM_EXCLUDE: t~.

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

@ -24,11 +24,34 @@
(require 'buttercup)
(require 'org-roam)
(describe "org-roam-list-files"
(before-each
(setq org-roam-directory (expand-file-name "tests/roam-files")
org-roam-db-location (expand-file-name "org-roam.db" temporary-file-directory)
org-roam-file-extensions '("org")
org-roam-file-exclude-regexp nil))
(it "gets files correctly"
(expect (length (org-roam-list-files))
:to-equal 3))
(it "respects org-roam-file-extensions"
(setq org-roam-file-extensions '("md"))
(expect (length (org-roam-list-files)) :to-equal 1)
(setq org-roam-file-extensions '("org" "md"))
(expect (length (org-roam-list-files)) :to-equal 4))
(it "respects org-roam-file-exclude-regexp"
(setq org-roam-file-exclude-regexp (regexp-quote "foo.org"))
(expect (length (org-roam-list-files)) :to-equal 2)))
(describe "org-roam-db-sync"
(before-all
(setq org-roam-directory (expand-file-name "tests/roam-files")
org-roam-db-location (expand-file-name "org-roam.db" temporary-file-directory))
(org-roam-setup))
org-roam-db-location (expand-file-name "org-roam.db" temporary-file-directory)
org-roam-file-extensions '("org")
org-roam-file-exclude-regexp nil)
(org-roam-db-sync))
(after-all
(org-roam-teardown)
@ -37,7 +60,7 @@
(it "has the correct number of files"
(expect (caar (org-roam-db-query [:select (funcall count) :from files]))
:to-equal
2))
3))
(it "has the correct number of nodes"
(expect (caar (org-roam-db-query [:select (funcall count) :from nodes]))
@ -47,7 +70,13 @@
(it "has the correct number of links"
(expect (caar (org-roam-db-query [:select (funcall count) :from links]))
:to-equal
1)))
1))
(it "respects ROAM_EXCLUDE"
;; The excluded node has ID "53fadc75-f48e-461e-be06-44a1e88b2abe"
(expect (mapcar #'car (org-roam-db-query [:select id :from nodes]))
:to-have-same-items-as
'("884b2341-b7fe-434d-848c-5282c0727861" "440795d0-70c1-4165-993d-aebd5eef7a24"))))
(provide 'test-org-roam)