diff --git a/default.mk b/default.mk index 3bab1cc..3afa60a 100644 --- a/default.mk +++ b/default.mk @@ -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 diff --git a/doc/org-roam.org b/doc/org-roam.org index 6cbc56e..7f2e602 100644 --- a/doc/org-roam.org +++ b/doc/org-roam.org @@ -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~ -~~: ~magit-section-toggle~ -- ~~: ~org-roam-visit-thing~ +- ~~: ~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. diff --git a/doc/org-roam.texi b/doc/org-roam.texi index aece6fb..4a2cd5f 100644 --- a/doc/org-roam.texi +++ b/doc/org-roam.texi @@ -798,10 +798,10 @@ keybindings available. Here are several of the more useful ones: -@code{}: @code{magit-section-toggle} @itemize @item -@code{}: @code{org-roam-visit-thing} +@code{}: @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. diff --git a/org-roam-dailies.el b/extensions/org-roam-dailies.el similarity index 90% rename from org-roam-dailies.el rename to extensions/org-roam-dailies.el index fd53629..082d0f8 100644 --- a/org-roam-dailies.el +++ b/extensions/org-roam-dailies.el @@ -1,6 +1,6 @@ ;;; org-roam-dailies.el --- Daily-notes for Org-roam -*- coding: utf-8; lexical-binding: t; -*- ;;; -;; Copyright © 2020 Jethro Kuan +;; Copyright © 2020-2021 Jethro Kuan ;; Copyright © 2020 Leo Vivier ;; Author: Jethro Kuan @@ -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'.") diff --git a/org-roam-graph.el b/extensions/org-roam-graph.el similarity index 92% rename from org-roam-graph.el rename to extensions/org-roam-graph.el index 9a63be8..2d7c454 100644 --- a/org-roam-graph.el +++ b/extensions/org-roam-graph.el @@ -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 @@ -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) diff --git a/org-roam-overlay.el b/extensions/org-roam-overlay.el similarity index 87% rename from org-roam-overlay.el rename to extensions/org-roam-overlay.el index f7dc9d8..614255c 100644 --- a/org-roam-overlay.el +++ b/extensions/org-roam-overlay.el @@ -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 @@ -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)) diff --git a/extensions/org-roam-protocol.el b/extensions/org-roam-protocol.el new file mode 100644 index 0000000..200d55c --- /dev/null +++ b/extensions/org-roam-protocol.el @@ -0,0 +1,192 @@ +;;; org-roam-protocol.el --- Protocol handler for roam:// links -*- coding: utf-8; lexical-binding: t; -*- + +;; Copyright © 2020-2021 Jethro Kuan +;; Author: Jethro Kuan +;; 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 diff --git a/org-roam-capture.el b/org-roam-capture.el index d4f1304..a9e68e9 100644 --- a/org-roam-capture.el +++ b/org-roam-capture.el @@ -1,6 +1,6 @@ ;;; org-roam-capture.el --- Capture functionality -*- coding: utf-8; lexical-binding: t; -*- -;; Copyright © 2020 Jethro Kuan +;; Copyright © 2020-2021 Jethro Kuan ;; Author: Jethro Kuan ;; 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) diff --git a/org-roam-compat.el b/org-roam-compat.el index a6c4810..bda8032 100644 --- a/org-roam-compat.el +++ b/org-roam-compat.el @@ -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 +;; Copyright © 2020-2021 Jethro Kuan ;; Author: Jethro Kuan ;; 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 diff --git a/org-roam-completion.el b/org-roam-completion.el deleted file mode 100644 index 0201152..0000000 --- a/org-roam-completion.el +++ /dev/null @@ -1,107 +0,0 @@ -;;; org-roam-completion.el --- Completion features -*- coding: utf-8; lexical-binding: t; -*- - -;; Copyright © 2020 Jethro Kuan - -;; Author: Jethro Kuan -;; 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 diff --git a/org-roam-db.el b/org-roam-db.el index 0887232..305b0d9 100644 --- a/org-roam-db.el +++ b/org-roam-db.el @@ -1,6 +1,6 @@ ;;; org-roam-db.el --- Org-roam database API -*- coding: utf-8; lexical-binding: t; -*- -;; Copyright © 2020 Jethro Kuan +;; Copyright © 2020-2021 Jethro Kuan ;; Author: Jethro Kuan ;; 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." diff --git a/org-roam-macs.el b/org-roam-macs.el deleted file mode 100644 index 22ffea4..0000000 --- a/org-roam-macs.el +++ /dev/null @@ -1,90 +0,0 @@ -;;; org-roam-macs.el --- Macros/utility functions -*- coding: utf-8; lexical-binding: t; -*- - -;; Copyright © 2020 Jethro Kuan - -;; Author: Jethro Kuan -;; 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 diff --git a/org-roam-migrate.el b/org-roam-migrate.el index a3ae196..ccdf5f0 100644 --- a/org-roam-migrate.el +++ b/org-roam-migrate.el @@ -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))))) diff --git a/org-roam-mode.el b/org-roam-mode.el index 767c29c..d30ef24 100644 --- a/org-roam-mode.el +++ b/org-roam-mode.el @@ -1,5 +1,6 @@ -;;; org-roam-mode.el --- create and refresh Org-roam buffers -*- lexical-binding: t -*- -;; Copyright © 2020 Jethro Kuan +;;; org-roam-mode.el --- Major mode for special Org-roam buffers -*- lexical-binding: t -*- + +;; Copyright © 2020-2021 Jethro Kuan ;; Author: Jethro Kuan ;; 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)) ":" diff --git a/org-roam-node.el b/org-roam-node.el new file mode 100644 index 0000000..a1448b5 --- /dev/null +++ b/org-roam-node.el @@ -0,0 +1,985 @@ +;;; org-roam-node.el --- Interfacing and interacting with nodes -*- lexical-binding: t; -*- + +;; Copyright © 2020-2021 Jethro Kuan + +;; Author: Jethro Kuan +;; 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 diff --git a/org-roam-protocol.el b/org-roam-protocol.el deleted file mode 100644 index a113e7f..0000000 --- a/org-roam-protocol.el +++ /dev/null @@ -1,107 +0,0 @@ -;;; org-roam-protocol.el --- Protocol handler for roam:// links -*- coding: utf-8; lexical-binding: t; -*- - -;; Copyright © 2020 Jethro Kuan -;; Author: Jethro Kuan -;; 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 diff --git a/org-roam-utils.el b/org-roam-utils.el index 22b2b37..e345d27 100644 --- a/org-roam-utils.el +++ b/org-roam-utils.el @@ -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 +;; Copyright © 2020-2021 Jethro Kuan ;; Author: Jethro Kuan ;; 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 diff --git a/org-roam.el b/org-roam.el index ec292ba..dc393a2 100644 --- a/org-roam.el +++ b/org-roam.el @@ -1,4 +1,4 @@ -;;; org-roam.el --- Roam Research replica with Org-mode -*- coding: utf-8; lexical-binding: t; -*- +;;; org-roam.el --- A database abstraction layer for Org-mode -*- coding: utf-8; lexical-binding: t; -*- ;; Copyright © 2020-2021 Jethro Kuan @@ -27,48 +27,79 @@ ;;; 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. +;; Org-roam is a Roam Research inspired Emacs package and is an addition to +;; Org-mode to have a way to quickly process complex SQL-like queries over a +;; large set of plain text Org-mode files. To achieve this Org-roam provides a +;; database abstraction layer, the capabilities of which include, but are not +;; limited to: ;; +;; - Link graph traversal and visualization. +;; - Instantaneous SQL-like queries on headlines +;; - What are my TODOs, scheduled for X, or due by Y? +;; - Accessing the properties of a node, such as its tags, refs, TODO state or +;; priority. +;; +;; All of these functionality is powered by this layer. Hence, at its core +;; Org-roam's primary goal is to provide a resilient dual representation of +;; what's already available in plain text, while cached in a binary database, +;; that is cheap to maintain, easy to understand, and is as up-to-date as it +;; possibly can. For users who would like to perform arbitrary programmatic +;; queries on their Org files Org-roam also exposes an API to this database +;; abstraction layer. +;; +;; ----------------------------------------------------------------------------- +;; +;; In order for the package to correctly work it's mandatory to add somewhere to +;; your configuration the next form: +;; +;; (org-roam-setup) +;; +;; The form can be called both, before or after loading the package, which is up +;; to your preferences. If you call this before the package is loaded, then it +;; will automatically load the package. +;; +;; ----------------------------------------------------------------------------- +;; +;; This package also comes with a set of officially supported extensions that +;; provide extra features. You can find them in the "extensions/" subdirectory. +;; These extensions are not automatically loaded with `org-roam`, but they still +;; will be lazy-loaded through their own `autoload's. +;; +;; Org-roam also has other extensions that don't come together with this package. +;; Such extensions are distributed as their own packages, while also +;; authored and maintained by different people on distinct repositories. The +;; majority of them can be found at https://github.com/org-roam and MELPA. ;; ;;; Code: -;;;; Dependencies -(require 'org) -(require 'org-element) -(require 'org-id) -(require 'ob-core) ;for org-babel-parse-header-arguments -(require 'ansi-color) ; org-roam--list-files strip ANSI color codes -(require 'cl-lib) -(require 'dash) (require 'f) +(require 'dash) + (require 'rx) (require 'seq) +(require 'cl-lib) + (require 'magit-section) -(eval-when-compile (require 'subr-x)) -;;;; Features -(require 'org-roam-migrate) -(require 'org-roam-compat) +(require 'emacsql) +(require 'emacsql-sqlite) + +(require 'org) +(require 'org-id) +(require 'ol) +(require 'org-element) +(require 'org-capture) + +(require 'ansi-color) ; to strip ANSI color codes in `org-roam--list-files' + (eval-when-compile - (require 'org-roam-macs) - (require 'org-macs)) + (require 'subr-x)) + (require 'org-roam-utils) -(require 'org-roam-mode) -(require 'org-roam-completion) -(require 'org-roam-capture) -(require 'org-roam-dailies) -(require 'org-roam-db) - -;;; Declarations -;; From org-ref-core.el -(defvar org-ref-cite-types) -(declare-function org-ref-split-and-strip-string "ext:org-ref-utils" (string)) -;; From org-id.el -(declare-function org-id-find-id-in-file "ext:org-id" (id file &optional markerp)) +(require 'org-roam-compat) +;;; Options (defgroup org-roam nil - "Roam Research replica in Org-mode." + "A database abstraction layer for Org-mode." :group 'org :prefix "org-roam-" :link '(url-link :tag "Github" "https://github.com/org-roam/org-roam") @@ -79,7 +110,6 @@ :group 'org-roam :group 'faces) -;;;; Variables (defcustom org-roam-verbose t "Echo messages that are not errors." :type 'boolean @@ -91,12 +121,16 @@ All Org files, at any level of nesting, are considered part of the Org-roam." :type 'directory :group 'org-roam) +(defcustom org-roam-find-file-hook nil + "Hook run when an Org-roam file is visited." + :group 'org-roam + :type 'hook) + (defcustom org-roam-file-extensions '("org") - "Detected file extensions to include in the Org-roam ecosystem. -The first item in the list is used as the default file extension. -While the file extensions may be different, the file format needs -to be an `org-mode' file, and it is the user's responsibility to -ensure that." + "List of file extensions to be included by Org-Roam. +While a file extension different from \".org\" may be used, the +file still needs to be an `org-mode' file, and it is the user's +responsibility to ensure that." :type '(repeat string) :group 'org-roam) @@ -139,34 +173,79 @@ By default, `executable-find' will be used to look up the path to the executable. If a custom path is required, it can be specified together with the method symbol as a cons cell. For example: '(find (rg . \"/path/to/rg\"))." :type '(set (const :tag "find" find) - (const :tag "rg" rg))) + (const :tag "fd" fd) + (const :tag "fdfind" fdfind) + (const :tag "rg" rg) + (const :tag "elisp" nil))) -;;;; ID Utilities -(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)))) +;;; Session watcher +;;;###autoload +(defun org-roam-setup () + "Setup Org-roam and initialize its database. +This will install the needed hooks and advices to keep everything +in sync with the connected databases." + (interactive) + (add-hook 'find-file-hook #'org-roam--file-setup-h) + (add-hook 'kill-emacs-hook #'org-roam-db--close-all) + (advice-add 'rename-file :after #'org-roam--rename-file-a) + (advice-add 'delete-file :before #'org-roam--delete-file-a) + (org-roam-db-sync)) -;;;; File functions and predicates -(defun org-roam--file-name-extension (filename) - "Return file name extension for FILENAME. -Like `file-name-extension', but does not strip version number." - (save-match-data - (let ((file (file-name-nondirectory filename))) - (if (and (string-match "\\.[^.]*\\'" file) - (not (eq 0 (match-beginning 0)))) - (substring file (+ (match-beginning 0) 1)))))) +(defun org-roam-teardown () + "Teardown Org-roam to completely disable it. +This will remove all the hooks and advices installed by +`org-roam-setup' and close all the database connections made by +Org-roam." + (interactive) + (remove-hook 'find-file-hook #'org-roam--file-setup-h) + (remove-hook 'kill-emacs-hook #'org-roam-db--close-all) + (advice-remove 'rename-file #'org-roam--rename-file-a) + (advice-remove 'delete-file #'org-roam--delete-file-a) + (org-roam-db--close-all) + ;; Disable local hooks for all org-roam buffers + (dolist (buf (org-roam-buffer-list)) + (with-current-buffer buf + (remove-hook 'after-save-hook #'org-roam-db--try-update-on-save-h t)))) +(defun org-roam--file-setup-h () + "Setup an Org-roam file." + (when (org-roam-file-p) + (run-hooks 'org-roam-find-file-hook))) + +(defun org-roam--delete-file-a (file &optional _trash) + "Maintain cache consistency when file deletes. +FILE is removed from the database." + (when (and (not (auto-save-file-name-p file)) + (not (backup-file-name-p file)) + (org-roam-file-p file)) + (org-roam-db-clear-file (expand-file-name file)))) + +(defun org-roam--rename-file-a (old-file new-file-or-dir &rest _args) + "Maintain cache consistency of file rename. +OLD-FILE is cleared from the database, and NEW-FILE-OR-DIR is added." + (let ((new-file (if (directory-name-p new-file-or-dir) + (expand-file-name (file-name-nondirectory old-file) new-file-or-dir) + new-file-or-dir))) + (setq new-file (expand-file-name new-file)) + (setq old-file (expand-file-name old-file)) + (when (and (not (auto-save-file-name-p old-file)) + (not (auto-save-file-name-p new-file)) + (not (backup-file-name-p old-file)) + (not (backup-file-name-p new-file)) + (org-roam-file-p old-file)) + (org-roam-db-clear-file old-file)) + (when (org-roam-file-p new-file) + (org-roam-db-update-file new-file)))) + +;;;; Library (defun org-roam-file-p (&optional file) - "Return t if FILE is part of Org-roam system, nil otherwise. -If FILE is not specified, use the current buffer's file-path." + "Return t if FILE is an Org-roam file, nil otherwise. +If FILE is not specified, use the current buffer's file-path. + +FILE is an Org-roam file if: +- It's located somewhere under `org-roam-directory' +- It has a matching file extension (`org-roam-file-extensions') +- It doesn't match excluded regexp (`org-roam-file-exclude-regexp')" (let* ((path (or file (buffer-file-name (buffer-base-buffer)))) (ext (when path (org-roam--file-name-extension path))) (ext (if (string= ext "gpg") @@ -180,54 +259,35 @@ If FILE is not specified, use the current buffer's file-path." (string-match-p org-roam-file-exclude-regexp path))) (f-descendant-of-p path (expand-file-name org-roam-directory)))))) -(defun org-roam--shell-command-files (cmd) - "Run CMD in the shell and return a list of files. If no files are found, an empty list is returned." - (--> cmd - (shell-command-to-string it) - (ansi-color-filter-apply it) - (split-string it "\n") - (seq-filter #'s-present? it))) +(defun org-roam-list-files () + "Return a list of all Org-roam files under `org-roam-directory'. +See `org-roam-file-p' for how each file is determined to be as +part of Org-Roam." + (org-roam--list-files (expand-file-name org-roam-directory))) -(defun org-roam--list-files-search-globs (exts) - "Given EXTS, return a list of search globs. -E.g. (\".org\") => (\"*.org\" \"*.org.gpg\")" - (cl-loop for e in exts - append (list (format "\"*.%s\"" e) - (format "\"*.%s.gpg\"" e)))) +(defun org-roam-buffer-p (&optional buffer) + "Return t if BUFFER is for an Org-roam file. +If BUFFER is not specified, use the current buffer." + (let ((buffer (or buffer (current-buffer))) + path) + (with-current-buffer buffer + (and (derived-mode-p 'org-mode) + (setq path (buffer-file-name (buffer-base-buffer))) + (org-roam-file-p path))))) -(defun org-roam--list-files-fd (executable dir) - "Return all Org-roam files located recursively within DIR, using fd, provided as EXECUTABLE." - (let* ((globs (org-roam--list-files-search-globs org-roam-file-extensions)) - (extensions (s-join " -e " (mapcar (lambda (glob) (substring glob 2 -1)) globs))) - (command (s-join " " `(,executable "-L" ,dir "--type file" ,extensions)))) - (org-roam--shell-command-files command))) +(defun org-roam-buffer-list () + "Return a list of buffers that are Org-roam files." + (--filter (org-roam-buffer-p it) + (buffer-list))) -(defalias 'org-roam--list-files-fdfind #'org-roam--list-files-fd) - -(defun org-roam--list-files-rg (executable dir) - "Return all Org-roam files located recursively within DIR, using ripgrep, provided as EXECUTABLE." - (let* ((globs (org-roam--list-files-search-globs org-roam-file-extensions)) - (command (s-join " " `(,executable "-L" ,dir "--files" - ,@(mapcar (lambda (glob) (concat "-g " glob)) globs))))) - (org-roam--shell-command-files command))) - -(defun org-roam--list-files-find (executable dir) - "Return all Org-roam files located recursively within DIR, using find, provided as EXECUTABLE." - (let* ((globs (org-roam--list-files-search-globs org-roam-file-extensions)) - (names (s-join " -o " (mapcar (lambda (glob) (concat "-name " glob)) globs))) - (command (s-join " " `(,executable "-L" ,dir "-type f \\(" ,names "\\)")))) - (org-roam--shell-command-files command))) - -(defun org-roam--list-files-elisp (dir) - "Return all Org-roam files located recursively within DIR, using elisp." - (let ((regex (concat "\\.\\(?:"(mapconcat - #'regexp-quote org-roam-file-extensions - "\\|" )"\\)\\(?:\\.gpg\\)?\\'")) - result) - (dolist (file (org-roam--directory-files-recursively dir regex nil nil t) result) - (when (and (file-readable-p file) - (org-roam-file-p file)) - (push file result))))) +(defun org-roam--file-name-extension (filename) + "Return file name extension for FILENAME. +Like `file-name-extension', but does not strip version number." + (save-match-data + (let ((file (file-name-nondirectory filename))) + (if (and (string-match "\\.[^.]*\\'" file) + (not (eq 0 (match-beginning 0)))) + (substring file (+ (match-beginning 0) 1)))))) (defun org-roam--list-files (dir) "Return all Org-roam files located recursively within DIR. @@ -255,1097 +315,64 @@ Use external shell commands if defined in `org-roam-list-files-commands'." files (org-roam--list-files-elisp dir)))) -(defun org-roam--list-all-files () - "Return a list of all Org-roam files within `org-roam-directory'." - (org-roam--list-files (expand-file-name org-roam-directory))) - -(defun org-roam--nodes-table () - "Return a hash table of node ID to org-roam-nodes." - (let ((ht (make-hash-table :test #'equal))) - (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) ht)) - ht)) - -(defun org-roam-buffer-p (&optional buffer) - "Return t if BUFFER is accessing a part of Org-roam system. -If BUFFER is not specified, use the current buffer." - (let ((buffer (or buffer (current-buffer))) - path) - (with-current-buffer buffer - (and (derived-mode-p 'org-mode) - (setq path (buffer-file-name (buffer-base-buffer))) - (org-roam-file-p path))))) - -(defun org-roam-buffer-list () - "Return a list of buffers that are Org-roam files." - (--filter (org-roam-buffer-p it) - (buffer-list))) - -(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]))) - -;;; Org-roam setup and teardown -(defvar org-roam-find-file-hook nil - "Hook run when an Org-roam file is visited.") - -;;;###autoload -(defun org-roam-setup () - "Setup Org-roam and initialize its database. -This will install the needed hooks and advices to keep everything -in sync with the connected databases." - (interactive) - (add-hook 'find-file-hook #'org-roam--file-setup) - (add-hook 'kill-emacs-hook #'org-roam-db--close-all) - (advice-add 'rename-file :after #'org-roam--rename-file-advice) - (advice-add 'delete-file :before #'org-roam--delete-file-advice) - (org-roam-db-sync)) - -(defun org-roam-teardown () - "Teardown Org-roam to completely disable it. -This will remove all the hooks and advices installed by -`org-roam-setup' and close all the database connections made by -Org-roam." - (interactive) - (remove-hook 'find-file-hook #'org-roam--file-setup) - (remove-hook 'kill-emacs-hook #'org-roam-db--close-all) - (advice-remove 'rename-file #'org-roam--rename-file-advice) - (advice-remove 'delete-file #'org-roam--delete-file-advice) - (org-roam-db--close-all) - ;; Disable local hooks for all org-roam buffers - (dolist (buf (org-roam-buffer-list)) - (with-current-buffer buf - (remove-hook 'after-save-hook #'org-roam-db--update-on-save t)))) - -;;; Hooks and advices -(defun org-roam--file-setup () - "Setup an Org-roam file." - (when (org-roam-file-p) - (run-hooks 'org-roam-find-file-hook))) - -(defun org-roam--delete-file-advice (file &optional _trash) - "Maintain cache consistency when file deletes. -FILE is removed from the database." - (when (and (not (auto-save-file-name-p file)) - (not (backup-file-name-p file)) - (org-roam-file-p file)) - (org-roam-db-clear-file (expand-file-name file)))) - -(defun org-roam--rename-file-advice (old-file new-file-or-dir &rest _args) - "Maintain cache consistency of file rename. -OLD-FILE is cleared from the database, and NEW-FILE-OR-DIR is added." - (let ((new-file (if (directory-name-p new-file-or-dir) - (expand-file-name (file-name-nondirectory old-file) new-file-or-dir) - new-file-or-dir))) - (setq new-file (expand-file-name new-file)) - (setq old-file (expand-file-name old-file)) - (when (and (not (auto-save-file-name-p old-file)) - (not (auto-save-file-name-p new-file)) - (not (backup-file-name-p old-file)) - (not (backup-file-name-p new-file)) - (org-roam-file-p old-file)) - (org-roam-db-clear-file old-file)) - (when (org-roam-file-p new-file) - (org-roam-db-update-file new-file)))) - -;;;; Nodes -(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))))) - -(defvar org-roam-node-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map org-roam-mode-map) - (define-key map [remap org-roam-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 contain heading for NODE.") - -(defvar org-roam-preview-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map org-roam-mode-map) - (define-key map [remap org-roam-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.") - -(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) - -(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) - -(defun org-roam--tags-to-str (tags) - "Convert list of TAGS into a string." - (mapconcat (lambda (s) (concat "#" s)) tags " ")) - -(defun org-roam-node--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--process-display-format org-roam-node-display-template))) - (org-roam-format - (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--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-get-preview (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-headline-get-preview-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-headline-get-preview-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 drawer-re kwd-time-re 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)) - -(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." - (if-let ((node (magit-section-case - (org-roam-node-section (oref it node)) - (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))))))))) - node - (when assert - (user-error "No node at point")))) - -(defun org-roam-node--find (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 node))) - (funcall (if other-window - #'switch-to-buffer-other-window - #'pop-to-buffer-same-window) buf))) - -(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-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))))) - -(defun org-roam-node--to-candidate (node) - "Return a minibuffer completion candidate given NODE." - (let ((candidate-main (org-roam-node--format-entry node (1- (frame-width))))) - (cons (propertize candidate-main 'node node) node))) - -(defun org-roam-node--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--cached-display-format nil) - (let ((nodes (org-roam-node-list))) - (mapcar #'org-roam-node--to-candidate nodes))) - -(defcustom org-roam-node-annotation-function #'org-roam-node--annotation - "The function used to return annotations in the minibuffer for Org-roam nodes. -This function 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 'const - :group 'org-roam) - -(defun org-roam-node-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-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)" - "Sort completions list by file modification time." - (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 (&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-sort-by-file-mtime' -for an example sort function. -If REQUIRE-MATCH, the minibuffer prompt will require a match." - (let* ((nodes (org-roam-node--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-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)))) - -(defun org-roam-node--annotation (_node) - "Dummy function. -Returns empty string for annotations." - "") - -(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-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))) - -(cl-defun org-roam-node-insert-section (&key source-node point properties) - "Insert section for a link from SOURCE-NODE to some other node. - -SOURCE-NODE is an `org-roam-node' that links or references some -other node. Normally the other node is -`org-roam-buffer-current-node'. - -POINT is the position in SOURCE-NODE's file where the link is -located. - -PROPERTIES (a plist) contains additional information about the -link. - -This section is made out of the next 2 `magit-section's: -1. `org-roam-node-section' for a heading that describes - SOURCE-NODE. - -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." - (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-get-preview (org-roam-node-file source-node) point)) - "\n") - (oset section file (org-roam-node-file source-node)) - (oset section point point) - (insert ?\n)))) - -;;;###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 -(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))) - -;;;###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))) - -;;;; 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)) - -(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 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)) - -(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"))))) - -;;;; Tags -(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)))) - -(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")))) - "") ":" 't))) - (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")) ":" 't)) - (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))) - -;;;; Aliases -(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)))) - -;;;; Refs -(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)))) - -(defun org-roam-ref--completions () - "Return an alist for ref completion. -The car is the ref, and the cdr is the corresponding node for the ref." - nil - (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 (&optional initial-input filter-fn) - "Read an Org-roam ref. -Return a string, is propertized in `meta' with additional properties. -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--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 . org-roam-ref--annotation) - (category . org-roam-ref)) - (complete-with-action action refs string pred))) - nil t initial-input))) - (cdr (assoc ref refs)))) - -(defun org-roam-ref--annotation (ref) - "Return the annotation for REF. -REF is assumed to be a propertized string." - (let* ((node (get-text-property 0 'node ref)) - (title (org-roam-node-title node))) - (when title - (concat " " title)))) - -;;;###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))) - (find-file (org-roam-node-file node)) - (goto-char (org-roam-node-point node)))) - -;;;; roam: link -(defcustom org-roam-link-auto-replace t - "If non-nil, replace \"roam:\" links to existing nodes with \"id:\" links." - :group 'org-roam - :type 'boolean) - -;;; the roam: link -(org-link-set-parameters "roam" :follow #'org-roam-link-follow-link) - -(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)))) - -(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))) - -(add-hook 'org-roam-find-file-hook #'org-roam--replace-roam-links-on-save-h) - -(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-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)))))) - -(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)) - -(add-hook 'org-roam-find-file-hook #'org-roam-open-id-with-org-roam-db-h) - -;;; Refiling -(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) - -(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--file-keyword-get "TITLE") - "\n") - (org-back-to-heading) - (org-set-tags (org-roam--file-keyword-get "FILETAGS")) - (org-roam--file-keyword-kill "TITLE") - (org-roam--file-keyword-kill "FILETAGS"))) - -(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))))) - (org-roam--kill-empty-buffer))) - -(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))))) - -(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 - (node (org-roam-node-at-point)) - (template (org-roam-format - (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))))) - +(defun org-roam--shell-command-files (cmd) + "Run CMD in the shell and return a list of files. +If no files are found, an empty list is returned." + (--> cmd + (shell-command-to-string it) + (ansi-color-filter-apply it) + (split-string it "\n") + (seq-filter #'s-present? it))) + +(defun org-roam--list-files-search-globs (exts) + "Given EXTS, return a list of search globs. +E.g. (\".org\") => (\"*.org\" \"*.org.gpg\")" + (cl-loop for e in exts + append (list (format "\"*.%s\"" e) + (format "\"*.%s.gpg\"" e)))) + +(defun org-roam--list-files-find (executable dir) + "Return all Org-roam files under DIR, using \"find\", provided as EXECUTABLE." + (let* ((globs (org-roam--list-files-search-globs org-roam-file-extensions)) + (names (s-join " -o " (mapcar (lambda (glob) (concat "-name " glob)) globs))) + (command (s-join " " `(,executable "-L" ,dir "-type f \\(" ,names "\\)")))) + (org-roam--shell-command-files command))) + +(defun org-roam--list-files-fd (executable dir) + "Return all Org-roam files under DIR, using \"fd\", provided as EXECUTABLE." + (let* ((globs (org-roam--list-files-search-globs org-roam-file-extensions)) + (extensions (s-join " -e " (mapcar (lambda (glob) (substring glob 2 -1)) globs))) + (command (s-join " " `(,executable "-L" ,dir "--type file" ,extensions)))) + (org-roam--shell-command-files command))) + +(defalias 'org-roam--list-files-fdfind #'org-roam--list-files-fd) + +(defun org-roam--list-files-rg (executable dir) + "Return all Org-roam files under DIR, using \"rg\", provided as EXECUTABLE." + (let* ((globs (org-roam--list-files-search-globs org-roam-file-extensions)) + (command (s-join " " `(,executable "-L" ,dir "--files" + ,@(mapcar (lambda (glob) (concat "-g " glob)) globs))))) + (org-roam--shell-command-files command))) + +(defun org-roam--list-files-elisp (dir) + "Return all Org-roam files under DIR, using Elisp based implementation." + (let ((regex (concat "\\.\\(?:"(mapconcat + #'regexp-quote org-roam-file-extensions + "\\|" )"\\)\\(?:\\.gpg\\)?\\'")) + result) + (dolist (file (org-roam--directory-files-recursively dir regex nil nil t) result) + (when (and (file-readable-p file) + (org-roam-file-p file)) + (push file result))))) + +;;; Package bootstrap (provide 'org-roam) + +(cl-eval-when (load eval) + (require 'org-roam-db) + (require 'org-roam-node) + (require 'org-roam-capture) + (require 'org-roam-mode) + (require 'org-roam-migrate)) + ;;; org-roam.el ends here diff --git a/tests/roam-files/markdown.md b/tests/roam-files/markdown.md new file mode 100644 index 0000000..e69de29 diff --git a/tests/roam-files/roam-exclude.org b/tests/roam-files/roam-exclude.org new file mode 100644 index 0000000..a83eab7 --- /dev/null +++ b/tests/roam-files/roam-exclude.org @@ -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~. diff --git a/tests/test-org-roam.el b/tests/test-org-roam.el index 7f31e33..c292fba 100644 --- a/tests/test-org-roam.el +++ b/tests/test-org-roam.el @@ -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)