mirror of
https://github.com/org-roam/org-roam
synced 2025-09-28 16:50:58 -05:00
(fix): fix non-fuzzy links being treated as fuzzy links (#1070)
Fuzzy links were initially detected as anything within double brackets. This could include code in source blocks. This PR introduces `(org-roam--fuzzy-link-p)`. This uses an additional check using the `org-element` API, and ensures that the link type is fuzzy (not a file: or https: link, for example). Fixes #1069, and an array of unreported bugs: 1. Link extraction into the database should no longer pick up false links (in code blocks, for example). 2. Link completion will only truly work within fuzzy links
This commit is contained in:
Jethro Kuan
GitHub
315
org-roam.el
315
org-roam.el
@@ -439,8 +439,8 @@ recursion."
|
||||
(if (eq predicate t)
|
||||
(condition-case nil
|
||||
(org-roam--directory-files-recursively
|
||||
full-file regexp include-directories
|
||||
predicate follow-symlinks)
|
||||
full-file regexp include-directories
|
||||
predicate follow-symlinks)
|
||||
(file-error nil))
|
||||
(org-roam--directory-files-recursively
|
||||
full-file regexp include-directories
|
||||
@@ -582,48 +582,44 @@ it as FILE-PATH."
|
||||
(unless file-path
|
||||
(setq file-path (file-truename (buffer-file-name))))
|
||||
(let (links)
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward org-link-any-re nil t)
|
||||
(save-excursion
|
||||
(goto-char (match-beginning 0))
|
||||
(let* ((link (org-element-link-parser))
|
||||
(type (org-element-property :type link))
|
||||
(path (org-element-property :path link))
|
||||
(element (org-element-at-point))
|
||||
(begin (or (org-element-property :content-begin element)
|
||||
(org-element-property :begin element)))
|
||||
(content (or (org-element-property :raw-value element)
|
||||
(buffer-substring-no-properties
|
||||
begin
|
||||
(or (org-element-property :content-end element)
|
||||
(org-element-property :end element)))))
|
||||
(content (string-trim content))
|
||||
(content (org-roam--expand-links content file-path))
|
||||
(properties (list :outline (mapcar (lambda (path)
|
||||
(org-roam--expand-links path file-path))
|
||||
(org-roam--get-outline-path))
|
||||
:content content
|
||||
:point begin))
|
||||
(names (pcase type
|
||||
("id"
|
||||
(list (car (org-roam-id-find path))))
|
||||
((pred (lambda (typ)
|
||||
(and (boundp 'org-ref-cite-types)
|
||||
(-contains? org-ref-cite-types typ))))
|
||||
(setq type "cite")
|
||||
(org-ref-split-and-strip-string path))
|
||||
("fuzzy" (list path))
|
||||
(_ (if (file-remote-p path)
|
||||
(list path)
|
||||
(let ((file-maybe (file-truename
|
||||
(expand-file-name path (file-name-directory file-path)))))
|
||||
(if (f-exists? file-maybe)
|
||||
(list file-maybe)
|
||||
(list path))))))))
|
||||
(dolist (name names)
|
||||
(when name
|
||||
(push (vector file-path name type properties) links)))))))
|
||||
(org-element-map (org-element-parse-buffer) 'link
|
||||
(lambda (link)
|
||||
(let* ((type (org-element-property :type link))
|
||||
(path (org-element-property :path link))
|
||||
(element (org-element-at-point))
|
||||
(begin (or (org-element-property :content-begin element)
|
||||
(org-element-property :begin element)))
|
||||
(content (or (org-element-property :raw-value element)
|
||||
(buffer-substring-no-properties
|
||||
begin
|
||||
(or (org-element-property :content-end element)
|
||||
(org-element-property :end element)))))
|
||||
(content (string-trim content))
|
||||
(content (org-roam--expand-links content file-path))
|
||||
(properties (list :outline (mapcar (lambda (path)
|
||||
(org-roam--expand-links path file-path))
|
||||
(org-roam--get-outline-path))
|
||||
:content content
|
||||
:point begin))
|
||||
(names (pcase type
|
||||
("id"
|
||||
(list (car (org-roam-id-find path))))
|
||||
((pred (lambda (typ)
|
||||
(and (boundp 'org-ref-cite-types)
|
||||
(-contains? org-ref-cite-types typ))))
|
||||
(setq type "cite")
|
||||
(org-ref-split-and-strip-string path))
|
||||
("fuzzy" (list path))
|
||||
(_ (if (file-remote-p path)
|
||||
(list path)
|
||||
(let ((file-maybe (file-truename
|
||||
(expand-file-name path (file-name-directory file-path)))))
|
||||
(if (f-exists? file-maybe)
|
||||
(list file-maybe)
|
||||
(list path))))))))
|
||||
(dolist (name names)
|
||||
(when name
|
||||
(push (vector file-path name type properties) links))))))
|
||||
links))
|
||||
|
||||
(defun org-roam--extract-headlines (&optional file-path)
|
||||
@@ -839,8 +835,8 @@ TYPE defaults to \"file\"."
|
||||
(file-name-directory)))))
|
||||
(org-roam-link-make-string
|
||||
(concat (or type "file") ":" (if here
|
||||
(file-relative-name target here)
|
||||
target))
|
||||
(file-relative-name target here)
|
||||
target))
|
||||
description)))
|
||||
|
||||
(defun org-roam--get-title-path-completions ()
|
||||
@@ -860,11 +856,11 @@ to the file."
|
||||
(dolist (row rows completions)
|
||||
(pcase-let ((`(,file-path ,title ,tags) row))
|
||||
(let ((k (concat
|
||||
(when tags
|
||||
(format "(%s) " (s-join org-roam-tag-separator tags)))
|
||||
title))
|
||||
(v (list :path file-path :title title)))
|
||||
(push (cons k v) completions))))))
|
||||
(when tags
|
||||
(format "(%s) " (s-join org-roam-tag-separator tags)))
|
||||
title))
|
||||
(v (list :path file-path :title title)))
|
||||
(push (cons k v) completions))))))
|
||||
|
||||
(defun org-roam--get-index-path ()
|
||||
"Return the path to the index in `org-roam-directory'.
|
||||
@@ -919,22 +915,22 @@ FILTER can either be a string or a function:
|
||||
(dolist (row rows completions)
|
||||
(pcase-let ((`(,type ,ref ,file-path ,title ,tags) row))
|
||||
(when (pcase filter
|
||||
('nil t)
|
||||
((pred stringp) (string= type filter))
|
||||
((pred functionp) (funcall filter type ref file-path))
|
||||
(wrong-type (signal 'wrong-type-argument
|
||||
`((stringp functionp)
|
||||
,wrong-type))))
|
||||
(let ((k (if (eq arg 1)
|
||||
(concat
|
||||
(when org-roam-include-type-in-ref-path-completions
|
||||
(format "{%s} " type))
|
||||
(when tags
|
||||
(format "(%s) " (s-join org-roam-tag-separator tags)))
|
||||
(format "%s (%s)" title ref))
|
||||
ref))
|
||||
(v (list :path file-path :type type :ref ref)))
|
||||
(push (cons k v) completions)))))))
|
||||
('nil t)
|
||||
((pred stringp) (string= type filter))
|
||||
((pred functionp) (funcall filter type ref file-path))
|
||||
(wrong-type (signal 'wrong-type-argument
|
||||
`((stringp functionp)
|
||||
,wrong-type))))
|
||||
(let ((k (if (eq arg 1)
|
||||
(concat
|
||||
(when org-roam-include-type-in-ref-path-completions
|
||||
(format "{%s} " type))
|
||||
(when tags
|
||||
(format "(%s) " (s-join org-roam-tag-separator tags)))
|
||||
(format "%s (%s)" title ref))
|
||||
ref))
|
||||
(v (list :path file-path :type type :ref ref)))
|
||||
(push (cons k v) completions)))))))
|
||||
|
||||
(defun org-roam--find-file (file)
|
||||
"Open FILE using `org-roam-find-file-function' or `find-file'."
|
||||
@@ -1057,10 +1053,10 @@ citation key, for Org-ref cite links."
|
||||
:link (format "file:%s" (abbreviate-file-name buffer-file-name))
|
||||
:description (car titles)))
|
||||
(let ((id (org-id-get)))
|
||||
(org-id-store-link)
|
||||
;; If :ID: was created, update the cache
|
||||
(unless id
|
||||
(org-roam-db--update-headlines))))))
|
||||
(org-id-store-link)
|
||||
;; If :ID: was created, update the cache
|
||||
(unless id
|
||||
(org-roam-db--update-headlines))))))
|
||||
|
||||
(defun org-roam-id-find (id &optional markerp strict)
|
||||
"Return the location of the entry with the id ID.
|
||||
@@ -1120,16 +1116,6 @@ This function hooks into `org-open-at-point' via
|
||||
:group 'org-roam
|
||||
:type 'boolean)
|
||||
|
||||
(defconst org-roam-fuzzy-link-regexp
|
||||
(rx (seq "[["
|
||||
(group
|
||||
(zero-or-more
|
||||
(or (not (any "[]\\"))
|
||||
(and "\\" (zero-or-more "\\\\") (any "[]"))
|
||||
(and (one-or-more "\\") (not (any "[]"))))))
|
||||
"]]"))
|
||||
"Regexp identifying a bracketed Org fuzzy link.")
|
||||
|
||||
(defun org-roam-complete-at-point ()
|
||||
"Do appropriate completion for the thing at point."
|
||||
(let ((end (point))
|
||||
@@ -1147,12 +1133,14 @@ This function hooks into `org-open-at-point' via
|
||||
exit-fn (lambda (str _status)
|
||||
(delete-char (- (length str)))
|
||||
(insert "\"" str "\""))))
|
||||
|
||||
(;; In a fuzzy link
|
||||
(org-in-regexp org-roam-fuzzy-link-regexp)
|
||||
(setq start (match-beginning 1)
|
||||
end (match-end 1))
|
||||
(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 1))))
|
||||
(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)))
|
||||
@@ -1163,6 +1151,11 @@ This function hooks into `org-open-at-point' via
|
||||
('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
|
||||
(thing-at-point 'word))
|
||||
@@ -1173,16 +1166,16 @@ This function hooks into `org-open-at-point' via
|
||||
exit-fn (lambda (str _status)
|
||||
(delete-char (- (length str)))
|
||||
(insert "[[" str "]]"))))))
|
||||
(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)
|
||||
:exit-function exit-fn)))))
|
||||
(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)
|
||||
:exit-function exit-fn)))))
|
||||
|
||||
;;; Fuzzy Links
|
||||
(defcustom org-roam-auto-replace-fuzzy-links t
|
||||
@@ -1190,6 +1183,21 @@ This function hooks into `org-open-at-point' via
|
||||
: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).
|
||||
@@ -1204,9 +1212,9 @@ star-idx is the index of the asterisk, if any."
|
||||
(substring-no-properties link (+ 1 star-index))
|
||||
""))
|
||||
(type (cond ((not star-index)
|
||||
'title)
|
||||
'title)
|
||||
((= 0 star-index)
|
||||
'headline)
|
||||
'headline)
|
||||
(t 'title+headline))))
|
||||
(list type title headline star-index))))
|
||||
|
||||
@@ -1258,8 +1266,8 @@ If USE-STACK, include the parent paths as well."
|
||||
"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)))))
|
||||
:where (= titles:title $v1)]
|
||||
(vector title)))))
|
||||
(pcase files
|
||||
('nil nil)
|
||||
(`(,file) file)
|
||||
@@ -1296,30 +1304,30 @@ marker is a marker to the headline, if applicable."
|
||||
(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"))))))
|
||||
(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")
|
||||
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")))))
|
||||
(`(,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)
|
||||
@@ -1353,21 +1361,22 @@ Three types of fuzzy links are supported:
|
||||
(org-goto-marker-or-bmk mkr)))))
|
||||
t))
|
||||
|
||||
(defun org-roam--replace-all-fuzzy-links ()
|
||||
(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-roam-fuzzy-link-regexp nil t)
|
||||
(goto-char (match-beginning 0))
|
||||
(when-let ((location (org-roam--get-fuzzy-link-location (match-string 1))))
|
||||
(pcase-let ((`(,link-type ,loc ,desc _) location))
|
||||
(when (and link-type loc)
|
||||
(org-roam-replace-fuzzy-link (concat link-type ":" loc) desc)))))))
|
||||
(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 org-roam-auto-replace-fuzzy-links
|
||||
(org-roam--replace-all-fuzzy-links)))
|
||||
(org-roam-replace-all-fuzzy-links)))
|
||||
|
||||
;;; Org-roam-mode
|
||||
;;;; Function Faces
|
||||
@@ -1397,7 +1406,7 @@ currently opened Org-roam file in the backlink buffer, or
|
||||
`org-roam-link-face' if PATH corresponds to any other Org-roam
|
||||
file."
|
||||
(let* ((in-note (-> (buffer-file-name (buffer-base-buffer))
|
||||
(org-roam--org-roam-file-p)))
|
||||
(org-roam--org-roam-file-p)))
|
||||
(custom (or (and in-note org-roam-link-use-custom-faces)
|
||||
(eq org-roam-link-use-custom-faces 'everywhere))))
|
||||
(cond ((and custom
|
||||
@@ -1420,7 +1429,7 @@ currently opened Org-roam file in the backlink buffer, or
|
||||
`org-roam-link-face' if ID corresponds to any other Org-roam
|
||||
file."
|
||||
(let* ((in-note (-> (buffer-file-name (buffer-base-buffer))
|
||||
(org-roam--org-roam-file-p)))
|
||||
(org-roam--org-roam-file-p)))
|
||||
(custom (or (and in-note org-roam-link-use-custom-faces)
|
||||
(eq org-roam-link-use-custom-faces 'everywhere))))
|
||||
(cond ((and custom
|
||||
@@ -1486,23 +1495,21 @@ update with NEW-DESC."
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward org-link-any-re nil t)
|
||||
(let* ((link (save-excursion
|
||||
(goto-char (match-beginning 0))
|
||||
(org-element-link-parser)))
|
||||
(type (org-element-property :type link))
|
||||
(path (org-element-property :path link)))
|
||||
(when (and (string-equal (file-truename path) old-path)
|
||||
(org-in-regexp org-link-bracket-re 1))
|
||||
(let* ((label (if (match-end 2)
|
||||
(match-string-no-properties 2)
|
||||
(org-link-unescape (match-string-no-properties 1))))
|
||||
(new-label (if (string-equal label old-desc)
|
||||
new-desc
|
||||
label)))
|
||||
(replace-match (org-roam-link-make-string
|
||||
(concat type ":"
|
||||
(file-relative-name new-path (file-name-directory (buffer-file-name))))
|
||||
new-label)))))))
|
||||
(when-let ((link (org-element-lineage (org-element-context) '(link) t)))
|
||||
(let ((type (org-element-property :type link))
|
||||
(path (org-element-property :path link)))
|
||||
(when (and (string-equal (file-truename path) old-path)
|
||||
(org-in-regexp org-link-bracket-re 1))
|
||||
(let* ((label (if (match-end 2)
|
||||
(match-string-no-properties 2)
|
||||
(org-link-unescape (match-string-no-properties 1))))
|
||||
(new-label (if (string-equal label old-desc)
|
||||
new-desc
|
||||
label)))
|
||||
(replace-match (org-roam-link-make-string
|
||||
(concat type ":"
|
||||
(file-relative-name new-path (file-name-directory (buffer-file-name))))
|
||||
new-label))))))))
|
||||
(save-buffer)))
|
||||
|
||||
(defun org-roam--fix-relative-links (old-path)
|
||||
@@ -1512,17 +1519,15 @@ replaced links are made relative to the current buffer."
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward org-link-any-re nil t)
|
||||
(let* ((link (save-excursion
|
||||
(goto-char (match-beginning 0))
|
||||
(org-element-link-parser)))
|
||||
(type (org-element-property :type link))
|
||||
(path (org-element-property :path link)))
|
||||
(when (and (f-relative-p path)
|
||||
(org-in-regexp org-link-bracket-re 1))
|
||||
(let* ((file-path (expand-file-name path (file-name-directory old-path)))
|
||||
(new-path (file-relative-name file-path (file-name-directory (buffer-file-name)))))
|
||||
(when-let ((link (org-element-lineage (org-element-context) '(link) t)))
|
||||
(let ((type (org-element-property :type link))
|
||||
(path (org-element-property :path link)))
|
||||
(when (and (f-relative-p path)
|
||||
(org-in-regexp org-link-bracket-re 1))
|
||||
(let* ((file-path (expand-file-name path (file-name-directory old-path)))
|
||||
(new-path (file-relative-name file-path (file-name-directory (buffer-file-name)))))
|
||||
(replace-match (concat type ":" new-path)
|
||||
nil t nil 1)))))))
|
||||
nil t nil 1))))))))
|
||||
|
||||
(defun org-roam--rename-file-advice (old-file new-file-or-dir &rest _args)
|
||||
"Rename backlinks of OLD-FILE to refer to NEW-FILE-OR-DIR."
|
||||
@@ -1902,7 +1907,7 @@ linked, lest the network graph get too crowded."
|
||||
(let ((rowcol (concat row ":" col)))
|
||||
(insert "- "
|
||||
(org-roam-link-make-string (concat "file:" file "::" rowcol)
|
||||
(format "[%s] %s" rowcol (org-roam--get-title-or-slug file))))
|
||||
(format "[%s] %s" rowcol (org-roam--get-title-or-slug file))))
|
||||
(when (executable-find "sed") ; insert line contents when sed is available
|
||||
(insert " :: "
|
||||
(shell-command-to-string
|
||||
|
||||
Reference in New Issue
Block a user