org-roam-node.el (49379B)
1 ;;; org-roam-node.el --- Interfacing and interacting with nodes -*- lexical-binding: t; -*- 2 3 ;; Copyright © 2020-2022 Jethro Kuan <jethrokuan95@gmail.com> 4 5 ;; Author: Jethro Kuan <jethrokuan95@gmail.com> 6 ;; URL: https://github.com/org-roam/org-roam 7 ;; Keywords: org-mode, roam, convenience 8 ;; Version: 2.2.2 9 ;; Package-Requires: ((emacs "26.1") (dash "2.13") (org "9.4") (magit-section "3.0.0")) 10 11 ;; This file is NOT part of GNU Emacs. 12 13 ;; This program is free software; you can redistribute it and/or modify 14 ;; it under the terms of the GNU General Public License as published by 15 ;; the Free Software Foundation; either version 3, or (at your option) 16 ;; any later version. 17 ;; 18 ;; This program is distributed in the hope that it will be useful, 19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 21 ;; GNU General Public License for more details. 22 ;; 23 ;; You should have received a copy of the GNU General Public License 24 ;; along with GNU Emacs; see the file COPYING. If not, write to the 25 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 26 ;; Boston, MA 02110-1301, USA. 27 28 ;;; Commentary: 29 ;; 30 ;; This module is dedicated for Org-roam nodes and its components. It provides 31 ;; standard means to interface with them, both programmatically and 32 ;; interactively. 33 ;; 34 ;;; Code: 35 (require 'org-roam) 36 37 ;;; Options 38 ;;;; Completing-read 39 (defcustom org-roam-node-display-template "${title}" 40 "Configures display formatting for Org-roam node. 41 Patterns of form \"${field-name:length}\" are interpolated based 42 on the current node. 43 44 Each \"field-name\" is replaced with the return value of each 45 corresponding accessor function for `org-roam-node', e.g. 46 \"${title}\" will be interpolated by the result of 47 `org-roam-node-title'. You can also define custom accessors using 48 `cl-defmethod'. For example, you can define: 49 50 (cl-defmethod org-roam-node-my-title ((node org-roam-node)) 51 (concat \"My \" (org-roam-node-title node))) 52 53 and then reference it here or in the capture templates as 54 \"${my-title}\". 55 56 \"length\" is an optional specifier and declares how many 57 characters can be used to display the value of the corresponding 58 field. If it's not specified, the field will be inserted as is, 59 i.e. it won't be aligned nor trimmed. If it's an integer, the 60 field will be aligned accordingly and all the exceeding 61 characters will be trimmed out. If it's \"*\", the field will use 62 as many characters as possible and will be aligned accordingly. 63 64 A closure can also be assigned to this variable in which case the 65 closure is evaluated and the return value is used as the 66 template. The closure must evaluate to a valid template string." 67 :group 'org-roam 68 :type '(string function)) 69 70 (defcustom org-roam-node-annotation-function #'org-roam-node-read--annotation 71 "This function used to attach annotations for `org-roam-node-read'. 72 It takes a single argument NODE, which is an `org-roam-node' construct." 73 :group 'org-roam 74 :type 'function) 75 76 (defcustom org-roam-node-default-sort 'file-mtime 77 "Default sort order for Org-roam node completions." 78 :type '(choice 79 (const :tag "none" nil) 80 (const :tag "file-mtime" file-mtime) 81 (const :tag "file-atime" file-atime)) 82 :group 'org-roam) 83 84 (defcustom org-roam-node-formatter nil 85 "The link description for node insertion. 86 If a function is provided, the function should take a single 87 argument, an `org-roam-node', and return a string. 88 89 If a string is provided, it is a template string expanded by 90 `org-roam-node--format-entry'." 91 :group 'org-roam 92 :type '(string function)) 93 94 (defcustom org-roam-node-template-prefixes 95 '(("tags" . "#") 96 ("todo" . "t:")) 97 "Prefixes for each of the node's properties. 98 This is used in conjunction with 99 `org-roam-node-display-template': in minibuffer completions the 100 node properties will be prefixed with strings in this variable, 101 acting as a query language of sorts. 102 103 For example, if a node has tags (\"foo\" \"bar\") and the alist 104 has the entry (\"tags\" . \"#\"), these will appear as 105 \"#foo #bar\"." 106 :group 'org-roam 107 :type '(alist)) 108 109 (defcustom org-roam-ref-annotation-function #'org-roam-ref-read--annotation 110 "This function used to attach annotations for `org-roam-ref-read'. 111 It takes a single argument REF, which is a propertized string." 112 :group 'org-roam 113 :type '(function)) 114 115 ;;;; Completion-at-point 116 (defcustom org-roam-completion-everywhere nil 117 "When non-nil, provide link completion matching outside of Org links." 118 :group 'org-roam 119 :type 'boolean) 120 121 (defcustom org-roam-completion-functions (list #'org-roam-complete-link-at-point 122 #'org-roam-complete-everywhere) 123 "List of functions to be used with `completion-at-point' for Org-roam." 124 :group 'org-roam 125 :type 'hook) 126 127 ;;;; Linkage 128 (defcustom org-roam-link-auto-replace t 129 "If non-nil, replace \"roam:\" links to existing nodes with \"id:\" links." 130 :group 'org-roam 131 :type 'boolean) 132 133 (defcustom org-roam-extract-new-file-path "%<%Y%m%d%H%M%S>-${slug}.org" 134 "The file path template to use when a node is extracted to its own file. 135 This path is relative to `org-roam-directory'." 136 :group 'org-roam 137 :type 'string) 138 139 (defvar org-roam-node-history nil 140 "Minibuffer history of nodes.") 141 142 (defvar org-roam-ref-history nil 143 "Minibuffer history of refs.") 144 145 ;;; Definition 146 (cl-defstruct (org-roam-node (:constructor org-roam-node-create) 147 (:copier nil)) 148 "A heading or top level file with an assigned ID property." 149 file file-title file-hash file-atime file-mtime 150 id level point todo priority scheduled deadline title properties olp 151 tags aliases refs) 152 153 ;; Shim `string-glyph-compose' and `string-glyph-decompose' for Emacs versions that do not have it. 154 ;; The functions were introduced in emacs commit 3f096eb3405b2fce7c35366eb2dcf025dda55783 and the 155 ;; (original) functions behind them aren't autoloaded anymore. 156 (dolist (sym.replace 157 '((string-glyph-compose . ucs-normalize-NFC-string) 158 (string-glyph-decompose . ucs-normalize-NFD-string))) 159 (let ((emacs-29-symbol (car sym.replace)) 160 (previous-implementation (cdr sym.replace))) 161 (unless (fboundp emacs-29-symbol) 162 (defalias emacs-29-symbol previous-implementation)))) 163 164 (cl-defmethod org-roam-node-slug ((node org-roam-node)) 165 "Return the slug of NODE." 166 (let ((title (org-roam-node-title node)) 167 (slug-trim-chars '(;; Combining Diacritical Marks https://www.unicode.org/charts/PDF/U0300.pdf 168 768 ; U+0300 COMBINING GRAVE ACCENT 169 769 ; U+0301 COMBINING ACUTE ACCENT 170 770 ; U+0302 COMBINING CIRCUMFLEX ACCENT 171 771 ; U+0303 COMBINING TILDE 172 772 ; U+0304 COMBINING MACRON 173 774 ; U+0306 COMBINING BREVE 174 775 ; U+0307 COMBINING DOT ABOVE 175 776 ; U+0308 COMBINING DIAERESIS 176 777 ; U+0309 COMBINING HOOK ABOVE 177 778 ; U+030A COMBINING RING ABOVE 178 779 ; U+030B COMBINING DOUBLE ACUTE ACCENT 179 780 ; U+030C COMBINING CARON 180 795 ; U+031B COMBINING HORN 181 803 ; U+0323 COMBINING DOT BELOW 182 804 ; U+0324 COMBINING DIAERESIS BELOW 183 805 ; U+0325 COMBINING RING BELOW 184 807 ; U+0327 COMBINING CEDILLA 185 813 ; U+032D COMBINING CIRCUMFLEX ACCENT BELOW 186 814 ; U+032E COMBINING BREVE BELOW 187 816 ; U+0330 COMBINING TILDE BELOW 188 817 ; U+0331 COMBINING MACRON BELOW 189 ))) 190 (cl-flet* ((nonspacing-mark-p (char) (memq char slug-trim-chars)) 191 (strip-nonspacing-marks (s) (string-glyph-compose 192 (apply #'string 193 (seq-remove #'nonspacing-mark-p 194 (string-glyph-decompose s))))) 195 (cl-replace (title pair) (replace-regexp-in-string (car pair) (cdr pair) title))) 196 (let* ((pairs `(("[^[:alnum:][:digit:]]" . "_") ;; convert anything not alphanumeric 197 ("__*" . "_") ;; remove sequential underscores 198 ("^_" . "") ;; remove starting underscore 199 ("_$" . ""))) ;; remove ending underscore 200 (slug (-reduce-from #'cl-replace (strip-nonspacing-marks title) pairs))) 201 (downcase slug))))) 202 203 (cl-defmethod org-roam-node-formatted ((node org-roam-node)) 204 "Return a formatted string for NODE." 205 (pcase org-roam-node-formatter 206 ((pred functionp) 207 (funcall org-roam-node-formatter node)) 208 ((pred stringp) 209 (org-roam-node--format-entry (org-roam-node--process-display-format org-roam-node-formatter) node)) 210 (_ 211 (org-roam-node-title node)))) 212 213 (cl-defmethod org-roam-node-category ((node org-roam-node)) 214 "Return the category for NODE." 215 (cdr (assoc-string "CATEGORY" (org-roam-node-properties node)))) 216 217 ;;; Nodes 218 ;;;; Getters 219 (defun org-roam-node-at-point (&optional assert) 220 "Return the node at point. 221 If ASSERT, throw an error if there is no node at point. 222 This function also returns the node if it has yet to be cached in the 223 database. In this scenario, only expect `:id' and `:point' to be 224 populated." 225 (or (magit-section-case 226 (org-roam-node-section (oref it node)) 227 (org-roam-preview-section (save-excursion 228 (magit-section-up) 229 (org-roam-node-at-point))) 230 (t (org-with-wide-buffer 231 (while (not (or (org-roam-db-node-p) 232 (bobp) 233 ;; Handle case where top-level is a heading 234 (= (funcall outline-level) 235 (save-excursion 236 (org-roam-up-heading-or-point-min) 237 (funcall outline-level))))) 238 (org-roam-up-heading-or-point-min)) 239 (when-let ((id (org-id-get))) 240 (org-roam-populate 241 (org-roam-node-create 242 :id id 243 :point (point))))))) 244 (and assert (user-error "No node at point")))) 245 246 (defun org-roam-node-from-id (id) 247 "Return an `org-roam-node' for the node containing ID. 248 Return nil if a node with ID does not exist." 249 (when (> (caar (org-roam-db-query [:select (funcall count) :from nodes 250 :where (= id $s1)] 251 id)) 0) 252 (org-roam-populate (org-roam-node-create :id id)))) 253 254 (defun org-roam-node-from-title-or-alias (s) 255 "Return an `org-roam-node' for the node with title or alias S. 256 Return nil if the node does not exist. 257 Throw an error if multiple choices exist." 258 (let ((matches (seq-uniq 259 (append 260 (org-roam-db-query [:select [id] :from nodes 261 :where (= title $s1)] 262 s) 263 (org-roam-db-query [:select [node-id] :from aliases 264 :where (= alias $s1)] 265 s))))) 266 (cond 267 ((seq-empty-p matches) 268 nil) 269 ((= 1 (length matches)) 270 (org-roam-populate (org-roam-node-create :id (caar matches)))) 271 (t 272 (user-error "Multiple nodes exist with title or alias \"%s\"" s))))) 273 274 (defun org-roam-node-from-ref (ref) 275 "Return an `org-roam-node' from REF reference. 276 Return nil if there's no node with such REF." 277 (save-match-data 278 (let (type path) 279 (cond 280 ((string-match org-link-plain-re ref) 281 (setq type (match-string 1 ref) 282 path (match-string 2 ref))) 283 ((string-prefix-p "@" ref) 284 (setq type "cite" 285 path (substring ref 1)))) 286 (when (and type path) 287 (when-let ((id (caar (org-roam-db-query 288 [:select [nodes:id] 289 :from refs 290 :left-join nodes 291 :on (= refs:node-id nodes:id) 292 :where (= refs:type $s1) 293 :and (= refs:ref $s2) 294 :limit 1] 295 type path)))) 296 (org-roam-populate (org-roam-node-create :id id))))))) 297 298 (cl-defmethod org-roam-populate ((node org-roam-node)) 299 "Populate NODE from database. 300 Uses the ID, and fetches remaining details from the database. 301 This can be quite costly: avoid, unless dealing with very few 302 nodes." 303 (when-let ((node-info (car (org-roam-db-query [:select [file level pos todo priority 304 scheduled deadline title properties olp] 305 :from nodes 306 :where (= id $s1) 307 :limit 1] 308 (org-roam-node-id node))))) 309 (pcase-let* ((`(,file ,level ,pos ,todo ,priority ,scheduled ,deadline ,title ,properties ,olp) node-info) 310 (`(,atime ,mtime ,file-title) (car (org-roam-db-query [:select [atime mtime title] 311 :from files 312 :where (= file $s1)] 313 file))) 314 (tag-info (mapcar #'car (org-roam-db-query [:select [tag] :from tags 315 :where (= node-id $s1)] 316 (org-roam-node-id node)))) 317 (alias-info (mapcar #'car (org-roam-db-query [:select [alias] :from aliases 318 :where (= node-id $s1)] 319 (org-roam-node-id node)))) 320 (refs-info (mapcar #'car (org-roam-db-query [:select [ref] :from refs 321 :where (= node-id $s1)] 322 (org-roam-node-id node))))) 323 (setf (org-roam-node-file node) file 324 (org-roam-node-file-title node) file-title 325 (org-roam-node-file-atime node) atime 326 (org-roam-node-file-mtime node) mtime 327 (org-roam-node-level node) level 328 (org-roam-node-point node) pos 329 (org-roam-node-todo node) todo 330 (org-roam-node-priority node) priority 331 (org-roam-node-scheduled node) scheduled 332 (org-roam-node-deadline node) deadline 333 (org-roam-node-title node) title 334 (org-roam-node-properties node) properties 335 (org-roam-node-olp node) olp 336 (org-roam-node-tags node) tag-info 337 (org-roam-node-refs node) refs-info 338 (org-roam-node-aliases node) alias-info))) 339 node) 340 341 (defun org-roam-node-list () 342 "Return all nodes stored in the database as a list of `org-roam-node's." 343 (let ((rows (org-roam-db-query 344 "SELECT 345 id, 346 file, 347 filetitle, 348 \"level\", 349 todo, 350 pos, 351 priority , 352 scheduled , 353 deadline , 354 title, 355 properties , 356 olp, 357 atime, 358 mtime, 359 '(' || group_concat(tags, ' ') || ')' as tags, 360 aliases, 361 refs 362 FROM 363 ( 364 SELECT 365 id, 366 file, 367 filetitle, 368 \"level\", 369 todo, 370 pos, 371 priority , 372 scheduled , 373 deadline , 374 title, 375 properties , 376 olp, 377 atime, 378 mtime, 379 tags, 380 '(' || group_concat(aliases, ' ') || ')' as aliases, 381 refs 382 FROM 383 ( 384 SELECT 385 nodes.id as id, 386 nodes.file as file, 387 nodes.\"level\" as \"level\", 388 nodes.todo as todo, 389 nodes.pos as pos, 390 nodes.priority as priority, 391 nodes.scheduled as scheduled, 392 nodes.deadline as deadline, 393 nodes.title as title, 394 nodes.properties as properties, 395 nodes.olp as olp, 396 files.atime as atime, 397 files.mtime as mtime, 398 files.title as filetitle, 399 tags.tag as tags, 400 aliases.alias as aliases, 401 '(' || group_concat(RTRIM (refs.\"type\", '\"') || ':' || LTRIM(refs.ref, '\"'), ' ') || ')' as refs 402 FROM nodes 403 LEFT JOIN files ON files.file = nodes.file 404 LEFT JOIN tags ON tags.node_id = nodes.id 405 LEFT JOIN aliases ON aliases.node_id = nodes.id 406 LEFT JOIN refs ON refs.node_id = nodes.id 407 GROUP BY nodes.id, tags.tag, aliases.alias ) 408 GROUP BY id, tags ) 409 GROUP BY id"))) 410 (cl-loop for row in rows 411 append (pcase-let* ((`(,id ,file ,file-title ,level ,todo ,pos ,priority ,scheduled ,deadline 412 ,title ,properties ,olp ,atime ,mtime ,tags ,aliases ,refs) 413 row) 414 (all-titles (cons title aliases))) 415 (mapcar (lambda (temp-title) 416 (org-roam-node-create :id id 417 :file file 418 :file-title file-title 419 :file-atime atime 420 :file-mtime mtime 421 :level level 422 :point pos 423 :todo todo 424 :priority priority 425 :scheduled scheduled 426 :deadline deadline 427 :title temp-title 428 :aliases aliases 429 :properties properties 430 :olp olp 431 :tags tags 432 :refs refs)) 433 all-titles))))) 434 435 ;;;; Finders 436 (defun org-roam-node-marker (node) 437 "Get the marker for NODE." 438 (unwind-protect 439 (let* ((file (org-roam-node-file node)) 440 (buffer (or (find-buffer-visiting file) 441 (find-file-noselect file)))) 442 (with-current-buffer buffer 443 (move-marker (make-marker) (org-roam-node-point node) buffer))))) 444 445 (defun org-roam-node-open (node &optional cmd force) 446 "Go to the node NODE. 447 CMD is the command used to display the buffer. If not provided, 448 `org-link-frame-setup' is respected. Assumes that the node is 449 fully populated, with file and point. If NODE is already visited, 450 this won't automatically move the point to the beginning of the 451 NODE, unless FORCE is non-nil." 452 (interactive (list (org-roam-node-at-point) current-prefix-arg)) 453 (org-mark-ring-push) 454 (let ((m (org-roam-node-marker node)) 455 (cmd (or cmd 456 (cdr 457 (assq 458 (cdr (assq 'file org-link-frame-setup)) 459 '((find-file . switch-to-buffer) 460 (find-file-other-window . switch-to-buffer-other-window) 461 (find-file-other-frame . switch-to-buffer-other-frame)))) 462 'switch-to-buffer-other-window))) 463 (if (not (equal (current-buffer) (marker-buffer m))) 464 (funcall cmd (marker-buffer m))) 465 (when (or force 466 (not (equal (org-roam-node-id node) 467 (org-roam-id-at-point)))) 468 (goto-char m)) 469 (move-marker m nil)) 470 (org-show-context)) 471 472 (defun org-roam-node-visit (node &optional other-window force) 473 "From the current buffer, visit NODE. Return the visited buffer. 474 Display the buffer in the selected window. With a prefix 475 argument OTHER-WINDOW display the buffer in another window 476 instead. 477 478 If NODE is already visited, this won't automatically move the 479 point to the beginning of the NODE, unless FORCE is non-nil. In 480 interactive calls FORCE always set to t." 481 (interactive (list (org-roam-node-at-point t) current-prefix-arg t)) 482 (org-roam-node-open node (if other-window 483 #'switch-to-buffer-other-window 484 #'pop-to-buffer-same-window) 485 force)) 486 487 ;;;###autoload 488 (cl-defun org-roam-node-find (&optional other-window initial-input filter-fn pred &key templates) 489 "Find and open an Org-roam node by its title or alias. 490 INITIAL-INPUT is the initial input for the prompt. 491 FILTER-FN is a function to filter out nodes: it takes an `org-roam-node', 492 and when nil is returned the node will be filtered out. 493 If OTHER-WINDOW, visit the NODE in another window. 494 The TEMPLATES, if provided, override the list of capture templates (see 495 `org-roam-capture-'.)" 496 (interactive current-prefix-arg) 497 (let ((node (org-roam-node-read initial-input filter-fn pred))) 498 (if (org-roam-node-file node) 499 (org-roam-node-visit node other-window) 500 (org-roam-capture- 501 :node node 502 :templates templates 503 :props '(:finalize find-file))))) 504 505 ;;;###autoload 506 (defun org-roam-node-random (&optional other-window filter-fn) 507 "Find and open a random Org-roam node. 508 With prefix argument OTHER-WINDOW, visit the node in another 509 window instead. 510 FILTER-FN is a function to filter out nodes: it takes an `org-roam-node', 511 and when nil is returned the node will be filtered out." 512 (interactive current-prefix-arg) 513 (org-roam-node-visit 514 (cdr (seq-random-elt (org-roam-node-read--completions filter-fn))) 515 other-window)) 516 517 ;;;; Completing-read interface 518 (defun org-roam-node-read (&optional initial-input filter-fn sort-fn require-match prompt) 519 "Read and return an `org-roam-node'. 520 INITIAL-INPUT is the initial minibuffer prompt value. 521 FILTER-FN is a function to filter out nodes: it takes an `org-roam-node', 522 and when nil is returned the node will be filtered out. 523 SORT-FN is a function to sort nodes. See `org-roam-node-read-sort-by-file-mtime' 524 for an example sort function. 525 If REQUIRE-MATCH, the minibuffer prompt will require a match. 526 PROMPT is a string to show at the beginning of the mini-buffer, defaulting to \"Node: \"" 527 (let* ((nodes (org-roam-node-read--completions filter-fn sort-fn)) 528 (prompt (or prompt "Node: ")) 529 (node (completing-read 530 prompt 531 (lambda (string pred action) 532 (if (eq action 'metadata) 533 `(metadata 534 ;; Preserve sorting in the completion UI if a sort-fn is used 535 ,@(when sort-fn 536 '((display-sort-function . identity) 537 (cycle-sort-function . identity))) 538 (annotation-function 539 . ,(lambda (title) 540 (funcall org-roam-node-annotation-function 541 (get-text-property 0 'node title)))) 542 (category . org-roam-node)) 543 (complete-with-action action nodes string pred))) 544 nil require-match initial-input 'org-roam-node-history))) 545 (or (cdr (assoc node nodes)) 546 (org-roam-node-create :title node)))) 547 548 (defun org-roam-node-read--completions (&optional filter-fn sort-fn) 549 "Return an alist for node completion. 550 The car is the displayed title or alias for the node, and the cdr 551 is the `org-roam-node'. 552 FILTER-FN is a function to filter out nodes: it takes an `org-roam-node', 553 and when nil is returned the node will be filtered out. 554 SORT-FN is a function to sort nodes. See `org-roam-node-read-sort-by-file-mtime' 555 for an example sort function. 556 The displayed title is formatted according to `org-roam-node-display-template'." 557 (let* ((template (org-roam-node--process-display-format org-roam-node-display-template)) 558 (nodes (org-roam-node-list)) 559 (nodes (if filter-fn 560 (cl-remove-if-not 561 (lambda (n) (funcall filter-fn n)) 562 nodes) 563 nodes)) 564 (nodes (mapcar (lambda (node) 565 (org-roam-node-read--to-candidate node template)) nodes)) 566 (sort-fn (or sort-fn 567 (when org-roam-node-default-sort 568 (intern (concat "org-roam-node-read-sort-by-" 569 (symbol-name org-roam-node-default-sort)))))) 570 (nodes (if sort-fn (seq-sort sort-fn nodes) 571 nodes))) 572 nodes)) 573 574 (defun org-roam-node-read--to-candidate (node template) 575 "Return a minibuffer completion candidate given NODE. 576 TEMPLATE is the processed template used to format the entry." 577 (let ((candidate-main (org-roam-node--format-entry 578 template 579 node 580 (1- (if (bufferp (current-buffer)) 581 (window-width) (frame-width)))))) 582 (cons (propertize candidate-main 'node node) node))) 583 584 (defun org-roam-node--format-entry (template node &optional width) 585 "Formats NODE for display in the results list. 586 WIDTH is the width of the results list. 587 TEMPLATE is the processed template used to format the entry." 588 (pcase-let ((`(,tmpl . ,tmpl-width) template)) 589 (org-roam-format-template 590 tmpl 591 (lambda (field _default-val) 592 (pcase-let* ((`(,field-name ,field-width) (split-string field ":")) 593 (getter (intern (concat "org-roam-node-" field-name))) 594 (field-value (funcall getter node))) 595 (when (and (equal field-name "file") 596 field-value) 597 (setq field-value (file-relative-name field-value org-roam-directory))) 598 (when (and (equal field-name "olp") 599 field-value) 600 (setq field-value (string-join field-value " > "))) 601 (when (and field-value (not (listp field-value))) 602 (setq field-value (list field-value))) 603 (setq field-value (mapconcat 604 (lambda (v) 605 (concat (or (cdr (assoc field-name org-roam-node-template-prefixes)) 606 "") 607 v)) 608 field-value " ")) 609 (setq field-width (cond 610 ((not field-width) 611 field-width) 612 ((string-equal field-width "*") 613 (if width 614 (- width tmpl-width) 615 tmpl-width)) 616 ((>= (string-to-number field-width) 0) 617 (string-to-number field-width)))) 618 (when field-width 619 (let* ((truncated (truncate-string-to-width field-value field-width 0 ?\s)) 620 (tlen (length truncated)) 621 (len (length field-value))) 622 (if (< tlen len) 623 ;; Make the truncated part of the string invisible. If strings 624 ;; are pre-propertized with display or invisible properties, the 625 ;; formatting may get messed up. Ideally, truncated strings are 626 ;; not preformatted with these properties. Face properties are 627 ;; allowed without restriction. 628 (put-text-property tlen len 'invisible t field-value) 629 ;; If the string wasn't truncated, but padded, use this string instead. 630 (setq field-value truncated)))) 631 field-value))))) 632 633 (defun org-roam-node--process-display-format (format) 634 "Pre-calculate minimal widths needed by the FORMAT string." 635 (let* ((fields-width 0) 636 (string-width 637 (string-width 638 (org-roam-format-template 639 format 640 (lambda (field _default-val) 641 (setq fields-width 642 (+ fields-width 643 (string-to-number 644 (or (cadr (split-string field ":")) 645 ""))))))))) 646 (cons format (+ fields-width string-width)))) 647 648 (defun org-roam-node-read-sort-by-file-mtime (completion-a completion-b) 649 "Sort files such that files modified more recently are shown first. 650 COMPLETION-A and COMPLETION-B are items in the form of 651 \(node-title org-roam-node-struct)" 652 (let ((node-a (cdr completion-a)) 653 (node-b (cdr completion-b))) 654 (time-less-p (org-roam-node-file-mtime node-b) 655 (org-roam-node-file-mtime node-a)))) 656 657 (defun org-roam-node-read-sort-by-file-atime (completion-a completion-b) 658 "Sort files such that files accessed more recently are shown first. 659 COMPLETION-A and COMPLETION-B are items in the form of 660 \(node-title org-roam-node-struct)" 661 (let ((node-a (cdr completion-a)) 662 (node-b (cdr completion-b))) 663 (time-less-p (org-roam-node-file-atime node-b) 664 (org-roam-node-file-atime node-a)))) 665 666 (defun org-roam-node-read--annotation (_node) 667 "Placeholder function. Return empty string for annotations." 668 "") 669 670 ;;;; Linkage 671 ;;;;; [id:] link 672 ;;;###autoload 673 (cl-defun org-roam-node-insert (&optional filter-fn &key templates info) 674 "Find an Org-roam node and insert (where the point is) an \"id:\" link to it. 675 FILTER-FN is a function to filter out nodes: it takes an `org-roam-node', 676 and when nil is returned the node will be filtered out. 677 The TEMPLATES, if provided, override the list of capture templates (see 678 `org-roam-capture-'.) 679 The INFO, if provided, is passed to the underlying `org-roam-capture-'." 680 (interactive) 681 (unwind-protect 682 ;; Group functions together to avoid inconsistent state on quit 683 (atomic-change-group 684 (let* (region-text 685 beg end 686 (_ (when (region-active-p) 687 (setq beg (set-marker (make-marker) (region-beginning))) 688 (setq end (set-marker (make-marker) (region-end))) 689 (setq region-text (org-link-display-format (buffer-substring-no-properties beg end))))) 690 (node (org-roam-node-read region-text filter-fn)) 691 (description (or region-text 692 (org-roam-node-formatted node)))) 693 (if (org-roam-node-id node) 694 (progn 695 (when region-text 696 (delete-region beg end) 697 (set-marker beg nil) 698 (set-marker end nil)) 699 (let ((id (org-roam-node-id node))) 700 (insert (org-link-make-string 701 (concat "id:" id) 702 description)) 703 (run-hook-with-args 'org-roam-post-node-insert-hook 704 id 705 description))) 706 (org-roam-capture- 707 :node node 708 :info info 709 :templates templates 710 :props (append 711 (when (and beg end) 712 (list :region (cons beg end))) 713 (list :link-description description 714 :finalize 'insert-link)))))) 715 (deactivate-mark))) 716 717 ;;;;; [roam:] link 718 (org-link-set-parameters "roam" :follow #'org-roam-link-follow-link) 719 (defun org-roam-link-follow-link (title-or-alias) 720 "Navigate \"roam:\" link to find and open the node with TITLE-OR-ALIAS. 721 Assumes that the cursor was put where the link is." 722 (if-let ((node (org-roam-node-from-title-or-alias title-or-alias))) 723 (progn 724 (when org-roam-link-auto-replace 725 (org-roam-link-replace-at-point)) 726 (org-mark-ring-push) 727 (org-roam-node-visit node nil 'force)) 728 (org-roam-capture- 729 :node (org-roam-node-create :title title-or-alias) 730 :props '(:finalize find-file)))) 731 732 (defun org-roam-link-replace-at-point (&optional link) 733 "Replace \"roam:\" LINK at point with an \"id:\" link." 734 (save-excursion 735 (save-match-data 736 (let* ((link (or link (org-element-context))) 737 (type (org-element-property :type link)) 738 (path (org-element-property :path link)) 739 (desc (and (org-element-property :contents-begin link) 740 (org-element-property :contents-end link) 741 (buffer-substring-no-properties 742 (org-element-property :contents-begin link) 743 (org-element-property :contents-end link)))) 744 node) 745 (goto-char (org-element-property :begin link)) 746 (when (and (org-in-regexp org-link-any-re 1) 747 (string-equal type "roam") 748 (setq node (save-match-data (org-roam-node-from-title-or-alias path)))) 749 (replace-match (org-link-make-string 750 (concat "id:" (org-roam-node-id node)) 751 (or desc path)))))))) 752 753 (defun org-roam-link-replace-all () 754 "Replace all \"roam:\" links in buffer with \"id:\" links." 755 (interactive) 756 (org-with-point-at 1 757 (while (re-search-forward org-link-bracket-re nil t) 758 (org-roam-link-replace-at-point)))) 759 760 (add-hook 'org-roam-find-file-hook #'org-roam--replace-roam-links-on-save-h) 761 (defun org-roam--replace-roam-links-on-save-h () 762 "Run `org-roam-link-replace-all' before buffer is saved to its file." 763 (when org-roam-link-auto-replace 764 (add-hook 'before-save-hook #'org-roam-link-replace-all nil t))) 765 766 ;;;;;; Completion-at-point interface 767 (defconst org-roam-bracket-completion-re 768 "\\[\\[\\(\\(?:roam:\\)?\\)\\([^z-a]*?\\)]]" 769 "Regex for completion within link brackets. 770 We use this as a substitute for `org-link-bracket-re', because 771 `org-link-bracket-re' requires content within the brackets for a match.") 772 773 (defun org-roam-complete-link-at-point () 774 "Complete \"roam:\" link at point to an existing Org-roam node." 775 (let (roam-p start end) 776 (when (org-in-regexp org-roam-bracket-completion-re 1) 777 (setq roam-p (not (or (org-in-src-block-p) 778 (string-blank-p (match-string 1)))) 779 start (match-beginning 2) 780 end (match-end 2)) 781 (list start end 782 (org-roam--get-titles) 783 :exit-function 784 (lambda (str &rest _) 785 (delete-char (- 0 (length str))) 786 (insert (concat (unless roam-p "roam:") 787 str)) 788 (forward-char 2)))))) 789 790 (defun org-roam-complete-everywhere () 791 "Complete symbol at point as a link completion to an Org-roam node. 792 This is a `completion-at-point' function, and is active when 793 `org-roam-completion-everywhere' is non-nil. 794 795 Unlike `org-roam-complete-link-at-point' this will complete even 796 outside of the bracket syntax for links (i.e. \"[[roam:|]]\"), 797 hence \"everywhere\"." 798 (when (and org-roam-completion-everywhere 799 (thing-at-point 'word) 800 (not (org-in-src-block-p)) 801 (not (save-match-data (org-in-regexp org-link-any-re)))) 802 (let ((bounds (bounds-of-thing-at-point 'word))) 803 (list (car bounds) (cdr bounds) 804 (org-roam--get-titles) 805 :exit-function 806 (lambda (str _status) 807 (delete-char (- (length str))) 808 (insert "[[roam:" str "]]")) 809 ;; Proceed with the next completion function if the returned titles 810 ;; do not match. This allows the default Org capfs or custom capfs 811 ;; of lower priority to run. 812 :exclusive 'no)))) 813 814 (add-hook 'org-roam-find-file-hook #'org-roam--register-completion-functions-h) 815 (add-hook 'org-roam-indirect-buffer-hook #'org-roam--register-completion-functions-h) 816 817 (defun org-roam--register-completion-functions-h () 818 "Setup `org-roam-completion-functions' for `completion-at-point'." 819 (dolist (f org-roam-completion-functions) 820 (add-hook 'completion-at-point-functions f nil t))) 821 822 ;;;; Editing 823 (defun org-roam-demote-entire-buffer () 824 "Convert an org buffer with any top level content to a single node. 825 826 All headings are demoted one level. 827 828 The #+TITLE: keyword is converted into a level-1 heading and deleted. 829 Any tags declared on #+FILETAGS: are transferred to tags on the new top heading. 830 831 Any top level properties drawers are incorporated into the new heading." 832 (interactive) 833 (org-with-point-at 1 834 (org-map-region #'org-do-demote 835 (point-min) (point-max)) 836 (insert "* " 837 (org-roam--get-keyword "title") 838 "\n") 839 (org-back-to-heading) 840 (org-set-tags (org-roam--get-keyword "filetags")) 841 (org-roam-erase-keyword "title") 842 (org-roam-erase-keyword "filetags"))) 843 844 (defun org-roam--h1-count () 845 "Count level-1 headings in the current file." 846 (let ((h1-count 0)) 847 (org-with-wide-buffer 848 (org-map-region (lambda () 849 (if (= (org-current-level) 1) 850 (cl-incf h1-count))) 851 (point-min) (point-max)) 852 h1-count))) 853 854 (defun org-roam--buffer-promoteable-p () 855 "Verify that this buffer is promoteable: 856 There is a single level-1 heading 857 and no extra content before the first heading." 858 (and 859 (= (org-roam--h1-count) 1) 860 (org-with-point-at 1 (org-at-heading-p)))) 861 862 (defun org-roam-promote-entire-buffer () 863 "Promote the current buffer. 864 Converts a file containing a single level-1 headline node to a file 865 node." 866 (interactive) 867 (unless (org-roam--buffer-promoteable-p) 868 (user-error "Cannot promote: multiple root headings or there is extra file-level text")) 869 (org-with-point-at 1 870 (let ((title (nth 4 (org-heading-components))) 871 (tags (org-get-tags))) 872 (kill-whole-line) 873 (org-roam-end-of-meta-data t) 874 (insert "#+title: " title "\n") 875 (when tags (org-roam-tag-add tags)) 876 (org-map-region #'org-promote (point-min) (point-max)) 877 (org-roam-db-update-file)))) 878 879 ;;;###autoload 880 (defun org-roam-refile () 881 "Refile node at point to an Org-roam node. 882 If region is active, then use it instead of the node at point." 883 (interactive) 884 (let* ((regionp (org-region-active-p)) 885 (region-start (and regionp (region-beginning))) 886 (region-end (and regionp (region-end))) 887 (node (org-roam-node-read nil nil nil 'require-match)) 888 (file (org-roam-node-file node)) 889 (nbuf (or (find-buffer-visiting file) 890 (find-file-noselect file))) 891 level reversed) 892 (if (equal (org-roam-node-at-point) node) 893 (user-error "Target is the same as current node") 894 (if regionp 895 (progn 896 (org-kill-new (buffer-substring region-start region-end)) 897 (org-save-markers-in-region region-start region-end)) 898 (progn 899 (if (org-before-first-heading-p) 900 (org-roam-demote-entire-buffer)) 901 (org-copy-subtree 1 nil t))) 902 (with-current-buffer nbuf 903 (org-with-wide-buffer 904 (goto-char (org-roam-node-point node)) 905 (setq level (org-get-valid-level (funcall outline-level) 1) 906 reversed (org-notes-order-reversed-p)) 907 (goto-char 908 (if reversed 909 (or (outline-next-heading) (point-max)) 910 (or (save-excursion (org-get-next-sibling)) 911 (org-end-of-subtree t t) 912 (point-max)))) 913 (unless (bolp) (newline)) 914 (org-paste-subtree level nil nil t) 915 (and org-auto-align-tags 916 (let ((org-loop-over-headlines-in-active-region nil)) 917 (org-align-tags))) 918 (when (fboundp 'deactivate-mark) (deactivate-mark)))) 919 (if regionp 920 (delete-region (point) (+ (point) (- region-end region-start))) 921 (org-preserve-local-variables 922 (delete-region 923 (and (org-back-to-heading t) (point)) 924 (min (1+ (buffer-size)) (org-end-of-subtree t t) (point))))) 925 ;; If the buffer end-up empty after the refile, kill it and delete its 926 ;; associated file. 927 (when (eq (buffer-size) 0) 928 (if (buffer-file-name) 929 (delete-file (buffer-file-name))) 930 (set-buffer-modified-p nil) 931 ;; If this was done during capture, abort the capture process. 932 (when (and org-capture-mode 933 (buffer-base-buffer (current-buffer))) 934 (org-capture-kill)) 935 (kill-buffer (current-buffer)))))) 936 937 ;;;###autoload 938 (defun org-roam-extract-subtree () 939 "Convert current subtree at point to a node, and extract it into a new file." 940 (interactive) 941 (save-excursion 942 (org-back-to-heading-or-point-min t) 943 (when (bobp) (user-error "Already a top-level node")) 944 (org-id-get-create) 945 (save-buffer) 946 (org-roam-db-update-file) 947 (let* ((template-info nil) 948 (node (org-roam-node-at-point)) 949 (template (org-roam-format-template 950 (string-trim (org-capture-fill-template org-roam-extract-new-file-path)) 951 (lambda (key default-val) 952 (let ((fn (intern key)) 953 (node-fn (intern (concat "org-roam-node-" key))) 954 (ksym (intern (concat ":" key)))) 955 (cond 956 ((fboundp fn) 957 (funcall fn node)) 958 ((fboundp node-fn) 959 (funcall node-fn node)) 960 (t (let ((r (read-from-minibuffer (format "%s: " key) default-val))) 961 (plist-put template-info ksym r) 962 r))))))) 963 (file-path 964 (expand-file-name 965 (read-file-name "Extract node to: " 966 (file-name-as-directory org-roam-directory) template nil template) 967 org-roam-directory))) 968 (when (file-exists-p file-path) 969 (user-error "%s exists. Aborting" file-path)) 970 (org-cut-subtree) 971 (save-buffer) 972 (with-current-buffer (find-file-noselect file-path) 973 (org-paste-subtree) 974 (while (> (org-current-level) 1) (org-promote-subtree)) 975 (save-buffer) 976 (org-roam-promote-entire-buffer) 977 (save-buffer))))) 978 979 ;;; Refs 980 ;;;; Completing-read interface 981 (defun org-roam-ref-read (&optional initial-input filter-fn) 982 "Read an Org-roam ref and return a corresponding `org-roam-node'. 983 INITIAL-INPUT is the initial prompt value. 984 FILTER-FN is a function to filter out nodes: it takes an `org-roam-node', 985 and when nil is returned the node will be filtered out. 986 filtered out." 987 (let* ((refs (org-roam-ref-read--completions)) 988 (refs (cl-remove-if-not (lambda (n) 989 (if filter-fn (funcall filter-fn (cdr n)) t)) refs)) 990 (ref (completing-read "Ref: " 991 (lambda (string pred action) 992 (if (eq action 'metadata) 993 `(metadata 994 (annotation-function 995 . ,org-roam-ref-annotation-function) 996 (category . org-roam-ref)) 997 (complete-with-action action refs string pred))) 998 nil t initial-input 'org-roam-ref-history))) 999 (cdr (assoc ref refs)))) 1000 1001 (defun org-roam-ref-read--completions () 1002 "Return an alist for ref completion. 1003 The car is the ref, and the cdr is the corresponding node for the ref." 1004 (let ((rows (org-roam-db-query 1005 [:select [id ref type nodes:file pos title] 1006 :from refs 1007 :left-join nodes 1008 :on (= refs:node-id nodes:id)]))) 1009 (cl-loop for row in rows 1010 collect (pcase-let* ((`(,id ,ref ,type ,file ,pos ,title) row) 1011 (node (org-roam-node-create :id id 1012 :file file 1013 :point pos 1014 :title title))) 1015 (cons 1016 (concat (propertize ref 'node node 'type type) 1017 (propertize id 'invisible t)) 1018 node))))) 1019 1020 (defun org-roam-ref-read--annotation (ref) 1021 "Return the annotation for REF, which assumed to be a propertized string." 1022 (let* ((node (get-text-property 0 'node ref)) 1023 (title (org-roam-node-title node))) 1024 (when title 1025 (concat " " title)))) 1026 1027 ;;;; Finders 1028 ;;;###autoload 1029 (defun org-roam-ref-find (&optional initial-input filter-fn) 1030 "Find and open an Org-roam node that's dedicated to a specific ref. 1031 INITIAL-INPUT is the initial input to the prompt. 1032 FILTER-FN is a function to filter out nodes: it takes an `org-roam-node', 1033 and when nil is returned the node will be filtered out." 1034 (interactive) 1035 (let* ((node (org-roam-ref-read initial-input filter-fn))) 1036 (org-roam-node-visit node))) 1037 1038 ;;;; Editing 1039 (defun org-roam-ref-add (ref) 1040 "Add REF to the node at point." 1041 (interactive "sRef: ") 1042 (let ((node (org-roam-node-at-point 'assert))) 1043 (save-excursion 1044 (goto-char (org-roam-node-point node)) 1045 (org-roam-property-add "ROAM_REFS" (if (memq " " (string-to-list ref)) 1046 (concat "\"" ref "\"") 1047 ref))))) 1048 1049 (defun org-roam-ref-remove (&optional ref) 1050 "Remove a REF from the node at point." 1051 (interactive) 1052 (let ((node (org-roam-node-at-point 'assert))) 1053 (save-excursion 1054 (goto-char (org-roam-node-point node)) 1055 (org-roam-property-remove "ROAM_REFS" ref)))) 1056 1057 ;;; Tags 1058 ;;;; Getters 1059 (defun org-roam-tag-completions () 1060 "Return list of tags for completions within Org-roam." 1061 (let ((roam-tags (mapcar #'car (org-roam-db-query [:select :distinct [tag] :from tags]))) 1062 (org-tags (cl-loop for tagg in org-tag-alist 1063 nconc (pcase tagg 1064 ('(:newline) 1065 nil) 1066 (`(,tag . ,_) 1067 (list tag)) 1068 (_ nil))))) 1069 (seq-uniq (append roam-tags org-tags)))) 1070 1071 ;;;; Editing 1072 (defun org-roam-tag-add (tags) 1073 "Add TAGS to the node at point." 1074 (interactive 1075 (list (let ((crm-separator "[ ]*:[ ]*")) 1076 (completing-read-multiple "Tag: " (org-roam-tag-completions))))) 1077 (let ((node (org-roam-node-at-point 'assert))) 1078 (save-excursion 1079 (goto-char (org-roam-node-point node)) 1080 (if (= (org-outline-level) 0) 1081 (let ((current-tags (split-string (or (cadr (assoc "FILETAGS" 1082 (org-collect-keywords '("filetags")))) 1083 "") 1084 ":" 'omit-nulls))) 1085 (org-roam-set-keyword "filetags" (org-make-tag-string (seq-uniq (append tags current-tags))))) 1086 (org-set-tags (seq-uniq (append tags (org-get-tags))))) 1087 tags))) 1088 1089 (defun org-roam-tag-remove (&optional tags) 1090 "Remove TAGS from the node at point." 1091 (interactive) 1092 (let ((node (org-roam-node-at-point 'assert))) 1093 (save-excursion 1094 (goto-char (org-roam-node-point node)) 1095 (if (= (org-outline-level) 0) 1096 (let* ((current-tags (split-string (or (cadr (assoc "FILETAGS" 1097 (org-collect-keywords '("filetags")))) 1098 (user-error "No tag to remove")) 1099 ":" 'omit-nulls)) 1100 (tags (or tags (completing-read-multiple "Tag: " current-tags)))) 1101 (org-roam-set-keyword "filetags" 1102 (org-make-tag-string (seq-difference current-tags tags #'string-equal)))) 1103 (let* ((current-tags (or (org-get-tags) 1104 (user-error "No tag to remove"))) 1105 (tags (or tags (completing-read-multiple "Tag: " current-tags)))) 1106 (org-set-tags (seq-difference current-tags tags #'string-equal)))) 1107 tags))) 1108 1109 ;;; Titles and Aliases 1110 ;;;; Getters 1111 (defun org-roam--get-titles () 1112 "Return all distinct titles and aliases in the Org-roam database." 1113 (mapcar #'car (org-roam-db-query [:select :distinct title :from nodes 1114 :union :select alias :from aliases]))) 1115 1116 ;;;; Editing 1117 (defun org-roam-alias-add (alias) 1118 "Add ALIAS to the node at point." 1119 (interactive "sAlias: ") 1120 (let ((node (org-roam-node-at-point 'assert))) 1121 (save-excursion 1122 (goto-char (org-roam-node-point node)) 1123 (org-roam-property-add "ROAM_ALIASES" alias)))) 1124 1125 (defun org-roam-alias-remove (&optional alias) 1126 "Remove an ALIAS from the node at point." 1127 (interactive) 1128 (let ((node (org-roam-node-at-point 'assert))) 1129 (save-excursion 1130 (goto-char (org-roam-node-point node)) 1131 (org-roam-property-remove "ROAM_ALIASES" alias)))) 1132 1133 1134 (provide 'org-roam-node) 1135 ;;; org-roam-node.el ends here