(feat): support fuzzy links (#910)
This commit is contained in:
Jethro Kuan
GitHub
parent
f18ecd1fc3
commit
da6fdd7542
5 changed files with 269 additions and 13 deletions
|
|
@ -2,12 +2,17 @@
|
|||
|
||||
## 1.2.2 (TBD)
|
||||
|
||||
In this release we support fuzzy links of the form `[[Title]]`, `[[*Headline]]` and `[[Title*Headline]]`. Completion for these fuzzy links is supported via `completion-at-point`.
|
||||
|
||||
### Breaking Changes
|
||||
|
||||
- [#910](https://github.com/org-roam/org-roam/pull/910) Deprecate `company-org-roam`, using `completion-at-point` instead. To use this with company, add the `company-capf` backend instead.
|
||||
|
||||
### Features
|
||||
|
||||
- [#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
|
||||
- [#910](https://github.com/org-roam/org-roam/pull/910) Support fuzzy links of the form [[Title]], [[*Headline]] and [[Title*Headline]]
|
||||
|
||||
### Bugfixes
|
||||
|
||||
|
|
|
|||
|
|
@ -45,6 +45,7 @@
|
|||
|
||||
(declare-function org-roam-db--ensure-built "org-roam-db")
|
||||
(declare-function org-roam--extract-ref "org-roam")
|
||||
(declare-function org-roam--extract-titles "org-roam")
|
||||
(declare-function org-roam--get-title-or-slug "org-roam")
|
||||
(declare-function org-roam--get-backlinks "org-roam")
|
||||
(declare-function org-roam-backlinks-mode "org-roam")
|
||||
|
|
@ -152,7 +153,9 @@ For example: (setq org-roam-buffer-window-parameters '((no-other-window . t)))"
|
|||
(defun org-roam-buffer--insert-backlinks ()
|
||||
"Insert the org-roam-buffer backlinks string for the current buffer."
|
||||
(if-let* ((file-path (buffer-file-name org-roam-buffer--current))
|
||||
(backlinks (org-roam--get-backlinks file-path))
|
||||
(titles (with-current-buffer org-roam-buffer--current
|
||||
(org-roam--extract-titles)))
|
||||
(backlinks (org-roam--get-backlinks (push file-path titles)))
|
||||
(grouped-backlinks (--group-by (nth 0 it) backlinks)))
|
||||
(progn
|
||||
(insert (let ((l (length backlinks)))
|
||||
|
|
|
|||
|
|
@ -77,6 +77,19 @@ to look.
|
|||
(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-link-make-string new-loc desc)))
|
||||
(sit-for 0)))
|
||||
|
||||
;;; Shielding regions
|
||||
(defun org-roam-shield-region (beg end)
|
||||
"Shield REGION against modifications.
|
||||
|
|
|
|||
241
org-roam.el
241
org-roam.el
|
|
@ -591,6 +591,7 @@ it as FILE-PATH."
|
|||
(-contains? org-ref-cite-types typ))))
|
||||
(setq type "cite")
|
||||
(org-ref-split-and-strip-string path))
|
||||
("fuzzy" (list path))
|
||||
(_ (list (org-element-property :raw-link link))))))
|
||||
(seq-do (lambda (name)
|
||||
(when name
|
||||
|
|
@ -1005,14 +1006,18 @@ This function hooks into `org-open-at-point' via `org-open-at-point-functions'."
|
|||
;; If called via `org-open-at-point', fall back to default behavior.
|
||||
(t nil)))
|
||||
|
||||
(defun org-roam--get-backlinks (target)
|
||||
"Return the backlinks for TARGET.
|
||||
TARGET may be a file, for Org-roam file links, or a citation key,
|
||||
for Org-ref cite links."
|
||||
(org-roam-db-query [:select [from, to, properties] :from links
|
||||
:where (= to $s1)
|
||||
:order-by (asc from)]
|
||||
target))
|
||||
(defun org-roam--get-backlinks (targets)
|
||||
"Return the backlinks for TARGETS.
|
||||
TARGETS is a list of strings corresponding to the TO value in the
|
||||
Org-roam cache. It may be a file, for Org-roam file links, or a
|
||||
citation key, for Org-ref cite links."
|
||||
(unless (listp targets)
|
||||
(setq targets (list targets)))
|
||||
(org-roam-db-query
|
||||
(concat "SELECT \"from\", \"to\", \"properties\" FROM links WHERE "
|
||||
(string-join (mapcar (lambda (target)
|
||||
(concat "\"to\" = '\"" target "\"'"))
|
||||
targets) " OR "))))
|
||||
|
||||
(defun org-roam-store-link ()
|
||||
"Store a link to an Org-roam file or heading."
|
||||
|
|
@ -1082,6 +1087,212 @@ This function hooks into `org-open-at-point' via
|
|||
(t
|
||||
nil)))))
|
||||
|
||||
;;; Completion at point
|
||||
(defconst org-roam-open-bracket-regexp
|
||||
"\\[\\[\\([^\]]*\\)")
|
||||
|
||||
(defconst org-roam-title-headline-split-regexp
|
||||
"\\([^\*]*\\)\\(\*?\\)\\([^\]]*\\)")
|
||||
|
||||
(defun org-roam-complete-at-point ()
|
||||
"Do appropriate completion for the thing at point."
|
||||
(let ((end (point))
|
||||
start
|
||||
collection)
|
||||
(cond (;; In an open bracket
|
||||
(looking-back (concat "^.*" org-roam-open-bracket-regexp) (line-beginning-position))
|
||||
(setq start (match-beginning 1)
|
||||
end (match-end 1))
|
||||
(save-match-data
|
||||
(save-excursion
|
||||
(goto-char start)
|
||||
(when (looking-at org-roam-title-headline-split-regexp)
|
||||
(let ((title (match-string-no-properties 1))
|
||||
(has-headline-p (not (string-empty-p (match-string-no-properties 2))))
|
||||
(headline-start (match-beginning 3)))
|
||||
(cond (;; title and headline present
|
||||
(and (not (string-empty-p title))
|
||||
has-headline-p)
|
||||
(when-let ((file (org-roam--get-file-from-title title t)))
|
||||
(setq collection (apply-partially #'org-roam--get-headlines file))
|
||||
(setq start headline-start)))
|
||||
(;; Only title
|
||||
(not has-headline-p)
|
||||
(setq collection #'org-roam--get-titles))
|
||||
(;; Only headline
|
||||
(string-empty-p title)
|
||||
has-headline-p
|
||||
(setq collection #'org-roam--get-headlines)
|
||||
(setq start headline-start)))))))))
|
||||
(when collection
|
||||
(let ((prefix (buffer-substring-no-properties start end)))
|
||||
(list start end
|
||||
(if (functionp collection)
|
||||
(completion-table-dynamic
|
||||
(lambda (_)
|
||||
(cl-remove-if (apply-partially 'string= prefix) (funcall collection))))
|
||||
collection)
|
||||
'ignore)))))
|
||||
|
||||
;;; Fuzzy Links
|
||||
;;TODO: Fully implement fuzzy link replacement (on navigation, and on save)
|
||||
(defcustom org-roam-auto-replace-fuzzy-links nil
|
||||
"Whether to replace Org-roam's fuzzy links with true file or id links.
|
||||
Doesn't currently work fully, please don't turn it on."
|
||||
:group 'org-roam
|
||||
:type 'boolean)
|
||||
|
||||
(defun org-roam--split-fuzzy-link (link)
|
||||
"Splits LINK into title and headline.
|
||||
Return a list of the form (title has-headline-p headline), nil otherwise."
|
||||
(save-match-data
|
||||
(when (string-match org-roam-title-headline-split-regexp link)
|
||||
(list (match-string-no-properties 1 link)
|
||||
(not (string-empty-p (match-string-no-properties 2 link)))
|
||||
(match-string-no-properties 3 link)))))
|
||||
|
||||
(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)))
|
||||
(bol-regex (concat "^\\(?:" outline-regexp "\\)"))
|
||||
(outline-title-fn (lambda () (buffer-substring-no-properties (point) (line-end-position))))
|
||||
(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 bol-regex nil t)
|
||||
(save-excursion
|
||||
(setq name (or (save-match-data
|
||||
(funcall outline-title-fn))
|
||||
""))
|
||||
(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--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 (bound-and-true-p org-roam-mode)
|
||||
(org-roam--org-roam-file-p))
|
||||
(let ((splits (org-roam--split-fuzzy-link link))
|
||||
loc loc-type desc target)
|
||||
(when splits
|
||||
(pcase-let ((`(,title ,has-headline-p ,headline) splits))
|
||||
(cond (;; title and headline present
|
||||
(and (not (string-empty-p title))
|
||||
has-headline-p)
|
||||
(let ((file (org-roam--get-file-from-title title)))
|
||||
(if (not file)
|
||||
(org-roam-message "Cannot find matching file")
|
||||
(setq loc (org-roam--get-id-from-headline headline file))
|
||||
(pcase loc
|
||||
(`(,marker . ,target-id)
|
||||
(setq loc marker
|
||||
target target-id
|
||||
loc-type "id"
|
||||
desc headline))
|
||||
(_ (org-roam-message "cannot find matching id"))))))
|
||||
(;; Only title
|
||||
(not has-headline-p)
|
||||
(setq loc (org-roam--get-file-from-title title)
|
||||
target loc
|
||||
loc-type "file")
|
||||
(when loc (setq loc (file-relative-name loc))))
|
||||
(;; Only headline
|
||||
(and (string-empty-p title)
|
||||
has-headline-p)
|
||||
(setq loc (org-roam--get-id-from-headline headline))
|
||||
(pcase loc
|
||||
(`(,marker . ,target-id)
|
||||
(setq loc marker
|
||||
target target-id
|
||||
desc headline
|
||||
loc-type "id"))
|
||||
(_ (org-roam-message "Cannot find matching headline")))))
|
||||
(cond ((and (not loc)
|
||||
(string-equal loc-type "file"))
|
||||
(org-roam-find-file title nil nil t)))
|
||||
(when loc
|
||||
(when org-roam-auto-replace-fuzzy-links
|
||||
(org-roam-replace-fuzzy-link (concat loc-type ":" target) desc))
|
||||
(pcase loc-type
|
||||
("file"
|
||||
(org-roam--find-file loc))
|
||||
("id"
|
||||
(org-goto-marker-or-bmk loc))))))
|
||||
t)))
|
||||
|
||||
;;; Org-roam-mode
|
||||
;;;; Function Faces
|
||||
;; These faces are used by `org-link-set-parameters', which take one argument,
|
||||
|
|
@ -1155,6 +1366,7 @@ file."
|
|||
(setq org-roam-last-window (get-buffer-window))
|
||||
(add-hook 'post-command-hook #'org-roam-buffer--update-maybe nil t)
|
||||
(add-hook 'after-save-hook #'org-roam-db--update-file nil t)
|
||||
(add-hook 'completion-at-point-functions #'org-roam-complete-at-point nil t)
|
||||
(org-roam-buffer--update-maybe :redisplay t)))
|
||||
|
||||
(defun org-roam--delete-file-advice (file &optional _trash)
|
||||
|
|
@ -1305,6 +1517,7 @@ 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)
|
||||
(advice-add 'rename-file :after #'org-roam--rename-file-advice)
|
||||
(advice-add 'delete-file :before #'org-roam--delete-file-advice)
|
||||
(when (fboundp 'org-link-set-parameters)
|
||||
|
|
@ -1316,6 +1529,7 @@ 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)
|
||||
(advice-remove 'rename-file #'org-roam--rename-file-advice)
|
||||
(advice-remove 'delete-file #'org-roam--delete-file-advice)
|
||||
(when (fboundp 'org-link-set-parameters)
|
||||
|
|
@ -1349,20 +1563,23 @@ M-x info for more information at Org-roam > Installation > Post-Installation Tas
|
|||
(insert (format "- Org-roam: %s" (org-roam-version)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun org-roam-find-file (&optional initial-prompt completions filter-fn)
|
||||
(defun org-roam-find-file (&optional initial-prompt completions filter-fn no-confirm)
|
||||
"Find and open an Org-roam file.
|
||||
INITIAL-PROMPT is the initial title prompt.
|
||||
COMPLETIONS is a list of completions to be used instead of
|
||||
`org-roam--get-title-path-completions`.
|
||||
FILTER-FN is the name of a function to apply on the candidates
|
||||
which takes as its argument an alist of path-completions. See
|
||||
`org-roam--get-title-path-completions' for details."
|
||||
`org-roam--get-title-path-completions' for details.
|
||||
If NO-CONFIRM, assume that the user does not want to modify the initial prompt."
|
||||
(interactive)
|
||||
(unless org-roam-mode (org-roam-mode))
|
||||
(let* ((completions (funcall (or filter-fn #'identity)
|
||||
(or completions (org-roam--get-title-path-completions))))
|
||||
(title-with-tags (org-roam-completion--completing-read "File: " completions
|
||||
:initial-input initial-prompt))
|
||||
(title-with-tags (if no-confirm
|
||||
initial-prompt
|
||||
(org-roam-completion--completing-read "File: " completions
|
||||
:initial-input initial-prompt)))
|
||||
(res (cdr (assoc title-with-tags completions)))
|
||||
(file-path (plist-get res :path)))
|
||||
(if file-path
|
||||
|
|
|
|||
|
|
@ -259,6 +259,24 @@
|
|||
`(["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"
|
||||
(it "title"
|
||||
(expect (org-roam--split-fuzzy-link "title")
|
||||
:to-equal
|
||||
'("title" nil "")))
|
||||
(it "title*"
|
||||
(expect (org-roam--split-fuzzy-link "title*")
|
||||
:to-equal
|
||||
'("title" t "")))
|
||||
(it "title*headline"
|
||||
(expect (org-roam--split-fuzzy-link "title*headline")
|
||||
:to-equal
|
||||
'("title" t "headline")))
|
||||
(it "*headline"
|
||||
(expect (org-roam--split-fuzzy-link "*headline")
|
||||
:to-equal
|
||||
'("" t "headline"))))
|
||||
|
||||
;;; Tests
|
||||
(xdescribe "org-roam-db-build-cache"
|
||||
(before-each
|
||||
|
|
|
|||
Loading…
Reference in a new issue