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): cache all link-types (#1009)

Browse Source 
Co-authored-by: Jethro Kuan <jethrokuan95@gmail.com>
This commit is contained in:
odomanov
2020-08-10 14:59:02 +07:00
committed by GitHub
parent 9753ee451f
commit 0318983cac
3 changed files with 65 additions and 61 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
org-roam-capture.el
View File

@ -340,11 +340,12 @@ the capture)."
(when region (when region
(delete-region (car region) (cdr region))) (delete-region (car region) (cdr region)))
(let ((path (org-roam-capture--get :file-path)) (let ((path (org-roam-capture--get :file-path))
(type (org-roam-capture--get :link-type))
(desc (org-roam-capture--get :link-description))) (desc (org-roam-capture--get :link-description)))
(if (eq (point) (marker-position mkr)) (if (eq (point) (marker-position mkr))
(insert (org-roam--format-link path desc)) (insert (org-roam--format-link path desc type))
(org-with-point-at mkr (org-with-point-at mkr
(insert (org-roam--format-link path desc)))))))))) (insert (org-roam--format-link path desc type))))))))))
(when region (when region
(set-marker beg nil) (set-marker beg nil)
(set-marker end nil)) (set-marker end nil))

4
org-roam-db.el
View File

@ -329,7 +329,7 @@ Insertions can fail if the key is already in the database."
If the file does not have any connections, nil is returned." If the file does not have any connections, nil is returned."
(let* ((query "WITH RECURSIVE (let* ((query "WITH RECURSIVE
links_of(file, link) AS links_of(file, link) AS
(WITH filelinks AS (SELECT * FROM links WHERE \"type\" = '\"file\"'), (WITH filelinks AS (SELECT * FROM links WHERE NOT \"type\" = '\"cite\"'),
citelinks AS (SELECT * FROM links citelinks AS (SELECT * FROM links
JOIN refs ON links.\"to\" = refs.\"ref\" JOIN refs ON links.\"to\" = refs.\"ref\"
AND links.\"type\" = '\"cite\"') AND links.\"type\" = '\"cite\"')
@ -351,7 +351,7 @@ This includes the file itself. If the file does not have any
connections, nil is returned." connections, nil is returned."
(let* ((query "WITH RECURSIVE (let* ((query "WITH RECURSIVE
links_of(file, link) AS links_of(file, link) AS
(WITH filelinks AS (SELECT * FROM links WHERE \"type\" = '\"file\"'), (WITH filelinks AS (SELECT * FROM links WHERE NOT \"type\" = '\"cite\"'),
citelinks AS (SELECT * FROM links citelinks AS (SELECT * FROM links
JOIN refs ON links.\"to\" = refs.\"ref\" JOIN refs ON links.\"to\" = refs.\"ref\"
AND links.\"type\" = '\"cite\"') AND links.\"type\" = '\"cite\"')

117
org-roam.el
View File

@ -258,19 +258,19 @@ space-delimited strings.
This is set by `org-roam--with-temp-buffer', to allow throwing of This is set by `org-roam--with-temp-buffer', to allow throwing of
descriptive warnings when certain operations fail (e.g. parsing).") descriptive warnings when certain operations fail (e.g. parsing).")
(defvar org-roam--org-link-file-bracket-re (defvar org-roam--org-link-bracket-typed-re
(rx "[[file:" (seq (group (one-or-more (or (not (any "]" "[" "\\")) (rx (seq "[["
(seq "\\" (group (+? anything))
(zero-or-more "\\\\") ":"
(any "[" "]")) (group
(seq (one-or-more "\\") (one-or-more
(not (any "]" "[")))))) (or (not (any "[]\\"))
"]" (and "\\" (zero-or-more "\\\\") (any "[]"))
(zero-or-one (seq "[" (and (one-or-more "\\") (not (any "[]"))))))
(group (+? anything)) "]"
"]")) (opt "[" (group (+? anything)) "]")
"]")) "]"))
"Matches a 'file:' link in double brackets.") "Matches a typed link in double brackets.")
;;;; Utilities ;;;; Utilities
(defun org-roam--plist-to-alist (plist) (defun org-roam--plist-to-alist (plist)
@ -489,20 +489,20 @@ The search terminates when the first property is encountered."
"Crawl CONTENT for relative links and expand them. "Crawl CONTENT for relative links and expand them.
PATH should be the root from which to compute the relativity." PATH should be the root from which to compute the relativity."
(let ((dir (file-name-directory path)) (let ((dir (file-name-directory path))
(re org-roam--org-link-file-bracket-re) link link-type)
link)
(with-temp-buffer (with-temp-buffer
(insert content) (insert content)
(goto-char (point-min)) (goto-char (point-min))
;; Loop over links ;; Loop over links
(while (re-search-forward re (point-max) t) (while (re-search-forward org-roam--org-link-bracket-typed-re (point-max) t)
(goto-char (match-beginning 1)) (goto-char (match-beginning 2))
;; Strip 'file:' (setq link-type (match-string 1)
(setq link (match-string 1)) link (match-string 2))
;; Delete relative link ;; Delete relative link
(when (f-relative-p link) (when (and (member link-type '("file")) ; TODO: Fix this
(delete-region (match-beginning 1) (f-relative-p link))
(match-end 1)) (delete-region (match-beginning 2)
(match-end 2))
(insert (expand-file-name link dir)))) (insert (expand-file-name link dir))))
(buffer-string)))) (buffer-string))))
@ -580,10 +580,6 @@ it as FILE-PATH."
:content content :content content
:point begin)) :point begin))
(names (pcase type (names (pcase type
("file"
(if (file-remote-p path)
(list path)
(list (file-truename (expand-file-name path (file-name-directory file-path))))))
("id" ("id"
(list (car (org-roam-id-find path)))) (list (car (org-roam-id-find path))))
((pred (lambda (typ) ((pred (lambda (typ)
@ -592,7 +588,13 @@ it as FILE-PATH."
(setq type "cite") (setq type "cite")
(org-ref-split-and-strip-string path)) (org-ref-split-and-strip-string path))
("fuzzy" (list path)) ("fuzzy" (list path))
(_ (list (org-element-property :raw-link link)))))) (_ (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))))))))
(seq-do (lambda (name) (seq-do (lambda (name)
(when name (when name
(push (vector file-path (push (vector file-path
@ -795,14 +797,16 @@ Examples:
(slug (-reduce-from #'cl-replace (strip-nonspacing-marks title) pairs))) (slug (-reduce-from #'cl-replace (strip-nonspacing-marks title) pairs)))
(downcase slug)))) (downcase slug))))
(defun org-roam--format-link-title (title) (defun org-roam--format-link-title (title &optional type)
"Return the link title, given the file TITLE." "Return the link title, given the file TITLE.
If `org-roam-link-title-format title' is defined, use it with TYPE."
(if (functionp org-roam-link-title-format) (if (functionp org-roam-link-title-format)
(funcall org-roam-link-title-format title) (funcall org-roam-link-title-format title type)
(format org-roam-link-title-format title))) (format org-roam-link-title-format title)))
(defun org-roam--format-link (target &optional description) (defun org-roam--format-link (target &optional description type)
"Formats an org link for a given file TARGET and link DESCRIPTION." "Formats an org link for a given file TARGET, link DESCRIPTION and link TYPE.
TYPE defaults to \"file\"."
(let* ((here (ignore-errors (let* ((here (ignore-errors
(-> (or (buffer-base-buffer) (-> (or (buffer-base-buffer)
(current-buffer)) (current-buffer))
@ -810,9 +814,9 @@ Examples:
(file-truename) (file-truename)
(file-name-directory))))) (file-name-directory)))))
(org-link-make-string (org-link-make-string
(concat "file:" (if here (concat (or type "file") ":" (if here
(file-relative-name target here) (file-relative-name target here)
target)) target))
description))) description)))
(defun org-roam--get-title-path-completions () (defun org-roam--get-title-path-completions ()
@ -970,8 +974,8 @@ buffer or a marker."
(type (org-element-property :type context)) (type (org-element-property :type context))
(dest (org-element-property :path context))) (dest (org-element-property :path context)))
(pcase type (pcase type
("file" dest) ("id" (car (org-roam-id-find dest)))
("id" (car (org-roam-id-find dest)))))))) (_ dest))))))
(defun org-roam--backlink-to-current-p () (defun org-roam--backlink-to-current-p ()
"Return t if backlink is to the current Org-roam file." "Return t if backlink is to the current Org-roam file."
@ -988,10 +992,8 @@ This function hooks into `org-open-at-point' via `org-open-at-point-functions'."
(cond (cond
;; Org-roam link ;; Org-roam link
((let* ((context (org-element-context)) ((let* ((context (org-element-context))
(type (org-element-property :type context))
(path (org-element-property :path context))) (path (org-element-property :path context)))
(when (and (eq (org-element-type context) 'link) (when (and (eq (org-element-type context) 'link)
(string= "file" type)
(org-roam--org-roam-file-p (file-truename path))) (org-roam--org-roam-file-p (file-truename path)))
(org-roam-buffer--find-file path) (org-roam-buffer--find-file path)
(org-show-context) (org-show-context)
@ -1431,12 +1433,12 @@ update with NEW-DESC."
(lambda (l) (lambda (l)
(let ((type (org-element-property :type l)) (let ((type (org-element-property :type l))
(path (org-element-property :path l))) (path (org-element-property :path l)))
(when (and (equal "file" type) (when (string-equal (file-truename path)
(string-equal (file-truename path) old-path)
old-path)) (cons (set-marker (make-marker) (org-element-property :begin l))
(set-marker (make-marker) (org-element-property :begin l)))))))) type)))))))
(dolist (m link-markers) (dolist (m link-markers)
(goto-char m) (goto-char (car m))
(save-match-data (save-match-data
(unless (org-in-regexp org-link-bracket-re 1) (unless (org-in-regexp org-link-bracket-re 1)
(user-error "No link at point")) (user-error "No link at point"))
@ -1447,7 +1449,8 @@ update with NEW-DESC."
new-desc new-desc
label))) label)))
(replace-match (org-link-make-string (replace-match (org-link-make-string
(concat "file:" (file-relative-name new-path (file-name-directory (buffer-file-name)))) (concat (cdr m) ":"
(file-relative-name new-path (file-name-directory (buffer-file-name))))
new-label))))))) new-label)))))))
(save-buffer))) (save-buffer)))
@ -1459,21 +1462,20 @@ replaced links are made relative to the current buffer."
(lambda (link) (lambda (link)
(let ((type (org-element-property :type link)) (let ((type (org-element-property :type link))
(path (org-element-property :path link))) (path (org-element-property :path link)))
(when (and (equal "file" type) (when (f-relative-p path)
(f-relative-p path))
(cons (set-marker (make-marker) (cons (set-marker (make-marker)
(org-element-property :begin link)) (org-element-property :begin link))
path))))))) (cons path type))))))))
(save-excursion (save-excursion
(save-match-data (save-match-data
(dolist (link links) (dolist (link links)
(pcase-let ((`(,marker . ,path) link)) (pcase-let ((`(,marker . (,path . ,type)) link))
(goto-char marker) (goto-char marker)
(unless (org-in-regexp org-link-bracket-re 1) (unless (org-in-regexp org-link-bracket-re 1)
(user-error "No link at point")) (user-error "No link at point"))
(let* ((file-path (expand-file-name path (file-name-directory old-path))) (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))))) (new-path (file-relative-name file-path (file-name-directory (buffer-file-name)))))
(replace-match (concat "file:" new-path) (replace-match (concat type ":" new-path)
nil t nil 1)) nil t nil 1))
(set-marker marker nil))))))) (set-marker marker nil)))))))
@ -1500,10 +1502,8 @@ replaced links are made relative to the current buffer."
(find-file-noselect new-path))) (find-file-noselect new-path)))
(files-to-rename (org-roam-db-query [:select :distinct [from] (files-to-rename (org-roam-db-query [:select :distinct [from]
:from links :from links
:where (= to $s1) :where (= to $s1)]
:and (= type $s2)] old-path)))
old-path
"file")))
;; Remove database entries for old-file.org ;; Remove database entries for old-file.org
(org-roam-db--clear-file old-file) (org-roam-db--clear-file old-file)
;; Insert new headlines locations in new-file.org after removing the previous IDs ;; Insert new headlines locations in new-file.org after removing the previous IDs
@ -1669,9 +1669,10 @@ included as a candidate."
(find-file (seq-random-elt (org-roam--list-all-files)))) (find-file (seq-random-elt (org-roam--list-all-files))))
;;;###autoload ;;;###autoload
(defun org-roam-insert (&optional lowercase completions filter-fn description) (defun org-roam-insert (&optional lowercase completions filter-fn description link-type)
"Find an Org-roam file, and insert a relative org link to it at point. "Find an Org-roam file, and insert a relative org link to it at point.
Return selected file if it exists. Return selected file if it exists.
LINK-TYPE is the type of link to be created. It defaults to \"file\".
If LOWERCASE, downcase the title before insertion. If LOWERCASE, downcase the title before insertion.
COMPLETIONS is a list of completions to be used instead of COMPLETIONS is a list of completions to be used instead of
`org-roam--get-title-path-completions`. `org-roam--get-title-path-completions`.
@ -1705,20 +1706,22 @@ If DESCRIPTION is provided, use this as the link label. See
(description (or description region-text title)) (description (or description region-text title))
(link-description (org-roam--format-link-title (if lowercase (link-description (org-roam--format-link-title (if lowercase
(downcase description) (downcase description)
description)))) description)
link-type)))
(cond ((and target-file-path (cond ((and target-file-path
(file-exists-p target-file-path)) (file-exists-p target-file-path))
(when region-text (when region-text
(delete-region beg end) (delete-region beg end)
(set-marker beg nil) (set-marker beg nil)
(set-marker end nil)) (set-marker end nil))
(insert (org-roam--format-link target-file-path link-description))) (insert (org-roam--format-link target-file-path link-description link-type)))
(t (t
(let ((org-roam-capture--info `((title . ,title-with-tags) (let ((org-roam-capture--info `((title . ,title-with-tags)
(slug . ,(funcall org-roam-title-to-slug-function title-with-tags)))) (slug . ,(funcall org-roam-title-to-slug-function title-with-tags))))
(org-roam-capture--context 'title)) (org-roam-capture--context 'title))
(setq org-roam-capture-additional-template-props (list :region (org-roam-shield-region beg end) (setq org-roam-capture-additional-template-props (list :region (org-roam-shield-region beg end)
:insert-at (point-marker) :insert-at (point-marker)
:link-type link-type
:link-description link-description :link-description link-description
:finalize 'insert-link)) :finalize 'insert-link))
(org-roam-capture--capture)))) (org-roam-capture--capture))))