(fix): fix fuzzy link completions (#1022)

This commit is contained in:
Jethro Kuan
2020-08-10 15:38:17 +08:00
committed by GitHub
parent 8c442a72de
commit 9753ee451f
2 changed files with 67 additions and 65 deletions

View File

@ -1089,11 +1089,14 @@ This function hooks into `org-open-at-point' via
nil))))) nil)))))
;;; Completion at point ;;; Completion at point
(defconst org-roam-open-bracket-regexp (defconst org-roam-fuzzy-link-regexp
"\\[\\[\\([^\]]*\\)") (rx (seq "[["
(group
(defconst org-roam-title-headline-split-regexp (zero-or-more
"\\([^\*]*\\)\\(\*?\\)\\([^\]]*\\)") (or (not (any "[]\\"))
(and "\\" (zero-or-more "\\\\") (any "[]"))
(and (one-or-more "\\") (not (any "[]"))))))
"]]")))
(defun org-roam-complete-at-point () (defun org-roam-complete-at-point ()
"Do appropriate completion for the thing at point." "Do appropriate completion for the thing at point."
@ -1112,41 +1115,31 @@ This function hooks into `org-open-at-point' via
exit-fn (lambda (str _status) exit-fn (lambda (str _status)
(delete-char (- (length str))) (delete-char (- (length str)))
(insert "\"" str "\"")))) (insert "\"" str "\""))))
(;; In an open bracket (;; In a fuzzy link
(looking-back (concat "^.*" org-roam-open-bracket-regexp) (line-beginning-position)) (org-in-regexp org-roam-fuzzy-link-regexp)
(setq start (match-beginning 1) (setq start (match-beginning 1)
end (match-end 1)) end (match-end 1))
(save-match-data (pcase-let ((`(,type ,title _ ,star-idx)
(save-excursion (org-roam--split-fuzzy-link (match-string-no-properties 1))))
(goto-char start) (pcase type
(when (looking-at (concat org-roam-title-headline-split-regexp "\]\]")) ('title+headline
(let ((title (match-string-no-properties 1)) (when-let ((file (org-roam--get-file-from-title title t)))
(has-headline-p (not (string-empty-p (match-string-no-properties 2)))) (setq collection (apply-partially #'org-roam--get-headlines file))
(headline-start (match-beginning 3))) (setq start (+ start star-idx 1))))
(cond (;; title and headline present ('title
(and (not (string-empty-p title)) (setq collection #'org-roam--get-titles))
has-headline-p) ('headline
(when-let ((file (org-roam--get-file-from-title title t))) (setq collection #'org-roam--get-headlines)
(setq collection (apply-partially #'org-roam--get-headlines file)) (setq start (+ start star-idx 1)))))))
(setq start headline-start))) (when collection
(;; Only title (let ((prefix (buffer-substring-no-properties start end)))
(not has-headline-p) (list start end
(setq collection #'org-roam--get-titles)) (if (functionp collection)
(;; Only headline (completion-table-dynamic
(string-empty-p title) (lambda (_)
has-headline-p (cl-remove-if (apply-partially 'string= prefix) (funcall collection))))
(setq collection #'org-roam--get-headlines) collection)
(setq start headline-start))))))))) :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
'ignore)))))
;;; Fuzzy Links ;;; Fuzzy Links
(defcustom org-roam-auto-replace-fuzzy-links t (defcustom org-roam-auto-replace-fuzzy-links t
@ -1156,12 +1149,23 @@ This function hooks into `org-open-at-point' via
(defun org-roam--split-fuzzy-link (link) (defun org-roam--split-fuzzy-link (link)
"Splits LINK into title and headline. "Splits LINK into title and headline.
Return a list of the form (title has-headline-p headline), nil otherwise." 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 (save-match-data
(when (string-match org-roam-title-headline-split-regexp link) (let* ((star-index (string-match-p "\\*" link))
(list (match-string-no-properties 1 link) (title (substring-no-properties link 0 star-index))
(not (string-empty-p (match-string-no-properties 2 link))) (headline (if star-index
(match-string-no-properties 3 link))))) (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 () (defun org-roam--get-titles ()
"Return all titles within Org-roam." "Return all titles within Org-roam."
@ -1248,14 +1252,11 @@ nil is returned if there is no matching location.
link-type is either \"file\" or \"id\". link-type is either \"file\" or \"id\".
loc is the target location: e.g. a file path, or an id. loc is the target location: e.g. a file path, or an id.
marker is a marker to the headline, if applicable." marker is a marker to the headline, if applicable."
(let ((splits (org-roam--split-fuzzy-link link)) (let (mkr link-type desc loc)
mkr link-type desc loc) (pcase-let ((`(,type ,title ,headline _) (org-roam--split-fuzzy-link link)))
(when splits (pcase type
(pcase-let ((`(,title ,has-headline-p ,headline) splits)) ('title+headline
(cond (;; title and headline present (let ((file (org-roam--get-file-from-title title)))
(and (not (string-empty-p title))
has-headline-p)
(let ((file (org-roam--get-file-from-title title)))
(if (not file) (if (not file)
(org-roam-message "Cannot find matching file") (org-roam-message "Cannot find matching file")
(setq mkr (org-roam--get-id-from-headline headline file)) (setq mkr (org-roam--get-id-from-headline headline file))
@ -1266,24 +1267,21 @@ marker is a marker to the headline, if applicable."
link-type "id" link-type "id"
desc headline)) desc headline))
(_ (org-roam-message "cannot find matching id")))))) (_ (org-roam-message "cannot find matching id"))))))
(;; Only title ('title
(not has-headline-p) (setq loc (org-roam--get-file-from-title title)
(setq loc (org-roam--get-file-from-title title)
desc title desc title
link-type "file") link-type "file")
(when loc (setq loc (file-relative-name loc)))) (when loc (setq loc (file-relative-name loc))))
(;; Only headline ('headline
(and (string-empty-p title) (setq mkr (org-roam--get-id-from-headline headline))
has-headline-p) (pcase mkr
(setq mkr (org-roam--get-id-from-headline headline))
(pcase mkr
(`(,marker . ,target-id) (`(,marker . ,target-id)
(setq mkr marker (setq mkr marker
loc target-id loc target-id
desc headline desc headline
link-type "id")) link-type "id"))
(_ (org-roam-message "Cannot find matching headline"))))) (_ (org-roam-message "Cannot find matching headline")))))
(list link-type loc desc mkr))))) (list link-type loc desc mkr))))
(defun org-roam--open-fuzzy-link (link) (defun org-roam--open-fuzzy-link (link)
"Open a Org fuzzy LINK. "Open a Org fuzzy LINK.

View File

@ -260,22 +260,26 @@
["801b58eb-97e2-435f-a33e-ff59a2f0c213" ,(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 fuzzy links"
(it ""
(expect (org-roam--split-fuzzy-link "")
:to-equal
'(title "" "" nil)))
(it "title" (it "title"
(expect (org-roam--split-fuzzy-link "title") (expect (org-roam--split-fuzzy-link "title")
:to-equal :to-equal
'("title" nil ""))) '(title "title" "" nil)))
(it "title*" (it "title*"
(expect (org-roam--split-fuzzy-link "title*") (expect (org-roam--split-fuzzy-link "title*")
:to-equal :to-equal
'("title" t ""))) '(title+headline "title" "" 5)))
(it "title*headline" (it "title*headline"
(expect (org-roam--split-fuzzy-link "title*headline") (expect (org-roam--split-fuzzy-link "title*headline")
:to-equal :to-equal
'("title" t "headline"))) '(title+headline "title" "headline" 5)))
(it "*headline" (it "*headline"
(expect (org-roam--split-fuzzy-link "*headline") (expect (org-roam--split-fuzzy-link "*headline")
:to-equal :to-equal
'("" t "headline")))) '(headline "" "headline" 0))))
;;; Tests ;;; Tests
(xdescribe "org-roam-db-build-cache" (xdescribe "org-roam-db-build-cache"