You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
279 lines
11 KiB
279 lines
11 KiB
;;; 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.1 |
|
;; 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) |
|
|
|
(defvar org-roam-completion-ignore-case) |
|
(declare-function org-roam--find-file "org-roam") |
|
(declare-function org-roam-find-file "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) |
|
|
|
;;; 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--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") |
|
(when loc (setq loc (file-relative-name loc)))) |
|
('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-link-make-string (concat link-type ":" loc) desc))))) |
|
|
|
(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) |
|
(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)))))))))) |
|
(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 (- (length str))) |
|
(insert (concat (unless (string= link-type "roam") "roam:") str)))))))) |
|
|
|
(provide 'org-roam-link) |
|
;;; org-roam-link.el ends here
|
|
|