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

(feat): move fuzzy links to roam: links (#1105)

Browse Source
This commit is contained in:
Jethro Kuan
2020-09-23 17:58:18 +08:00
committed by GitHub
parent da6af3a468
commit ae32c465de
8 changed files with 539 additions and 384 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
CHANGELOG.md
View File

@ -23,7 +23,7 @@ Org-roam also now does not resolve symlinks. This significantly speeds up cache
- [#974](https://github.com/org-roam/org-roam/pull/974) Protect region targeted by `org-roam-insert`
- [#994](https://github.com/org-roam/org-roam/pull/994) Simplify org-roam-store-link
- [#1062](https://github.com/org-roam/org-roam/pull/1062) Variable `org-roam-completions-everywhere` allows for completions everywhere from word at point
- [#910](https://github.com/org-roam/org-roam/pull/910) Support fuzzy links of the form [[Title]], [[*Headline]] and [[Title*Headline]]
- [#910](https://github.com/org-roam/org-roam/pull/910), [#1105](https://github.com/org-roam/org-roam/pull/1105) Support fuzzy links of the form [[roam:Title]], [[roam:*Headline]] and [[roam:Title*Headline]]
### Bugfixes

56
doc/org-roam.org
View File

@ -544,10 +544,46 @@ The Org-roam buffer displays backlinks for the currently active Org-roam note.
The ~no-delete-window~ parameter for the org-roam buffer. Setting it to ~'t~ prevents the window from being deleted when calling ~delete-other-windows~.
** Org-roam Links
** Org-roam Files
Org-roam links are regular ~file:~ links in Org-mode. By default, links are
inserted with the title as the link description with ~org-roam-insert~.
Org-roam files are created and prefilled using Org-roam's templating
system. The templating system is customizable (see [[*The Templating System][The Templating System]]).
* Inserting Links
The preferred mode of linking is via ~file~ links to files, and ~id~ links for
headlines. This maintains the strongest compatibility with Org-mode, ensuring
that the links still function without Org-roam, and work well exporting to other
backends.
~file~ links can be inserted via ~org-roam-insert~. Links to headlines can be
inserted by navigating to the desired headline and calling ~org-store-link~.
This will create an ID for the headline if it does not already exist, and
populate the Org-roam database. The link can then be inserted via
~org-insert-link~.
An alternative mode of insertion is using Org-roam's ~roam~ links. Org-roam
registers this link type, and interprets the path as follows:
- ~[[roam:title]]~ :: links to an Org-roam file with title or alias "title"
- ~[[roam:*headline]]~ :: links to the headline "headline" in the current Org-roam file
- ~[[roam:title*headline]]~ :: links to the headline "headline" in the Org-roam file with title or alias "title"
~roam~ links support auto-completion via ~completion-at-point~: simply call
~completion-at-point~ within a roam link. Users of ~company-mode~ may want to
prepend ~company-capf~ to the beginning of variable ~company-backends~.
To easily insert ~roam~ links, one may wish to use a package like [[https://github.com/emacsorphanage/key-chord/][key-chord]]. In the following example, typing "[[" will insert a stub ~roam~ link:
#+BEGIN_SRC emacs-lisp
(key-chord-define org-mode-map "[[" #'my/insert-roam-link)
(defun my/insert-roam-link ()
"Inserts an Org-roam link."
(interactive)
(insert "[[roam:]]")
(backward-char 2))
#+END_SRC
- User Option: org-roam-link-title-format
@ -557,10 +593,18 @@ inserted with the title as the link description with ~org-roam-insert~.
If your version of Org is at least ~9.2~, consider styling the link differently,
by customizing the ~org-roam-link~, and ~org-roam-link-current~ faces.
** Org-roam Files
- User Option: org-roam-completion-ignore-case
Org-roam files are created and prefilled using Org-roam's templating
system. The templating system is customizable (see [[*The Templating System][The Templating System]]).
When non-nil, the ~roam~ link completions are ignore case. For example,
calling ~completion-at-point~ within ~[[roam:fo]]~ will present a completion
for a file with title "Foo". Defaults to ~t~.
- User Option: org-roam-link-auto-replace
When non-nil, ~roam~ links will be replaced with ~file~ or ~id~ links when
they are navigated to, and on file save, when a match is found. This is
desirable to maintain compatibility with vanilla Org, but resolved links are
harder to edit. Defaults to ~t~.
* Navigating Around

74
doc/org-roam.texi
View File

@ -72,6 +72,7 @@ General Public License for more details.
* Anatomy of an Org-roam File::
* The Templating System::
* Concepts and Configuration::
* Inserting Links::
* Navigating Around::
* Encryption::
* Graphing::
@ -108,7 +109,6 @@ Concepts and Configuration
* Directories and Files::
* The Org-roam Buffer::
* Org-roam Links::
* Org-roam Files::
Navigating Around
@ -707,7 +707,6 @@ All of Org-roam's customization options can be viewed via
@menu
* Directories and Files::
* The Org-roam Buffer::
* Org-roam Links::
* Org-roam Files::
@end menu
@ -773,11 +772,53 @@ User Option: org-roam-buffer-no-delete-other-windows
The @code{no-delete-window} parameter for the org-roam buffer. Setting it to @code{'t} prevents the window from being deleted when calling @code{delete-other-windows}.
@end itemize
@node Org-roam Links
@section Org-roam Links
@node Org-roam Files
@section Org-roam Files
Org-roam links are regular @code{file:} links in Org-mode. By default, links are
inserted with the title as the link description with @code{org-roam-insert}.
Org-roam files are created and prefilled using Org-roam's templating
system. The templating system is customizable (see @ref{The Templating System}).
@node Inserting Links
@chapter Inserting Links
The preferred mode of linking is via @code{file} links to files, and @code{id} links for
headlines. This maintains the strongest compatibility with Org-mode, ensuring
that the links still function without Org-roam, and work well exporting to other
backends.
@code{file} links can be inserted via @code{org-roam-insert}. Links to headlines can be
inserted by navigating to the desired headline and calling @code{org-store-link}.
This will create an ID for the headline if it does not already exist, and
populate the Org-roam database. The link can then be inserted via
@code{org-insert-link}.
An alternative mode of insertion is using Org-roam's @code{roam} links. Org-roam
registers this link type, and interprets the path as follows:
@table @asis
@item @code{[[roam:title]]}
links to an Org-roam file with title or alias ``title''
@item @code{[[roam:*headline]]}
links to the headline ``headline'' in the current Org-roam file
@item @code{[[roam:title*headline]]}
links to the headline ``headline'' in the Org-roam file with title or alias ``title''
@end table
@code{roam} links support auto-completion via @code{completion-at-point}: simply call
@code{completion-at-point} within a roam link. Users of @code{company-mode} may want to
prepend @code{company-capf} to the beginning of variable @code{company-backends}.
To easily insert @code{roam} links, one may wish to use a package like @uref{https://github.com/emacsorphanage/key-chord/, key-chord}. In the following example, typing ``[['' will insert a stub @code{roam} link:
@lisp
(key-chord-define org-mode-map "[[" #'my/insert-roam-link)
(defun my/insert-roam-link ()
"Inserts an Org-roam link."
(interactive)
(insert "[[roam:]]")
(backward-char 2))
@end lisp
@itemize
@item
@ -788,14 +829,23 @@ special indicators for Org-roam links. Defaults to @code{"%s"}.
If your version of Org is at least @code{9.2}, consider styling the link differently,
by customizing the @code{org-roam-link}, and @code{org-roam-link-current} faces.
@item
User Option: org-roam-completion-ignore-case
When non-nil, the @code{roam} link completions are ignore case. For example,
calling @code{completion-at-point} within @code{[[roam:fo]]} will present a completion
for a file with title ``Foo''. Defaults to @code{t}.
@item
User Option: org-roam-link-auto-replace
When non-nil, @code{roam} links will be replaced with @code{file} or @code{id} links when
they are navigated to, and on file save, when a match is found. This is
desirable to maintain compatibility with vanilla Org, but resolved links are
harder to edit. Defaults to @code{t}.
@end itemize
@node Org-roam Files
@section Org-roam Files
Org-roam files are created and prefilled using Org-roam's templating
system. The templating system is customizable (see @ref{The Templating System}).
@node Navigating Around
@chapter Navigating Around

5
org-roam-completion.el
View File

@ -47,6 +47,11 @@
(function :tag "Custom function"))
:group 'org-roam)
(defcustom org-roam-completion-ignore-case t
"Whether to ignore case in Org-roam `completion-at-point' completions."
:group 'org-roam
:type 'boolean)
(defun org-roam-completion--helm-candidate-transformer (candidates _source)
"Transforms CANDIDATES for Helm-based completing read.
SOURCE is not used."

274
org-roam-link.el Normal file
View File

@ -0,0 +1,274 @@
;;; org-roam-link.el --- Custom links for Org-roam -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright © 2020 Jethro Kuan <jethrokuan95@gmail.com>
;; Alan Carroll
;; Author: Jethro Kuan <jethrokuan95@gmail.com>
;; URL: https://github.com/org-roam/org-roam
;; Keywords: org-mode, roam, convenience
;; Version: 1.2.1
;; Package-Requires: ((emacs "26.1") (dash "2.13") (f "0.17.2") (s "1.12.0") (org "9.3") (emacsql "3.0.0") (emacsql-sqlite3 "1.0.2"))
;; 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 adds the custom `roam:' link to Org-roam. `roam:' links allow linking to
;; Org-roam files via their titles and headlines.
;;
;;; Code:
;;;; Dependencies
(require 'ol)
(require 'org-roam-compat)
(defvar org-roam-completion-ignore-case)
(declare-function org-roam--find-file "org-roam")
(declare-function org-roam-find-file "org-roam")
(defcustom org-roam-link-auto-replace t
"When non-nil, replace Org-roam's roam links with file or id links whenever possible."
:group 'org-roam
:type 'boolean)
;;; the roam: link
(org-link-set-parameters "roam"
:follow #'org-roam-link-follow-link)
(defun org-roam-link-follow-link (path)
"Navigates to location specified by PATH."
(pcase-let ((`(,link-type ,loc ,desc ,mkr) (org-roam-link--get-location path)))
(when (and org-roam-link-auto-replace loc desc)
(org-roam-link--replace-link link-type loc desc))
(pcase link-type
("file"
(if loc
(org-roam--find-file loc)
(org-roam-find-file desc nil nil t)))
("id"
(org-goto-marker-or-bmk mkr)))))
;;; Retrieval Functions
(defun org-roam-link--get-titles ()
"Return all titles within Org-roam."
(mapcar #'car (org-roam-db-query [:select [titles:title] :from titles])))
(defun org-roam-link--get-headlines (&optional file with-marker use-stack)
"Return all outline headings for the current buffer.
If FILE, return outline headings for passed FILE instead.
If WITH-MARKER, return a cons cell of (headline . marker).
If USE-STACK, include the parent paths as well."
(let* ((buf (or (and file
(or (find-buffer-visiting file)
(find-file-noselect file)))
(current-buffer)))
(outline-level-fn outline-level)
(path-separator "/")
(stack-level 0)
stack cands name level marker)
(with-current-buffer buf
(save-excursion
(goto-char (point-min))
(while (re-search-forward org-complex-heading-regexp nil t)
(save-excursion
(setq name (substring-no-properties (or (match-string 4) "")))
(setq marker (point-marker))
(when use-stack
(goto-char (match-beginning 0))
(setq level (funcall outline-level-fn))
;; Update stack. The empty entry guards against incorrect
;; headline hierarchies, e.g. a level 3 headline
;; immediately following a level 1 entry.
(while (<= level stack-level)
(pop stack)
(cl-decf stack-level))
(while (> level stack-level)
(push name stack)
(cl-incf stack-level))
(setq name (mapconcat #'identity
(reverse stack)
path-separator)))
(push (if with-marker
(cons name marker)
name) cands)))))
(nreverse cands)))
(defun org-roam-link--get-file-from-title (title &optional no-interactive)
"Return the file path corresponding to TITLE.
When NO-INTERACTIVE, return nil if there are multiple options."
(let ((files (mapcar #'car (org-roam-db-query [:select [titles:file] :from titles
:where (= titles:title $v1)]
(vector title)))))
(pcase files
('nil nil)
(`(,file) file)
(_
(unless no-interactive
(completing-read "Select file: " files))))))
(defun org-roam-link--get-id-from-headline (headline &optional file)
"Return (marker . id) correspondng to HEADLINE.
If FILE, get headline from FILE instead.
If there is no corresponding headline, return nil."
(save-excursion
(with-current-buffer (or (and file
(or (find-buffer-visiting file)
(find-file-noselect file)))
(current-buffer))
(let ((headlines (org-roam-link--get-headlines file 'with-markers)))
(when-let ((marker (cdr (assoc-string headline headlines))))
(goto-char marker)
(cons marker
(when org-roam-link-auto-replace
(org-id-get-create))))))))
;;; Path-related functions
(defun org-roam-link--split-path (path)
"Splits PATH into title and headline.
Return a list of the form (type title has-headline-p headline star-idx).
type is one of `title', `headline', `title+headline'.
title is the title component of the path.
headline is the headline component of the path.
star-idx is the index of the asterisk, if any."
(save-match-data
(let* ((star-index (string-match-p "\\*" path))
(title (substring-no-properties path 0 star-index))
(headline (if star-index
(substring-no-properties path (+ 1 star-index))
""))
(type (cond ((not star-index)
'title)
((= 0 star-index)
'headline)
(t 'title+headline))))
(list type title headline star-index))))
(defun org-roam-link--get-location (link)
"Return the location of Org-roam fuzzy LINK.
The location is returned as a list containing (link-type loc desc marker).
nil is returned if there is no matching location.
link-type is either \"file\" or \"id\".
loc is the target location: e.g. a file path, or an id.
marker is a marker to the headline, if applicable."
(let (mkr link-type desc loc)
(pcase-let ((`(,type ,title ,headline _) (org-roam-link--split-path link)))
(pcase type
('title+headline
(let ((file (org-roam-link--get-file-from-title title)))
(if (not file)
(org-roam-message "Cannot find matching file")
(setq mkr (org-roam-link--get-id-from-headline headline file))
(pcase mkr
(`(,marker . ,target-id)
(setq mkr marker
loc target-id
link-type "id"
desc headline))
(_ (org-roam-message "cannot find matching id"))))))
('title
(setq loc (org-roam-link--get-file-from-title title)
desc title
link-type "file")
(when loc (setq loc (file-relative-name loc))))
('headline
(setq mkr (org-roam-link--get-id-from-headline headline))
(pcase mkr
(`(,marker . ,target-id)
(setq mkr marker
loc target-id
desc headline
link-type "id"))
(_ (org-roam-message "Cannot find matching headline")))))
(list link-type loc desc mkr))))
;;; Conversion Functions
(defun org-roam-link--replace-link (link-type loc &optional desc)
"Replace link at point with a vanilla Org link.
LINK-TYPE is the Org link type, typically \"file\" or \"id\".
LOC is path for the Org link.
DESC is the link description."
(save-excursion
(save-match-data
(unless (org-in-regexp org-link-bracket-re 1)
(user-error "No link at point"))
(replace-match "")
(insert (org-roam-link-make-string (concat link-type ":" loc) desc)))))
(defun org-roam-link-replace-all ()
"Replace all roam links in the current buffer."
(interactive)
(save-excursion
(goto-char (point-min))
(while (re-search-forward org-link-bracket-re nil t)
(let ((context (org-element-context)))
(pcase (org-element-lineage context '(link) t)
(`nil nil)
(link
(when (string-equal "roam" (org-element-property :type link))
(pcase-let ((`(,link-type ,loc ,desc _) (org-roam-link--get-location (org-element-property :path link))))
(when (and link-type loc)
(org-roam-link--replace-link link-type loc desc))))))))))
(defun org-roam-link--replace-link-on-save ()
"Hook to replace all roam links on save."
(when org-roam-link-auto-replace
(org-roam-link-replace-all)))
;;; Completion
(defun org-roam-link-complete-at-point ()
"Do appropriate completion for the link at point."
(let ((end (point))
(start (point))
(exit-fn (lambda (&rest _) nil))
collection)
(when (org-in-regexp org-link-bracket-re 1)
(setq start (+ (match-beginning 1) (length "roam:"))
end (match-end 1))
(let ((context (org-element-context)))
(pcase (org-element-lineage context '(link) t)
(`nil nil)
(link (when (string-equal "roam" (org-element-property :type link))
(pcase-let ((`(,type ,title _ ,star-idx)
(org-roam-link--split-path (org-element-property :path link))))
(pcase type
('title+headline
(when-let ((file (org-roam-link--get-file-from-title title t)))
(setq collection (apply-partially #'org-roam-link--get-headlines file))
(setq start (+ start star-idx 1))))
('title
(setq collection #'org-roam-link--get-titles))
('headline
(setq collection #'org-roam-link--get-headlines)
(setq start (+ start star-idx 1))))))))))
(when collection
(let ((prefix (buffer-substring-no-properties start end)))
(list start end
(if (functionp collection)
(completion-table-case-fold
(completion-table-dynamic
(lambda (_)
(cl-remove-if (apply-partially #'string= prefix)
(funcall collection))))
(not org-roam-completion-ignore-case))
collection)
:exit-function exit-fn)))))
(provide 'org-roam-link)
;;; org-roam-link.el ends here

13
org-roam-macs.el
View File

@ -74,19 +74,6 @@ If FILE, set `org-roam-temp-file-name' to file and insert its contents."
(s-replace "\\" "\\\\")
(s-replace "\"" "\\\"")))
;;; Link Utilities
(defun org-roam-replace-fuzzy-link (new-loc &optional desc)
"Replace the current fuzzy link (e.g. [[Foo]]) with a NEW-LOC.
If DESC, also replace the desc"
(save-match-data
(unless (org-in-regexp org-link-bracket-re 1)
(user-error "No link at point"))
(let ((desc (or desc (match-string-no-properties 1)))
(remove (list (match-beginning 0) (match-end 0))))
(apply #'delete-region remove)
(insert (org-roam-link-make-string new-loc desc)))
(sit-for 0)))
;;; Shielding regions
(defun org-roam-shield-region (beg end)
"Shield REGION against modifications.

293
org-roam.el
View File

@ -63,6 +63,7 @@
(require 'org-roam-db)
(require 'org-roam-doctor)
(require 'org-roam-graph)
(require 'org-roam-link)
;;;; Declarations
;; From org-ref-core.el
@ -277,6 +278,9 @@ The currently supported symbols are:
:type 'boolean
:group 'org-roam)
(defvar org-roam-completion-functions nil
"List of functions to be used with `completion-at-point' for Org-roam.")
;;;; Dynamic variables
(defvar org-roam-last-window nil
"Last window `org-roam' was called from.")
@ -633,6 +637,7 @@ it as FILE-PATH."
(setq type "cite")
(org-ref-split-and-strip-string path))
("fuzzy" (list path))
("roam" (list path))
(_ (if (or (file-remote-p path)
(org-roam--url-p path))
(list path)
@ -1152,15 +1157,14 @@ This function hooks into `org-open-at-point' via
:group 'org-roam
:type 'boolean)
(defun org-roam-complete-at-point ()
"Do appropriate completion for the thing at point."
;;;; Tags completion
(defun org-roam-complete-tags-at-point ()
"`completion-at-point' function for Org-roam tags."
(let ((end (point))
(start (point))
(exit-fn (lambda (&rest _) nil))
collection)
(cond
(;; completing roam_tags
(looking-back "^#\\+roam_tags:.*" (line-beginning-position))
(when (looking-back "^#\\+roam_tags:.*" (line-beginning-position))
(when (looking-at "\\>")
(setq start (save-excursion (skip-syntax-backward "w")
(point))
@ -1169,33 +1173,31 @@ This function hooks into `org-open-at-point' via
exit-fn (lambda (str _status)
(delete-char (- (length str)))
(insert "\"" str "\""))))
(;; Completions for fuzzy links
org-roam-enable-fuzzy-links
(cond
(;; In a fuzzy link
(and (org-roam--fuzzy-link-p))
(org-in-regexp org-link-any-re 1) ; org-roam--fuzzy-link-p guarantees this is true
(setq start (match-beginning 2)
end (match-end 2))
(pcase-let ((`(,type ,title _ ,star-idx)
(org-roam--split-fuzzy-link (match-string-no-properties 2))))
(pcase type
('title+headline
(when-let ((file (org-roam--get-file-from-title title t)))
(setq collection (apply-partially #'org-roam--get-headlines file))
(setq start (+ start star-idx 1))))
('title
(setq collection #'org-roam--get-titles))
('headline
(setq collection #'org-roam--get-headlines)
(setq start (+ start star-idx 1))))))
(;; At a plain "[[|]]"
(org-in-regexp (rx "[[]]"))
(setq start (+ (match-beginning 0) 2)
end (+ (match-beginning 0) 2)
collection #'org-roam--get-titles))))
(;; Completions everywhere
(and org-roam-completion-everywhere
(when collection
(let ((prefix (buffer-substring-no-properties start end)))
(list start end
(if (functionp collection)
(completion-table-case-fold
(completion-table-dynamic
(lambda (_)
(cl-remove-if (apply-partially #'string= prefix)
(funcall collection))))
(not org-roam-completion-ignore-case))
collection)
:exit-function exit-fn)))))
(defun org-roam--get-titles ()
"Return all titles within Org-roam."
(mapcar #'car (org-roam-db-query [:select [titles:title] :from titles])))
(defun org-roam-complete-everywhere ()
"`completion-at-point' function for word at point.
This is active when `org-roam-completion-everywhere' is non-nil."
(let ((end (point))
(start (point))
(exit-fn (lambda (&rest _) nil))
collection)
(when (and org-roam-completion-everywhere
(thing-at-point 'word))
(let ((bounds (bounds-of-thing-at-point 'word)))
(setq start (car bounds)
@ -1203,229 +1205,23 @@ This function hooks into `org-open-at-point' via
collection #'org-roam--get-titles
exit-fn (lambda (str _status)
(delete-char (- (length str)))
(insert "[[" str "]]"))))))
(insert "[[" str "]]")))))
(when collection
(let ((prefix (buffer-substring-no-properties start end)))
(list start end
(if (functionp collection)
(completion-table-case-fold
(completion-table-dynamic
(lambda (_)
(cl-remove-if (apply-partially #'string= prefix)
(funcall collection))))
(not org-roam-completion-ignore-case))
collection)
:exit-function exit-fn)))))
;;; Fuzzy Links
(defcustom org-roam-enable-fuzzy-links t
"When non-nil, replace Org's [[fuzzy link]] behaviour with Org-roam's.
Org-roam emulates Roam Research, treating [[Foo]] links as links
to files titled Foo. In addition to this behaviour, [[Foo*Bar]]
links to the headline Bar within the file titled Foo."
:group 'org-roam
:type 'boolean)
(defcustom org-roam-auto-replace-fuzzy-links t
"When non-nil, replace Org-roam's fuzzy links with file or id links whenever possible."
:group 'org-roam
:type 'boolean)
(defun org-roam--fuzzy-link-p (&optional point-or-marker)
"Return t if the link at point is a fuzzy link.
If POINT-OR-MARKER, then check the link at POINT-OR-MARKER.
Some [[foo]] links are not fuzzy links: they could have a
type (e.g. file, https) or be a custom id link (e.g. #foo)."
(save-excursion
(save-match-data
(goto-char (or point-or-marker (point)))
(when (org-in-regexp org-link-any-re 1)
(let ((context (org-element-context)))
(pcase (org-element-lineage context '(link) t)
(`nil nil)
(link (string-equal "fuzzy" (org-element-property :type link)))))))))
(defun org-roam--split-fuzzy-link (link)
"Splits LINK into title and headline.
Return a list of the form (type title has-headline-p headline star-idx).
type is one of `title', `headline', `title+headline'.
title is the title component of the link.
headline is the headline component of the link.
star-idx is the index of the asterisk, if any."
(save-match-data
(let* ((star-index (string-match-p "\\*" link))
(title (substring-no-properties link 0 star-index))
(headline (if star-index
(substring-no-properties link (+ 1 star-index))
""))
(type (cond ((not star-index)
'title)
((= 0 star-index)
'headline)
(t 'title+headline))))
(list type title headline star-index))))
(defun org-roam--get-titles ()
"Return all titles within Org-roam."
(mapcar #'car (org-roam-db-query [:select [titles:title] :from titles])))
(defun org-roam--get-headlines (&optional file with-marker use-stack)
"Return all outline headings for the current buffer.
If FILE, return outline headings for passed FILE instead.
If WITH-MARKER, return a cons cell of (headline . marker).
If USE-STACK, include the parent paths as well."
(let* ((buf (or (and file
(or (find-buffer-visiting file)
(find-file-noselect file)))
(current-buffer)))
(outline-level-fn outline-level)
(path-separator "/")
(stack-level 0)
stack cands name level marker)
(with-current-buffer buf
(save-excursion
(goto-char (point-min))
(while (re-search-forward org-complex-heading-regexp nil t)
(save-excursion
(setq name (substring-no-properties (or (match-string 4) "")))
(setq marker (point-marker))
(when use-stack
(goto-char (match-beginning 0))
(setq level (funcall outline-level-fn))
;; Update stack. The empty entry guards against incorrect
;; headline hierarchies, e.g. a level 3 headline
;; immediately following a level 1 entry.
(while (<= level stack-level)
(pop stack)
(cl-decf stack-level))
(while (> level stack-level)
(push name stack)
(cl-incf stack-level))
(setq name (mapconcat #'identity
(reverse stack)
path-separator)))
(push (if with-marker
(cons name marker)
name) cands)))))
(nreverse cands)))
(defun org-roam--get-file-from-title (title &optional no-interactive)
"Return the file path corresponding to TITLE.
When NO-INTERACTIVE, return nil if there are multiple options."
(let ((files (mapcar #'car (org-roam-db-query [:select [titles:file] :from titles
:where (= titles:title $v1)]
(vector title)))))
(pcase files
('nil nil)
(`(,file) file)
(_
(unless no-interactive
(completing-read "Select file: " files))))))
(defun org-roam--get-id-from-headline (headline &optional file)
"Return (marker . id) correspondng to HEADLINE.
If FILE, get headline from FILE instead.
If there is no corresponding headline, return nil."
(save-excursion
(with-current-buffer (or (and file
(or (find-buffer-visiting file)
(find-file-noselect file)))
(current-buffer))
(let ((headlines (org-roam--get-headlines file 'with-markers)))
(when-let ((marker (cdr (assoc-string headline headlines))))
(goto-char marker)
(cons marker
(when org-roam-auto-replace-fuzzy-links
(org-id-get-create))))))))
(defun org-roam--get-fuzzy-link-location (link)
"Return the location of Org-roam fuzzy LINK.
The location is returned as a list containing (link-type loc desc marker).
nil is returned if there is no matching location.
link-type is either \"file\" or \"id\".
loc is the target location: e.g. a file path, or an id.
marker is a marker to the headline, if applicable."
(let (mkr link-type desc loc)
(pcase-let ((`(,type ,title ,headline _) (org-roam--split-fuzzy-link link)))
(pcase type
('title+headline
(let ((file (org-roam--get-file-from-title title)))
(if (not file)
(org-roam-message "Cannot find matching file")
(setq mkr (org-roam--get-id-from-headline headline file))
(pcase mkr
(`(,marker . ,target-id)
(setq mkr marker
loc target-id
link-type "id"
desc headline))
(_ (org-roam-message "cannot find matching id"))))))
('title
(setq loc (org-roam--get-file-from-title title)
desc title
link-type "file")
(when loc (setq loc (file-relative-name loc))))
('headline
(setq mkr (org-roam--get-id-from-headline headline))
(pcase mkr
(`(,marker . ,target-id)
(setq mkr marker
loc target-id
desc headline
link-type "id"))
(_ (org-roam-message "Cannot find matching headline")))))
(list link-type loc desc mkr))))
(defun org-roam--open-fuzzy-link (link)
"Open a Org fuzzy LINK.
To be added to `org-open-link-functions'. This function always
resolves, completely replacing Org's original fuzzy link opening behaviour.
Three types of fuzzy links are supported:
[[Title]]
Opens a file with the corresponding title.
[[*Headline]]
Creates or gets an ID for the corresponding headline from current file.
[[Title*Headline]]
Creates or gets an ID for the corresponding headline from file with corresponding title."
(when (and org-roam-enable-fuzzy-links
(bound-and-true-p org-roam-mode)
(org-roam--org-roam-file-p))
(when-let ((location (org-roam--get-fuzzy-link-location link)))
(pcase-let ((`(,link-type ,loc ,desc ,mkr) location))
(when (and org-roam-auto-replace-fuzzy-links
loc desc)
(org-roam-replace-fuzzy-link (concat link-type ":" loc) desc))
(pcase link-type
("file"
(if loc
(org-roam--find-file loc)
(org-roam-find-file desc nil nil t)))
("id"
(org-goto-marker-or-bmk mkr)))))
t))
(defun org-roam-replace-all-fuzzy-links ()
"Replace all fuzzy links in current buffer."
(interactive)
(save-excursion
(goto-char (point-min))
(while (re-search-forward org-link-any-re nil t)
(when (org-roam--fuzzy-link-p)
(when-let ((location (org-roam--get-fuzzy-link-location (match-string-no-properties 2))))
(pcase-let ((`(,link-type ,loc ,desc _) location))
(when (and link-type loc)
(org-roam-replace-fuzzy-link (concat link-type ":" loc) desc))))))))
(defun org-roam--replace-fuzzy-link-on-save ()
"Hook to replace all fuzzy links on save."
(when (and org-roam-enable-fuzzy-links
org-roam-auto-replace-fuzzy-links)
(org-roam-replace-all-fuzzy-links)))
(add-to-list 'org-roam-completion-functions #'org-roam-complete-tags-at-point)
(add-to-list 'org-roam-completion-functions #'org-roam-complete-everywhere)
(add-to-list 'org-roam-completion-functions #'org-roam-link-complete-at-point)
;;; Org-roam-mode
;;;; Function Faces
@ -1525,9 +1321,10 @@ during the next idle slot."
(run-hooks 'org-roam-file-setup-hook) ; Run user hooks
(org-roam--setup-title-auto-update)
(add-hook 'post-command-hook #'org-roam-buffer--update-maybe nil t)
(add-hook 'before-save-hook #'org-roam--replace-fuzzy-link-on-save nil t)
(add-hook 'before-save-hook #'org-roam-link--replace-link-on-save nil t)
(add-hook 'after-save-hook #'org-roam--queue-file-for-update nil t)
(add-hook 'completion-at-point-functions #'org-roam-complete-at-point nil t)
(dolist (fn org-roam-completion-functions)
(add-hook 'completion-at-point-functions fn nil t))
(org-roam-buffer--update-maybe :redisplay t)))
(defun org-roam--delete-file-advice (file &optional _trash)
@ -1725,7 +1522,6 @@ M-x info for more information at Org-roam > Installation > Post-Installation Tas
(add-hook 'find-file-hook #'org-roam--find-file-hook-function)
(add-hook 'kill-emacs-hook #'org-roam-db--close-all)
(add-hook 'org-open-at-point-functions #'org-roam-open-id-at-point)
(add-hook 'org-open-link-functions #'org-roam--open-fuzzy-link)
(unless org-roam--file-update-timer
(setq org-roam--file-update-timer (run-with-idle-timer org-roam-update-db-idle-seconds t #'org-roam--process-update-queue)))
(advice-add 'rename-file :after #'org-roam--rename-file-advice)
@ -1740,7 +1536,6 @@ M-x info for more information at Org-roam > Installation > Post-Installation Tas
(remove-hook 'find-file-hook #'org-roam--find-file-hook-function)
(remove-hook 'kill-emacs-hook #'org-roam-db--close-all)
(remove-hook 'org-open-at-point-functions #'org-roam-open-id-at-point)
(remove-hook 'org-open-link-functions #'org-roam--open-fuzzy-link)
(when org-roam--file-update-timer
(cancel-timer org-roam--file-update-timer))
(advice-remove 'rename-file #'org-roam--rename-file-advice)
@ -1753,7 +1548,7 @@ M-x info for more information at Org-roam > Installation > Post-Installation Tas
(dolist (buf (org-roam--get-roam-buffers))
(with-current-buffer buf
(remove-hook 'post-command-hook #'org-roam-buffer--update-maybe t)
(remove-hook 'before-save-hook #'org-roam--replace-fuzzy-link-on-save t)
(remove-hook 'before-save-hook #'org-roam-link--replace-link-on-save t)
(remove-hook 'after-save-hook #'org-roam--queue-file-for-update t))))))
;;; Interactive Commands

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

@ -259,25 +259,25 @@
`(["e84d0630-efad-4017-9059-5ef917908823" ,(test-org-roam--abs-path "headlines/headline.org")]
["801b58eb-97e2-435f-a33e-ff59a2f0c213" ,(test-org-roam--abs-path "headlines/headline.org")])))))
(describe "Test fuzzy links"
(describe "Test roam links"
(it ""
(expect (org-roam--split-fuzzy-link "")
(expect (org-roam-link--split-path "")
:to-equal
'(title "" "" nil)))
(it "title"
(expect (org-roam--split-fuzzy-link "title")
(expect (org-roam-link--split-path "title")
:to-equal
'(title "title" "" nil)))
(it "title*"
(expect (org-roam--split-fuzzy-link "title*")
(expect (org-roam-link--split-path "title*")
:to-equal
'(title+headline "title" "" 5)))
(it "title*headline"
(expect (org-roam--split-fuzzy-link "title*headline")
(expect (org-roam-link--split-path "title*headline")
:to-equal
'(title+headline "title" "headline" 5)))
(it "*headline"
(expect (org-roam--split-fuzzy-link "*headline")
(expect (org-roam-link--split-path "*headline")
:to-equal
'(headline "" "headline" 0))))