mirror of
https://github.com/org-roam/org-roam
synced 2025-08-01 12:17:21 -05:00
56c47fbff8
...about undefined functions or unused lexical variables. Undefined functions: for example, s.el and org-element should be `require`'d when their functions are used. Unused lexical variables: if Org isn't loaded yet, dynamic variables defined in org.el would be treated as lexical and byte-comp would emit this warning. This is especially important in the future as native-comp / gccemacs will optimize away unused lexical variables, and we cannot rely on Org having been implicitly loaded before our modules are compiled. Explicitly stating in our modules that the variables are dynamic prevents that.
315 lines
12 KiB
EmacsLisp
315 lines
12 KiB
EmacsLisp
;;; org-roam-link.el --- Custom links for Org-roam -*- coding: utf-8; lexical-binding: t; -*-
|
|
|
|
;; Copyright © 2020 Jethro Kuan <jethrokuan95@gmail.com>
|
|
;; Alan Carroll
|
|
|
|
;; Author: Jethro Kuan <jethrokuan95@gmail.com>
|
|
;; URL: https://github.com/org-roam/org-roam
|
|
;; Keywords: org-mode, roam, convenience
|
|
;; Version: 1.2.2
|
|
;; Package-Requires: ((emacs "26.1") (dash "2.13") (f "0.17.2") (s "1.12.0") (org "9.3") (emacsql "3.0.0") (emacsql-sqlite3 "1.0.2"))
|
|
|
|
;; This file is NOT part of GNU Emacs.
|
|
|
|
;; This program is free software; you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation; either version 3, or (at your option)
|
|
;; any later version.
|
|
;;
|
|
;; This program is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
;;
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
|
;; Boston, MA 02110-1301, USA.
|
|
|
|
;;; Commentary:
|
|
;;
|
|
;; This adds the custom `roam:' link to Org-roam. `roam:' links allow linking to
|
|
;; Org-roam files via their titles and headlines.
|
|
;;
|
|
;;; Code:
|
|
;;;; Dependencies
|
|
|
|
(require 'ol)
|
|
(require 'org-roam-compat)
|
|
(require 'org-roam-macs)
|
|
(require 'org-roam-db)
|
|
|
|
(require 'org-element)
|
|
|
|
(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")
|
|
(declare-function org-roam-format-link "org-roam")
|
|
|
|
(defcustom org-roam-link-auto-replace t
|
|
"When non-nil, replace Org-roam's roam links with file or id links whenever possible."
|
|
: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)
|
|
|
|
(defun org-roam-link-follow-link (path)
|
|
"Navigates to location specified by PATH."
|
|
(pcase-let ((`(,link-type ,loc ,desc ,mkr) (org-roam-link--get-location path)))
|
|
(when (and org-roam-link-auto-replace loc desc)
|
|
(org-roam-link--replace-link link-type loc desc))
|
|
(pcase link-type
|
|
("file"
|
|
(if loc
|
|
(org-roam--find-file loc)
|
|
(org-roam-find-file desc nil nil t)))
|
|
("id"
|
|
(org-goto-marker-or-bmk mkr)))))
|
|
|
|
;;; Retrieval Functions
|
|
(defun org-roam-link--get-titles ()
|
|
"Return all titles within Org-roam."
|
|
(mapcar #'car (org-roam-db-query [:select [titles:title] :from titles])))
|
|
|
|
(defun org-roam-link--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)))
|
|
(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 org-complex-heading-regexp nil t)
|
|
(save-excursion
|
|
(setq name (substring-no-properties (or (match-string 4) "")))
|
|
(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-link--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-link--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-link--get-headlines file 'with-markers)))
|
|
(when-let ((marker (cdr (assoc-string headline headlines))))
|
|
(goto-char marker)
|
|
(cons marker
|
|
(when org-roam-link-auto-replace
|
|
(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).
|
|
type is one of `title', `headline', `title+headline'.
|
|
title is the title component of the path.
|
|
headline is the headline component of the path.
|
|
star-idx is the index of the asterisk, if any."
|
|
(save-match-data
|
|
(let* ((star-index (string-match-p "\\*" path))
|
|
(title (substring-no-properties path 0 star-index))
|
|
(headline (if star-index
|
|
(substring-no-properties path (+ 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-link--get-location (link)
|
|
"Return the location of Org-roam fuzzy LINK.
|
|
The location is returned as a list containing (link-type loc desc marker).
|
|
nil is returned if there is no matching location.
|
|
|
|
link-type is either \"file\" or \"id\".
|
|
loc is the target location: e.g. a file path, or an id.
|
|
marker is a marker to the headline, if applicable."
|
|
(let (mkr link-type desc loc)
|
|
(pcase-let ((`(,type ,title ,headline _) (org-roam-link--split-path link)))
|
|
(pcase type
|
|
('title+headline
|
|
(let ((file (org-roam-link--get-file-from-title title)))
|
|
(if (not file)
|
|
(org-roam-message "Cannot find matching file")
|
|
(setq mkr (org-roam-link--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-link--get-file-from-title title)
|
|
desc title
|
|
link-type "file"))
|
|
('headline
|
|
(setq mkr (org-roam-link--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")))))
|
|
(list link-type loc desc mkr))))
|
|
|
|
;;; Conversion Functions
|
|
(defun org-roam-link--replace-link (link-type loc &optional desc)
|
|
"Replace link at point with a vanilla Org link.
|
|
LINK-TYPE is the Org link type, typically \"file\" or \"id\".
|
|
LOC is path for the Org link.
|
|
DESC is the link description."
|
|
(save-excursion
|
|
(save-match-data
|
|
(unless (org-in-regexp org-link-bracket-re 1)
|
|
(user-error "No link at point"))
|
|
(replace-match "")
|
|
(insert (org-roam-format-link loc desc link-type)))))
|
|
|
|
(defun org-roam-link-replace-all ()
|
|
"Replace all roam links in the current buffer."
|
|
(interactive)
|
|
(save-excursion
|
|
(goto-char (point-min))
|
|
(while (re-search-forward org-link-bracket-re nil t)
|
|
(let ((context (org-element-context)))
|
|
(pcase (org-element-lineage context '(link) t)
|
|
(`nil nil)
|
|
(link
|
|
(when (string-equal "roam" (org-element-property :type link))
|
|
(pcase-let ((`(,link-type ,loc ,desc _) (org-roam-link--get-location (org-element-property :path link))))
|
|
(when (and link-type loc)
|
|
(org-roam-link--replace-link link-type loc desc))))))))))
|
|
|
|
(defun org-roam-link--replace-link-on-save ()
|
|
"Hook to replace all roam links on save."
|
|
(when org-roam-link-auto-replace
|
|
(org-roam-link-replace-all)))
|
|
|
|
;;; Completion
|
|
(defun org-roam-link-complete-at-point ()
|
|
"Do appropriate completion for the link at point."
|
|
(let ((end (point))
|
|
(start (point))
|
|
collection link-type headline-only-p)
|
|
(when (org-in-regexp org-link-bracket-re 1)
|
|
(setq start (match-beginning 1)
|
|
end (match-end 1))
|
|
(let ((context (org-element-context)))
|
|
(pcase (org-element-lineage context '(link) t)
|
|
(`nil nil)
|
|
(link
|
|
(setq link-type (org-element-property :type link))
|
|
(when (member link-type '("roam" "fuzzy"))
|
|
(when (string= link-type "roam") (setq start (+ start (length "roam:"))))
|
|
(pcase-let ((`(,type ,title _ ,star-idx)
|
|
(org-roam-link--split-path (org-element-property :path link))))
|
|
(pcase type
|
|
('title+headline
|
|
(when-let ((file (org-roam-link--get-file-from-title title t)))
|
|
(setq collection (apply-partially #'org-roam-link--get-headlines file))
|
|
(setq start (+ start star-idx 1))))
|
|
('title
|
|
(setq collection #'org-roam-link--get-titles))
|
|
('headline
|
|
(setq collection #'org-roam-link--get-headlines)
|
|
(setq start (+ start star-idx 1))
|
|
(setq headline-only-p t)))))))))
|
|
(when collection
|
|
(let ((prefix (buffer-substring-no-properties start end)))
|
|
(list start end
|
|
(if (functionp collection)
|
|
(completion-table-case-fold
|
|
(completion-table-dynamic
|
|
(lambda (_)
|
|
(cl-remove-if (apply-partially #'string= prefix)
|
|
(funcall collection))))
|
|
(not org-roam-completion-ignore-case))
|
|
collection)
|
|
:exit-function
|
|
(lambda (str &rest _)
|
|
(delete-char (- 0 (length str)
|
|
(if headline-only-p 1 0)))
|
|
(insert (concat (unless (string= link-type "roam") "roam:")
|
|
(when headline-only-p "*")
|
|
str))))))))
|
|
|
|
(provide 'org-roam-link)
|
|
;;; org-roam-link.el ends here
|