(feat): clean up link expansions (#1157)

Adds `org-roam-link-file-path-type`, used for link path computation
wherever sensible. This includes in the org-roam backlinks buffer, and
in link replacement.

Also moves link expansion/fixing from cache build to Org-roam buffer
render time. This reduces cache build time, but makes buffer rendering
slightly slower.
This commit is contained in:
Jethro Kuan
2020-09-30 19:21:02 +08:00
committed by GitHub
parent 93d8c477fe
commit 369753c98b
3 changed files with 73 additions and 47 deletions

View File

@ -34,6 +34,7 @@
(require 'cl-lib)
(require 'dash)
(require 's)
(require 'f)
(defvar org-roam-directory)
(defvar org-link-frame-setup)
@ -42,6 +43,7 @@
(defvar org-roam-last-window)
(defvar org-ref-cite-types) ;; in org-ref-core.el
(defvar org-roam-mode)
(defvar org-roam--org-link-bracket-typed-re)
(declare-function org-roam-db--ensure-built "org-roam-db")
(declare-function org-roam--extract-ref "org-roam")
@ -51,6 +53,9 @@
(declare-function org-roam-backlinks-mode "org-roam")
(declare-function org-roam-mode "org-roam")
(declare-function org-roam--find-file "org-roam")
(declare-function org-roam--format-link "org-roam")
(declare-function org-roam-link-make-string "org-roam-compat")
(declare-function org-roam-link-get-path "org-roam-link")
(defcustom org-roam-buffer-position 'right
"Position of `org-roam' buffer.
@ -101,6 +106,7 @@ For example: (setq org-roam-buffer-window-parameters '((no-other-window . t)))"
(defun org-roam-buffer--find-file (file)
"Open FILE in the window `org-roam' was called from."
(setq file (expand-file-name file))
(if (and org-roam-last-window (window-valid-p org-roam-last-window))
(progn (with-selected-window org-roam-last-window
(org-roam--find-file file))
@ -124,6 +130,22 @@ For example: (setq org-roam-buffer-window-parameters '((no-other-window . t)))"
,wrong-type))))))
(concat string (when (> l 1) "s"))))
(defun org-roam-buffer-expand-links (content orig-path)
"Crawl CONTENT for relative links and corrects them to be correctly displayed.
ORIG-PATH is the path where the CONTENT originated."
(with-temp-buffer
(insert content)
(goto-char (point-min))
(let (link link-type)
(while (re-search-forward org-roam--org-link-bracket-typed-re (point-max) t)
(setq link-type (match-string 1)
link (match-string 2))
(when (and (string-equal link-type "file")
(f-relative-p link))
(replace-match (org-roam-link-get-path (expand-file-name link (file-name-directory orig-path)))
nil t nil 2))))
(buffer-string)))
(defun org-roam-buffer--insert-ref-links ()
"Insert ref backlinks for the current buffer."
(when-let ((path (cdr (with-temp-buffer
@ -138,12 +160,14 @@ For example: (setq org-roam-buffer-window-parameters '((no-other-window . t)))"
(dolist (group grouped-backlinks)
(let ((file-from (car group))
(bls (cdr group)))
(insert (format "** [[file:%s][%s]]\n"
file-from
(org-roam--get-title-or-slug file-from)))
(insert (org-roam-link-make-string)
(format "** %s\n"
(org-roam--format-link file-from
(org-roam--get-title-or-slug file-from)
"file")))
(dolist (backlink bls)
(pcase-let ((`(,file-from _ ,props) backlink))
(insert (propertize (plist-get props :content)
(insert (propertize (org-roam-buffer-expand-links (plist-get props :content) file-from)
'help-echo "mouse-1: visit backlinked note"
'file-from file-from
'file-from-point (plist-get props :point)))
@ -165,9 +189,10 @@ For example: (setq org-roam-buffer-window-parameters '((no-other-window . t)))"
(let ((file-from (car group))
(bls (mapcar (lambda (row)
(nth 2 row)) (cdr group))))
(insert (format "** [[file:%s][%s]]\n"
file-from
(org-roam--get-title-or-slug file-from)))
(insert (format "** %s\n"
(org-roam--format-link file-from
(org-roam--get-title-or-slug file-from)
"file")))
;; Sort backlinks according to time of occurrence in buffer
(setq bls (seq-sort-by (lambda (bl)
(plist-get bl :point))
@ -176,12 +201,14 @@ For example: (setq org-roam-buffer-window-parameters '((no-other-window . t)))"
(dolist (props bls)
(insert "*** "
(if-let ((outline (plist-get props :outline)))
(string-join outline " > ")
(-> outline
(string-join " > ")
(org-roam-buffer-expand-links file-from))
"Top")
"\n"
(propertize
(s-trim (s-replace "\n" " "
(plist-get props :content)))
(org-roam-buffer-expand-links (plist-get props :content) file-from)))
'help-echo "mouse-1: visit backlinked note"
'file-from file-from
'file-from-point (plist-get props :point))

View File

@ -38,6 +38,7 @@
(require 'org-roam-compat)
(defvar org-roam-completion-ignore-case)
(defvar org-roam-directory)
(declare-function org-roam--find-file "org-roam")
(declare-function org-roam-find-file "org-roam")
@ -47,6 +48,21 @@
:group 'org-roam
:type 'boolean)
(defcustom org-roam-link-file-path-type 'relative
"How the path name in file links should be stored.
Valid values are:
relative Relative to the current directory, i.e. the directory of the file
into which the link is being inserted.
absolute Absolute path, if possible with ~ for home directory.
noabbrev Absolute path, no abbreviation of home directory."
:group 'org-roam
:type '(choice
(const relative)
(const absolute)
(const noabbrev))
:safe #'symbolp)
;;; the roam: link
(org-link-set-parameters "roam"
:follow #'org-roam-link-follow-link)
@ -139,6 +155,18 @@ If there is no corresponding headline, return nil."
(org-id-get-create))))))))
;;; Path-related functions
(defun org-roam-link-get-path (path)
"Return the PATH of the link to use.
Respect `org-link-file-path-type', see the variable documentation for details.
If DIR is passed, use DIR as the default directory."
(pcase org-roam-link-file-path-type
('absolute
(abbreviate-file-name (expand-file-name path)))
('noabbrev
(expand-file-name path))
('relative
(file-relative-name path))))
(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).
@ -185,8 +213,7 @@ marker is a marker to the headline, if applicable."
('title
(setq loc (org-roam-link--get-file-from-title title)
desc title
link-type "file")
(when loc (setq loc (file-relative-name loc))))
link-type "file"))
('headline
(setq mkr (org-roam-link--get-id-from-headline headline))
(pcase mkr
@ -209,6 +236,8 @@ DESC is the link description."
(unless (org-in-regexp org-link-bracket-re 1)
(user-error "No link at point"))
(replace-match "")
(when (string-equal link-type "file")
(setq loc (org-roam-link-get-path loc)))
(insert (org-roam-link-make-string (concat link-type ":" loc) desc)))))
(defun org-roam-link-replace-all ()

View File

@ -536,27 +536,6 @@ The search terminates when the first property is encountered."
(push (cons prop p) res)))
res)))
(defun org-roam--expand-links (content path)
"Crawl CONTENT for relative links and expand them.
PATH should be the root from which to compute the relativity."
(let ((dir (file-name-directory path))
link link-type)
(with-temp-buffer
(insert content)
(goto-char (point-min))
;; Loop over links
(while (re-search-forward org-roam--org-link-bracket-typed-re (point-max) t)
(setq link-type (match-string 1)
link (match-string 2))
(when (and (string-equal link-type "file")
(f-relative-p link))
(save-excursion
(goto-char (match-beginning 2))
(delete-region (match-beginning 2)
(match-end 2))
(insert (expand-file-name link dir)))))
(buffer-string))))
(defun org-roam--get-outline-path ()
"Return the outline path to the current entry.
@ -624,10 +603,7 @@ it as FILE-PATH."
(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))
(properties (list :outline (org-roam--get-outline-path)
:content content
:point begin))
(names (pcase type
@ -844,16 +820,10 @@ If `org-roam-link-title-format title' is defined, use it with TYPE."
(defun org-roam--format-link (target &optional description type)
"Formats an org link for a given file TARGET, link DESCRIPTION and link TYPE.
TYPE defaults to \"file\"."
(let* ((here (ignore-errors
(-> (or (buffer-base-buffer)
(current-buffer))
(buffer-file-name)
(file-name-directory)))))
(org-roam-link-make-string
(concat (or type "file") ":" (if here
(file-relative-name target here)
target))
description)))
(setq type (or type "file"))
(when (string-equal type "file")
(setq target (org-roam-link-get-path target)))
(org-roam-link-make-string (concat type ":" target) description))
(defun org-roam--prepend-tag-string (str tags)
"Prepend TAGS to STR."
@ -1344,7 +1314,7 @@ replaced links are made relative to the current buffer."
(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)))))
(new-path (org-roam-link-get-path file-path)))
(replace-match (concat type ":" new-path)
nil t nil 1))))))))