dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

org-roam-db.el (32435B)


      1 ;;; org-roam-db.el --- Org-roam database API -*- coding: utf-8; 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") (emacsql "3.0.0") (emacsql-sqlite "1.0.0") (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 provides the underlying database API to Org-roam.
     31 ;;
     32 ;;; Code:
     33 (require 'org-roam)
     34 (require 'url-parse)
     35 (require 'ol)
     36 (defvar org-outline-path-cache)
     37 
     38 ;;; Options
     39 (defcustom org-roam-database-connector (if (and (progn
     40                                                   (require 'emacsql-sqlite-builtin nil t)
     41                                                   (functionp 'emacsql-sqlite-builtin))
     42                                                 (functionp 'sqlite-open))
     43                                            'sqlite-builtin
     44                                          'sqlite)
     45   "The database connector used by Org-roam.
     46 This must be set before `org-roam' is loaded.  To use an alternative
     47 connector you must install the respective package explicitly.
     48 The default is `sqlite', which uses the `emacsql-sqlite' library
     49 that is being maintained in the same repository as `emacsql'
     50 itself.
     51 If you are using Emacs 29, then the recommended connector is
     52 `sqlite-builtin', which uses the new builtin support for SQLite.
     53 You need to install the `emacsql-sqlite-builtin' package to use
     54 this connector.
     55 If you are using an older Emacs release, then the recommended
     56 connector is `sqlite-module', which uses the module provided by
     57 the `sqlite3' package.  This is very similar to the previous
     58 connector and the built-in support in Emacs 29 derives from this
     59 module.  You need to install the `emacsql-sqlite-module' package
     60 to use this connector.
     61 For the time being `libsqlite3' is still supported.  Do not use
     62 this, it is an older version of the `sqlite-module' connector
     63 from before the connector and the package were renamed.
     64 For the time being `sqlite3' is also supported.  Do not use this.
     65 This uses the third-party `emacsql-sqlite3' package, which uses
     66 the official `sqlite3' cli tool, which is not intended
     67 to be used like this.  See https://nullprogram.com/blog/2014/02/06/."
     68   :package-version '(forge . "0.3.0")
     69   :group 'org-roam
     70   :type '(choice (const sqlite)
     71                  (const sqlite-builtin)
     72                  (const sqlite-module)
     73                  (const :tag "libsqlite3 (OBSOLETE)" libsqlite3)
     74                  (const :tag "sqlite3 (BROKEN)" sqlite3)))
     75 
     76 (defcustom org-roam-db-location (locate-user-emacs-file "org-roam.db")
     77   "The path to file where the Org-roam database is stored.
     78 
     79 It is the user's responsibility to set this correctly, especially
     80 when used with multiple Org-roam instances."
     81   :type 'string
     82   :group 'org-roam)
     83 
     84 (defcustom org-roam-db-gc-threshold gc-cons-threshold
     85   "The value to temporarily set the `gc-cons-threshold' threshold to.
     86 During `org-roam-db-sync', Emacs can pause multiple times to
     87 perform garbage collection because of the large number of
     88 temporary structures generated (e.g. parsed ASTs).
     89 
     90 `gc-cons-threshold' is temporarily set to
     91 `org-roam-db-gc-threshold' during this operation, and increasing
     92 `gc-cons-threshold' will help reduce the number of GC operations,
     93 at the cost of memory usage. Tweaking this value may lead to
     94 better overall performance.
     95 
     96 For example, to reduce the number of GCs to the minimum, on
     97 machines with large memory one may set it to
     98 `most-positive-fixnum'."
     99   :type 'int
    100   :group 'org-roam)
    101 
    102 (defcustom org-roam-db-node-include-function (lambda () t)
    103   "A custom function to check if the point contains a valid node.
    104 This function is called each time a node (both file and headline)
    105 is about to be saved into the Org-roam database.
    106 
    107 If the function returns nil, Org-roam will skip the node. This
    108 function is useful for excluding certain nodes from the Org-roam
    109 database."
    110   :type 'function
    111   :group 'org-roam)
    112 
    113 (defcustom org-roam-db-update-on-save t
    114   "If t, update the Org-roam database upon saving the file.
    115 Disable this if your files are large and updating the database is
    116 slow."
    117   :type 'boolean
    118   :group 'org-roam)
    119 
    120 (defcustom org-roam-db-extra-links-elements '(node-property keyword)
    121   "The list of Org element types to include for parsing by Org-roam.
    122 
    123 By default, when parsing Org's AST, links within keywords and
    124 property drawers are not parsed as links. Sometimes however, it
    125 is desirable to parse and cache these links (e.g. hiding links in
    126 a property drawer)."
    127   :package-version '(org-roam . "2.2.0")
    128   :group 'org-roam
    129   :type '(set (const :tag "keywords" keyword)
    130               (const :tag "property drawers" node-property)))
    131 
    132 (defcustom org-roam-db-extra-links-exclude-keys '((node-property . ("ROAM_REFS"))
    133                                                   (keyword . ("transclude")))
    134   "Keys to ignore when mapping over links.
    135 
    136 The car of the association list is the Org element type (e.g.
    137 keyword). The cdr is a list of case-insensitive strings to
    138 exclude from being treated as links.
    139 
    140 For example, we use this to prevent self-referential links in
    141 ROAM_REFS."
    142   :package-version '(org-roam . "2.2.0")
    143   :group 'org-roam
    144   :type '(alist))
    145 
    146 ;;; Variables
    147 (defconst org-roam-db-version 18)
    148 
    149 (defvar org-roam-db--connection (make-hash-table :test #'equal)
    150   "Database connection to Org-roam database.")
    151 
    152 ;;; Core Functions
    153 (defun org-roam-db--get-connection ()
    154   "Return the database connection, if any."
    155   (gethash (expand-file-name (file-name-as-directory org-roam-directory))
    156            org-roam-db--connection))
    157 
    158 (declare-function emacsql-sqlite "ext:emacsql-sqlite")
    159 (declare-function emacsql-sqlite3 "ext:emacsql-sqlite3")
    160 (declare-function emacsql-libsqlite3 "ext:emacsql-libsqlite3")
    161 (declare-function emacsql-sqlite-builtin "ext:emacsql-sqlite-builtin")
    162 (declare-function emacsql-sqlite-module "ext:emacsql-sqlite-module")
    163 
    164 (defun org-roam-db--conn-fn ()
    165   "Return the function for creating the database connection."
    166   (cl-case org-roam-database-connector
    167     (sqlite
    168      (progn
    169        (require 'emacsql-sqlite)
    170        #'emacsql-sqlite))
    171     (sqlite-builtin
    172      (progn
    173        (require 'emacsql-sqlite-builtin)
    174        #'emacsql-sqlite-builtin))
    175     (sqlite-module
    176      (progn
    177        (require 'emacsql-sqlite-module)
    178        #'emacsql-sqlite-module))
    179     (libsqlite3
    180      (progn
    181        (require 'emacsql-libsqlite3)
    182        #'emacsql-libsqlite3))
    183     (sqlite3
    184      (progn
    185        (require 'emacsql-sqlite3)
    186        #'emacsql-sqlite3))))
    187 
    188 (defun org-roam-db ()
    189   "Entrypoint to the Org-roam sqlite database.
    190 Initializes and stores the database, and the database connection.
    191 Performs a database upgrade when required."
    192   (unless (and (org-roam-db--get-connection)
    193                (emacsql-live-p (org-roam-db--get-connection)))
    194     (let ((init-db (not (file-exists-p org-roam-db-location))))
    195       (make-directory (file-name-directory org-roam-db-location) t)
    196       (let ((conn (funcall (org-roam-db--conn-fn) org-roam-db-location)))
    197         (emacsql conn [:pragma (= foreign_keys ON)])
    198         (when-let* ((process (emacsql-process conn))
    199                     (_ (processp process)))
    200           (set-process-query-on-exit-flag process nil))
    201         (puthash (expand-file-name (file-name-as-directory org-roam-directory))
    202                  conn
    203                  org-roam-db--connection)
    204         (when init-db
    205           (org-roam-db--init conn))
    206         (let* ((version (caar (emacsql conn "PRAGMA user_version")))
    207                (version (org-roam-db--upgrade-maybe conn version)))
    208           (cond
    209            ((> version org-roam-db-version)
    210             (emacsql-close conn)
    211             (user-error
    212              "The Org-roam database was created with a newer Org-roam version.  "
    213              "You need to update the Org-roam package"))
    214            ((< version org-roam-db-version)
    215             (emacsql-close conn)
    216             (error "BUG: The Org-roam database scheme changed %s"
    217                    "and there is no upgrade path")))))))
    218   (org-roam-db--get-connection))
    219 
    220 ;;; Entrypoint: (org-roam-db-query)
    221 (define-error 'emacsql-constraint "SQL constraint violation")
    222 (defun org-roam-db-query (sql &rest args)
    223   "Run SQL query on Org-roam database with ARGS.
    224 SQL can be either the emacsql vector representation, or a string."
    225   (apply #'emacsql (org-roam-db) sql args))
    226 
    227 (defun org-roam-db-query! (handler sql &rest args)
    228   "Run SQL query on Org-roam database with ARGS.
    229 SQL can be either the emacsql vector representation, or a string.
    230 The query is expected to be able to fail, in this situation, run HANDLER."
    231   (condition-case err
    232       (org-roam-db-query sql args)
    233     (emacsql-constraint
    234      (funcall handler err))))
    235 
    236 ;;; Schemata
    237 (defconst org-roam-db--table-schemata
    238   '((files
    239      [(file :unique :primary-key)
    240       title
    241       (hash :not-null)
    242       (atime :not-null)
    243       (mtime :not-null)])
    244 
    245     (nodes
    246      ([(id :not-null :primary-key)
    247        (file :not-null)
    248        (level :not-null)
    249        (pos :not-null)
    250        todo
    251        priority
    252        (scheduled text)
    253        (deadline text)
    254        title
    255        properties
    256        olp]
    257       (:foreign-key [file] :references files [file] :on-delete :cascade)))
    258 
    259     (aliases
    260      ([(node-id :not-null)
    261        alias]
    262       (:foreign-key [node-id] :references nodes [id] :on-delete :cascade)))
    263 
    264     (citations
    265      ([(node-id :not-null)
    266        (cite-key :not-null)
    267        (pos :not-null)
    268        properties]
    269       (:foreign-key [node-id] :references nodes [id] :on-delete :cascade)))
    270 
    271     (refs
    272      ([(node-id :not-null)
    273        (ref :not-null)
    274        (type :not-null)]
    275       (:foreign-key [node-id] :references nodes [id] :on-delete :cascade)))
    276 
    277     (tags
    278      ([(node-id :not-null)
    279        tag]
    280       (:foreign-key [node-id] :references nodes [id] :on-delete :cascade)))
    281 
    282     (links
    283      ([(pos :not-null)
    284        (source :not-null)
    285        (dest :not-null)
    286        (type :not-null)
    287        (properties :not-null)]
    288       (:foreign-key [source] :references nodes [id] :on-delete :cascade)))))
    289 
    290 (defconst org-roam-db--table-indices
    291   '((alias-node-id aliases [node-id])
    292     (refs-node-id refs [node-id])
    293     (tags-node-id tags [node-id])))
    294 
    295 (defun org-roam-db--init (db)
    296   "Initialize database DB with the correct schema and user version."
    297   (emacsql-with-transaction db
    298     (pcase-dolist (`(,table ,schema) org-roam-db--table-schemata)
    299       (emacsql db [:create-table $i1 $S2] table schema))
    300     (pcase-dolist (`(,index-name ,table ,columns) org-roam-db--table-indices)
    301       (emacsql db [:create-index $i1 :on $i2 $S3] index-name table columns))
    302     (emacsql db (format "PRAGMA user_version = %s" org-roam-db-version))))
    303 
    304 (defun org-roam-db--upgrade-maybe (db version)
    305   "Upgrades the database schema for DB, if VERSION is old."
    306   (emacsql-with-transaction db
    307     'ignore
    308     (if (< version org-roam-db-version)
    309         (progn
    310           (org-roam-message (format "Upgrading the Org-roam database from version %d to version %d"
    311                                     version org-roam-db-version))
    312           (org-roam-db-sync t))))
    313   version)
    314 
    315 (defun org-roam-db--close (&optional db)
    316   "Closes the database connection for database DB.
    317 If DB is nil, closes the database connection for the database in
    318 the current `org-roam-directory'."
    319   (unless db
    320     (setq db (org-roam-db--get-connection)))
    321   (when (and db (emacsql-live-p db))
    322     (emacsql-close db)))
    323 
    324 (defun org-roam-db--close-all ()
    325   "Closes all database connections made by Org-roam."
    326   (dolist (conn (hash-table-values org-roam-db--connection))
    327     (org-roam-db--close conn)))
    328 
    329 ;;; Database API
    330 ;;;; Clearing
    331 (defun org-roam-db-clear-all ()
    332   "Clears all entries in the Org-roam cache."
    333   (interactive)
    334   (when (file-exists-p org-roam-db-location)
    335     (dolist (table (mapcar #'car org-roam-db--table-schemata))
    336       (org-roam-db-query `[:delete :from ,table]))))
    337 
    338 (defun org-roam-db-clear-file (&optional file)
    339   "Remove any related links to the FILE.
    340 This is equivalent to removing the node from the graph.
    341 If FILE is nil, clear the current buffer."
    342   (setq file (or file (buffer-file-name (buffer-base-buffer))))
    343   (org-roam-db-query [:delete :from files
    344                       :where (= file $s1)]
    345                      file))
    346 
    347 ;;;; Updating tables
    348 
    349 (defun org-roam-db--file-title ()
    350   "In current Org buffer, get the title.
    351 If there is no title, return the file name relative to
    352 `org-roam-directory'."
    353   (org-link-display-format
    354    (or (string-join (cdr (assoc "TITLE" (org-collect-keywords '("title")))) " ")
    355        (file-name-sans-extension (file-relative-name
    356                                   (buffer-file-name (buffer-base-buffer))
    357                                   org-roam-directory)))))
    358 
    359 (defun org-roam-db-insert-file (&optional hash)
    360   "Update the files table for the current buffer.
    361 If UPDATE-P is non-nil, first remove the file in the database.
    362 If HASH is non-nil, use that as the file's hash without recalculating it."
    363   (let* ((file (buffer-file-name))
    364          (file-title (org-roam-db--file-title))
    365          (attr (file-attributes file))
    366          (atime (file-attribute-access-time attr))
    367          (mtime (file-attribute-modification-time attr))
    368          (hash (or hash (org-roam-db--file-hash file))))
    369     (org-roam-db-query
    370      [:insert :into files
    371       :values $v1]
    372      (list (vector file file-title hash atime mtime)))))
    373 
    374 (defun org-roam-db-get-scheduled-time ()
    375   "Return the scheduled time at point in ISO8601 format."
    376   (when-let ((time (org-get-scheduled-time (point))))
    377     (org-format-time-string "%FT%T%z" time)))
    378 
    379 (defun org-roam-db-get-deadline-time ()
    380   "Return the deadline time at point in ISO8601 format."
    381   (when-let ((time (org-get-deadline-time (point))))
    382     (org-format-time-string "%FT%T%z" time)))
    383 
    384 (defun org-roam-db-node-p ()
    385   "Return t if headline at point is an Org-roam node, else return nil."
    386   (and (org-id-get)
    387        (not (org-entry-get (point) "ROAM_EXCLUDE"))
    388        (funcall org-roam-db-node-include-function)))
    389 
    390 (defun org-roam-db-map-nodes (fns)
    391   "Run FNS over all nodes in the current buffer."
    392   (org-with-wide-buffer
    393    (org-map-region
    394     (lambda ()
    395       (when (org-roam-db-node-p)
    396         (dolist (fn fns)
    397           (funcall fn))))
    398     (point-min) (point-max))))
    399 
    400 (defun org-roam-db-map-links (fns)
    401   "Run FNS over all links in the current buffer."
    402   (org-with-point-at 1
    403     (while (re-search-forward org-link-any-re nil :no-error)
    404       ;; `re-search-forward' let the cursor one character after the link, we need to go backward one char to
    405       ;; make the point be on the link.
    406       (backward-char)
    407       (let* ((begin (match-beginning 0))
    408              (element (org-element-context))
    409              (type (org-element-type element))
    410              link bounds)
    411         (cond
    412          ;; Links correctly recognized by Org Mode
    413          ((eq type 'link)
    414           (setq link element))
    415          ;; Links in property drawers and lines starting with #+. Recall that, as for Org Mode v9.4.4, the
    416          ;; org-element-type of links within properties drawers is "node-property" and for lines starting with
    417          ;; #+ is "keyword".
    418          ((and (member type org-roam-db-extra-links-elements)
    419                (not (member-ignore-case (org-element-property :key element)
    420                                         (cdr (assoc type org-roam-db-extra-links-exclude-keys))))
    421                (setq link (save-excursion
    422                             (goto-char begin)
    423                             (save-match-data (org-element-link-parser)))))))
    424         (when link
    425           (dolist (fn fns)
    426             (funcall fn link)))))))
    427 
    428 (defun org-roam-db-map-citations (info fns)
    429   "Run FNS over all citations in the current buffer.
    430 INFO is the org-element parsed buffer."
    431   (org-element-map info 'citation-reference
    432     (lambda (cite)
    433       (dolist (fn fns)
    434         (funcall fn cite)))))
    435 
    436 (defun org-roam-db-insert-file-node ()
    437   "Insert the file-level node into the Org-roam cache."
    438   (org-with-point-at 1
    439     (when (and (= (org-outline-level) 0)
    440                (org-roam-db-node-p))
    441       (when-let ((id (org-id-get)))
    442         (let* ((file (buffer-file-name (buffer-base-buffer)))
    443                (title (org-roam-db--file-title))
    444                (pos (point))
    445                (todo nil)
    446                (priority nil)
    447                (scheduled nil)
    448                (deadline nil)
    449                (level 0)
    450                (tags org-file-tags)
    451                (properties (org-entry-properties))
    452                (olp nil))
    453           (org-roam-db-query!
    454            (lambda (err)
    455              (lwarn 'org-roam :warning "%s for %s (%s) in %s"
    456                     (error-message-string err)
    457                     title id file))
    458            [:insert :into nodes
    459             :values $v1]
    460            (vector id file level pos todo priority
    461                    scheduled deadline title properties olp))
    462           (when tags
    463             (org-roam-db-query
    464              [:insert :into tags
    465               :values $v1]
    466              (mapcar (lambda (tag)
    467                        (vector id (substring-no-properties tag)))
    468                      tags)))
    469           (org-roam-db-insert-aliases)
    470           (org-roam-db-insert-refs))))))
    471 
    472 (cl-defun org-roam-db-insert-node-data ()
    473   "Insert node data for headline at point into the Org-roam cache."
    474   (when-let ((id (org-id-get)))
    475     (let* ((file (buffer-file-name (buffer-base-buffer)))
    476            (heading-components (org-heading-components))
    477            (pos (point))
    478            (todo (nth 2 heading-components))
    479            (priority (nth 3 heading-components))
    480            (level (nth 1 heading-components))
    481            (scheduled (org-roam-db-get-scheduled-time))
    482            (deadline (org-roam-db-get-deadline-time))
    483            (title (or (nth 4 heading-components)
    484                       (progn (lwarn 'org-roam :warning "Node in %s:%s:%s has no title, skipping..."
    485                                     file
    486                                     (line-number-at-pos)
    487                                     (1+ (- (point) (line-beginning-position))))
    488                              (cl-return-from org-roam-db-insert-node-data))))
    489            (properties (org-entry-properties))
    490            (olp (org-get-outline-path nil 'use-cache))
    491            (title (org-link-display-format title)))
    492       (org-roam-db-query!
    493        (lambda (err)
    494          (lwarn 'org-roam :warning "%s for %s (%s) in %s"
    495                 (error-message-string err)
    496                 title id file))
    497        [:insert :into nodes
    498         :values $v1]
    499        (vector id file level pos todo priority
    500                scheduled deadline title properties olp)))))
    501 
    502 (defun org-roam-db-insert-aliases ()
    503   "Insert aliases for node at point into Org-roam cache."
    504   (when-let* ((node-id (org-id-get))
    505               (aliases (org-entry-get (point) "ROAM_ALIASES"))
    506               (aliases (split-string-and-unquote aliases)))
    507     (org-roam-db-query [:insert :into aliases
    508                         :values $v1]
    509                        (mapcar (lambda (alias)
    510                                  (vector node-id alias))
    511                                aliases))))
    512 
    513 (defun org-roam-db-insert-tags ()
    514   "Insert tags for node at point into Org-roam cache."
    515   (when-let ((node-id (org-id-get))
    516              (tags (org-get-tags)))
    517     (org-roam-db-query [:insert :into tags
    518                         :values $v1]
    519                        (mapcar (lambda (tag)
    520                                  (vector node-id (substring-no-properties tag))) tags))))
    521 
    522 (defun org-roam-db-insert-refs ()
    523   "Insert refs for node at point into Org-roam cache."
    524   (when-let* ((node-id (org-id-get))
    525               (refs (org-entry-get (point) "ROAM_REFS"))
    526               (refs (split-string-and-unquote refs)))
    527     (let (rows)
    528       (dolist (ref refs)
    529         (save-match-data
    530           (cond (;; @citeKey
    531                  (string-prefix-p "@" ref)
    532                  (push (vector node-id (substring ref 1) "cite") rows))
    533                 (;; [cite:@citeKey]
    534                  (string-prefix-p "[cite:" ref)
    535                  (condition-case nil
    536                      (let ((cite-obj (org-cite-parse-objects ref)))
    537                        (org-element-map cite-obj 'citation-reference
    538                          (lambda (cite)
    539                            (let ((key (org-element-property :key cite)))
    540                              (push (vector node-id key "cite") rows)))))
    541                    (error
    542                     (lwarn '(org-roam) :warning
    543                            "%s:%s\tInvalid cite %s, skipping..." (buffer-file-name) (point) ref))))
    544                 (;; https://google.com, cite:citeKey
    545                  ;; Note: we use string-match here because it matches any link: e.g. [[cite:abc][abc]]
    546                  ;; But this form of matching is loose, and can accept invalid links e.g. [[cite:abc]
    547                  (string-match org-link-any-re (org-link-encode ref '(#x20)))
    548                  (setq ref (org-link-encode ref '(#x20)))
    549                  (let ((ref-url (url-generic-parse-url (or (match-string 2 ref) (match-string 0 ref))))
    550                        (link-type ()) ;; clear url-type for backward compatible.
    551                        (path ()))
    552                    (setq link-type (url-type ref-url))
    553                    (setf (url-type ref-url) nil)
    554                    (setq path (org-link-decode (url-recreate-url ref-url)))
    555                    (if (and (boundp 'org-ref-cite-types)
    556                             (or (assoc link-type org-ref-cite-types)
    557                                 (member link-type org-ref-cite-types)))
    558                        (dolist (key (org-roam-org-ref-path-to-keys path))
    559                          (push (vector node-id key link-type) rows))
    560                      (push (vector node-id path link-type) rows))))
    561                 (t
    562                  (lwarn '(org-roam) :warning
    563                         "%s:%s\tInvalid ref %s, skipping..." (buffer-file-name) (point) ref)))))
    564       (when rows
    565         (org-roam-db-query [:insert :into refs
    566                             :values $v1]
    567                            rows)))))
    568 
    569 (defun org-roam-db-insert-link (link)
    570   "Insert link data for LINK at current point into the Org-roam cache."
    571   (save-excursion
    572     (goto-char (org-element-property :begin link))
    573     (let ((type (org-element-property :type link))
    574           (path (org-element-property :path link))
    575           (source (org-roam-id-at-point))
    576           (properties (list :outline (ignore-errors
    577                                        ;; This can error if link is not under any headline
    578                                        (org-get-outline-path 'with-self 'use-cache)))))
    579       ;; For Org-ref links, we need to split the path into the cite keys
    580       (when (and source path)
    581         (if (and (boundp 'org-ref-cite-types)
    582                  (or (assoc type org-ref-cite-types)
    583                      (member type org-ref-cite-types)))
    584             (org-roam-db-query
    585              [:insert :into citations
    586               :values $v1]
    587              (mapcar (lambda (k) (vector source k (point) properties))
    588                      (org-roam-org-ref-path-to-keys path)))
    589           (org-roam-db-query
    590            [:insert :into links
    591             :values $v1]
    592            (vector (point) source path type properties)))))))
    593 
    594 (defun org-roam-db-insert-citation (citation)
    595   "Insert data for CITATION at current point into the Org-roam cache."
    596   (save-excursion
    597     (goto-char (org-element-property :begin citation))
    598     (let ((key (org-element-property :key citation))
    599           (source (org-roam-id-at-point))
    600           (properties (list :outline (ignore-errors
    601                                        ;; This can error if link is not under any headline
    602                                        (org-get-outline-path 'with-self 'use-cache)))))
    603       (when (and source key)
    604         (org-roam-db-query
    605          [:insert :into citations
    606           :values $v1]
    607          (vector source key (point) properties))))))
    608 
    609 ;;;; Fetching
    610 (defun org-roam-db--get-current-files ()
    611   "Return a hash-table of file to the hash of its file contents."
    612   (let ((current-files (org-roam-db-query [:select [file hash] :from files]))
    613         (ht (make-hash-table :test #'equal)))
    614     (dolist (row current-files)
    615       (puthash (car row) (cadr row) ht))
    616     ht))
    617 
    618 (defun org-roam-db--file-hash (file-path)
    619   "Compute the hash of FILE-PATH."
    620   (with-temp-buffer
    621     (set-buffer-multibyte nil)
    622     (insert-file-contents-literally file-path)
    623     (secure-hash 'sha1 (current-buffer))))
    624 
    625 ;;;; Synchronization
    626 (defun org-roam-db-update-file (&optional file-path no-require)
    627   "Update Org-roam cache for FILE-PATH.
    628 
    629 If the file does not exist anymore, remove it from the cache.
    630 
    631 If the file exists, update the cache with information.
    632 
    633 If NO-REQUIRE, don't require optional libraries. Set NO-REQUIRE
    634 when the libraries are already required at some toplevel, e.g.
    635 in `org-roam-db-sync'."
    636   (setq file-path (or file-path (buffer-file-name (buffer-base-buffer))))
    637   (let ((content-hash (org-roam-db--file-hash file-path))
    638         (db-hash (caar (org-roam-db-query [:select hash :from files
    639                                            :where (= file $s1)] file-path)))
    640         info)
    641     (unless (string= content-hash db-hash)
    642       (unless no-require
    643         (org-roam-require '(org-ref oc)))
    644       (org-roam-with-file file-path nil
    645         (emacsql-with-transaction (org-roam-db)
    646           (org-with-wide-buffer
    647            (org-set-regexps-and-options 'tags-only)
    648            (org-refresh-category-properties)
    649            (org-roam-db-clear-file)
    650            (org-roam-db-insert-file content-hash)
    651            (org-roam-db-insert-file-node)
    652            (setq org-outline-path-cache nil)
    653            (org-roam-db-map-nodes
    654             (list #'org-roam-db-insert-node-data
    655                   #'org-roam-db-insert-aliases
    656                   #'org-roam-db-insert-tags
    657                   #'org-roam-db-insert-refs))
    658            (setq org-outline-path-cache nil)
    659            (setq info (org-element-parse-buffer))
    660            (org-roam-db-map-links
    661             (list #'org-roam-db-insert-link))
    662            (when (fboundp 'org-cite-insert)
    663              (require 'oc)             ;ensure feature is loaded
    664              (org-roam-db-map-citations
    665               info
    666               (list #'org-roam-db-insert-citation)))))))))
    667 
    668 ;;;###autoload
    669 (defun org-roam-db-sync (&optional force)
    670   "Synchronize the cache state with the current Org files on-disk.
    671 If FORCE, force a rebuild of the cache from scratch."
    672   (interactive "P")
    673   (org-roam-db--close) ;; Force a reconnect
    674   (when force (delete-file org-roam-db-location))
    675   (org-roam-db) ;; To initialize the database, no-op if already initialized
    676   (org-roam-require '(org-ref oc))
    677   (let* ((gc-cons-threshold org-roam-db-gc-threshold)
    678          (org-agenda-files nil)
    679          (org-roam-files (org-roam-list-files))
    680          (current-files (org-roam-db--get-current-files))
    681          (modified-files nil))
    682     (dolist (file org-roam-files)
    683       (let ((contents-hash (org-roam-db--file-hash file)))
    684         (unless (string= (gethash file current-files)
    685                          contents-hash)
    686           (push file modified-files)))
    687       (remhash file current-files))
    688     (emacsql-with-transaction (org-roam-db)
    689       (org-roam-dolist-with-progress (file (hash-table-keys current-files))
    690           "Clearing removed files..."
    691         (org-roam-db-clear-file file))
    692       (org-roam-dolist-with-progress (file modified-files)
    693           "Processing modified files..."
    694         (condition-case err
    695             (org-roam-db-update-file file 'no-require)
    696           (error
    697            (org-roam-db-clear-file file)
    698            (lwarn 'org-roam :error "Failed to process %s with error %s, skipping..."
    699                   file (error-message-string err))))))))
    700 
    701 ;;;###autoload
    702 (define-minor-mode org-roam-db-autosync-mode
    703   "Global minor mode to keep your Org-roam session automatically synchronized.
    704 Through the session this will continue to setup your
    705 buffers (that are Org-roam file visiting), keep track of the
    706 related changes, maintain cache consistency and incrementally
    707 update the currently active database.
    708 
    709 If you need to manually trigger resync of the currently active
    710 database, see `org-roam-db-sync' command."
    711   :group 'org-roam
    712   :global t
    713   :init-value nil
    714   (let ((enabled org-roam-db-autosync-mode))
    715     (cond
    716      (enabled
    717       (add-hook 'find-file-hook  #'org-roam-db-autosync--setup-file-h)
    718       (add-hook 'kill-emacs-hook #'org-roam-db--close-all)
    719       (advice-add #'rename-file :after  #'org-roam-db-autosync--rename-file-a)
    720       (advice-add #'delete-file :before #'org-roam-db-autosync--delete-file-a)
    721       (org-roam-db-sync))
    722      (t
    723       (remove-hook 'find-file-hook  #'org-roam-db-autosync--setup-file-h)
    724       (remove-hook 'kill-emacs-hook #'org-roam-db--close-all)
    725       (advice-remove #'rename-file #'org-roam-db-autosync--rename-file-a)
    726       (advice-remove #'delete-file #'org-roam-db-autosync--delete-file-a)
    727       (org-roam-db--close-all)
    728       ;; Disable local hooks for all org-roam buffers
    729       (dolist (buf (org-roam-buffer-list))
    730         (with-current-buffer buf
    731           (remove-hook 'after-save-hook #'org-roam-db-autosync--try-update-on-save-h t)))))))
    732 
    733 ;;;###autoload
    734 (defun org-roam-db-autosync-enable ()
    735   "Activate `org-roam-db-autosync-mode'."
    736   (org-roam-db-autosync-mode +1))
    737 
    738 (defun org-roam-db-autosync-disable ()
    739   "Deactivate `org-roam-db-autosync-mode'."
    740   (org-roam-db-autosync-mode -1))
    741 
    742 (defun org-roam-db-autosync-toggle ()
    743   "Toggle `org-roam-db-autosync-mode' enabled/disabled."
    744   (org-roam-db-autosync-mode 'toggle))
    745 
    746 (defun org-roam-db-autosync--delete-file-a (file &optional _trash)
    747   "Maintain cache consistency when file deletes.
    748 FILE is removed from the database."
    749   (when (and (not (auto-save-file-name-p file))
    750              (not (backup-file-name-p file))
    751              (org-roam-file-p file))
    752     (org-roam-db-clear-file (expand-file-name file))))
    753 
    754 (defun org-roam-db-autosync--rename-file-a (old-file new-file-or-dir &rest _args)
    755   "Maintain cache consistency of file rename.
    756 OLD-FILE is cleared from the database, and NEW-FILE-OR-DIR is added."
    757   (let ((new-file (if (directory-name-p new-file-or-dir)
    758                       (expand-file-name (file-name-nondirectory old-file) new-file-or-dir)
    759                     new-file-or-dir)))
    760     (setq new-file (expand-file-name new-file))
    761     (setq old-file (expand-file-name old-file))
    762     (when (and (not (auto-save-file-name-p old-file))
    763                (not (auto-save-file-name-p new-file))
    764                (not (backup-file-name-p old-file))
    765                (not (backup-file-name-p new-file))
    766                (org-roam-file-p old-file))
    767       (org-roam-db-clear-file old-file))
    768     (when (org-roam-file-p new-file)
    769       (org-roam-db-update-file new-file))))
    770 
    771 (defun org-roam-db-autosync--setup-file-h ()
    772   "Setup the current buffer if it visits an Org-roam file."
    773   (when (org-roam-file-p) (run-hooks 'org-roam-find-file-hook)))
    774 
    775 (add-hook 'org-roam-find-file-hook #'org-roam-db-autosync--setup-update-on-save-h)
    776 (defun org-roam-db-autosync--setup-update-on-save-h ()
    777   "Setup the current buffer to update the DB after saving the current file."
    778   (add-hook 'after-save-hook #'org-roam-db-autosync--try-update-on-save-h nil t))
    779 
    780 (defun org-roam-db-autosync--try-update-on-save-h ()
    781   "If appropriate, update the database for the current file after saving buffer."
    782   (when org-roam-db-update-on-save (org-roam-db-update-file)))
    783 
    784 ;;; Diagnostics
    785 (defun org-roam-db-diagnose-node ()
    786   "Print information about node at point."
    787   (interactive)
    788   (prin1 (org-roam-node-at-point)))
    789 
    790 (provide 'org-roam-db)
    791 
    792 ;;; org-roam-db.el ends here