1184 lines
48 KiB
EmacsLisp
1184 lines
48 KiB
EmacsLisp
;;; org-roam-node.el --- Interfacing and interacting with nodes -*- lexical-binding: t; -*-
|
||
|
||
;; Copyright © 2020-2025 Jethro Kuan <jethrokuan95@gmail.com>
|
||
|
||
;; 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 module is dedicated for Org-roam nodes and its components. It provides
|
||
;; standard means to interface with them, both programmatically and
|
||
;; interactively.
|
||
;;
|
||
;;; Code:
|
||
(require 'crm)
|
||
(require 'subr-x)
|
||
(eval-when-compile (require 'rx))
|
||
(require 'org-roam)
|
||
|
||
;;; Options
|
||
;;;; Completing-read
|
||
(defcustom org-roam-node-display-template "${title}"
|
||
"Configures display formatting for Org-roam node.
|
||
|
||
If it is a function, it will be called to format a node.
|
||
Its result is expected to be a string (potentially with
|
||
embedded properties).
|
||
|
||
If it is a string and it will be used as described in org-roam
|
||
(see org-roam-node-display-template)
|
||
|
||
When it is a string, the following processing is done:
|
||
|
||
Patterns of form \"${field-name:length}\" are interpolated based
|
||
on the current node.
|
||
|
||
Each \"field-name\" is replaced with the return value of each
|
||
corresponding accessor function for `org-roam-node', e.g.
|
||
\"${title}\" will be interpolated by the result of
|
||
`org-roam-node-title'. You can also define custom accessors using
|
||
`cl-defmethod'. For example, you can define:
|
||
|
||
(cl-defmethod org-roam-node-my-title ((node org-roam-node))
|
||
(concat \"My \" (org-roam-node-title node)))
|
||
|
||
and then reference it here or in the capture templates as
|
||
\"${my-title}\".
|
||
|
||
\"length\" is an optional specifier and declares how many
|
||
characters can be used to display the value of the corresponding
|
||
field. If it\\='s not specified, the field will be inserted as is,
|
||
i.e. it won\\='t be aligned nor trimmed. If it\\='s an integer, the
|
||
field will be aligned accordingly and all the exceeding
|
||
characters will be trimmed out. If it\\='s \"*\", the field will use
|
||
as many characters as possible and will be aligned accordingly.
|
||
|
||
A closure can also be assigned to this variable in which case the
|
||
closure is evaluated and the return value is used as the
|
||
template. The closure must evaluate to a valid template string.
|
||
|
||
When org-roam-node-display-template is a function, the function is
|
||
expected to return a string, potentially propertized. For example, the
|
||
following function shows the title and base filename of the node:
|
||
|
||
\(defun my--org-roam-format (node)
|
||
\"formats the node\"
|
||
(format \"%-40s %s\"
|
||
(if (org-roam-node-title node)
|
||
(propertize (org-roam-node-title node) \\='face \\='org-todo)
|
||
\"\")
|
||
(file-name-nondirectory (org-roam-node-file node))))
|
||
|
||
\(setq org-roam-node-display-template \\='my--org-roam-format)"
|
||
:group 'org-roam
|
||
:type '(choice string function))
|
||
|
||
(defcustom org-roam-node-annotation-function #'org-roam-node-read--annotation
|
||
"This function used to attach annotations for `org-roam-node-read'.
|
||
It takes a single argument NODE, which is an `org-roam-node' construct."
|
||
:group 'org-roam
|
||
:type 'function)
|
||
|
||
(defcustom org-roam-node-default-sort 'file-mtime
|
||
"Default sort order for Org-roam node completions."
|
||
:type '(choice
|
||
(const :tag "none" nil)
|
||
(const :tag "file-mtime" file-mtime)
|
||
(const :tag "file-atime" file-atime))
|
||
:group 'org-roam)
|
||
|
||
(defcustom org-roam-node-formatter nil
|
||
"The link description for node insertion.
|
||
If a function is provided, the function should take a single
|
||
argument, an `org-roam-node', and return a string.
|
||
|
||
If a string is provided, it is a template string expanded by
|
||
`org-roam-node--format-entry'."
|
||
:group 'org-roam
|
||
:type '(choice string function))
|
||
|
||
(defcustom org-roam-node-template-prefixes
|
||
'(("tags" . "#")
|
||
("todo" . "t:"))
|
||
"Prefixes for each of the node's properties.
|
||
This is used in conjunction with
|
||
`org-roam-node-display-template': in minibuffer completions the
|
||
node properties will be prefixed with strings in this variable,
|
||
acting as a query language of sorts.
|
||
|
||
For example, if a node has tags (\"foo\" \"bar\") and the alist
|
||
has the entry (\"tags\" . \"#\"), these will appear as
|
||
\"#foo #bar\"."
|
||
:group 'org-roam
|
||
:type '(alist))
|
||
|
||
(defcustom org-roam-ref-annotation-function #'org-roam-ref-read--annotation
|
||
"This function used to attach annotations for `org-roam-ref-read'.
|
||
It takes a single argument REF, which is a propertized string."
|
||
:group 'org-roam
|
||
:type '(function))
|
||
|
||
(defcustom org-roam-ref-prompt-function nil
|
||
"Function to prompt for ref strings in `org-roam-ref-add'.
|
||
Should take no arguments, prompt the user, and return a string."
|
||
:group 'org-roam
|
||
:type 'function)
|
||
|
||
;;;; Completion-at-point
|
||
(defcustom org-roam-completion-everywhere nil
|
||
"When non-nil, provide link completion matching outside of Org links."
|
||
:group 'org-roam
|
||
:type 'boolean)
|
||
|
||
(defcustom org-roam-completion-functions (list #'org-roam-complete-link-at-point
|
||
#'org-roam-complete-everywhere)
|
||
"List of functions to be used with `completion-at-point' for Org-roam."
|
||
:group 'org-roam
|
||
:type 'hook)
|
||
|
||
;;;; Linkage
|
||
(defcustom org-roam-link-auto-replace t
|
||
"If non-nil, replace \"roam:\" links to existing nodes with \"id:\" links."
|
||
:group 'org-roam
|
||
:type 'boolean)
|
||
|
||
(defcustom org-roam-extract-new-file-path "%<%Y%m%d%H%M%S>-${slug}.org"
|
||
"The file path template to use when a node is extracted to its own file.
|
||
This path is relative to `org-roam-directory'."
|
||
:group 'org-roam
|
||
:type 'string)
|
||
|
||
(defvar org-roam-link-type "roam"
|
||
"Link type for org-roam nodes.
|
||
Replaced by `id' automatically when `org-roam-link-auto-replace' is non-nil.")
|
||
|
||
(defvar org-roam-node-history nil
|
||
"Minibuffer history of nodes.")
|
||
|
||
(defvar org-roam-ref-history nil
|
||
"Minibuffer history of refs.")
|
||
|
||
;;; Definition
|
||
(cl-defstruct (org-roam-node (:constructor org-roam-node-create)
|
||
(:constructor org-roam-node-create-from-db
|
||
(title aliases ; 2
|
||
id file file-title level todo ; 5
|
||
point priority scheduled deadline properties ;;5
|
||
olp file-atime file-mtime tags refs)) ;;5
|
||
(:copier nil))
|
||
"A heading or top level file with an assigned ID property."
|
||
file file-title file-hash file-atime file-mtime
|
||
id level point todo priority scheduled deadline title properties olp
|
||
tags aliases refs)
|
||
|
||
(cl-defmethod org-roam-node-slug ((node org-roam-node))
|
||
"Return the slug of NODE."
|
||
(org-roam-node-slugify (org-roam-node-title node)))
|
||
|
||
(defun org-roam-node-slugify (title)
|
||
"Slugify TITLE."
|
||
(require 'ucs-normalize)
|
||
(let ((slug-trim-chars
|
||
;; Combining Diacritical Marks https://www.unicode.org/charts/PDF/U0300.pdf
|
||
;; For why these specific glyphs: https://github.com/org-roam/org-roam/pull/1460
|
||
'( #x300 #x301 #x302 #x303 #x304 #x306 #x307
|
||
#x308 #x309 #x30A #x30B #x30C #x31B #x323
|
||
#x324 #x325 #x327 #x32D #x32E #x330 #x331)))
|
||
(thread-last title
|
||
(ucs-normalize-NFD-string) ;; aka. `string-glyph-decompose' from Emacs 29
|
||
(seq-remove (lambda (char) (memq char slug-trim-chars)))
|
||
(apply #'string)
|
||
(ucs-normalize-NFC-string) ;; aka. `string-glyph-compose' from Emacs 29
|
||
(replace-regexp-in-string "[^[:alnum:]]" "_") ;; convert anything not alphanumeric
|
||
(replace-regexp-in-string "__*" "_") ;; remove sequential underscores
|
||
(replace-regexp-in-string "^_" "") ;; remove starting underscore
|
||
(replace-regexp-in-string "_$" "") ;; remove ending underscore
|
||
(downcase))))
|
||
|
||
(cl-defmethod org-roam-node-formatted ((node org-roam-node))
|
||
"Return a formatted string for NODE."
|
||
(pcase org-roam-node-formatter
|
||
((pred functionp)
|
||
(funcall org-roam-node-formatter node))
|
||
((pred stringp)
|
||
(org-roam-node--format-entry (org-roam-node--process-display-format org-roam-node-formatter) node))
|
||
(_
|
||
(org-roam-node-title node))))
|
||
|
||
(cl-defmethod org-roam-node-category ((node org-roam-node))
|
||
"Return the category for NODE."
|
||
(cdr (assoc-string "CATEGORY" (org-roam-node-properties node))))
|
||
|
||
;;; Nodes
|
||
;;;; Getters
|
||
(defun org-roam-node-at-point (&optional assert)
|
||
"Return the node at point.
|
||
If ASSERT, throw an error if there is no node at point.
|
||
This function also returns the node if it has yet to be cached in the
|
||
database. In this scenario, only expect `:id' and `:point' to be
|
||
populated."
|
||
(or (magit-section-case
|
||
(org-roam-node-section (oref it node))
|
||
(org-roam-preview-section (save-excursion
|
||
(magit-section-up)
|
||
(org-roam-node-at-point)))
|
||
(t (org-with-wide-buffer
|
||
(while (not (or (org-roam-db-node-p)
|
||
(bobp)
|
||
(eq (funcall outline-level)
|
||
(save-excursion
|
||
(org-roam-up-heading-or-point-min)
|
||
(funcall outline-level)))))
|
||
(org-roam-up-heading-or-point-min))
|
||
(when-let* ((id (org-id-get)))
|
||
(org-roam-populate
|
||
(org-roam-node-create
|
||
:id id
|
||
:point (point)))))))
|
||
(and assert (user-error "No node at point"))))
|
||
|
||
(defun org-roam-node-from-id (id)
|
||
"Return an `org-roam-node' for the node containing ID.
|
||
Return nil if a node with ID does not exist."
|
||
(when (> (caar (org-roam-db-query [:select (funcall count) :from nodes
|
||
:where (= id $s1)]
|
||
id)) 0)
|
||
(org-roam-populate (org-roam-node-create :id id))))
|
||
|
||
(defun org-roam-node-from-title-or-alias (s &optional nocase)
|
||
"Return an `org-roam-node' for the node with title or alias S.
|
||
Return nil if the node does not exist.
|
||
Throw an error if multiple choices exist.
|
||
|
||
If NOCASE is non-nil, the query is case insensitive.
|
||
It is case sensitive otherwise."
|
||
(let ((matches (seq-uniq
|
||
(append
|
||
(org-roam-db-query (vconcat [:select [id] :from nodes
|
||
:where (= title $s1)]
|
||
(if nocase [ :collate NOCASE ]))
|
||
s)
|
||
(org-roam-db-query (vconcat [:select [node-id] :from aliases
|
||
:where (= alias $s1)]
|
||
(if nocase [ :collate NOCASE ]))
|
||
s)))))
|
||
(cond
|
||
((seq-empty-p matches)
|
||
nil)
|
||
((= 1 (length matches))
|
||
(org-roam-populate (org-roam-node-create :id (caar matches))))
|
||
(t
|
||
(user-error "Multiple nodes exist with title or alias \"%s\"" s)))))
|
||
|
||
(defun org-roam-node-from-ref (ref)
|
||
"Return an `org-roam-node' from REF reference.
|
||
Return nil if there's no node with such REF."
|
||
(save-match-data
|
||
(let (type path)
|
||
(cond
|
||
((string-match org-link-plain-re ref)
|
||
(setq type (match-string 1 ref)
|
||
path (match-string 2 ref)))
|
||
((string-prefix-p "@" ref)
|
||
(setq type "cite"
|
||
path (substring ref 1))))
|
||
(when (and type path)
|
||
(when-let* ((id (caar (org-roam-db-query
|
||
[:select [nodes:id]
|
||
:from refs
|
||
:left-join nodes
|
||
:on (= refs:node-id nodes:id)
|
||
:where (= refs:type $s1)
|
||
:and (= refs:ref $s2)
|
||
:limit 1]
|
||
type path))))
|
||
(org-roam-populate (org-roam-node-create :id id)))))))
|
||
|
||
(cl-defmethod org-roam-populate ((node org-roam-node))
|
||
"Populate NODE from database.
|
||
Uses the ID, and fetches remaining details from the database.
|
||
This can be quite costly: avoid, unless dealing with very few
|
||
nodes."
|
||
(when-let* ((node-info (car (org-roam-db-query [:select [
|
||
file level pos todo priority
|
||
scheduled deadline title properties olp]
|
||
:from nodes
|
||
:where (= id $s1)
|
||
:limit 1]
|
||
(org-roam-node-id node)))))
|
||
(pcase-let* ((`(,file ,level ,pos ,todo ,priority ,scheduled ,deadline ,title ,properties ,olp) node-info)
|
||
(`(,atime ,mtime ,file-title) (car (org-roam-db-query [:select [atime mtime title]
|
||
:from files
|
||
:where (= file $s1)]
|
||
file)))
|
||
(tag-info (mapcar #'car (org-roam-db-query [:select [tag] :from tags
|
||
:where (= node-id $s1)]
|
||
(org-roam-node-id node))))
|
||
(alias-info (mapcar #'car (org-roam-db-query [:select [alias] :from aliases
|
||
:where (= node-id $s1)]
|
||
(org-roam-node-id node))))
|
||
(refs-info (mapcar #'car (org-roam-db-query [:select [ref] :from refs
|
||
:where (= node-id $s1)]
|
||
(org-roam-node-id node)))))
|
||
(setf (org-roam-node-file node) file
|
||
(org-roam-node-file-title node) file-title
|
||
(org-roam-node-file-atime node) atime
|
||
(org-roam-node-file-mtime node) mtime
|
||
(org-roam-node-level node) level
|
||
(org-roam-node-point node) pos
|
||
(org-roam-node-todo node) todo
|
||
(org-roam-node-priority node) priority
|
||
(org-roam-node-scheduled node) scheduled
|
||
(org-roam-node-deadline node) deadline
|
||
(org-roam-node-title node) title
|
||
(org-roam-node-properties node) properties
|
||
(org-roam-node-olp node) olp
|
||
(org-roam-node-tags node) tag-info
|
||
(org-roam-node-refs node) refs-info
|
||
(org-roam-node-aliases node) alias-info)))
|
||
node)
|
||
|
||
(defun org-roam-node-list ()
|
||
"Return all nodes stored in the database as a list of `org-roam-node's."
|
||
(let ((rows (org-roam-db-query
|
||
"
|
||
SELECT
|
||
title,
|
||
aliases,
|
||
|
||
id,
|
||
file,
|
||
filetitle,
|
||
\"level\",
|
||
todo,
|
||
|
||
pos,
|
||
priority ,
|
||
scheduled ,
|
||
deadline ,
|
||
properties ,
|
||
|
||
olp,
|
||
atime,
|
||
mtime,
|
||
'(' || group_concat(tags, ' ') || ')' as tags,
|
||
refs
|
||
FROM
|
||
(
|
||
SELECT
|
||
id,
|
||
file,
|
||
filetitle,
|
||
\"level\",
|
||
todo,
|
||
pos,
|
||
priority ,
|
||
scheduled ,
|
||
deadline ,
|
||
title,
|
||
properties ,
|
||
olp,
|
||
atime,
|
||
mtime,
|
||
tags,
|
||
'(' || group_concat(aliases, ' ') || ')' as aliases,
|
||
refs
|
||
FROM
|
||
(
|
||
SELECT
|
||
nodes.id as id,
|
||
nodes.file as file,
|
||
nodes.\"level\" as \"level\",
|
||
nodes.todo as todo,
|
||
nodes.pos as pos,
|
||
nodes.priority as priority,
|
||
nodes.scheduled as scheduled,
|
||
nodes.deadline as deadline,
|
||
nodes.title as title,
|
||
nodes.properties as properties,
|
||
nodes.olp as olp,
|
||
files.atime as atime,
|
||
files.mtime as mtime,
|
||
files.title as filetitle,
|
||
tags.tag as tags,
|
||
aliases.alias as aliases,
|
||
'(' || group_concat(RTRIM (refs.\"type\", '\"') || ':' || LTRIM(refs.ref, '\"'), ' ') || ')' as refs
|
||
FROM nodes
|
||
LEFT JOIN files ON files.file = nodes.file
|
||
LEFT JOIN tags ON tags.node_id = nodes.id
|
||
LEFT JOIN aliases ON aliases.node_id = nodes.id
|
||
LEFT JOIN refs ON refs.node_id = nodes.id
|
||
GROUP BY nodes.id, tags.tag, aliases.alias )
|
||
GROUP BY id, tags )
|
||
GROUP BY id
|
||
")))
|
||
(mapcan
|
||
(lambda (row)
|
||
(let (
|
||
(all-titles (cons (car row) (nth 1 row)))
|
||
)
|
||
(mapcar (lambda (temp-title)
|
||
(apply 'org-roam-node-create-from-db (cons temp-title (cdr row))))
|
||
all-titles)
|
||
))
|
||
rows)
|
||
)
|
||
)
|
||
|
||
;;;; Finders
|
||
(defun org-roam-node-marker (node)
|
||
"Get the marker for NODE."
|
||
(let* ((file (org-roam-node-file node))
|
||
(buffer (or (find-buffer-visiting file)
|
||
(find-file-noselect file))))
|
||
(with-current-buffer buffer
|
||
(move-marker (make-marker) (org-roam-node-point node) buffer))))
|
||
|
||
(defun org-roam-node-open (node &optional cmd force)
|
||
"Go to the node NODE.
|
||
CMD is the command used to display the buffer. If not provided,
|
||
`org-link-frame-setup' is respected. Assumes that the node is
|
||
fully populated, with file and point. If NODE is already visited,
|
||
this won't automatically move the point to the beginning of the
|
||
NODE, unless FORCE is non-nil."
|
||
(interactive (list (org-roam-node-at-point) current-prefix-arg))
|
||
(org-mark-ring-push)
|
||
(let ((m (org-roam-node-marker node))
|
||
(cmd (or cmd
|
||
(cdr
|
||
(assq
|
||
(cdr (assq 'file org-link-frame-setup))
|
||
'((find-file . switch-to-buffer)
|
||
(find-file-other-window . switch-to-buffer-other-window)
|
||
(find-file-other-frame . switch-to-buffer-other-frame))))
|
||
'switch-to-buffer-other-window)))
|
||
(if (not (equal (current-buffer) (marker-buffer m)))
|
||
(funcall cmd (marker-buffer m)))
|
||
(when (or force
|
||
(not (equal (org-roam-node-id node)
|
||
(org-roam-id-at-point))))
|
||
(goto-char m))
|
||
(move-marker m nil))
|
||
(org-fold-show-context))
|
||
|
||
(defun org-roam-node-visit (node &optional other-window force)
|
||
"From the current buffer, visit NODE.
|
||
Display the buffer in the selected window. With a prefix
|
||
argument OTHER-WINDOW display the buffer in another window
|
||
instead.
|
||
|
||
If NODE is already visited, this won't automatically move the
|
||
point to the beginning of the NODE, unless FORCE is non-nil. In
|
||
interactive calls FORCE always set to t."
|
||
(interactive (list (org-roam-node-at-point t) current-prefix-arg t))
|
||
(org-roam-node-open node (if other-window
|
||
#'switch-to-buffer-other-window
|
||
#'pop-to-buffer-same-window)
|
||
force))
|
||
|
||
;;;###autoload
|
||
(cl-defun org-roam-node-find (&optional other-window initial-input filter-fn pred &key templates)
|
||
"Find and open an Org-roam node by its title or alias.
|
||
INITIAL-INPUT is the initial input for the prompt.
|
||
FILTER-FN is a function to filter out nodes: it takes an `org-roam-node',
|
||
and when nil is returned the node will be filtered out.
|
||
If OTHER-WINDOW, visit the NODE in another window.
|
||
The TEMPLATES, if provided, override the list of capture templates (see
|
||
`org-roam-capture-'.)"
|
||
(interactive current-prefix-arg)
|
||
(let ((node (org-roam-node-read initial-input filter-fn pred)))
|
||
(if (org-roam-node-file node)
|
||
(org-roam-node-visit node other-window)
|
||
(org-roam-capture-
|
||
:node node
|
||
:templates templates
|
||
:props '(:finalize find-file)))))
|
||
|
||
;;;###autoload
|
||
(defun org-roam-node-random (&optional other-window filter-fn)
|
||
"Find and open a random Org-roam node.
|
||
With prefix argument OTHER-WINDOW, visit the node in another
|
||
window instead.
|
||
FILTER-FN is a function to filter out nodes: it takes an `org-roam-node',
|
||
and when nil is returned the node will be filtered out."
|
||
(interactive current-prefix-arg)
|
||
(org-roam-node-visit
|
||
(cdr (seq-random-elt (org-roam-node-read--completions filter-fn)))
|
||
other-window))
|
||
|
||
;;;; Completing-read interface
|
||
(defun org-roam-node-read (&optional initial-input filter-fn sort-fn require-match prompt)
|
||
"Read and return an `org-roam-node'.
|
||
INITIAL-INPUT is the initial minibuffer prompt value.
|
||
FILTER-FN is a function to filter out nodes: it takes an `org-roam-node',
|
||
and when nil is returned the node will be filtered out.
|
||
SORT-FN is a function to sort nodes. See `org-roam-node-read-sort-by-file-mtime'
|
||
for an example sort function.
|
||
If REQUIRE-MATCH, the minibuffer prompt will require a match.
|
||
PROMPT is a string to show at the beginning of the mini-buffer,
|
||
defaulting to \"Node: \""
|
||
(let* ((nodes (org-roam-node-read--completions filter-fn sort-fn))
|
||
(prompt (or prompt "Node: "))
|
||
(node (completing-read
|
||
prompt
|
||
(lambda (string pred action)
|
||
(if (eq action 'metadata)
|
||
`(metadata
|
||
;; Preserve sorting in the completion UI if a sort-fn is used
|
||
,@(when sort-fn
|
||
'((display-sort-function . identity)
|
||
(cycle-sort-function . identity)))
|
||
(annotation-function
|
||
. ,(lambda (title)
|
||
(funcall org-roam-node-annotation-function
|
||
(get-text-property 0 'node title))))
|
||
(category . org-roam-node))
|
||
(complete-with-action action nodes string pred)))
|
||
nil require-match initial-input 'org-roam-node-history)))
|
||
(or (cdr (assoc node nodes))
|
||
(org-roam-node-create :title node))))
|
||
|
||
(defun org-roam--format-nodes-using-template (nodes)
|
||
"Formats NODES using org-roam template features.
|
||
Uses org-roam--node-display-template."
|
||
(let (
|
||
(wTemplate (org-roam-node--process-display-format org-roam-node-display-template))
|
||
)
|
||
(mapcar (lambda (node)
|
||
(org-roam-node-read--to-candidate node wTemplate)) nodes))
|
||
)
|
||
|
||
(defun org-roam--format-nodes-using-function (nodes)
|
||
"Formats NODES using the function org-roam-node-display-template."
|
||
(mapcar (lambda (node)
|
||
(cons
|
||
(propertize (funcall org-roam-node-display-template node) 'node node)
|
||
node))
|
||
nodes)
|
||
)
|
||
|
||
(defun org-roam-node-read--completions (&optional filter-fn sort-fn)
|
||
"Return an alist for node completion.
|
||
The car is the displayed title or alias for the node, and the cdr
|
||
is the `org-roam-node'.
|
||
FILTER-FN is a function to filter out nodes: it takes an `org-roam-node',
|
||
and when nil is returned the node will be filtered out.
|
||
SORT-FN is a function to sort nodes. See `org-roam-node-read-sort-by-file-mtime'
|
||
for an example sort function.
|
||
The displayed title is formatted according to `org-roam-node-display-template'."
|
||
(let* (
|
||
(nodes (org-roam-node-list))
|
||
(nodes (if filter-fn
|
||
(cl-remove-if-not
|
||
(lambda (n) (funcall filter-fn n))
|
||
nodes)
|
||
nodes))
|
||
(nodes (if (functionp org-roam-node-display-template)
|
||
(org-roam--format-nodes-using-function nodes)
|
||
(org-roam--format-nodes-using-template nodes)))
|
||
|
||
(sort-fn (or sort-fn
|
||
(when org-roam-node-default-sort
|
||
(intern (concat "org-roam-node-read-sort-by-"
|
||
(symbol-name org-roam-node-default-sort))))))
|
||
(nodes (if sort-fn (seq-sort sort-fn nodes)
|
||
nodes)))
|
||
nodes))
|
||
|
||
(defun org-roam-node-read--to-candidate (node template)
|
||
"Return a minibuffer completion candidate given NODE.
|
||
TEMPLATE is the processed template used to format the entry."
|
||
(let ((candidate-main (org-roam-node--format-entry
|
||
template
|
||
node
|
||
(1- (if (bufferp (current-buffer))
|
||
(window-width) (frame-width))))))
|
||
(cons (propertize candidate-main 'node node) node)))
|
||
|
||
(defun org-roam-node--format-entry (template node &optional width)
|
||
"Formats NODE for display in the results list.
|
||
WIDTH is the width of the results list.
|
||
TEMPLATE is the processed template used to format the entry."
|
||
(pcase-let ((`(,tmpl . ,tmpl-width) template))
|
||
(org-roam-format-template
|
||
tmpl
|
||
(lambda (field _default-val)
|
||
(pcase-let* ((`(,field-name ,field-width) (split-string field ":"))
|
||
(getter (intern (concat "org-roam-node-" field-name)))
|
||
(field-value (funcall getter node)))
|
||
(when (and (equal field-name "file")
|
||
field-value)
|
||
(setq field-value (file-relative-name field-value org-roam-directory)))
|
||
(when (and (equal field-name "olp")
|
||
field-value)
|
||
(setq field-value (string-join field-value " > ")))
|
||
(when (and field-value (not (listp field-value)))
|
||
(setq field-value (list field-value)))
|
||
(setq field-value (mapconcat
|
||
(lambda (v)
|
||
(concat (or (cdr (assoc field-name org-roam-node-template-prefixes))
|
||
"")
|
||
v))
|
||
field-value " "))
|
||
(setq field-width (cond
|
||
((not field-width)
|
||
field-width)
|
||
((string-equal field-width "*")
|
||
(if width
|
||
(- width tmpl-width)
|
||
tmpl-width))
|
||
((>= (string-to-number field-width) 0)
|
||
(string-to-number field-width))))
|
||
(when field-width
|
||
(let* ((truncated (truncate-string-to-width field-value field-width 0 ?\s))
|
||
(tlen (length truncated))
|
||
(len (length field-value)))
|
||
(if (< tlen len)
|
||
;; Make the truncated part of the string invisible. If strings
|
||
;; are pre-propertized with display or invisible properties, the
|
||
;; formatting may get messed up. Ideally, truncated strings are
|
||
;; not preformatted with these properties. Face properties are
|
||
;; allowed without restriction.
|
||
(put-text-property tlen len 'invisible t field-value)
|
||
;; If the string wasn't truncated, but padded, use this string instead.
|
||
(setq field-value truncated))))
|
||
field-value)))))
|
||
|
||
(defun org-roam-node--process-display-format (format)
|
||
"Pre-calculate minimal widths needed by the FORMAT string."
|
||
(let* ((fields-width 0)
|
||
(string-width
|
||
(string-width
|
||
(org-roam-format-template
|
||
format
|
||
(lambda (field _default-val)
|
||
(setq fields-width
|
||
(+ fields-width
|
||
(string-to-number
|
||
(or (cadr (split-string field ":"))
|
||
"")))))))))
|
||
(cons format (+ fields-width string-width))))
|
||
|
||
(defun org-roam-node-read-sort-by-file-mtime (completion-a completion-b)
|
||
"Sort files such that files modified more recently are shown first.
|
||
COMPLETION-A and COMPLETION-B are items in the form of
|
||
\(node-title org-roam-node-struct)"
|
||
(let ((node-a (cdr completion-a))
|
||
(node-b (cdr completion-b)))
|
||
(time-less-p (org-roam-node-file-mtime node-b)
|
||
(org-roam-node-file-mtime node-a))))
|
||
|
||
(defun org-roam-node-read-sort-by-file-atime (completion-a completion-b)
|
||
"Sort files such that files accessed more recently are shown first.
|
||
COMPLETION-A and COMPLETION-B are items in the form of
|
||
\(node-title org-roam-node-struct)"
|
||
(let ((node-a (cdr completion-a))
|
||
(node-b (cdr completion-b)))
|
||
(time-less-p (org-roam-node-file-atime node-b)
|
||
(org-roam-node-file-atime node-a))))
|
||
|
||
(defun org-roam-node-read--annotation (_node)
|
||
"Placeholder function. Return empty string for annotations."
|
||
"")
|
||
|
||
;;;; Linkage
|
||
;;;;; [id:] link
|
||
;;;###autoload
|
||
(cl-defun org-roam-node-insert (&optional filter-fn &key templates info)
|
||
"Find an Org-roam node and insert (where the point is) an \"id:\" link to it.
|
||
FILTER-FN is a function to filter out nodes: it takes an `org-roam-node',
|
||
and when nil is returned the node will be filtered out.
|
||
The TEMPLATES, if provided, override the list of capture templates (see
|
||
`org-roam-capture-'.)
|
||
The INFO, if provided, is passed to the underlying `org-roam-capture-'."
|
||
(interactive)
|
||
(unwind-protect
|
||
;; Group functions together to avoid inconsistent state on quit
|
||
(atomic-change-group
|
||
(let* (region-text
|
||
beg end
|
||
(_ (when (region-active-p)
|
||
(setq beg (set-marker (make-marker) (region-beginning)))
|
||
(setq end (set-marker (make-marker) (region-end)))
|
||
(setq region-text (org-link-display-format (buffer-substring-no-properties beg end)))))
|
||
(node (org-roam-node-read region-text filter-fn))
|
||
(description (or region-text
|
||
(org-roam-node-formatted node))))
|
||
(if (org-roam-node-id node)
|
||
(progn
|
||
(when region-text
|
||
(delete-region beg end)
|
||
(set-marker beg nil)
|
||
(set-marker end nil))
|
||
(let ((id (org-roam-node-id node)))
|
||
(insert (org-link-make-string
|
||
(concat "id:" id)
|
||
description))
|
||
(run-hook-with-args 'org-roam-post-node-insert-hook
|
||
id
|
||
description)))
|
||
(org-roam-capture-
|
||
:node node
|
||
:info info
|
||
:templates templates
|
||
:props (append
|
||
(when (and beg end)
|
||
(list :region (cons beg end)))
|
||
(list :link-description description
|
||
:finalize 'insert-link))))))
|
||
(deactivate-mark)))
|
||
|
||
;;;;; [roam:] link
|
||
(org-link-set-parameters org-roam-link-type :follow #'org-roam-link-follow-link)
|
||
(defun org-roam-link-follow-link (title-or-alias)
|
||
"Navigate \"roam:\" link to find and open the node with TITLE-OR-ALIAS.
|
||
Assumes that the cursor was put where the link is."
|
||
(if-let* ((node (org-roam-node-from-title-or-alias title-or-alias)))
|
||
(progn
|
||
(when org-roam-link-auto-replace
|
||
(org-roam-link-replace-at-point))
|
||
(org-mark-ring-push)
|
||
(org-roam-node-visit node nil 'force))
|
||
(org-roam-capture-
|
||
:node (org-roam-node-create :title title-or-alias)
|
||
:props '(:finalize find-file))))
|
||
|
||
(defun org-roam-link-replace-at-point (&optional link)
|
||
"Replace \"roam:\" LINK at point with an \"id:\" link."
|
||
(save-excursion
|
||
(save-match-data
|
||
(let* ((link (or link (org-element-context)))
|
||
(type (org-element-property :type link))
|
||
(path (org-element-property :path link))
|
||
(desc (and (org-element-property :contents-begin link)
|
||
(org-element-property :contents-end link)
|
||
(buffer-substring-no-properties
|
||
(org-element-property :contents-begin link)
|
||
(org-element-property :contents-end link))))
|
||
node)
|
||
(goto-char (org-element-property :begin link))
|
||
(when (and (org-in-regexp org-link-any-re 1)
|
||
(string-equal type org-roam-link-type)
|
||
(setq node (save-match-data (org-roam-node-from-title-or-alias path))))
|
||
(replace-match (org-link-make-string
|
||
(concat "id:" (org-roam-node-id node))
|
||
(or desc path))))))))
|
||
|
||
(defun org-roam-link-replace-all ()
|
||
"Replace all \"roam:\" links in buffer with \"id:\" links."
|
||
(interactive)
|
||
(org-with-point-at 1
|
||
(while (search-forward (concat "[[" org-roam-link-type ":") nil t)
|
||
(org-roam-link-replace-at-point))))
|
||
|
||
(add-hook 'org-roam-find-file-hook #'org-roam--replace-roam-links-on-save-h)
|
||
(defun org-roam--replace-roam-links-on-save-h ()
|
||
"Run `org-roam-link-replace-all' before buffer is saved to its file."
|
||
(when org-roam-link-auto-replace
|
||
(add-hook 'before-save-hook #'org-roam-link-replace-all nil t)))
|
||
|
||
;;;;;; Completion-at-point interface
|
||
(defconst org-roam-bracket-completion-re
|
||
(rx "[["
|
||
(group (opt "roam:"))
|
||
;; Change from ‘org-link-bracket-re’: allow empty URI part
|
||
(group (zero-or-more
|
||
(or (not (any "[]\\"))
|
||
(and "\\" (zero-or-more "\\\\") (any "[]"))
|
||
(and (one-or-more "\\") (not (any "[]"))))))
|
||
"]]")
|
||
"Regexp for completion within link brackets.
|
||
Intended for ‘org-roam-complete-link-at-point’, which see.")
|
||
|
||
(defun org-roam-complete-link-at-point ()
|
||
"Complete inside link brackets to an existing Org-roam node.
|
||
Targets [[$title]] and [[roam:$title]] links. [[id:$id][$description]]
|
||
links are not targeted to allow for changing link descriptions without
|
||
changing the target node."
|
||
(when-let* ((_ (org-in-regexp org-roam-bracket-completion-re 1))
|
||
(uri-start (match-beginning 1))
|
||
(title-start (match-beginning 2))
|
||
(end (match-end 2))
|
||
;; don’t try to complete if point is in the delimiting brackets
|
||
(_ (<= title-start (point) end))
|
||
(_ (not (org-in-src-block-p))))
|
||
(list title-start end
|
||
(org-roam--get-titles)
|
||
:exit-function
|
||
(lambda (str &rest _)
|
||
"Replace title inserted by completion with ID and title."
|
||
(delete-region uri-start (point))
|
||
(insert "id:"
|
||
(org-roam-node-id (org-roam-node-from-title-or-alias
|
||
(substring-no-properties str)))
|
||
"][" str)
|
||
;; Move point after closing brackets
|
||
(forward-char 2)))))
|
||
|
||
(defun org-roam-complete-everywhere ()
|
||
"Complete symbol at point as a link completion to an Org-roam node.
|
||
This is a `completion-at-point' function, and is active when
|
||
`org-roam-completion-everywhere' is non-nil.
|
||
|
||
Unlike `org-roam-complete-link-at-point' this will complete even
|
||
outside of the bracket syntax for links (i.e. \"[[|]]\"),
|
||
hence \"everywhere\"."
|
||
(when (and org-roam-completion-everywhere
|
||
(thing-at-point 'word)
|
||
(not (org-in-src-block-p))
|
||
(not (save-match-data (org-in-regexp org-link-any-re))))
|
||
(let ((bounds (bounds-of-thing-at-point 'word)))
|
||
(list (car bounds) (cdr bounds)
|
||
(org-roam--get-titles)
|
||
:exit-function
|
||
(lambda (str _status)
|
||
(delete-char (- (length str)))
|
||
(insert "[[id:"
|
||
(org-roam-node-id (org-roam-node-from-title-or-alias
|
||
(substring-no-properties str)))
|
||
"][" str "]]"))
|
||
;; Proceed with the next completion function if the returned titles
|
||
;; do not match. This allows the default Org capfs or custom capfs
|
||
;; of lower priority to run.
|
||
:exclusive 'no))))
|
||
|
||
(add-hook 'org-roam-find-file-hook #'org-roam--register-completion-functions-h)
|
||
(add-hook 'org-roam-indirect-buffer-hook #'org-roam--register-completion-functions-h)
|
||
|
||
(defun org-roam--register-completion-functions-h ()
|
||
"Setup `org-roam-completion-functions' for `completion-at-point'."
|
||
(dolist (f org-roam-completion-functions)
|
||
(add-hook 'completion-at-point-functions f nil t)))
|
||
|
||
;;;; Editing
|
||
(defun org-roam-demote-entire-buffer ()
|
||
"Convert an org buffer with any top level content to a single node.
|
||
|
||
All headings are demoted one level.
|
||
|
||
The #+TITLE: keyword is converted into a level-1 heading and deleted.
|
||
Any tags declared on #+FILETAGS: are transferred to tags on the new top heading.
|
||
|
||
Any top level properties drawers are incorporated into the new heading."
|
||
(interactive)
|
||
(org-with-point-at 1
|
||
(org-map-region #'org-do-demote
|
||
(point-min) (point-max))
|
||
(insert "* "
|
||
(org-roam--get-keyword "title")
|
||
"\n")
|
||
(org-back-to-heading)
|
||
(org-set-tags (org-roam--get-keyword "filetags"))
|
||
(org-roam-erase-keyword "title")
|
||
(org-roam-erase-keyword "filetags")))
|
||
|
||
(defun org-roam--h1-count ()
|
||
"Count level-1 headings in the current file."
|
||
(let ((h1-count 0))
|
||
(org-with-wide-buffer
|
||
(org-map-region (lambda ()
|
||
(if (= (org-current-level) 1)
|
||
(cl-incf h1-count)))
|
||
(point-min) (point-max))
|
||
h1-count)))
|
||
|
||
(defun org-roam--buffer-promoteable-p ()
|
||
"Verify that this buffer is promoteable:
|
||
There is a single level-1 heading
|
||
and no extra content before the first heading."
|
||
(and
|
||
(= (org-roam--h1-count) 1)
|
||
(org-with-point-at 1 (org-at-heading-p))))
|
||
|
||
(defun org-roam-promote-entire-buffer ()
|
||
"Promote the current buffer, and save.
|
||
Converts a file containing a single level-1 headline node to a file
|
||
node."
|
||
(interactive)
|
||
(org-roam--promote-entire-buffer-internal)
|
||
(org-roam-db-update-file))
|
||
|
||
(defun org-roam--promote-entire-buffer-internal ()
|
||
"Promote the current buffer."
|
||
(unless (org-roam--buffer-promoteable-p)
|
||
(user-error "Cannot promote: multiple root headings or there is extra file-level text"))
|
||
(org-with-point-at 1
|
||
(let ((title (nth 4 (org-heading-components)))
|
||
(tags (org-get-tags)))
|
||
(org-fold-show-all)
|
||
(kill-whole-line)
|
||
(org-roam-end-of-meta-data t)
|
||
(insert "#+title: " title "\n")
|
||
(when tags (org-roam-tag-add tags))
|
||
(org-map-region #'org-promote (point-min) (point-max)))))
|
||
|
||
;;;###autoload
|
||
(defun org-roam-refile (node)
|
||
"Refile node at point to an org-roam NODE.
|
||
|
||
If region is active, then use it instead of the node at point."
|
||
(interactive
|
||
(list (org-roam-node-read nil nil nil 'require-match)))
|
||
(let* ((regionp (org-region-active-p))
|
||
(region-start (and regionp (region-beginning)))
|
||
(region-end (and regionp (region-end)))
|
||
(file (org-roam-node-file node))
|
||
(nbuf (or (find-buffer-visiting file)
|
||
(find-file-noselect file)))
|
||
level reversed)
|
||
(if (equal (org-roam-node-at-point) node)
|
||
(user-error "Target is the same as current node")
|
||
(if regionp
|
||
(progn
|
||
(org-kill-new (buffer-substring region-start region-end))
|
||
(org-save-markers-in-region region-start region-end))
|
||
(progn
|
||
(if (org-before-first-heading-p)
|
||
(org-roam-demote-entire-buffer))
|
||
(org-copy-subtree 1 nil t)))
|
||
(with-current-buffer nbuf
|
||
(org-with-wide-buffer
|
||
(goto-char (org-roam-node-point node))
|
||
(setq level (org-get-valid-level (funcall outline-level) 1)
|
||
reversed (org-notes-order-reversed-p))
|
||
(goto-char
|
||
(if reversed
|
||
(or (outline-next-heading) (point-max))
|
||
(or (save-excursion (org-get-next-sibling))
|
||
(org-end-of-subtree t t)
|
||
(point-max))))
|
||
(unless (bolp) (newline))
|
||
(org-paste-subtree level nil nil t)
|
||
(and org-auto-align-tags
|
||
(let ((org-loop-over-headlines-in-active-region nil))
|
||
(org-align-tags)))
|
||
(when (fboundp 'deactivate-mark) (deactivate-mark))))
|
||
(if regionp
|
||
(delete-region (point) (+ (point) (- region-end region-start)))
|
||
(org-preserve-local-variables
|
||
(delete-region
|
||
(and (org-back-to-heading t) (point))
|
||
(min (1+ (buffer-size)) (org-end-of-subtree t t) (point)))))
|
||
;; If the buffer end-up empty after the refile, kill it and delete its
|
||
;; associated file.
|
||
(when (eq (buffer-size) 0)
|
||
(if (buffer-file-name)
|
||
(delete-file (buffer-file-name)))
|
||
(set-buffer-modified-p nil)
|
||
;; If this was done during capture, abort the capture process.
|
||
(when (and org-capture-mode
|
||
(buffer-base-buffer (current-buffer)))
|
||
(org-capture-kill))
|
||
(kill-buffer (current-buffer))))))
|
||
|
||
;;;###autoload
|
||
(defun org-roam-extract-subtree ()
|
||
"Convert current subtree at point to a node, and extract it into a new file."
|
||
(interactive)
|
||
(save-excursion
|
||
(org-back-to-heading-or-point-min t)
|
||
(when (bobp) (user-error "Already a top-level node"))
|
||
(org-id-get-create)
|
||
(save-buffer)
|
||
(org-roam-db-update-file)
|
||
(let* ((template-info nil)
|
||
(node (org-roam-node-at-point))
|
||
(template (org-roam-format-template
|
||
(string-trim (org-capture-fill-template org-roam-extract-new-file-path))
|
||
(lambda (key default-val)
|
||
(let ((fn (intern key))
|
||
(node-fn (intern (concat "org-roam-node-" key)))
|
||
(ksym (intern (concat ":" key))))
|
||
(cond
|
||
((fboundp fn)
|
||
(funcall fn node))
|
||
((fboundp node-fn)
|
||
(funcall node-fn node))
|
||
(t (let ((r (read-from-minibuffer (format "%s: " key) default-val)))
|
||
(plist-put template-info ksym r)
|
||
r)))))))
|
||
(file-path
|
||
(expand-file-name
|
||
(read-file-name "Extract node to: "
|
||
(file-name-as-directory org-roam-directory) template nil template)
|
||
org-roam-directory)))
|
||
(when (file-exists-p file-path)
|
||
(user-error "%s exists. Aborting" file-path))
|
||
(org-cut-subtree)
|
||
(save-buffer)
|
||
(with-current-buffer (find-file-noselect file-path)
|
||
(org-paste-subtree)
|
||
(while (> (org-current-level) 1) (org-promote-subtree))
|
||
(save-buffer)
|
||
(org-roam-promote-entire-buffer)
|
||
(save-buffer)))))
|
||
|
||
;;; Refs
|
||
;;;; Completing-read interface
|
||
(defun org-roam-ref-read (&optional initial-input filter-fn)
|
||
"Read an Org-roam ref and return a corresponding `org-roam-node'.
|
||
INITIAL-INPUT is the initial prompt value.
|
||
FILTER-FN is a function to filter out nodes: it takes an `org-roam-node',
|
||
and when nil is returned the node will be filtered out.
|
||
filtered out."
|
||
(let* ((refs (org-roam-ref-read--completions))
|
||
(refs (cl-remove-if-not (lambda (n)
|
||
(if filter-fn (funcall filter-fn (cdr n)) t)) refs))
|
||
(ref (completing-read "Ref: "
|
||
(lambda (string pred action)
|
||
(if (eq action 'metadata)
|
||
`(metadata
|
||
(annotation-function
|
||
. ,org-roam-ref-annotation-function)
|
||
(category . org-roam-ref))
|
||
(complete-with-action action refs string pred)))
|
||
nil t initial-input 'org-roam-ref-history)))
|
||
(cdr (assoc ref refs))))
|
||
|
||
(defun org-roam-ref-read--completions ()
|
||
"Return an alist for ref completion.
|
||
The car is the ref, and the cdr is the corresponding node for the ref."
|
||
(let ((rows (org-roam-db-query
|
||
[:select [id ref type nodes:file pos title]
|
||
:from refs
|
||
:left-join nodes
|
||
:on (= refs:node-id nodes:id)])))
|
||
(cl-loop for row in rows
|
||
collect (pcase-let* ((`(,id ,ref ,type ,file ,pos ,title) row)
|
||
(node (org-roam-node-create :id id
|
||
:file file
|
||
:point pos
|
||
:title title)))
|
||
(cons
|
||
(concat (propertize ref 'node node 'type type)
|
||
(propertize id 'invisible t))
|
||
node)))))
|
||
|
||
(defun org-roam-ref-read--annotation (ref)
|
||
"Return the annotation for REF, which assumed to be a propertized string."
|
||
(let* ((node (get-text-property 0 'node ref))
|
||
(title (org-roam-node-title node)))
|
||
(when title
|
||
(concat " " title))))
|
||
|
||
;;;; Finders
|
||
;;;###autoload
|
||
(defun org-roam-ref-find (&optional initial-input filter-fn)
|
||
"Find and open an Org-roam node that's dedicated to a specific ref.
|
||
INITIAL-INPUT is the initial input to the prompt.
|
||
FILTER-FN is a function to filter out nodes: it takes an `org-roam-node',
|
||
and when nil is returned the node will be filtered out."
|
||
(interactive)
|
||
(let* ((node (org-roam-ref-read initial-input filter-fn)))
|
||
(org-roam-node-visit node)))
|
||
|
||
;;;; Editing
|
||
(defun org-roam-ref-add (ref)
|
||
"Add REF to the node at point."
|
||
(interactive `(,(if org-roam-ref-prompt-function
|
||
(funcall org-roam-ref-prompt-function)
|
||
(read-string "Ref: "))))
|
||
(let ((node (org-roam-node-at-point 'assert)))
|
||
(save-excursion
|
||
(goto-char (org-roam-node-point node))
|
||
(org-roam-property-add "ROAM_REFS" (if (member " " (string-to-list ref))
|
||
(concat "\"" ref "\"")
|
||
ref)))))
|
||
|
||
(defun org-roam-ref-remove (&optional ref)
|
||
"Remove a REF from the node at point."
|
||
(interactive)
|
||
(let ((node (org-roam-node-at-point 'assert)))
|
||
(save-excursion
|
||
(goto-char (org-roam-node-point node))
|
||
(org-roam-property-remove "ROAM_REFS" ref))))
|
||
|
||
;;; Tags
|
||
;;;; Getters
|
||
(defun org-roam-tag-completions ()
|
||
"Return list of tags for completions within Org-roam."
|
||
(let ((roam-tags (mapcar #'car (org-roam-db-query [:select :distinct [tag] :from tags])))
|
||
(org-tags (seq-filter #'stringp (mapcar #'car org-tag-alist))))
|
||
(seq-uniq (append roam-tags org-tags))))
|
||
|
||
;;;; Editing
|
||
(defun org-roam-tag-add (tags)
|
||
"Add TAGS to the node at point."
|
||
(interactive
|
||
(list (let ((crm-separator "[ ]*:[ ]*"))
|
||
(completing-read-multiple "Tag: " (org-roam-tag-completions)))))
|
||
(let ((node (org-roam-node-at-point 'assert)))
|
||
(save-excursion
|
||
(goto-char (org-roam-node-point node))
|
||
(if (= (org-outline-level) 0)
|
||
(let ((current-tags (split-string (or (cadr (assoc "FILETAGS"
|
||
(org-collect-keywords '("filetags"))))
|
||
"")
|
||
":" 'omit-nulls)))
|
||
(org-roam-set-keyword "filetags" (org-make-tag-string (seq-uniq (append tags current-tags)))))
|
||
(org-set-tags (seq-uniq (append tags (org-get-tags)))))
|
||
tags)))
|
||
|
||
(defun org-roam-tag-remove (&optional tags)
|
||
"Remove TAGS from the node at point."
|
||
(interactive)
|
||
(let ((node (org-roam-node-at-point 'assert)))
|
||
(save-excursion
|
||
(goto-char (org-roam-node-point node))
|
||
(if (= (org-outline-level) 0)
|
||
(let* ((current-tags (split-string (or (cadr (assoc "FILETAGS"
|
||
(org-collect-keywords '("filetags"))))
|
||
(user-error "No tag to remove"))
|
||
":" 'omit-nulls))
|
||
(tags (or tags (completing-read-multiple "Tag: " current-tags))))
|
||
(org-roam-set-keyword "filetags"
|
||
(org-make-tag-string (seq-difference current-tags tags #'string-equal))))
|
||
(let* ((current-tags (or (org-get-tags)
|
||
(user-error "No tag to remove")))
|
||
(tags (or tags (completing-read-multiple "Tag: " current-tags))))
|
||
(org-set-tags (seq-difference current-tags tags #'string-equal))))
|
||
tags)))
|
||
|
||
;;; Titles and Aliases
|
||
;;;; Getters
|
||
(defun org-roam--get-titles ()
|
||
"Return all distinct titles and aliases in the Org-roam database."
|
||
(mapcar #'car (org-roam-db-query [:select :distinct title :from nodes
|
||
:union :select alias :from aliases])))
|
||
|
||
;;;; Editing
|
||
(defun org-roam-alias-add (alias)
|
||
"Add ALIAS to the node at point."
|
||
(interactive "sAlias: ")
|
||
(let ((node (org-roam-node-at-point 'assert)))
|
||
(save-excursion
|
||
(goto-char (org-roam-node-point node))
|
||
(org-roam-property-add "ROAM_ALIASES" alias))))
|
||
|
||
(defun org-roam-alias-remove (&optional alias)
|
||
"Remove an ALIAS from the node at point."
|
||
(interactive)
|
||
(let ((node (org-roam-node-at-point 'assert)))
|
||
(save-excursion
|
||
(goto-char (org-roam-node-point node))
|
||
(org-roam-property-remove "ROAM_ALIASES" alias))))
|
||
|
||
|
||
(provide 'org-roam-node)
|
||
;;; org-roam-node.el ends here
|