org-node.el

;;; org-node.el --- Fast org-roam replacement -*- lexical-binding: t; -*-

;; Copyright (C) 2024-2026 Martin Edström
;; SPDX-License-Identifier: GPL-3.0-or-later

;; Author:   Martin Edström <meedstrom91@gmail.com>
;; URL:      https://github.com/meedstrom/org-node
;; Created:  2024-04-13
;; Keywords: org, hypermedia
;; Package-Requires: ((emacs "29.1")
;;                    (cond-let "0.2")
;;                    (llama "1.0")
;;                    (magit-section "4.3.0")
;;                    (org-mem "0.34.0"))

;;; Commentary:

;; If you were the sort of person to prefer "id:" links,
;; over "file:" links, radio-targets or any other type of link,
;; you're in the right place!

;; Now you can worry less about mentally tracking subtree hierarchies
;; and directory structures.  Once you've assigned an ID to something,
;; you can find it later.

;; The philosophy is the same as org-roam: if you assign an ID every
;; time you make an entry that you know you might want to link to from
;; elsewhere, then it tends to work out that the `org-node-find' command
;; can jump to more-or-less every entry you'd ever want to jump to.

;; That's just the core of it as described to someone not familiar with
;; zettelkasten-inspired software.  In fact, out of the simplicity
;; arises something powerful, more to be experienced than explained.

;;   "The fixed address of each note is the alpha and omega of the
;;   world of Zettelkasten. Everything becomes possible because of it."
;; -- https://zettelkasten.de/introduction

;; Compared to Org-roam:

;;   + Compatible (you can use both packages and compare)
;;   + Fast
;;   + No SQLite
;;   + If you want, opt out of those file-level :PROPERTIES: drawers
;;     + See user option `org-node-prefer-with-heading'
;;   + Try to rely in a bare-metal way on upstream org-id and org-capture
;;   + Extra utilities, notably to auto-rename files and links
;;   + An alternative way to display backlinks

;;   - No support for "roam:" links
;;   - Smaller package ecosystem
;;     + Packages based on org-roam can still work!  Either by using
;;       org-roam at the same time, or by configuring
;;       `org-mem-roamy-do-overwrite-real-db' and enabling
;;       `org-mem-roamy-db-mode'.
;;   - Blind to TRAMP files (for now)

;; Compared to Denote:

;;   + Compatible (you can use both packages and compare)
;;   + No mandatory filename style (can match Denote format if you like)
;;   + You can have as many "notes" as you want inside one file.
;;     + You could possibly use Denote for coarse browsing,
;;       and Org-node for more granular browsing.

;;   - No support for "denote:" links
;;   - No support for Markdown or other file types
;;   - Blind to TRAMP files (for now)

;;; Code:

(declare-function consult--grep "ext:consult")
(declare-function consult--grep-make-builder "ext:consult")
(declare-function consult--ripgrep-make-builder "ext:consult")
(declare-function org-at-heading-p "org")
(declare-function org-back-to-heading "org")
(declare-function org-back-to-heading-or-point-min "org")
(declare-function org-before-first-heading-p "org")
(declare-function org-capture-get "org-capture")
(declare-function org-capture-put "org-capture")
(declare-function org-collect-keywords "org")
(declare-function org-cut-subtree "org")
(declare-function org-end-of-meta-data "org")
(declare-function org-entry-end-position "org")
(declare-function org-entry-get "org")
(declare-function org-entry-get-with-inheritance "org")
(declare-function org-entry-properties "org")
(declare-function org-entry-put "org")
(declare-function org-find-property "org")
(declare-function org-fold-show-children "org-fold")
(declare-function org-fold-show-context "org-fold")
(declare-function org-fold-show-entry "org-fold")
(declare-function org-get-buffer-tags "org")
(declare-function org-get-heading "org")
(declare-function org-get-tags "org")
(declare-function org-get-title "org")
(declare-function org-id-add-location "org-id")
(declare-function org-id-find "org-id")
(declare-function org-id-get-create "org-id")
(declare-function org-id-new "org-id")
(declare-function org-id-update-id-locations "org-id")
(declare-function org-in-block-p "org")
(declare-function org-in-regexp "org-macs")
(declare-function org-in-src-block-p "org")
(declare-function org-insert-drawer "org")
(declare-function org-insert-heading "org")
(declare-function org-insert-subheading "org")
(declare-function org-invisible-p "org-macs")
(declare-function org-link-display-format "ol")
(declare-function org-link-make-string "ol")
(declare-function org-lint "org-lint")
(declare-function org-map-region "org")
(declare-function org-mem-list--pop-to-tabulated-buffer "org-mem-list")
(declare-function org-mem-roamy-mk-backlinks "org-mem-roamy")
(declare-function org-mem-roamy-mk-reflinks "org-mem-roamy")
(declare-function org-paste-subtree "org")
(declare-function org-promote "org")
(declare-function org-remove-empty-drawer-at "org")
(declare-function org-roam-node-id "ext:org-roam-node")
(declare-function org-set-tags "org")
(declare-function org-time-stamp-format "org")
(declare-function org-up-heading-or-point-min "org")
(declare-function outline-next-heading "outline")
(defvar consult-ripgrep-args)
(defvar crm-separator)
(defvar org-attach-id-dir)
(defvar org-drawer-regexp)
(defvar org-element-citation-prefix-re)
(defvar org-link-plain-re)
(defvar org-roam-capture-templates)
(defvar org-roam-preview-function)
(defvar org-roam-preview-postprocess-functions)
(defvar zone-programs)
(require 'cl-lib)
(require 'fileloop)
(require 'org-faces)
(require 'repeat)
(require 'subr-x)

;; Externals
(require 'org-node-changes)
(require 'cond-let)
(require 'llama)
(require 'org-mem)
(require 'org-mem-updater)

(eval-when-compile
  (require 'org)
  (require 'org-id)
  (require 'org-macs)
  (require 'org-fold)
  (require 'org-element))

(defconst org-node-internal-version 12)


;;;; Faces

(defgroup org-node-faces nil
  "Faces used by Org-node."
  :group 'faces
  :group 'org-node)

(defface org-node-cite
  '((t :inherit org-cite))
  "Face for @citations in Org-node commands.")

(defface org-node-cite-type
  '((t :inherit completions-annotations))
  "Face for \"http:\" part of an URL citation in Org-node commands.")

(defface org-node-tag
  '((t :inherit org-tag))
  "Face for :tags: in Org-node commands.")

(defface org-node-parent
  '((t :inherit completions-annotations))
  "Face for parent headings in Org-node commands.")

(defface org-node-rewrite-link
  '((t :inherit org-link
       :inverse-video t))
  "Face for use in `org-node-rewrite-links-ask'.")

(defface org-node-context-origin-title
  '((((type nil)) ;; On a terminal.
     :extend t
     :inherit org-document-title)
    (t ;; On GUI.
     :extend t
     :height 1.5
     ;; :inherit variable-pitch ;; Too controversial
     :weight bold))
  "Face for backlink node titles in the context buffer.")


;;;; Early defs

(defvar org-node--candidate<>entry (make-hash-table :test 'equal)
  "1:1 table mapping minibuffer completion candidates to ID-nodes.
These candidates may or may not be pre-affixated, depending on
user option `org-node-alter-candidates'.")

(defvar org-node--title<>affixations (make-hash-table :test 'equal)
  "1:1 table mapping titles or aliases to affixation triplets.
Even when the triplets are not used, this table serves double-duty such
that its keys constitute the subset of `org-mem--title<>id' that
passed `org-node-filter-fn'.")


;;;; Some options

(defgroup org-node nil
  "Support a zettelkasten of org-id files and subtrees."
  :group 'org
  :link '(url-link :tag "GitHub source" "https://github.com/meedstrom/org-node")
  :link '(info-link :tag "Info manual" "(org-node)"))

(defvar org-node-data-dir user-emacs-directory
  "Directory in which to persist data between sessions.
As of 3.7.1, only used when `org-node-context-persist-on-disk' is t.")

(defun org-node--set-and-remind-reset (sym val)
  "Set SYM to VAL.
Then remind the user to run \\[org-mem-reset]."
  (let ((caller (cadr (backtrace-frame 5))))
    (when (and (boundp 'org-node--first-init)
               (not org-node--first-init)
               ;; TIL: loading a theme calls ALL custom-setters?!
               (not (memq caller '(custom-theme-recalc-variable load-theme))))
      (lwarn 'org-node :debug
             "org-node--set-and-remind-reset called by %s" caller)
      (run-with-timer
       .1 nil #'message
       "Remember to run M-x org-mem-reset after configuring %S" sym)))
  (custom-set-default sym val))

(defcustom org-node-blank-input-hint
  (propertize "(untitled node)" 'face 'completions-annotations)
  "Whether to add an empty completion candidate to some commands.
It helps indicate that a blank input can be used there to
create an untitled node.

If non-nil, the value is actually the annotation added to it, a
propertized string."
  :type '(choice string (const nil))
  :package-version '(org-node . "3.3.0"))

;; Perhaps it would be handy if the blank input could do smart things like
;; create a daily-note, but it was not obvious how to shoehorn that into the
;; system we already have.  This was what we could easily do.
(defcustom org-node-blank-input-title-generator #'org-node-titlegen-untitled
  "Function to generate a title, given no user input.
Used in some commands when exiting minibuffer with a blank string."
  :type '(radio (function-item org-node-titlegen-untitled)
                (function-item org-node-titlegen-today)
                (function-item org-node-titlegen-this-week)
                (function :tag "Custom function" :value (lambda ())))
  :package-version '(org-node . "3.3.12"))

;; TODO: If setting `org-node-creation-fn' to `org-capture', can we design a
;;       capture template that makes new subtree in a pre-existing entry,
;;       rather than always making a new file?
;;       Would be handy for some kind of "inbox.org" datetree.
(defvar org-node-untitled-format "untitled-%d")
(defvar org-node--untitled-ctr 0)
(defun org-node-titlegen-untitled ()
  "Combine `org-node-untitled-format' with a new integer on every call."
  (cl-loop do (cl-incf org-node--untitled-ctr)
           as title = (format org-node-untitled-format org-node--untitled-ctr)
           while (or (gethash title org-node--title<>affixations)
                     (file-exists-p (org-node-title-to-filename-quiet title)))
           finally return title))

(defun org-node-titlegen-today ()
  "Make a node title for the day\\='s date."
  (format-time-string "Assorted for %A, %d %b %Y"))

(defun org-node-titlegen-this-week ()
  "Make a node title for the current ISO8601 week."
  (format-time-string "Assorted for Week %V, %G"))


;;;; Time

;; Should have been TIME_CREATED but too late to change the default.
(defcustom org-node-property-crtime "CREATED"
  "Name of a property for holding a creation-time timestamp.
Used by:
- `org-node-rename-file-by-title'
- `org-node-ensure-crtime-property'
- `org-node-sort-by-crtime-property'"
  :type '(radio (const "CREATED")
                (const :tag "TIME_CREATED (good for alphabetic sort near TIME_MODIFIED)"
                       "TIME_CREATED")
                string)
  :package-version '(org-node . "3.7.1"))

(defcustom org-node-property-mtime "TIME_MODIFIED"
  "Name of a property for holding a last-modification-time timestamp.
Used by:
- `org-node-update-mtime-property'
- `org-node-sort-by-mtime-property'"
  :type 'string
  :package-version '(org-node . "3.10.0"))

(defun org-node-time-stamp (with-time inactive &optional time zone)
  "Make a timestamp passing WITH-TIME, INACTIVE to `org-time-stamp-format'.
Pass TIME, ZONE to `format-time-string'."
  (format-time-string (org-time-stamp-format with-time inactive)
                      time zone))

(defun org-node-update-mtime-property ()
  "Update property `org-node-property-mtime' in entry at point.
Suitable on `org-node-modification-hook'."
  (org-entry-put nil
                 org-node-property-mtime
                 (org-node-time-stamp t t)))


;;;; Filter

;; TODO: Compose a list of functions?
(defcustom org-node-filter-fn #'org-node-filter-no-roam-exclude-p
  "Predicate returning non-nil to include a node, or nil to exclude it.

The filter affects two tables:
- `org-node--candidate<>entry', used by completions in the minibuffer
- `org-node--title<>affixations', used by `org-node-complete-at-point-mode'

In other words, returning nil means the user cannot autocomplete to the
node, but Lisp code can still find it in the output of
`org-mem-all-id-nodes', and backlinks are discovered normally.

This function is applied once for every ID-node found, and receives the
node data as a single argument: an `org-mem-entry' object.  See examples
by typing \\[org-node-list-example]."
  :type '(radio (function-item org-node-filter-no-roam-exclude-p)
                (function-item org-node-filter-no-local-roam-exclude-p)
                (function-item org-node-filter-watched-dir-p)
                (function :tag "Custom function"
                          :value (lambda (node) t)))
  :set #'org-node--set-and-remind-reset
  :package-version '(org-node . "3.3.0"))

(defun org-node-filter-no-roam-exclude-p (node)
  "Hide NODE if it has or inherits a :ROAM_EXCLUDE: property."
  (not (org-mem-property-with-inheritance "ROAM_EXCLUDE" node)))

(defun org-node-filter-no-local-roam-exclude-p (node)
  "Hide NODE if it has a :ROAM_EXCLUDE: property."
  (not (org-mem-property "ROAM_EXCLUDE" node)))

(defun org-node-filter-watched-dir-p (node)
  "Show NODE only if it is found inside `org-mem-watch-dirs'."
  (let ((file (org-mem-file-truename node)))
    (cl-some (lambda (dir) (string-prefix-p dir file))
             (with-memoization (org-mem--table 0 'true-watch-dirs)
               (with-temp-buffer ;; No buffer-env
                 (delete-dups (mapcar #'file-truename org-mem-watch-dirs)))))))

(defun org-node-all-filtered-nodes ()
  "All currently cached ID-nodes that satisfied `org-node-filter-fn'."
  (delete-dups (hash-table-values org-node--candidate<>entry)))

(defun org-node-all-filtered-files ()
  "All files containing any of `org-node-all-filtered-nodes'."
  (delete-dups (mapcar #'org-mem-entry-file (org-node-all-filtered-nodes))))


;;;; Sort

(defcustom org-node-display-sort-fn nil
  "How to sort completions.
Used as `display-sort-function' in `completion-metadata'.
See Info node `(elisp) Completion Variables'."
  :type '(radio
          (const :tag "Do not override `completions-sort'" :value nil)
          (function-item org-node-sort-by-file-mtime)
          (function-item org-node-sort-by-crtime-property)
          (function-item org-node-sort-by-mtime-property)
          (function :tag "Custom function" :value (lambda (completions))))
  :package-version '(org-node . "3.9.0"))

(defun org-node-sort-by-file-mtime (completions)
  "Sort COMPLETIONS by file modification time."
  (sort completions
        (lambda (c1 c2)
          (let* ((node1 (gethash c1 org-node--candidate<>entry))
                 (node2 (gethash c2 org-node--candidate<>entry))
                 ;; mtime could be nil if the file does not exist yet
                 (mtime1 (and node1 (ignore-errors (org-mem-file-mtime node1))))
                 (mtime2 (and node2 (ignore-errors (org-mem-file-mtime node2)))))
            ;; REVIEW: Actually should all of these four cases return t?
            (cond ((null node1) t)
                  ((null node2) nil)
                  ((null mtime1) t)
                  ((null mtime2) nil)
                  (t (time-less-p mtime2 mtime1)))))))

(defun org-node-sort-by-crtime-property (completions)
  "Sort COMPLETIONS by timestamp in `org-node-property-crtime'.
Nodes with no such property come after all the rest that do have the
property - in other words, nodes without may as well be dated to 1970."
  (sort completions
        (lambda (c1 c2)
          (let* ((node1 (gethash c1 org-node--candidate<>entry))
                 (node2 (gethash c2 org-node--candidate<>entry))
                 (crtime1 (and node1 (org-mem-property org-node-property-crtime node1)))
                 (crtime2 (and node2 (org-mem-property org-node-property-crtime node2))))
            (cond ((null node1) t)
                  ((null node2) nil)
                  ((null crtime1) nil)
                  ((null crtime2) t)
                  (t (string< crtime2 crtime1)))))))

(defun org-node-sort-by-mtime-property (completions)
  "Sort COMPLETIONS by timestamp in `org-node-property-mtime'."
  (sort completions
        (lambda (c1 c2)
          (let* ((node1 (gethash c1 org-node--candidate<>entry))
                 (node2 (gethash c2 org-node--candidate<>entry))
                 (time1 (and node1 (org-mem-property org-node-property-mtime node1)))
                 (time2 (and node2 (org-mem-property org-node-property-mtime node2))))
            (cond ((null node1) t)
                  ((null node2) nil)
                  ((null time1) nil)
                  ((null time2) t)
                  (t (string< time2 time1)))))))


;;;; Pretty completion

(defcustom org-node-alter-candidates nil
  "Whether to alter completion candidates instead of affixating.

This means that org-node will concatenate the results of
`org-node-affixation-fn' into a single string, so what the user types in
the minibuffer can match against the prefix and suffix as well as
against the node title.

In other words: you can match against the node's outline path, if
`org-node-affixation-fn' is set to `org-node-prepend-olp' \(default).

Another consequence: this setting can lift the uniqueness constraint on
note titles: you\\='ll be able to have two nodes with the same name, so
long as their prefix or suffix differ in some way."
  :type 'boolean
  :set #'org-node--set-and-remind-reset
  :package-version '(org-node . "0.2"))

(defcustom org-node-affixation-fn #'org-node-prepend-olp
  "Function to give prefix and suffix to minibuffer completions.

After changing this setting, run \\[org-mem-reset].

------
Info for writing a custom function

The function receives two arguments: NODE and TITLE, and it must return
a list of three strings: title, prefix and suffix.  Of those three, the
title should be TITLE unmodified.

NODE is an `org-mem-entry' object.  See examples
by typing \\[org-node-list-example].

If a node has aliases, the same node is passed to this function
again for every alias, in which case TITLE is actually one of the
aliases."
  :type '(radio
          (function-item org-node-affix-bare)
          (function-item org-node-prepend-olp)
          (function-item org-node-prepend-tags)
          (function-item org-node-prepend-tags-and-olp)
          (function-item org-node-prepend-olp-append-tags)
          (function-item org-node-prepend-olp-append-tags-use-frame-width)
          (function-item org-node-append-tags-use-frame-width)
          (function :tag "Custom function"
                    :value (lambda (node title) (list title "" ""))))
  :set #'org-node--set-and-remind-reset
  :package-version '(org-node . "0.2"))

(defun org-node-affix-bare (_node title)
  "Use TITLE as-is."
  (list title "" ""))

(defun org-node-prepend-tags (node title)
  "Prepend NODE\\='s tags to TITLE."
  (list title
        (let ((tags (org-mem-entry-tags node)))
          (if tags
              (propertize (concat "(" (string-join tags ", ") ") ")
                          'face 'org-node-tag)
            ""))
        ""))

(defun org-node-prepend-olp (node title)
  "Prepend NODE\\='s outline path to TITLE."
  (list title
        (if-let ((fontified-ancestors
                  (cl-loop
                   for ancestor in (org-mem-olpath-with-file-title node)
                   collect
                   (propertize ancestor 'face 'org-node-parent))))
            (concat (string-join fontified-ancestors " > ") " > ")
          "")
        ""))

(defun org-node-prepend-tags-and-olp (node title)
  "Prepend NODE's tags and outline path to TITLE."
  (list title
        (let ((tags (org-mem-entry-tags node))
              (fontified-ancestors
               (cl-loop
                for ancestor in (org-mem-olpath-with-file-title node)
                collect (propertize ancestor 'face 'org-node-parent))))
          (concat
           ;; TODO: Fallback on other face before org init
           (and tags (propertize (concat "(" (string-join tags ", ") ") ")
                                 'face 'org-node-tag))
           (and fontified-ancestors
                (concat (and tags " ")
                        (string-join fontified-ancestors " > ") " > "))))
        ""))

(defun org-node-prepend-olp-append-tags (node title)
  "Prepend NODE's outline path to TITLE, and append NODE\\='s tags."
  (list title
        (if (org-mem-entry-subtree-p node)
            (let ((ancestors (org-mem-olpath-with-file-title node))
                  (result nil))
              (dolist (anc ancestors)
                (push (propertize anc 'face 'org-node-parent) result)
                (push " > " result))
              (setq result (apply #'concat (nreverse result)))
              result)
          "")
        (let ((tags (org-mem-entry-tags node)))
          (if tags (propertize (concat "   :" (string-join tags ":") ":")
                               'face 'org-node-tag)
            ""))))

(defun org-node-append-tags-use-frame-width (node title)
  "Append NODE tags after TITLE and justify them to `frame-width'.
Looks bad when you resize the frame, until you call `org-mem-reset'."
  (list title
        ""
        (concat
         (let ((tags (org-mem-entry-tags node)))
           (when tags
             (setq tags (propertize (concat ":" (string-join tags ":") ":")
                                    'face 'org-node-tag))
             (concat (make-string (max 2 (- (frame-width)
                                            (string-width title)
                                            (string-width tags)
                                            (fringe-columns 'right)
                                            (fringe-columns 'left)))
                                  ?\s)
                     tags))))))

(defun org-node-prepend-olp-append-tags-use-frame-width (node title)
  "Prepend NODE outline path to TITLE, and put NODE tags at frame edge.
Looks bad when you resize the frame, until you call `org-mem-reset'."
  (let (olp)
    (list title
          (concat
           (when (org-mem-entry-subtree-p node)
             (let ((ancestors (org-mem-olpath-with-file-title node)))
               (dolist (anc ancestors)
                 (push (propertize anc 'face 'org-node-parent) olp)
                 (push " > " olp))
               (setq olp (apply #'concat (nreverse olp))))))
          (concat
           (let ((tags (org-mem-entry-tags node)))
             (when tags
               (setq tags (propertize (concat ":" (string-join tags ":") ":")
                                      'face 'org-node-tag))
               (concat (make-string (max 2 (- (frame-width)
                                              (string-width title)
                                              (if olp (string-width olp) 0)
                                              (string-width tags)
                                              (fringe-columns 'right)
                                              (fringe-columns 'left)))
                                    ?\s)
                       tags)))))))

;; TODO: Bind a custom exporter to `embark-export'
;; TODO: Add user option to set 'group-function
;; TODO: Copy https://github.com/jgru/consult-org-roam
(defun org-node-collection (str pred action)
  "Custom COLLECTION for `completing-read'.

Ahead of time, org-node takes titles and aliases from all nodes, runs
`org-node-affixation-fn' on each, and depending on the user option
`org-node-alter-candidates', it either saves the affixated thing
directly into `org-node--candidate<>entry', or into a secondary table
`org-node--title<>affixations'.  Finally, this function then either
simply reads candidates off the former table, or attaches the
affixations in realtime.

Regardless of which, all completions are guaranteed to be keys of
`org-node--candidate<>entry' \(which is the main reason for this dual
code flow\), but remember that it is possible for `completing-read' to
exit with user-entered input that didn\\='t match anything.

Arguments STR, PRED and ACTION are handled behind the scenes,
see Info node `(elisp)Programmed Completion'."
  (if (eq action 'metadata)
      (cons 'metadata (append (and org-node-display-sort-fn
                                   `((display-sort-function . ,org-node-display-sort-fn)))
                              `((category . org-node))
                              `((affixation-function . org-node--affixate))))
    (complete-with-action action org-node--candidate<>entry str pred)))

(defun org-node--affixate (collection)
  "From flat list COLLECTION, make alist ((TITLE PREFIX SUFFIX) ...).
Presumes that COLLECTION is the keys of `org-node--candidate<>entry'."
  (and collection
       ;; REVIEW: We probably shouldn't assume it is always the `car'.
       (if (string-blank-p (car collection))
           (cons
            (list (car collection) "" (or org-node-blank-input-hint ""))
            (if org-node-alter-candidates
                (cl-loop for altered-candidate in (cdr collection)
                         collect (list altered-candidate "" ""))
              (cl-loop for title in (cdr collection)
                       collect (or (gethash title org-node--title<>affixations)
                                   ;; REVIEW: Sometimes above gethash returns
                                   ;; nil, don't remember why.  That results in
                                   ;; odd glyphs in the completions, hence this
                                   ;; workaround. Can we guarantee it would
                                   ;; never return nil?
                                   (list title "" "")))))
         (if org-node-alter-candidates
             (cl-loop for altered-candidate in collection
                      collect (list altered-candidate "" ""))
           (cl-loop for title in collection
                    collect (or (gethash title org-node--title<>affixations)
                                (list title "" "")))))))

;; Finally, tying it all together
(defun org-node-read-candidate
    (&optional prompt blank-ok predicate require-match initial-input hist def inherit-input-method)
  "PROMPT for a known node and return the user input.

If the node exists, the user input is a key of table
`org-node--candidate<>entry', and the node is the value.

Otherwise, it does not exist and the user input can be taken as the
desired title for a new node.

BLANK-OK non-nil means to use `org-node-blank-input-hint' if non-nil.
This can affect PREDICATE and REQUIRE-MATCH, because a fake entry is
added to `org-node--candidate<>entry' during completion.

The rest of the arguments \(PREDICATE, REQUIRE-MATCH, INITIAL-INPUT,
HIST, DEF, INHERIT-INPUT-METHOD) same as in `completing-read'.

An obsolete calling convention allows the third argument to be a string,
used as INITIAL-INPUT in `completing-read'."
  (when (stringp predicate)
    ;; Convert from obsolete calling convention.
    (cl-assert (cl-every #'null (list require-match initial-input hist def inherit-input-method)))
    (setq initial-input predicate)
    (setq predicate nil))
  (when (and (hash-table-empty-p org-node--candidate<>entry)
             (not (featurep 'org)))
    (when (y-or-n-p "No nodes found, load Org? ")
      (require 'org)
      (org-mem-reset t "Resetting org-mem...")
      (org-mem-await "Resetting org-mem..." 60)))
  (when (and blank-ok org-node-blank-input-hint)
    (puthash (if (bound-and-true-p helm-mode) " " "")
             (make-org-mem-entry)
             org-node--candidate<>entry))
  (unwind-protect (completing-read (or prompt "Node: ")
                                   #'org-node-collection
                                   predicate
                                   require-match
                                   initial-input
                                   (or hist (if org-node-alter-candidates
                                                'org-node-hist-altered
                                              'org-node-hist))
                                   def
                                   inherit-input-method)
    (remhash "" org-node--candidate<>entry)
    (remhash " " org-node--candidate<>entry)))

(defvar org-node-hist nil
  "Minibuffer history.")

(defvar org-node-hist-altered nil
  "Minibuffer history while `org-node-alter-candidates' was t.")

;; Boost completion hist to at least 1000 elements, unless user has nerfed
;; the default `history-length'.
;; Because you often narrow down the completions majorly, and still want to
;; sort among what's left; perhaps it's a general topic you have not touched
;; since two months ago, but when you do, the recency order remains relevant.
(when (and (numberp history-length)
           (not (get 'org-node-hist 'history-length))
           (>= history-length (car (get 'history-length 'standard-value)))
           (< history-length 1000))
  (put 'org-node-hist 'history-length 1000)
  (put 'org-node-hist-altered 'history-length 1000))


;;;; The cache mode

(defun org-node--let-refs-be-aliases (entry)
  "Add ROAM_REFS of ENTRY as extra minibuffer completions."
  (when (and (org-mem-entry-id entry)
             (funcall org-node-filter-fn entry))
    (dolist (ref (org-mem-entry-roam-refs entry))
      (puthash (concat (when-let ((type (gethash ref org-mem--roam-ref<>type)))
                         (propertize (concat type ":") 'face 'org-node-cite-type))
                       (propertize ref 'face 'org-node-cite))
               entry
               org-node--candidate<>entry))))

(defun org-node--record-completion-candidates (entry)
  "Cache completions for ENTRY and its aliases, if it is an ID-node."
  (when (and (org-mem-entry-id entry)
             (funcall org-node-filter-fn entry))
    (dolist (title (cons (org-mem-entry-title entry)
                         (org-mem-entry-roam-aliases entry)))
      (let ((affx (funcall org-node-affixation-fn entry title)))
        (puthash title affx org-node--title<>affixations)
        (if org-node-alter-candidates
            ;; Absorb the affixations into one candidate string
            (puthash (concat (nth 1 affx) (nth 0 affx) (nth 2 affx))
                     entry
                     org-node--candidate<>entry)
          ;; Bare title, to be affixated later
          (puthash title entry org-node--candidate<>entry))))))

(defun org-node--record-completion-candidates-all (parse-results)
  "Cache completions for all entries in PARSE-RESULTS."
  (cl-loop for (_ _ _ entries) in parse-results
           do (dolist (entry entries)
                (org-node--record-completion-candidates entry)
                (org-node--let-refs-be-aliases entry))))

(defun org-node--wipe-completions (_parse-results)
  "Clear completions tables."
  (clrhash org-node--title<>affixations)
  (clrhash org-node--candidate<>entry))

(defun org-node--forget-completions-in-results (parse-results)
  "Remove old completions where PARSE-RESULTS indicates they are stale."
  (org-node--forget-completions-in-files
   (cl-loop for (bad-path _ file-data) in parse-results
            collect bad-path
            collect (car file-data))))

(defun org-node--forget-completions-in-files (files)
  "Remove the minibuffer completions for all nodes in FILES."
  (when files
    (maphash (lambda (candidate entry)
               (when (member (org-mem-file-truename entry) files)
                 (remhash candidate org-node--candidate<>entry)
                 (remhash (org-mem-title entry) org-node--title<>affixations)))
             org-node--candidate<>entry)))

;; TODO: Submit patch upstream to print a message when `org-id-find'
;;       fails to find ID and calls update-id-locations.
;; TODO: While we're at it... patch `org-id-find-id-in-file' so it allows the
;;       file not to exist if a buffer exists with that file name.
;; TODO: While we're at it... patch `org-id-find-id-file' not to fallback on
;;       the current buffer, that is so inviting to bugs!  Probably it
;;       shouldn't have been a separate function at all.
(defun org-node--ad-org-id-find (id &rest _)
  "Print a message if ID is not in `org-id-locations'.

Designed as before-advice for `org-id-find'.  This is merely an
informative helper, because often the attempt to open an unknown ID-link
results in Emacs appearing to freeze as org-id updates its database
without telling the user that it is doing so.  With a lot of files, this
takes a long time."
  (cond
   ((symbolp id) (setq id (symbol-name id)))
   ((numberp id) (setq id (number-to-string id))))
  (when (and (hash-table-p org-id-locations)
             (not (gethash id org-id-locations)))
    (message "No cached location for ID \"%s\"..." id)))

(defcustom org-node-reset-on-org-load t
  "Whether to allow resetting org-mem after Org loads.
This is the delay you can observe if `org-mem-do-look-everywhere' is t
and you jump into an Org file for the first time."
  :type 'boolean)

;;;###autoload
(define-minor-mode org-node-cache-mode
  "Cache completion candidates every time Org-mem updates its cache.

Enabling this mode asks org-mem to reset its cache.
You should enable `org-mem-updater-mode' at nearly the same time in your
init process, because then org-mem will tend to only scan files once
rather than twice."
  :global t
  (cond
   (org-node-cache-mode
    (advice-add #'org-id-find :before #'org-node--ad-org-id-find)
    (add-hook 'org-mem-pre-full-scan-functions #'org-node--wipe-completions)
    (add-hook 'org-mem-pre-targeted-scan-functions #'org-node--forget-completions-in-results)
    (add-hook 'org-mem-post-full-scan-functions #'org-node--record-completion-candidates-all)
    (add-hook 'org-mem-post-targeted-scan-functions #'org-node--record-completion-candidates-all)
    (when (and org-mem-do-look-everywhere
               (not (featurep 'org))
               (not org-mem-watch-dirs)
               (not (bound-and-true-p recentf-list)))
      (eval-after-load 'org
        (defun org-node--reset-once ()
          (when org-node-cache-mode
            (when org-node-reset-on-org-load
              (org-mem-reset t "org-node: Re-caching to include org-id locations..."))
            (fset 'org-node--reset-once #'ignore)))))
    (org-mem-reset)
    (org-mem-tip-if-empty)
    (org-node-track-modifications-mode))
   (t
    (advice-remove #'org-id-find #'org-node--ad-org-id-find)
    (remove-hook 'org-mem-pre-full-scan-functions #'org-node--wipe-completions)
    (remove-hook 'org-mem-pre-targeted-scan-functions #'org-node--forget-completions-in-results)
    (remove-hook 'org-mem-post-full-scan-functions #'org-node--record-completion-candidates-all)
    (remove-hook 'org-mem-post-targeted-scan-functions #'org-node--record-completion-candidates-all)
    (org-node-track-modifications-mode 0))))

;;;###autoload
(define-obsolete-function-alias 'org-node-reset #'org-mem-reset "3.0.0 (May 2025)")

;; TODO: Deprecate somehow
(defvar org-node--first-init t
  "Non-nil until org-node has been initialized, then nil.")

(defun org-node-cache-ensure (&optional block force)
  "Ensure that org-node is ready for use.
Ensure that modes `org-node-cache-mode' and `org-mem-updater-mode' are
enabled.  If FORCE, trigger org-mem to rebuild cache.  If BLOCK and a
cache build is underway \(perhaps started by FORCE), block Emacs until
it finishes \(or 60 seconds elapse\).

If cache has never been built, act as if both FORCE and BLOCK.

It is good to call this function at the start of autoloaded commands.
Most of the time, you can expect it to no-op.

These cache builds are normally async, so without BLOCK, this returns
immediately and can mean that the data you will next query from org-mem
is still out of date.  That usually only matters if you had done
something to change the facts on the ground just prior."
  (setq org-node--first-init nil)
  (unless org-node-cache-mode
    (when (y-or-n-p "Org-node needs `org-node-cache-mode', enable? ")
      (org-node-cache-mode))
    (setq force t))
  (unless org-mem-updater-mode
    (when (y-or-n-p "Org-node needs `org-mem-updater-mode', enable? ")
      (org-mem-updater-mode))
    (setq force t))
  (when (hash-table-empty-p org-node--candidate<>entry)
    (setq block t)
    (setq force t))
  (when force
    (org-mem-reset nil "Org-node waiting for org-mem..."))
  (when block
    (org-mem-await "Org-node waiting for org-mem..." 60))
  (org-mem-tip-if-empty))


;;;; Filename functions

(defcustom org-node-file-directory-ask nil
  "Whether to ask the user where to save a new file.

- Value nil: Let `org-node-guess-dir' decide
- Value t: Ask every time
- String: A directory in which to put the file"
  :type '(radio (const :tag "Let `org-node-guess-dir' decide" nil)
                (const :tag "Ask every time" t)
                directory)
  :package-version '(org-node . "0.1"))

(defcustom org-node-file-timestamp-format ""
  "Passed to `format-time-string' to prepend to filenames.

Beware that this setting is an \\+`attractive nuisance'.
Changing it leads to lots of possibly unwanted renames if you have
`org-node-rename-file-by-title' on a hook, and in any case requires
manual intervention for pre-existing files.

Example from Org-roam: %Y%m%d%H%M%S-
Example from Denote: %Y%m%dT%H%M%S--

For the rest of the filename, configure `org-node-file-slug-fn'."
  :type '(radio
          (const :tag "None" :value "")
          (const :tag "Like Org-roam: %Y%m%d%H%M%S-" :value "%Y%m%d%H%M%S-")
          (const :tag "Like Denote: %Y%m%dT%H%M%S--" :value "%Y%m%dT%H%M%S--")
          (string :tag "Custom"))
  :package-version '(org-node . "0.4"))

;; TODO: For Denote users, you get valid filename with just the default slug fn,
;;       and a datestamp "%Y%m%dT%H%M%S--".  However, Denote's full format
;;       including optional parts looks like:
;;
;;       DATE==SIGNATURE--TITLE__KEYWORDS.EXT
;;
;;       So either the user adds SIGNATURE and KEYWORDS themselves, and never
;;       uses `org-node-rename-file-by-title'.  Or we could pass more arguments
;;       into the slug fn, that it can use to systematically add these parts
;;       based on some rule, like perhaps the content of an Org property.

(defcustom org-node-file-slug-fn #'org-node-slugify-for-web
  "Function taking a node title and returning a filename component.
Receives one argument: the value of an Org #+TITLE keyword, or
the first heading in a file that has no #+TITLE.

It is popular to also prefix filenames with a datestamp.  To do
that, configure `org-node-file-timestamp-format'."
  :type '(radio
          (function-item org-node-slugify-for-web)
          (function-item org-node-slugify-like-roam-default)
          (function :tag "Custom function" :value (lambda (title) title)))
  :package-version '(org-node . "0.4"))

(defun org-node-slugify-like-roam-default (title)
  "From TITLE, make a filename slug in default org-roam style.
Does not require org-roam installed.

A title like \"Löb\\='s Theorem\" becomes \"lob_s_theorem\".

Diacritical marks U+0300 to U+0331 are stripped \(mostly used with Latin
alphabets).  Also stripped are all glyphs not categorized in Unicode as
\\+`alphanumeric', such as punctuation and emoji.

If you seek to emulate org-roam filenames, you may also want to
configure `org-node-file-timestamp-format'."
  (require 'ol)
  (thread-last title
               (org-link-display-format)
               (string-glyph-decompose)
               (seq-remove (lambda (char) (<= #x300 char #x331)))
               (concat)
               (string-glyph-compose)
               (downcase)
               (string-trim)
               (replace-regexp-in-string "[^[:alnum:]]" "_")
               (replace-regexp-in-string "__*" "_")
               (replace-regexp-in-string "^_" "")
               (replace-regexp-in-string "_$" "")))

(defun org-node-slugify-for-web (title)
  "From TITLE, make a filename slug meant to look nice as URL component.

A title like \"Löb\\='s Theorem\" becomes \"lobs-theorem\".

Diacritical marks U+0300 to U+0331 are stripped \(mostly used with Latin
alphabets).  Also stripped are all glyphs not categorized in Unicode as
\\+`alphanumeric', such as punctuation and emoji."
  (require 'ol)
  (thread-last title
               (org-link-display-format)
               (string-glyph-decompose)
               (seq-remove (lambda (char) (<= #x300 char #x331)))
               (concat)
               (string-glyph-compose)
               (downcase)
               (string-trim)
               (replace-regexp-in-string "[[:space:]]+" "-")
               (replace-regexp-in-string "[^[:alnum:]\\/-]" "")
               (replace-regexp-in-string "\\/" "-")
               (replace-regexp-in-string "--*" "-")
               (replace-regexp-in-string "^-" "")
               (replace-regexp-in-string "-$" "")))

;; Hacking on the above?  Some useful test cases!

;; (org-node-slugify-for-web "A/B testing")
;; (org-node-slugify-for-web "\"But there's still a chance, right?\"")
;; (org-node-slugify-for-web "Löb's Theorem")
;; (org-node-slugify-for-web "Mañana Çedilla")
;; (org-node-slugify-for-web "How to convince me that 2 + 2 = 3")
;; (org-node-slugify-for-web "E. T. Jaynes")
;; (org-node-slugify-for-web "Amnesic recentf? Solution: Run kill-emacs-hook every 2 minutes.")
;; (org-node-slugify-for-web "Slimline/\"pizza box\" computer chassis")
;; (org-node-slugify-for-web "#emacs")
;; (org-node-slugify-for-web "칹え🐛")

(defun org-node--root-dirs (file-list)
  "Infer root directories of FILE-LIST.

By root, we mean the longest directory path common to a set of files,
as long as that directory contains at least one member of
FILE-LIST itself.  For example, if you have the 3 members

- \"/home/me/Syncthing/foo.org\"
- \"/home/kept/archive/bar.org\"
- \"/home/kept/baz.org\"

the return value will not be \(\"/home/\"), even though
the substring \"/home/\" is common to all three,
but \(\"/home/kept/\" \"/home/me/Syncthing/\").


On finding more than one root, sort by count of files they contain
recursively, so that the most populous root directory will be the first
element.

This function does not consult the filesystem, so FILE-LIST must be a
list of full paths that can be compared as strings, so e.g. there must
e.g. not be instances of substring \"~\" as well as instances of
substring \"/home/me\" referring to the same location."
  (let* (file-name-handler-alist ;; Otherwise 90% cpu in `file-name-directory'
         ;; A lot of dups from e.g. (hash-table-values org-id-locations)
         (files (seq-uniq file-list))
         (dirs (sort (delete-consecutive-dups
                      (sort (mapcar #'file-name-directory files) #'string<))
                     (##length< %1 (length %2))))
         root-dirs)
    ;; Example: if there is /home/roam/courses/Math1A/, but ancestor dir
    ;; /home/roam/ is also a member of the set, throw out the child dir.
    ;; REVIEW: Maybe more elegant to use `nreverse' twice?
    (while-let ((dir (car (last dirs))))
      (setq dirs (nbutlast dirs))
      (cl-loop for other-dir in dirs
               when (string-prefix-p other-dir dir)
               return (delete dir dirs)
               finally return (push dir root-dirs)))
    (if (= (length root-dirs) 1)
        root-dirs
      ;; Found more than 1 root, sort them by count of files inside.
      (cl-loop
       with dir-counters = (cl-loop for dir in root-dirs collect (cons dir 0))
       for file in files
       do (cl-loop for dir in root-dirs
                   when (string-prefix-p dir file)
                   return (cl-incf (cdr (assoc dir dir-counters))))
       finally return (mapcar #'car (cl-sort dir-counters #'> :key #'cdr))))))

(defun org-node-title-to-filename-quiet (title)
  "From TITLE, make a full file path, and never prompt."
  (file-name-concat (if (stringp org-node-file-directory-ask)
                        org-node-file-directory-ask
                      (org-node-guess-dir))
                    (org-node-title-to-basename title)))

(defun org-node-title-to-basename (title)
  "From TITLE, make the non-directory component of a file name."
  (concat (format-time-string org-node-file-timestamp-format)
          (funcall org-node-file-slug-fn title)
          ".org"))

(defun org-node-guess-dir ()
  "Return the root level of user\\='s apparently most-used directories."
  (car (org-node--root-dirs (org-node-all-filtered-files))))

;; TODO: It'd be more user-friendly if the interactive prompt also lets you
;;       change the basename.  So, conditionally call `org-node-file-slug-fn'
;;       here, then use `read-file-name' rather than `read-directory-name'.
;;       But first we need some refactoring elsewhere.
(defun org-node-guess-or-ask-dir (prompt)
  "Maybe prompt for a directory, and if so, use string PROMPT.
Behavior depends on user option `org-node-file-directory-ask'."
  (or (and (null org-node-file-directory-ask)
           (org-node-guess-dir))
      (if (stringp org-node-file-directory-ask)
          org-node-file-directory-ask
        (read-directory-name prompt))))


;;;; Creation functions

(defcustom org-node-prefer-with-heading nil
  "Make a heading even when creating isolated file nodes.
If nil, write a #+TITLE and a file-level property-drawer instead.

In other words:

- if nil, make file with no heading (outline level 0)
- if t, make file with heading (outline level 1)

This affects the behavior of `org-node-new-file',
`org-node-extract-subtree', and `org-node-capture-target'.

If you change your mind about this setting, you can
transition the files you already have with the Org-roam commands
`org-roam-promote-entire-buffer' and `org-roam-demote-entire-buffer'."
  :type 'boolean
  :package-version '(org-node . "0.4"))

(defcustom org-node-relocation-hook '(org-node--poke-org-id)
  "Hook run with point in the newly relocated file or entry.

A relocation is an operation like `org-node-refile' or
`org-node-extract-subtree', such that some of the node\\='s data was
already known."
  :type 'hook
  :package-version '(org-node . "3.18.0"))

;; 2026-03-04: We used to try to do this sort of thing all the time even in
;; unsaved buffers and it led to difficulty in reasoning about org-mem (since
;; it only has data from saved files on disk, which then conflict with what
;; org-id says about unsaved buffers), but since org-mem 0.32.0 it should at
;; least not be an issue that pollutes the next reset with wrong file names:
;; org-mem can handle org-id-locations having wrong file names.
;;
;; Interestingly, however, this is not enough to make ID-links send you to the
;; correct location if a buffer hasn't yet been written to disk.  Org-id may
;; actually signal error in that case or hang Emacs.  See `org-node-goto-id',
;; `org-node--ad-org-id-find'.
(defun org-node--poke-org-id ()
  "Put ID of entry at point into `org-id-locations'."
  (require 'org-id)
  (when-let* ((file (buffer-file-name (buffer-base-buffer)))
              (id (org-entry-get nil "ID")))
    (org-id-add-location id file)))

(defcustom org-node-creation-hook nil
  "Hook run with point in the newly created file or entry.

A good function for this hook is `org-node-ensure-crtime-property',
since the default `org-node-file-timestamp-format' is empty."
  :type 'hook
  :package-version '(org-node . "0.1"))

(unless (featurep 'org-node)
  (add-hook 'org-node-creation-hook    #'org-id-get-create -90)
  (add-hook 'org-node-creation-hook    #'org-node-ensure-crtime-property))

(defcustom org-node-creation-fn #'org-node-new-file
  "Function called to create a node that does not yet exist.
Used by commands such as `org-node-find'.

Some choices:
- `org-node-new-file'
- `org-node-new-via-roam-capture'
- `org-capture'

It is pointless to choose `org-capture' here unless you configure
`org-capture-templates' such that some capture templates use
`org-node-capture-target' as their target.

If you wish to write a custom function instead of any of the
above three choices, know that two variables are set at the time
the function is called: `org-node-proposed-title' and
`org-node-proposed-id', which it is expected to obey."
  :group 'org-node
  :type '(radio
          (function-item org-node-new-file)
          (function-item org-node-new-via-roam-capture)
          (function-item org-capture)
          (function :tag "Custom function" :value (lambda ())))
  :package-version '(org-node . "0.1"))

(defvar org-node-proposed-title nil
  "For use by `org-node-creation-fn'.
Automatically set, should be nil most of the time.")

(defvar org-node-proposed-id nil
  "For use by `org-node-creation-fn'.
Automatically set, should be nil most of the time.")

(defvar org-node-proposed-seq nil
  "Key that identifies a node sequence about to be added-to.
Automatically set, should be nil most of the time.")

(defvar org-node--new-unsaved-buffers nil
  "List of file-visiting buffers that have never written to the file.")

;; TODO: Return the node it created...?  Handy for programming.  We'd have to
;;       mandate saving the buffer after creation, and refactor org-mem so it
;;       can update synchronously instead of async, but that risks slowness in
;;       the use-case where you call this rapid-fire in an already huge file.
;;       Maybe this function can just accept a lambda that it temporarily adds
;;       to `org-mem-post-targeted-scan-functions'?
(defun org-node-create (title id &optional seq-key)
  "Call `org-node-creation-fn' with necessary variables set.

TITLE will be title of node, ID will be id of node \(pass
an output of `org-id-new' if you don\\='t know\).

Optional argument SEQ-KEY means use the resulting node to
maybe grow the corresponding sequence.

When calling from Lisp, you should not assume anything about
which buffer will be current afterwards, since it depends on
`org-node-creation-fn', whether TITLE or ID had existed, and
whether the user carried through with the creation.

To operate on a node after creating it, hook onto
`org-node-creation-hook' temporarily:

    \(let ((fix-up (lambda () ...)))
      (add-hook \\='org-node-creation-hook fix-up)
      (unwind-protect (org-node-create TITLE ID)
        (remove-hook \\='org-node-creation-hook fix-up))"
  (require 'org)
  (let ((org-node-proposed-title title)
        (org-node-proposed-id id)
        (org-node-proposed-seq seq-key))
    (funcall org-node-creation-fn)))

(defun org-node-new-file (&optional title id)
  "Create a new file with a new node.
Designed for `org-node-creation-fn'."
  (unless title (or (setq title org-node-proposed-title)
                    (error "Proposed title was nil")))
  (unless id (or (setq id org-node-proposed-id)
                 (error "Proposed ID was nil")))
  (org-node-pop-to-fresh-file-buffer title)
  (if org-node-prefer-with-heading
      (insert "* " title
              "\n:PROPERTIES:"
              "\n:ID:       " id
              "\n:END:"
              "\n")
    (insert ":PROPERTIES:"
            "\n:ID:       " id
            "\n:END:"
            "\n#+title: " title
            "\n"))
  (goto-char (point-max))
  (push (current-buffer) org-node--new-unsaved-buffers)
  (run-hooks 'org-node-creation-hook))

(defun org-node-pop-to-fresh-file-buffer (title)
  "Open a buffer that visits a file for a node to be named TITLE.

May open a pre-existing buffer even if it was not yet written to disk,
but throws an error if that buffer already has content, since this
function is meant as a subroutine for creating a new file-level node.
To merely visit an existing node, see `org-node-goto-id'.

If the file already exists, this also attempts a `revert-buffer'."
  (let* ((dir (org-node-guess-or-ask-dir "New file in which directory? "))
         (file (file-name-concat dir (org-node-title-to-basename title)))
         (buf (progn (mkdir dir t)
                     (or (find-buffer-visiting file)
                         (find-file-noselect file)))))
    (pop-to-buffer-same-window buf)
    (cl-assert (eq (current-buffer) buf))
    (cl-flet ((assert-empty ()
                (when (not (length= (buffer-string) 0))
                  (let ((msg (format "Resetting cache because file seems to already have contents: %s"
                                     file)))
                    (org-mem-reset t msg)
                    (user-error "%s" msg)))))
      (assert-empty)
      (when (file-exists-p file)
        (revert-buffer)
        (assert-empty)))))

(defun org-node-new-via-roam-capture ()
  "Call `org-roam-capture-' with predetermined arguments.
Designed for `org-node-creation-fn'."
  (unless org-node-proposed-title (error "Proposed title was nil"))
  (unless org-node-proposed-id (error "Proposed ID was nil"))
  (unless (require 'org-roam nil t)
    (error "`org-node-new-via-roam-capture' requires library \"org-roam\""))
  (when (and (fboundp 'org-roam-capture-)
             (fboundp 'org-roam-node-create))
    (let ((creation-hook-runner (##run-hooks 'org-node-creation-hook)))
      (add-hook 'org-roam-capture-new-node-hook creation-hook-runner)
      (unwind-protect (org-roam-capture-
                       :node (org-roam-node-create
                              :title org-node-proposed-title
                              :id    org-node-proposed-id))
        (remove-hook 'org-roam-capture-new-node-hook creation-hook-runner)))))

;;;###autoload
(defun org-node-capture-target ()
  "Can be used as target in a capture template.
See `org-capture-templates' for more info about targets.

In simple terms, let\\='s say you have configured
`org-capture-templates' so it has a template that
targets `(function org-node-capture-target)'.
Now here\\='s a possible workflow:

1. Run `org-capture'
2. Select your template
3. Type name of known or unknown node
4a. If it was known, it will capture into that node.
4b. If it was unknown, it will create a file-level node and then
    capture into there.

Additionally, with (setq org-node-creation-fn #\\='org-capture),
commands like `org-node-find' will outsource to `org-capture' when you
type the name of a node that does not exist.  That enables this
\\+`inverted' workflow, familiar to Org-roam users:

1. Run `org-node-find'
2. Type name of an unknown node
3. Select your template
4. Same as 4b earlier."
  (org-node-cache-ensure)
  ;; Store the title and ID in such a way that the user gets access to
  ;; expansions %(org-capture-get :title) and %(org-capture-get :id) in the
  ;; template string.
  (apply #'org-capture-put (org-node-capture-infer-title-etc))
  (if-let ((node (org-capture-get :existing-node)))
      (org-node-goto node t)
    (org-node-new-file (org-capture-get :title)
                       (org-capture-get :id))
    (goto-char (point-min)))
  (when (eq (org-capture-get :type) 'plain)
    (let ((file-level-node (org-before-first-heading-p)))
      (if (org-capture-get :prepend)
          (org-node-full-end-of-meta-data)
        (outline-next-heading))
      ;; Seems that after org-capture has run this function, it reacts to point
      ;; being on a single-star asterisk, moving it further downwards with
      ;; `org-end-of-meta-data'. Prevent that.
      (when (and file-level-node (org-at-heading-p))
        (if (looking-back "\n\n" nil)
            (backward-char)
          ;; Unfortunately, we must modify the buffer
          (open-line 1))))))

(defun org-node-capture-infer-title-etc ()
  "Return a plist with values for :title, :id and :existing-node.

If possible, determine :title and :id from current values of
`org-node-proposed-title' and `org-node-proposed-id'.
Otherwise, prompt the user for a title.
Finally, if the title matches an existing node, set :existing-node to
that node \(an `org-mem-entry' object\), otherwise leave it at nil."
  (let (title id node)
    (if org-node-proposed-title
        ;; Was presumably called from wrapper `org-node-create', so the user
        ;; had typed the title and no such node exists yet.
        (setq title org-node-proposed-title
              id org-node-proposed-id
              node (org-mem-entry-by-id id))
      ;; Was presumably called from bare `org-capture', which means the user
      ;; has not yet typed the title; let them type it now.
      (let ((input (org-node-read-candidate nil t)))
        (when (string-blank-p input)
          (setq input (funcall org-node-blank-input-title-generator)))
        (setq node (gethash input org-node--candidate<>entry))
        (if node
            (setq title (org-mem-entry-title node)
                  id (org-mem-entry-id node))
          (setq title input
                id (org-id-new)))))
    (cl-assert title)
    (cl-assert id)
    (list :title title :id id :existing-node node)))


;;;; Subroutines for some commands

(defun org-node--try-complete-title-at-pt ()
  "See user option `org-node-find-use-thing-at-point'."
  (save-excursion
    (let* ((titles (hash-table-keys org-node--title<>affixations))
           (sym (thing-at-point 'symbol))
           (word (thing-at-point 'word))
           ;; Handle note title like "#statistics", with the #
           (beg (+ (point) (skip-chars-backward "^[:space:]\n[]")))
           (end (+ (point) (skip-chars-forward "^[:space:]\n[]")))
           (real-thing-at-pt (and (not (= beg end))
                                  (buffer-substring beg end))))
      ;; Discussion about the preference order:
      ;; https://github.com/meedstrom/org-node/pull/134
      (org-node--try-completions (list real-thing-at-pt sym word)
                                 (append titles (mapcar #'downcase titles))))))

(defun org-node--try-completions (tests collection)
  "Like `try-completion' but easier to use in general-purpose code.

Tries each string in TESTS against COLLECTION until one matches.
TESTS may include nils, which are skipped.
On match, the return value is always a string."
  (cl-loop for test in tests
           as result = (and test (try-completion test collection))
           if (eq t result) return test
           else if (stringp result) return result))

(defun org-node--safe-ensure-blank-line ()
  "Ensure point is in a blank line or a new blank line below current.
Place point after any indentation."
  ;; Don't `newline-and-indent', it runs amok near an Org list.
  (let ((col (progn (back-to-indentation) (current-indentation))))
    (unless (eolp) (goto-char (pos-eol)) (newline) (indent-to col))))


;;;; Commands 1: Cute little commands

(defcustom org-node-find-use-thing-at-point nil
  "Whether `org-node-find' should try to have smart initial input.

This means it checks the text around point for a partial or full match
to an existing node title, and in that case fills the minibuffer with
the text that matched."
  :type 'boolean
  :package-version '(org-node . "3.9.0"))

;;;###autoload
(defun org-node-find ()
  "Select and visit one of your ID nodes."
  (interactive)
  (org-node-cache-ensure)
  (let* ((input (org-node-read-candidate "Visit or create node: "
                                         t nil nil
                                         (when org-node-find-use-thing-at-point
                                           (org-node--try-complete-title-at-pt))))
         (_ (when (string-blank-p input)
              (setq input (funcall org-node-blank-input-title-generator))))
         (node (gethash input org-node--candidate<>entry)))
    (require 'org-id) ;; REVIEW
    (if node
        (org-node-goto node)
      (org-node-create input (org-id-new)))))

;;;###autoload
(defun org-node-insert-heading ()
  "Insert a heading with ID and run `org-node-creation-hook'.
Tip: Command `org-node-nodeify-entry' is more widely applicable, it can
be sufficient to key-bind that one."
  (interactive "*" org-mode)
  (org-insert-heading)
  (org-node-nodeify-entry))

;;;###autoload
(defun org-node-nodeify-entry ()
  "Add an ID to entry at point and run `org-node-creation-hook'."
  (interactive "*" org-mode)
  (org-node-cache-ensure) ;; Because the hook could contain anything
  (run-hooks 'org-node-creation-hook))

;;;###autoload
(defun org-node-ensure-crtime-property ()
  "Add a CREATED property to entry at point, if none already.
Actually, it can be named something other than CREATED -- configure
`org-node-property-crtime'."
  (interactive "*" org-mode)
  (unless (org-entry-get nil org-node-property-crtime)
    (org-entry-put nil
                   org-node-property-crtime
                   (org-node-time-stamp t t))))

(defun org-node-visit-random-1 ()
  "Visit a random node."
  (interactive)
  (org-node-cache-ensure)
  (org-node-goto (seq-random-elt (org-node-all-filtered-nodes)))
  t)

;;;###autoload
(defun org-node-visit-random ()
  "Visit a random node.
Repeatable on the last key of a key sequence if
`repeat-on-final-keystroke' is t."
  (interactive)
  (setq last-repeatable-command #'org-node-visit-random-1)
  (if repeat-on-final-keystroke
      (repeat nil)
    (org-node-visit-random-1)))

;; TODO: Optionally obey `org-node-filter-fn'
;;;###autoload
(defun org-node-grep ()
  "Grep across all files known to org-node."
  (interactive)
  (unless (require 'consult nil t)
    (user-error "This command requires package \"consult\""))
  (org-node-cache-ensure)
  ;; Prevent consult from turning the names relative, with such enlightening
  ;; directory paths as ../../../../../../.
  ;; https://github.com/minad/consult/discussions/1073
  (cl-letf (((symbol-function #'file-relative-name)
             (lambda (name &optional _dir) name)))
    (let ((consult-ripgrep-args (concat consult-ripgrep-args " --type=org")))
      (if (executable-find "rg")
          (consult--grep "Grep in files known to org-mem: "
                         #'consult--ripgrep-make-builder
                         (org-node--root-dirs (org-node-all-filtered-files))
                         nil)
        ;; Much slower!  Vanilla grep does not have Ripgrep's --type=org, so
        ;; must target thousands of files and not a handful of dirs, a calling
        ;; pattern that would also slow Ripgrep down.
        (consult--grep "(Ripgrep not found) Grep in files known to org-mem: "
                       #'consult--grep-make-builder
                       (org-node-all-filtered-files)
                       nil)))))

;;;###autoload
(defun org-node-customize ()
  "Display the `org-node' customization group."
  (interactive)
  (customize-group 'org-node))

;;;###autoload
(defun org-node-help ()
  "Display the Info manual for \"(org-node)\"."
  (interactive)
  (info "(org-node)"))


;;;; Commands 2: Inserting things

(defcustom org-node-insert-link-hook nil
  "Hook run after inserting a link, with point in the new link."
  :type 'hook
  :package-version '(org-node . "0.1"))

(defcustom org-node-custom-link-format-fn nil
  "Function to format inserted links specially.
Takes a node as argument, should return a string."
  :type '(choice (const nil) function)
  :package-version '(org-node . "2.3.3"))

;;;###autoload
(defun org-node-insert-link (&optional region-as-initial-input novisit)
  "Insert a link to one of your ID nodes.

To behave exactly like org-roam\\='s `org-roam-node-insert',
see `org-node-insert-link*', or pass REGION-AS-INITIAL-INPUT t.

Argument NOVISIT for use by `org-node-insert-link-novisit'."
  (interactive "@*" org-mode)
  (unless (derived-mode-p 'org-mode)
    (user-error "Only works in org-mode buffers"))
  (org-node-cache-ensure)
  (let* ((beg nil)
         (end nil)
         (region-text (when (region-active-p)
                        (setq end (region-end))
                        (goto-char (region-beginning))
                        (skip-chars-forward "\n[:space:]")
                        (setq beg (point))
                        (goto-char end)
                        (skip-chars-backward "\n[:space:]")
                        (setq end (point))
                        (org-link-display-format
                         (buffer-substring-no-properties beg end))))
         (initial (if (or region-as-initial-input
                          (and region-text
                               (try-completion region-text
                                               org-node--title<>affixations)))
                      region-text
                    nil))
         (_ (when (eq t initial)
              ;; Guard against `try-completion' returning t instead of a string
              ;; (who knew?!)
              (setq initial nil)))
         (input (if (and novisit initial)
                    initial
                  (org-node-read-candidate nil t initial)))
         (_ (when (string-blank-p input)
              (setq input (funcall org-node-blank-input-title-generator))))
         (node (gethash input org-node--candidate<>entry))
         (id (if node (org-mem-entry-id node) (org-id-new)))
         (link-desc (or region-text
                        (and node
                             org-node-custom-link-format-fn
                             (funcall org-node-custom-link-format-fn node))
                        (and (not org-node-alter-candidates) input)
                        (and node (seq-find (##string-search % input)
                                            (org-mem-entry-roam-aliases node)))
                        (and node (org-mem-entry-title node))
                        input)))
    (atomic-change-group
      (when region-text
        (delete-region beg end))
      ;; TODO: When inserting a citation, insert a [cite:] instead of a normal
      ;;       link
      ;; (if (string-prefix-p "@" input))
      (insert (org-link-make-string (concat "id:" id) link-desc)))
    (run-hooks 'org-node-insert-link-hook)
    ;; TODO: Delete the link if a node was not created
    ;;       See `org-node-insert-transclusion'
    ;; TODO: Respect `org-node-stay-in-source-buffer'
    (unless node
      (org-node-create input id))))

;;;###autoload
(defun org-node-insert-link* ()
  "Insert a link to one of your ID nodes.

Unlike `org-node-insert-link', emulate `org-roam-node-insert' by
always copying any active region as initial input.

That behavior can be convenient if you often want to use the
selected region as a new node title, or you already know it
matches a node title.

On the other hand if you always find yourself erasing the
minibuffer before selecting some other node you had in mind, to
which the region should be linkified, you\\='ll prefer
`org-node-insert-link'.

The commands are the same, just differing in initial input."
  (interactive "*" org-mode)
  (org-node-insert-link t))

;; TODO: Get rid of it
;;;###autoload
(defun org-node-insert-link-novisit ()
  "(Unimplemented) Only supported with `org-node-new-via-roam-capture'.
Insert a link to one of your ID nodes without ever visiting it.

Normally, if the node does not exist, `org-node-insert-link' would
create it and then visit it.  This will not visit it."
  (interactive "*" org-mode)
  (let ((org-roam-capture-templates
         (list (append (car (bound-and-true-p org-roam-capture-templates))
                       '(:immediate-finish t)))))
    (org-node-insert-link nil t)))

;;;###autoload
(defun org-node-insert-link-novisit* ()
  "(Unimplemented) Only supported with `org-node-new-via-roam-capture'.
Insert a link to one of your ID nodes without ever visiting it.

Normally, if the node does not exist, `org-node-insert-link*' would
create it and then visit it.  This will not visit it."
  (interactive "*" org-mode)
  (let ((org-roam-capture-templates
         (list (append (car (bound-and-true-p org-roam-capture-templates))
                       '(:immediate-finish t)))))
    (org-node-insert-link t t)))

;; https://old.reddit.com/r/orgmode/comments/1khtt9k/release_orgincludeinline/msn9p50/
(defun org-node-insert-include (&optional node)
  "Insert an #+include referring to NODE.
Tip: It can be previewed with package \"org-include-inline\".
https://github.com/yibie/org-include-inline

The result includes NODE\\='s current file name, unfortunately required."
  (interactive () org-mode)
  (unless (derived-mode-p 'org-mode)
    (error "Only works in org-mode buffers"))
  (org-node-cache-ensure)
  (unless node
    (setq node (org-node-read)))
  (if (not node)
      (message "Node not known, create it first")
    (goto-char (pos-eol))
    (insert "\n#+include: \""
            (org-mem-file node)
            "::"
            (org-mem-entry-id node)
            "\"")
    (backward-char)
    (run-hooks 'org-node-insert-link-hook)))

;; New 2026-02-09.  Polish later and make public.
(defun org-node--create-sync (title id)
  "Create node, sync, and return the newly created node.
May return nil."
  (let ((saver (lambda () (save-buffer)))
        (updater (lambda () (org-mem-updater-update))))
    (add-hook 'org-node-creation-hook saver)
    (add-hook 'after-save-hook updater -95)
    (unwind-protect (org-node-create title id)
      (remove-hook 'org-node-creation-hook saver)
      (remove-hook 'after-save-hook updater)))
  (org-mem-await "Org-node syncing..." 60)
  ;; FIXME: Can return nil, why?
  (org-mem-entry-by-id id))

;;;###autoload
(defun org-node-insert-transclusion (&optional node)
  "Insert a #+transclude: referring to NODE.

Tip: If you often transclude file-level nodes with no initial heading,
consider configuring `org-transclusion-exclude-elements' to exclude
keywords."
  (interactive "*" org-mode)
  (org-node-cache-ensure)
  (let (input)
    (unless node
      (setq input (org-node-read-candidate "Transclude node content: " t))
      (when (string-blank-p input)
        (setq input (funcall org-node-blank-input-title-generator)))
      (setq node (gethash input org-node--candidate<>entry)))
    (let ((id (if node (org-mem-entry-id node) (org-id-new)))
          (title (if node (org-mem-title node) input))
          (buf (current-buffer))
          (pt (point-marker)))
      (unless node
        (setq node (org-node--create-sync title id)))
      (with-current-buffer buf
        (goto-char pt)
        (set-marker pt nil)
        (org-node--safe-ensure-blank-line)
        (insert "#+transclude: "
                (org-link-make-string
                 (concat "id:" id)
                 (or (and org-node-custom-link-format-fn
                          node
                          (funcall org-node-custom-link-format-fn node))
                     title))
                " :level auto")))))

;;;###autoload
(defun org-node-insert-transclusion-as-subtree (&optional node arg)
  "Insert a subheading, link, newline and transclusion.
Prompt for NODE if needed.
Result will basically look like:

** [[Note]]
#+transclude: [[Note]] :level auto :no-first-heading

Tip: If you often transclude file-level nodes with no initial heading,
consider configuring `org-transclusion-exclude-elements' to exclude
keywords.

Prefix argument ARG as in `org-insert-subheading'."
  (interactive "*i\nP" org-mode)
  (org-node-cache-ensure)
  (let (input)
    (unless node
      (setq input (org-node-read-candidate "Transclude node content: " t))
      (when (string-blank-p input)
        (setq input (funcall org-node-blank-input-title-generator)))
      (setq node (gethash input org-node--candidate<>entry)))
    (let ((id (if node (org-mem-entry-id node) (org-id-new)))
          (title (if node (org-mem-title node) input))
          (buf (current-buffer))
          (pt (point-marker)))
      (unless node
        ;; Try new `org-node--create-sync' so that
        ;; `org-node-custom-link-format-fn' can be used further below.
        (setq node (org-node--create-sync title id)))
      (with-current-buffer buf
        (goto-char pt)
        (set-marker pt nil)
        ;; Never bring along any text from the current line.
        (org-node--safe-ensure-blank-line)
        (org-insert-subheading arg)
        (let* ((desc (or (and org-node-custom-link-format-fn
                              node
                              (funcall org-node-custom-link-format-fn node))
                         title))
               (link (org-link-make-string (concat "id:" id) desc)))
          (insert link)
          (save-excursion
            (newline-and-indent)
            (insert "#+transclude: " link " :level auto :no-first-heading"))
          (run-hooks 'org-node-insert-link-hook))))))

;;;###autoload
(defun org-node-insert-raw-link ()
  "Insert input at point, completing to any link ever seen in Org.
Works in non-Org buffers."
  (interactive)
  (insert (completing-read "Insert raw link: "
                           (org-node--list-known-raw-links)
                           nil nil nil 'org-node-link-hist)))

;; TODO: Try to include all Firefox bookmarks and so on
(defun org-node--list-known-raw-links ()
  "Return list of all \(non-ID\) links seen in all known files."
  (let (result)
    (maphash (lambda (target links)
               (let ((types (seq-keep #'org-mem-link-type
                                      (seq-remove #'org-mem-link-citation-p
                                                  links))))
                 (dolist (type (delete-dups (delete "id" types)))
                   (push (concat type ":" target) result))))
             org-mem--target<>links)
    result))

(defcustom org-node-name-of-links-drawer "RELATED"
  "Name of drawer created by command `org-node-insert-into-related'."
  :type '(radio (const :value "RELATED")
                (const :value "SEE-ALSO")
                (const :value "LINKS")
                string)
  :package-version '(org-node . "3.3.3"))

;; TODO: Option to insert at end of drawer instead of beginning
;; TODO: Option to control how to format each new insertion
(defun org-node-insert-into-related ()
  "Insert a link into a drawer named by `org-node-name-of-links-drawer'.
If such a drawer is not found in the current entry, create one at the
end of the entry.

Unlike the BACKLINKS drawer, this drawer is not \\+`smart' and will never
modify itself other than through this command."
  (interactive "*" org-mode)
  (if (derived-mode-p 'org-agenda-mode)
      ;; Support use from agenda.
      (org-with-point-at (org-get-at-bol 'org-hd-marker)
        (org-node-insert-into-related))
    (when-let* ((input (org-node-read-candidate))
                (node (gethash input org-node--candidate<>entry)))
      (save-excursion
        (save-restriction
          (org-node-narrow-to-drawer-create org-node-name-of-links-drawer
                                            #'org-entry-end-position)
          (atomic-change-group
            ;; TODO: Go to end of drawer.
            ;;       This should probably be controlled by user option.
            ;; (goto-char (point-max))
            ;; (org-node--safe-ensure-blank-line t)
            (unless (eolp)
              (let ((col (current-indentation)))
                (newline)
                (indent-to col))
              (forward-line -1)
              (back-to-indentation))
            (insert (org-node-time-stamp t t) " -> "
                    (org-link-make-string (concat "id:" (org-mem-entry-id node))
                                          (org-mem-title node)))))))))


;;;; Commands 3: Extract and refile

;; TODO: After an extract, add a temporary save hook that saves the other file
;; as well if two files were involved.

(defcustom org-node-stay-in-source-buffer nil
  "Keep the source buffer current after extract or refile.
Used by `org-node-extract-subtree' and `org-node-refile'."
  :type 'boolean
  :package-version '(org-node . "3.6.4"))

(defcustom org-node-extract-leave-link-in-source t
  "Whether to insert a link to the just-extracted subtree.
The link would be placed at the end of the parent entry.

Used by `org-node-extract-subtree'."
  :type 'boolean
  :package-version '(org-node . "3.6.0"))

(defcustom org-node-extract-add-inherited-tags t
  "Add all tags that had been inherited in the original context.
Used by `org-node-extract-subtree'."
  :type 'boolean
  :package-version '(org-node . "3.6.3"))

;;;###autoload
(defun org-node-extract-subtree ()
  "Extract subtree at point into a file of its own.
If it had an ID, run `org-node-relocation-hook', else run
`org-node-creation-hook'.

Note that this command can be indirectly called from another command
\\[org-node-refile], so you may not need to key-bind this one.

Some behaviors are configurable in user options:
- `org-node-stay-in-source-buffer'
- `org-node-extract-leave-link-in-source'
- `org-node-extract-add-inherited-tags'
- `org-node-prefer-with-heading'

Adding to that, see below for an example advice that copies any
inherited \"CREATED\" property, if an ancestor had such a
property.  It is subjective whether you\\='d want this behavior,
but it can be desirable if you know the subtree had been part of
the source file for ages so that you regard the ancestor\\='s
creation-date as more truthful or useful than today\\='s date.

\(advice-add \\='org-node-extract-subtree :around
            (defun my-inherit-creation-date (orig-fn &rest args)
              (let* ((ancestor-crtime (org-entry-get nil \"CREATED\" t))
                     (crtime-putter
                      (lambda ()
                        (org-entry-put nil \"CREATED\"
                                       (or ancestor-crtime
                                           (org-node-time-stamp t t))))))
                (add-hook \\='org-node-relocation-hook crtime-putter)
                (add-hook \\='org-node-creation-hook crtime-putter)
                (unwind-protect (apply orig-fn args)
                  (remove-hook \\='org-node-relocation-hook crtime-putter)
                  (remove-hook \\='org-node-creation-hook crtime-putter)))))"
  (interactive "*" org-mode)
  (org-node-cache-ensure)
  (org-back-to-heading t)
  (save-buffer)
  (let* ((tags (if org-node-extract-add-inherited-tags (org-get-tags)
                 (org-get-tags nil t)))
         (title (org-get-heading t t t t))
         (dir (org-node-guess-or-ask-dir "Extract to new file in directory: "))
         (path-to-write
          (file-name-concat dir (org-node-title-to-basename title)))
         (already-a-node (org-entry-get nil "ID"))
         (crtime (org-entry-get nil org-node-property-crtime))
         (id (progn
               (when (file-exists-p path-to-write)
                 (user-error "A file already exists named %s" path-to-write))
               (org-id-get-create)))
         (boundary (save-excursion (org-end-of-meta-data t) (point)))
         (case-fold-search t)
         ;; Why is CATEGORY autocreated by `org-entry-properties'...  It's
         ;; an invisible property that's always present and usually not
         ;; interesting, unless user has entered some explicit value
         (explicit-category (save-excursion
                              (when (search-forward ":CATEGORY:" boundary t)
                                (org-entry-get nil "CATEGORY"))))
         (properties (seq-remove
                      (##string-equal-ignore-case "CATEGORY" (car %))
                      (org-entry-properties nil 'standard)))
         (source (point-marker))
         (source-parent (save-excursion
                          (without-restriction
                            (org-up-heading-or-point-min)
                            (point-marker)))))
    (mkdir dir t)
    (if (org-at-heading-p) (org-fold-show-entry) (org-fold-show-context))
    (find-file path-to-write)
    (save-excursion
      (with-current-buffer (marker-buffer source)
        (goto-char source)
        (org-cut-subtree)))
    (org-paste-subtree)
    (unless org-node-prefer-with-heading
      (org-end-of-meta-data)
      (kill-region (point-min) (point))
      (org-map-region #'org-promote (point-min) (point-max))
      (insert
       ":PROPERTIES:\n"
       (string-join (mapcar (##concat ":" (car %) ": " (cdr %))
                            properties)
                    "\n")
       "\n:END:"
       (if explicit-category
           (concat "\n#+category: " explicit-category)
         "")
       (if tags
           (concat "\n#+filetags: :" (string-join tags ":") ":")
         "")
       "\n#+title: " title
       "\n"))
    (push (current-buffer) org-node--new-unsaved-buffers)
    (if already-a-node
        (run-hooks 'org-node-relocation-hook)
      (run-hooks 'org-node-creation-hook))
    (when org-node-extract-leave-link-in-source
      (save-excursion
        (with-current-buffer (marker-buffer source-parent)
          (unless (bound-and-true-p org-capture-mode) ;; idk if it can be sane
            (save-excursion
              (goto-char source-parent)
              (goto-char (org-entry-end-position))
              (open-line 1)
              (insert "\n"
                      (format-time-string
                       (format "%s Created " (or crtime (org-node-time-stamp t t))))
                      (org-link-make-string (concat "id:" id) title)
                      "\n"))))))
    (when org-node-stay-in-source-buffer
      (switch-to-buffer (marker-buffer source)))
    (set-marker source-parent nil)
    (set-marker source nil)))

;; TODO: Allow refile from inside a capture buffer, at least for some capture
;; templates.  (During a capture, `org-refile' is rebound to
;; `org-capture-refile', which see).  It seems we can just temp override
;; definition of `org-refile' with this one, if I am correct that that long
;; function basically does the equivalent of org-cut-subtree and paste.

;;;###autoload
(defun org-node-refile ()
  "Prompt for a node and refile the tree at point into it.
No support yet for refiling a whole file.

Exiting the prompt with a blank input calls `org-node-extract-subtree'."
  (interactive "*" org-mode)
  (when (org-before-first-heading-p)
    ;; TODO: Support refiling a file.  Just implement
    ;; `org-roam-demote-entire-buffer', call it and then proceed as normal.
    ;; Then prompt to delete empty file left behind.
    (user-error "`org-node-refile' only works on subtrees for now"))
  (org-node-cache-ensure)
  (let* ((org-node-blank-input-hint
          (propertize "(extract to own file)" 'face 'completions-annotations))
         (input (org-node-read-candidate "Refile into ID-node: " t)))
    (if (string-blank-p input)
        (org-node-extract-subtree)
      (let ((node (or (gethash input org-node--candidate<>entry)
                      (error "Node not found: %s" input)))
            (source (point-marker)))
        (org-node-goto node t) ;; NOTE: May or may not change current buffer
        (forward-char)
        (save-excursion
          (with-current-buffer (marker-buffer source)
            (goto-char source)
            (org-cut-subtree)))
        (org-paste-subtree)
        (run-hooks 'org-node-relocation-hook)
        (when org-node-stay-in-source-buffer
          (switch-to-buffer (marker-buffer source)))
        (set-marker source nil)))))


;;;; Commands 4: Renaming things

(defcustom org-node-renames-allowed-dirs nil
  "Dirs in which files may be auto-renamed.
Used if you have the function `org-node-rename-file-by-title' on
`after-save-hook' or otherwise call it from Lisp.

To add exceptions, see `org-node-renames-exclude'."
  :type '(repeat directory)
  :package-version '(org-node . "0.7"))

(defcustom org-node-renames-exclude "\\(?:daily\\|dailies\\|journal\\)/"
  "Regexp matching file names not to auto-rename.
For use by `org-node-rename-file-by-title'.

Only applied to files under `org-node-renames-allowed-dirs'.
If a file is not there, it is not considered in any case."
  :type 'string
  :package-version '(org-node . "0.7"))

;; Answers the question: how do you experiment with changing datestamp formats?
;; All the user needs to do is use wdired to delete pre-existing stamps, then
;; run `org-node-rename-file-by-title' on all files.
(defcustom org-node-renames-use-time-from-property t
  "Whether to fall back on timestamp in `org-node-property-crtime'.
See `org-node-rename-file-by-title'."
  :type 'boolean
  :package-version '(org-node . "3.7.2"))

;;;###autoload
(defun org-node-rename-file-by-title (&optional interactive)
  "Rename the current file according to `org-node-file-slug-fn'.

Also attempt to check for a prefix in the style of current
`org-node-file-timestamp-format', and preserve such a prefix.
Otherwise, add one, obeying `org-node-renames-use-time-from-property'.

Suitable at the end of `after-save-hook'.  If called from a hook
\(or from Lisp in general), only operate on files in
`org-node-renames-allowed-dirs'.  When called interactively as a
command, always prompt for confirmation.

Argument INTERACTIVE automatically set."
  (interactive "p" org-mode)
  (let* ((buf (or (buffer-base-buffer) (current-buffer)))
         (path (file-truename (buffer-file-name buf)))
         (title nil)
         (time-from-property nil))
    (cond
     ((or (not (derived-mode-p 'org-mode))
          (not (equal "org" (file-name-extension path))))
      (when interactive
        (message "Will only rename Org files")))
     ((and (not interactive)
           (null org-node-renames-allowed-dirs))
      (message "User option `org-node-renames-allowed-dirs' should be configured"))
     ((or interactive
          (cl-loop
           for dir in (mapcar #'file-truename org-node-renames-allowed-dirs)
           if (string-match-p org-node-renames-exclude dir)
           do (error "Regexp `org-node-renames-exclude' would directly match a directory from `org-node-renames-allowed-dirs'")
           else if (and (string-prefix-p dir path)
                        (not (string-match-p org-node-renames-exclude path)))
           return t))
      (org-node--assert-transclusion-safe)
      (save-excursion
        (without-restriction
          (goto-char (point-min))
          (setq title (or (org-get-title)
                          ;; No #+TITLE keyword.  If also no file-level :ID:,
                          ;; let the first heading stand for title.
                          (unless (and (org-before-first-heading-p)
                                       (org-entry-get nil "ID"))
                            (and (or (org-at-heading-p)
                                     (outline-next-heading))
                                 (org-get-heading t t t t)))))
          (when org-node-renames-use-time-from-property
            (let ((xx (org-entry-get nil org-node-property-crtime)))
              (when (and xx (seq-some #'natnump (parse-time-string xx)))
                (setq time-from-property
                      (encode-time (org-parse-time-string xx))))))))
      (if (not title)
          (message "org-node-rename-file-by-title: No title in file %s" path)
        (let* ((name (file-name-nondirectory path))
               (date-prefix
                (or (org-node-extract-file-name-datestamp path)
                    ;; Couldn't find date prefix, add a new one.
                    ;; Base it on the :CREATED: property if it was
                    ;; present, else generate one for today.
                    (format-time-string org-node-file-timestamp-format
                                        time-from-property)))
               (slug (funcall org-node-file-slug-fn title))
               (new-name (concat date-prefix slug ".org"))
               (new-path
                (file-name-concat (file-name-directory path) new-name)))
          (cond
           ((equal path new-path)
            (when interactive
              (message "Filename already correct: %s" path)))
           ((string-empty-p slug)
            (when interactive
              (message "Filename would become blank: %s" path)))
           ((buffer-modified-p buf)
            (when interactive
              (message "Unsaved file, letting it be: %s" path)))
           ((find-buffer-visiting new-path)
            (error "Wanted to rename, but a buffer already visits target: %s"
                   new-path))
           ((or (not (file-writable-p path))
                (not (file-writable-p new-path)))
            (error "No permissions to rename file: %s"
                   path))
           ((or (not interactive)
                (y-or-n-p (format "Rename file '%s' to '%s'?" name new-name)))
            (rename-file path new-path)
            (with-current-buffer buf
              (set-visited-file-name new-path t t))
            (message "File '%s' renamed to '%s'" name new-name)))))))))

(defun org-node-extract-file-name-datestamp (path)
  "From filename PATH, get the datestamp prefix if it has one.
Do so by comparing with `org-node-file-timestamp-format'.

High risk of false positives if you have been changing formats over
time without renaming existing files."
  (when (and org-node-file-timestamp-format
             (not (string-blank-p org-node-file-timestamp-format)))
    (let ((name (file-name-nondirectory path)))
      (when (string-match
             (org-node--make-regexp-for-time-format org-node-file-timestamp-format)
             name)
        (match-string 0 name)))))

;; "Some people, when confronted with a problem, think
;; 'I know, I'll use regular expressions.'
;; Now they have two problems." —Jamie Zawinski
(defun org-node--make-regexp-for-time-format (format)
  "Make regexp to match a result of (format-time-string FORMAT).

In other words, if e.g. FORMAT is %Y-%m-%d, which can be
instantiated in many ways such as 2024-08-10, then this should
return a regexp that can match any of those ways it might turn
out, with any year, month or day."
  (with-memoization (org-mem--table 'org-node--make-regexp-for-time-format format)
    ;; TODO: Improve error messages, now they presume caller
    ;;       (or do the checks in the caller, rather than here).
    (when (string-empty-p format)
      (error "Called with empty FORMAT"))
    (when (string-match-p "[[:alnum:]]" (substring format -1))
      (error "Cannot safely rename if `org-node-file-timestamp-format' does not end in a separator such as a dash"))
    (let ((example (format-time-string format)))
      (if (string-match-p (rx (any "^*+([\\")) example)
          (error "org-node: Unable to safely rename with current `org-node-file-timestamp-format'.
This is not inherent in your choice of format, I am just not smart enough")
        (concat "^"
                (string-replace
                 "." "\\."
                 (replace-regexp-in-string
                  "[[:digit:]]+" "[[:digit:]]+"
                  (replace-regexp-in-string
                   "[[:alpha:]]+" "[[:alpha:]]+"
                   example t))))))))

(defconst org-node-rewrite-link-overlay (make-overlay 1 1))
(overlay-put org-node-rewrite-link-overlay 'face 'org-node-rewrite-link)

;; TODO: Kill opened buffers that were not edited.
;;       But first make sure it can pick up where it left off if canceled
;;       midway. Maybe use fileloop, like `org-node-lint-all-files'.
;; REVIEW: Verify `org-node-filter-fn' is used correctly.
;;;###autoload
(defun org-node-rewrite-links-ask (&optional files)
  "Update desynced link descriptions, interactively.

Search all files, or just FILES if non-nil, for ID-links where
the link description has gotten out of sync from the
destination\\='s current title.

At each link, prompt for user consent to update the link
so it matches the destination\\='s current title."
  (interactive)
  (require 'ol)
  (org-node-cache-ensure)
  (when (org-node--consent-to-bothersome-modes-for-mass-edit)
    (let ((org-agenda-files nil) ;; perf
          (inhibit-message t)
          (n-links 0)
          (n-files 0))
      (dolist (file (or files (cl-sort (org-node-all-filtered-files)
                                       (lambda (_ _) (natnump (random))))))
        (with-current-buffer (delay-mode-hooks (find-file-noselect file))
          (save-excursion
            (without-restriction
              (goto-char (point-min))
              (cl-incf n-files)
              (while-let ((end (re-search-forward org-link-bracket-re nil t)))
                (let* ((beg (match-beginning 0))
                       (uri (match-string 1))
                       (desc (match-string 2))
                       (id (when (string-match (rx bos "id:" (group (* (not ":")))) uri)
                             (match-string 1 uri)))
                       (node (org-mem-entry-by-id id))
                       (true-title (and node (org-mem-entry-title node)))
                       (custom-desc
                        (and org-node-custom-link-format-fn
                             node
                             (funcall org-node-custom-link-format-fn node)))
                       (inhibit-message nil))
                  (message "Checking... link %d (file #%d)"
                           (cl-incf n-links) n-files)
                  (redisplay t)
                  (when (and id node desc
                             (funcall org-node-filter-fn node)
                             (if custom-desc
                                 (not (string-equal desc custom-desc))
                               (and (not (string-equal-ignore-case
                                          desc
                                          true-title))
                                    (not (member-ignore-case
                                          desc
                                          (org-mem-entry-roam-aliases node))))))
                    (switch-to-buffer (current-buffer))
                    (goto-char end)
                    (if (org-at-heading-p)
                        (org-fold-show-entry)
                      (org-fold-show-context))
                    (recenter)
                    (move-overlay org-node-rewrite-link-overlay beg end (current-buffer))
                    (unwind-protect
                        (let* ((new-desc (or custom-desc true-title))
                               (answer (read-multiple-choice
                                        (format "Rewrite link? Will become:  \"%s\""
                                                new-desc)
                                        '((?y "yes")
                                          (?n "no")
                                          (?e "edit")))))
                          (when (memq (car answer) '(?y ?e))
                            (when (eq (car answer) ?e)
                              (setq new-desc (read-string "Rewrite to: " new-desc)))
                            (atomic-change-group
                              (delete-region beg end)
                              (insert (org-link-make-string uri new-desc)))
                            ;; Give user a moment to glimpse the result before
                            ;; hopping to the next link, in case something goes
                            ;; very wrong
                            (redisplay t)
                            (sleep-for .12)))
                      (delete-overlay org-node-rewrite-link-overlay))))))))))))

(defun org-node--consent-to-bothersome-modes-for-mass-edit ()
  "Confirm about certain modes being enabled.
These are modes such as `auto-save-visited-mode' that can
interfere with user experience during or after mass-editing operation."
  ;; TODO: Expand the list, there are probably other annoying modes
  (cl-loop for mode in '(auto-save-visited-mode
                         git-auto-commit-mode)
           when (and (boundp mode)
                     (symbol-value mode)
                     (not (y-or-n-p
                           (format "%S is active - proceed anyway?" mode))))
           return nil
           finally return t))

;; Quick and dirty.  It works but don't like it.
;;;###autoload
(defun org-node-rename-asset-and-rewrite-links ()
  "Helper for renaming images and all links that point to them.

Prompt for an asset such as an image file to be renamed, then search
recursively for Org files containing a link to that asset, open a wgrep
buffer of the search hits, and start an interactive search-replace that
updates the links.  After the user consents or doesn\\='t consent to
replacing all the links, finally rename the asset file itself.  If the
user quits, do not apply any modifications."
  (interactive)
  (unless (require 'wgrep nil t)
    (user-error "This command requires the wgrep package"))
  (when (and (fboundp 'wgrep-change-to-wgrep-mode)
             (fboundp 'wgrep-finish-edit))
    (let ((root (car (org-node--root-dirs (org-node-all-filtered-files))))
          (default-directory default-directory))
      (or (equal default-directory root)
          (if (y-or-n-p (format "Go to folder \"%s\"?" root))
              (setq default-directory root)
            (setq default-directory
                  (read-directory-name
                   "Directory with Org notes to operate on: "))))
      (when-let ((bufs (seq-filter (##string-search "*grep*" (buffer-name %))
                                   (buffer-list))))
        (when (yes-or-no-p "Kill other *grep* buffers to be sure this works?")
          (mapc #'kill-buffer bufs)))
      (let* ((filename (file-relative-name (read-file-name "File to rename: ")))
             (new (read-string "New name: " filename)))
        (mkdir (file-name-directory new) t)
        (unless (file-writable-p new)
          (error "New path wouldn't be writable"))
        (rgrep (regexp-quote filename) "*.org")
        ;; HACK Doesn't work right away, so wait a sec, then it works
        (run-with-timer
         1 nil
         (lambda ()
           (pop-to-buffer (seq-find (##string-search "*grep*" (buffer-name %))
                                    (buffer-list)))
           (wgrep-change-to-wgrep-mode)
           (goto-char (point-min))
           ;; Interactive replaces
           (query-replace filename new)
           ;; NOTE: If the user quits the replaces with C-g, the following code
           ;;       never runs, which is good.
           (when (buffer-modified-p)
             (wgrep-finish-edit)
             (rename-file filename new)
             (message "File renamed from %s to %s" filename new))))
        (message "Waiting for rgrep to populate buffer...")))))


;;;; Commands 5: Listing things

;;;###autoload
(defun org-node-list-reflinks ()
  "List all reflinks and the ID-nodes in which they were found.

Useful to see how many times you\\='ve inserted a link that is very
similar to another link, but not identical, so that perhaps only
one of them is associated with a ROAM_REFS property."
  (interactive)
  (require 'org-mem-list)
  (let ((entries
         (cl-loop
          for link in (org-mem-all-links)
          as node = (org-mem-entry-by-id (org-mem-link-nearby-id link))
          unless (equal "id" (org-mem-link-type link))
          when node
          collect
          (let ((type (org-mem-link-type link))
                (target (org-mem-link-target link))
                (pos (org-mem-link-pos link))
                (origin (org-mem-link-nearby-id link))
                (file-name (org-mem-link-file link)))
            (list (sxhash link)
                  (vector
                   (if (gethash target org-mem--roam-ref<>id)
                       "*"
                     "")
                   (if (and node (org-mem-entry-title node))
                       (buttonize (org-mem-entry-title node)
                                  `(lambda (_button)
                                     (find-file ,file-name)
                                     (goto-char ,pos)
                                     (org-fold-show-entry)
                                     (org-fold-show-context)))
                     (or origin ""))
                   (if type (concat type ":" target) target)))))))
    (if entries
        (org-mem-list--pop-to-tabulated-buffer
         :buffer "*org-node reflinks*"
         :format [("Ref" 4 t) ("Inside node" 30 t) ("Link" 0 t)]
         :reverter #'org-node-list-reflinks
         :entries entries)
      (message "No links found"))))

;; TODO: Make something like a find-dired buffer, handy!
;;;###autoload
(defun org-node-list-files ()
  "List files and associated information."
  (interactive)
  (require 'org-mem-list)
  (org-mem-list--pop-to-tabulated-buffer
   :buffer "*org-node files list*"
   :format [("Modified" 11 t) ("Size" 7 t) ("File" 70 t) ("Coding system" 15 t) ("Title" 40 t) ("Properties" 10 t)]
   :entries
   (cl-loop
    for file in (org-node-all-filtered-files)
    as props = (org-mem-properties (car (org-mem-entries-in file)))
    as kb = (/ (org-mem-file-size file) 1024.0)
    collect
    (list file
          (vector (format-time-string "%F" (org-mem-file-mtime file))
                  (format (if (< kb 1) "" "%d kB") kb)
                  (buttonize file #'find-file file)
                  (prin1-to-string (org-mem-file-coding-system file))
                  (or (org-mem-file-title-topmost file) "")
                  (if props (prin1-to-string props) ""))))
   :reverter #'org-node-list-files))

;;;###autoload
(defun org-node-list-feedback-arcs ()
  "Show a feedback-arc-set of forward id-links.

Requires GNU R installed, with R packages stringr, readr, igraph.

A feedback arc set is a set of links such that if they are all
cut (though sometimes it suffices to reverse the direction rather
than cut them), the remaining links in the network will
constitute a DAG (directed acyclic graph).

This is not to say that your notes /should/ constitute a DAG,
but you may consider this as one of many ways to explore them
for quality-control issues that can reveal themselves."
  (interactive)
  (require 'org-mem-list)
  (unless (executable-find "Rscript")
    (user-error
     "This command requires GNU R, with R packages: stringr, readr, igraph"))
  (let* ((r-code "
          library(stringr)
          library(readr)
          library(igraph)

          tsv <- commandArgs(TRUE)[1]
          g <- graph_from_data_frame(read_tsv(tsv), directed = TRUE)
          fas1 <- feedback_arc_set(g, algo = \"approx_eades\")

          lisp_data <- str_c(\"(\\\"\", as_ids(fas1), \"\\\")\") |>
            str_replace(\"\\\\|\", \"\\\" . \\\"\") |>
            str_flatten(\"\n \") |>
            (function(x) {
              str_c(\"(\", x, \")\")
            })()

          write_file(lisp_data,
                     file.path(dirname(tsv),
                     \"feedback-arcs.eld\"))")
         (tmpdir (file-name-concat temporary-file-directory "org-node"))
         (script-file (file-name-concat tmpdir "analyze_feedback_arcs.R"))
         (input-tsv (file-name-concat tmpdir "id_node_digraph.tsv"))
         (output-eld (file-name-concat tmpdir "feedback-arcs.eld")))
    (mkdir tmpdir t)
    (write-region r-code () script-file () 'quiet)
    (write-region (org-node--make-digraph-tsv-string) () input-tsv () 'quiet)
    (with-temp-buffer
      (unless (= 0 (call-process "Rscript" () t () script-file input-tsv))
        (error "%s" (buffer-string))))
    (let ((feedbacks (with-temp-buffer
                       (insert-file-contents output-eld)
                       (read (buffer-string)))))
      (org-mem-list--pop-to-tabulated-buffer
       :buffer "*org-node feedback arcs*"
       :format [("Node containing link" 39 t) ("Target of link" 0 t)]
       :entries (cl-loop
                 for (origin . target) in feedbacks
                 as origin-node = (org-mem-entry-by-id origin)
                 as target-node = (org-mem-entry-by-id target)
                 collect
                 (list (+ (sxhash origin) (sxhash target))
                       (vector (buttonize (org-mem-title origin-node)
                                          #'org-node-goto
                                          origin-node)
                               (buttonize (org-mem-title target-node)
                                          #'org-node-goto
                                          target-node))))))))

;; TODO: Temp merge all refs into corresponding ID
(defun org-node--make-digraph-tsv-string ()
  "Generate a string in Tab-Separated Values form.
The string is a 2-column table of destination-origin pairs, made
from ID links found in `org-mem--target<>links'."
  (concat
   "src\tdest\n"
   (string-join
    (seq-uniq (cl-loop
               for target being each hash-key of org-mem--target<>links
               using (hash-values links)
               append (cl-loop
                       for link in links
                       when (and (org-mem-link-nearby-id link)
                                 (equal "id" (org-mem-link-type link)))
                       collect (concat target "\t" (org-mem-link-nearby-id link)))))
    "\n")))

(defvar org-node--lint-remaining-files nil)
(defvar org-node--lint-warnings nil)

;;;###autoload
(defun org-node-lint-all-files ()
  "Run `org-lint' on all known Org files, and report results."
  (interactive)
  (require 'org-lint)
  (require 'org-mem-list)
  (let ((proceed (and (not current-prefix-arg) ;; Let C-u reset the file list.
                      org-node--lint-remaining-files
                      (equal fileloop--scan-function #'org-node--lint-scanner)))
        (files (or (org-node-all-filtered-files)
                   (mapcar #'car (org-mem--truenames-and-attrs)))))
    (unless proceed
      (when (y-or-n-p (format "Lint %d files?" (length files)))
        (setq org-node--lint-warnings nil)
        (setq org-node--lint-remaining-files files)
        (fileloop-initialize files #'org-node--lint-scanner #'ignore)
        (setq proceed t)))
    (condition-case _
        (when proceed
          (let ((enable-local-variables :safe)
                (non-essential t))
            ;; PERF: Prevent re-running `org-id-update-id-locations' in every
            ;;       file; 85% of runtime according to the CPU profiler!
            (cl-letf (((symbol-function #'org-id-update-id-locations) #'ignore))
              (with-temp-buffer ;; HACK: Help prevent loss of font-lock
                (fileloop-continue)))))
      ;; When fileloop finishes, it signals `user-error' as a hack to stop
      ;; looping.  Let that or a `quit' proceed to the display of results.
      ((quit user-error))))
  ;; We're here in three cases: linting finished, linting was quit midway thru,
  ;; or user said no at `y-or-n-p' and just wants to see results of last time.
  (when org-node--lint-warnings
    (org-mem-list--pop-to-tabulated-buffer
     :buffer "*org lint results*"
     :format [("File" 30 t) ("Line" 5 t) ("Trust" 5 t) ("Explanation" 0 t)]
     :reverter #'org-node-lint-all-files
     :entries (cl-loop
               for cell in org-node--lint-warnings
               as (file . warning) = cell
               collect (let ((array (cadr warning)))
                         (list cell
                               (vector
                                (buttonize (file-name-nondirectory file)
                                           `(lambda (_button)
                                              (find-file ,file)
                                              (goto-line ,(string-to-number
                                                           (elt array 0)))))
                                (elt array 0)
                                (elt array 1)
                                (elt array 2))))))))

(defun org-node--lint-scanner ()
  "A SCAN-FUNCTION for `fileloop-initialize'."
  (redisplay)
  (unless (derived-mode-p 'org-mode)
    (let ((org-agenda-files nil)
          (org-inhibit-startup t))
      (delay-mode-hooks
        (org-mode))))
  (when-let* ((file (pop org-node--lint-remaining-files))
              (default-directory (file-name-directory file))
              (inhibit-message t) ;; Muffle spam from `org-lint-invalid-id-link'
              ;; Prevent an error in `org-attach-check-absolute-path'
              (org-attach-id-dir (expand-file-name org-attach-id-dir))
              (warnings (org-lint)))
    (while warnings
      (push (cons file (pop warnings)) org-node--lint-warnings)))
  nil)


;;;; Commands 6: Editing tags / refs / aliases

(defun org-node-nearest-relevant ()
  "Like `org-entry-beginning-position' but prefer an ID-node.
That is, if the current entry has no ID but can inherit it from an
ancestor entry, return the position of that ancestor.

Per org-mem convention, if that ancestor is a so-called file-level node,
it counts as a level-0 entry with position 1, and this will return 1."
  (or (and (org-entry-get-with-inheritance "ID")
           (marker-position org-entry-property-inherited-from))
      ;; Ignore narrow bc `org-entry-get-with-inheritance' does too.
      (without-restriction
        (if (org-before-first-heading-p)
            (point-min)
          (org-entry-beginning-position)))))

(defun org-node--call-at-nearest-node (function &rest args)
  "With point at `org-node-nearest-relevant', call FUNCTION with ARGS.

If the affected heading is outside current narrow region, this calls
`widen'.  Afterwards, point may move if that is necessary to bring the
affected heading into view of the current window."
  (let ((where-i-was (point-marker))
        (pos (org-node-nearest-relevant)))
    (when (< pos (point-min))
      (widen))
    (save-excursion
      (goto-char pos)
      (apply function args))
    (cl-assert (eq (current-buffer) (marker-buffer where-i-was)))
    (unless (pos-visible-in-window-p pos)
      (goto-char pos)
      (recenter 0)
      (when (pos-visible-in-window-p where-i-was)
        (forward-char (- where-i-was (point)))))
    (set-marker where-i-was nil)))

;;;;; Refs & aliases

(defun org-node--add-to-property-keep-space (property value)
  "Add VALUE to PROPERTY in entry at `org-node-nearest-relevant'.

Behave like `org-entry-add-to-multivalued-property' but
preserve spaces: instead of percent-escaping each space character
as \"%20\", wrap VALUE in quotes if it has spaces."
  (org-node--call-at-nearest-node
   (lambda ()
     (let ((old (org-entry-get nil property)))
       (when old (setq old (split-string-and-unquote old)))
       (unless (member value old)
         (org-entry-put nil property (combine-and-quote-strings
                                      (cons value old))))))))

;;;###autoload
(defun org-node-add-alias (alias &optional interactive)
  "Add ALIAS to ROAM_ALIASES in entry at `org-node-nearest-relevant'.
If INTERACTIVE, and ALIAS exists somewhere, prompt for confirmation."
  (interactive "sAlias: \np" org-mode)
  (setq alias (string-trim alias))
  (let ((existing-id (org-mem-id-by-title alias)))
    (when (or (not interactive)
              (not existing-id)
              (y-or-n-p (format "Alias \"%s\" exists on ID \"%s\", really add here too? "
                                alias existing-id)))
      (org-node--add-to-property-keep-space "ROAM_ALIASES" alias))))

;;;###autoload
(defun org-node-add-ref (ref)
  "Add REF to ROAM_REFS in entry at `org-node-nearest-relevant'."
  (interactive
   (list (completing-read "Add ref: " (org-node--list-known-raw-links)
                          nil nil nil 'org-node-link-hist))
   org-mode)
  (setq ref (string-trim ref))
  (when (and (string-search " " ref)
             (string-match-p org-link-plain-re ref)
             (not (string-match-p org-element-citation-prefix-re ref)))
    ;; If it is a link, ensure it is enclosed in brackets
    (setq ref (concat "[[" (string-trim ref (rx "[[") (rx "]]")) "]]")))
  (org-node--add-to-property-keep-space "ROAM_REFS" ref))

;;;;; Tags

;;;###autoload
(defun org-node-set-tags ()
  "Set tags in the entry at `org-node-nearest-relevant'.

To always operate on the current entry, use `org-node-set-tags-here'."
  (declare (interactive-only t))
  (interactive "*" org-mode)
  (org-node--call-at-nearest-node #'org-node-set-tags-here nil t))

;;;###autoload
(defun org-node-set-tags-here (tags &optional interactive)
  "Set the tags of the current entry to TAGS.
Prompt if INTERACTIVE.

Similar to `org-set-tags-command', but:
- supports filetags
- supplies more completion candidates (see `org-node-do-filter-tags')
- is missing some of its advanced features"
  (interactive "i\np" org-mode)
  (when interactive
    (let ((current-tags (string-join (org-node-get-tags-here) ":"))
          (crm-separator "[ \t]*:[ \t]*")
          (completion-extra-properties (append completion-extra-properties
                                               '(:category org-tag))))
      (setq tags (completing-read-multiple
                  "Tags: "
                  (org-node--get-all-known-tags)
                  nil nil
                  (if (string-empty-p current-tags)
                      nil
                    (concat ":" current-tags ":"))))))
  (org-node--ersatz-set-tags (seq-uniq tags)))

(defcustom org-node-do-filter-tags nil
  "Whether `org-node-set-tags' should limit completions.
Normally it supplies every tag org-mem has seen.
When t, only supply tags from nodes that passed `org-node-filter-fn'."
  :type 'boolean
  :package-version '(org-node . "3.9.2"))

(defun org-node--get-all-known-tags ()
  "Return a list of tags for use in completions.
Sourced from `org-tag-alist' and from looking in many files."
  (delete-dups
   (nconc (thread-last (append org-tag-persistent-alist
                               org-tag-alist
                               (and org-element-use-cache
                                    (derived-mode-p 'org-mode)
                                    (org-get-buffer-tags)))
                       (mapcar #'car)
                       (cl-remove-if #'keywordp)
                       (mapcar #'substring-no-properties))
          (cl-loop for entry in (if org-node-do-filter-tags
                                    (org-node-all-filtered-nodes)
                                  (org-mem-all-entries))
                   append (org-mem-entry-tags entry)))))

;; TODO: Patch upstream `org-set-tags'.
(defun org-node--ersatz-set-tags (tags)
  (if (org-before-first-heading-p)
      ;; There's no Org builtin to set filetags yet, we have to in-house it.
      (save-excursion
        (goto-char (point-min))
        (let* ((filetags-lines
                (cl-loop while (re-search-forward "^#\\+filetags: " nil t)
                         collect (point)))
               (pos (if (> (length filetags-lines) 1)
                        (error "Not supported having more than one #+filetags: line.")
                      (car filetags-lines))))
          (if (null tags)
              (when pos
                (goto-char pos)
                (delete-region (pos-bol) (pos-eol)))
            (atomic-change-group
              (if pos
                  (goto-char pos)
                (org-node-full-end-of-meta-data)
                (unless (and (bolp) (eolp))
                  (open-line 1))
                (insert "#+filetags: "))
              (delete-region (point) (pos-eol))
              (insert ":" (string-join tags ":") ":")))))
    (save-excursion
      (org-back-to-heading)
      (org-set-tags tags))))

;; TODO: Patch upstream `org-get-tags'.
(defun org-node-get-tags-here ()
  "Get tags of current entry, or filetags if before first heading."
  (if (without-restriction (org-before-first-heading-p))
      (cl-loop for raw in (cdar (org-collect-keywords '("FILETAGS")))
               append (split-string raw ":" t))
    (org-get-tags nil t)))


;;;; Commands 7: "Cards"

(defcustom org-node-card-setup-hook '(org-node--card-setup-default)
  "Hook run in each window created by `org-node-card-view'."
  :type 'hook
  :package-version '(org-node . "3.18.0"))

(defcustom org-node-card-min-width 55
  "Minimum window width for `org-node-card-view'."
  :type 'integer
  :package-version '(org-node . "3.18.0"))

(defcustom org-node-card-min-height 15
  "Minimum window height for `org-node-card-view'."
  :type 'integer
  :package-version '(org-node . "3.18.0"))

(defcustom org-node-card-disable-line-numbers t
  "Whether `org-node-card-view' should turn off line number display.
This setting is used by `org-node--card-setup-default'."
  :type 'boolean
  :package-version '(org-node . "3.18.0"))

(defun org-node--card-setup-default ()
  "Default member of `org-node-card-setup-hook'."
  (org-back-to-heading-or-point-min)
  (when org-node-card-disable-line-numbers
    (dolist (mode '(display-line-numbers-mode line-number-mode nlinum-mode))
      (when (and (boundp mode) (eval mode))
        (funcall mode 0))))
  (if (org-before-first-heading-p)
      (if (search-forward "#+title:" (org-entry-end-position) t)
          (goto-char (pos-bol))
        (org-node-full-end-of-meta-data))
    (org-fold--hide-drawers (point) (org-entry-end-position)))
  (recenter 0))

(defun org-node--blank-buffer ()
  "Return a blank buffer."
  (cl-loop with i = 0
           as buf = (get-buffer-create (format "*blank-%d*" (cl-incf i)))
           if (with-current-buffer buf (and (bobp) (eobp)))
           return buf
           while t))

;;;###autoload
(defun org-node-card-view (&optional only-random no-random)
  "Reconfigure current frame to show an array of random notes.
Works best in a large frame.

Tries to make many compact windows, obeying user options:
- `org-node-card-min-width'
- `org-node-card-min-height'

This command may motivate you to keep notes short,
per an ideal of zettelkasten.

The notes are in fact not random, but prefers the most recent Org
buffers.  For a fully random selection, pass ONLY-RANDOM or use
`org-node-card-view-only-random'.
To prefer blank windows over random notes, pass NO-RANDOM or use
`org-node-card-view-no-random'.

Also affected by user options:
- `org-node-card-setup-hook'
- `org-node-card-disable-line-numbers'"
  (interactive)
  (require 'org)
  (org-node-cache-ensure)
  (delete-other-windows)
  (dotimes (_ (- (/ (window-text-height) org-node-card-min-height) 1))
    (split-window-below))
  (dolist (win (window-list))
    (select-window win)
    (dotimes (_ (- (/ (window-text-width) org-node-card-min-width) 1))
      (split-window-right)))
  (balance-windows)
  (let ((bufs (take (length (window-list)) (org-buffer-list))))
    (dolist (win (window-list))
      (select-window win)
      (cond (only-random (org-node-visit-random-1))
            (bufs (pop-to-buffer-same-window (pop bufs)))
            (no-random (pop-to-buffer-same-window (org-node--blank-buffer)))
            (t (org-node-visit-random-1)))
      (when (derived-mode-p 'org-mode)
        (run-hooks 'org-node-card-setup-hook)))))

(defun org-node-card-view-only-random ()
  "Variant of `org-node-card-view'."
  (interactive)
  (org-node-card-view t))

(defun org-node-card-view-no-random ()
  "Variant of `org-node-card-view'."
  (interactive)
  (org-node-card-view nil t))


;;;; Keymap
;; NOTE: Reserve "c" for a possible future capture-related key.

;;;###autoload
(defvar-keymap org-node-global-prefix-map
  :doc "Org-node commands that work in any buffer.

The author meedstrom recommends that unless this map is bound to a
single key chord, that you bind some commands to shallower key
sequences of your choice, in order of importance:
1. `org-node-find'
2. `org-node-insert-link' (in org-mode)
3. `org-node-context-dwim'"
  "b" 'org-node-context-dwim ;; b for "backlinks"
  "f" #'org-node-find
  "g" #'org-node-grep
  "s" 'org-node-seq-dispatch
  "l a" #'org-node-list-feedback-arcs ; l a for "list arcs"
  "l c" 'org-mem-list-db-contents ; l c for "list contents"
  "l d" 'org-mem-list-dead-id-links
  "l e" #'org-mem-list-example
  "l f" #'org-node-list-files
  "l l" #'org-node-lint-all-files
  "l p" 'org-mem-list-problems
  "l r" #'org-node-list-reflinks
  "l t" 'org-mem-list-title-collisions ; l t for "list title..."
  "x a" #'org-node-rename-asset-and-rewrite-links
  "x c" #'org-node-card-view
  "x h" #'org-node-help
  "x l" #'org-node-rewrite-links-ask
  "x r" #'org-node-visit-random
  "x o" #'org-node-customize
  "x u" #'org-node-insert-raw-link ;; u for "URL"
  "x x" #'org-mem-reset)

;;;###autoload
(defvar-keymap org-node-org-prefix-map
  :doc "Superset of `org-node-global-prefix-map'.
Includes extra commands that work only in Org mode.

The author meedstrom recommends that unless this map is bound to a
single key chord, that you bind some commands to shallower key
sequences of your choice, in order of importance:
1. `org-node-find'
2. `org-node-insert-link' (in org-mode)
3. `org-node-context-dwim'"
  :parent org-node-global-prefix-map
  "d" #'org-node-insert-into-related  ;; d for "drawer".  TODO: Maybe rename?
  ;; "e" #'org-node-extract-subtree ;; NOTE: `org-node-refile' does same now.
  "i" #'org-node-insert-link
  "m" #'org-node-rename-file-by-title ;; m for "move"
  "n" #'org-node-nodeify-entry
  "w" #'org-node-refile ;; because C-c w is `org-refile'
  "q" #'org-node-set-tags ;; because C-c C-q is `org-set-tags-command'
  "a a" #'org-node-add-alias
  "a h" #'org-node-add-tags-here
  "a r" #'org-node-add-ref
  "a t" #'org-node-add-tags
  "x b" 'org-node-backlink-fix-buffer
  "x p" #'org-node-complete-at-point-local-mode
  ;; "x i" #'org-node-insert-include ;; TODO. Not yet a good command.
  "x t" #'org-node-insert-transclusion
  "x y" #'org-node-insert-transclusion-as-subtree)


;;;; Gotos

(defcustom org-node-after-exact-goto-hook '(org-node--after-exact-goto)
  "Hook run after `org-node-goto' was called with EXACT t.
These functions are not allowed to move point at all."
  :type 'hook
  :package-version '(org-node . "3.18.0"))

(defcustom org-node-after-lax-goto-hook '(org-node--after-lax-goto)
  "Hook run after `org-node-goto' was called with EXACT nil or omitted.
These functions should not move point out of the current entry.
Please do not even move point to `org-entry-end-position'."
  :type 'hook
  :package-version '(org-node . "3.18.0"))

(defun org-node--after-exact-goto ()
  "Default member of `org-node-after-exact-goto-hook'."
  (org-node--reveal)
  (when (org-at-heading-p)
    (recenter 0)))

(defun org-node--after-lax-goto ()
  "Default member of `org-node-after-lax-goto-hook'."
  (org-node--reveal)
  (when (org-at-heading-p)
    (recenter 0))
  (when (bobp)
    (org-node-full-end-of-meta-data)
    (when (and (bolp) (org-at-heading-p))
      (backward-char))))

(defun org-node--reveal ()
  "Like `org-fold-show-context' but reveal enough to see no ellipses @ BoL.
Also reveal entry and children even if point is on a headline."
  (let ((org-fold-show-context-detail t))
    (org-fold-show-context))
  (org-fold-show-entry)
  (org-fold-show-children))

(defun org-node-goto (entry &optional exact assume-sane)
  "Visit file containing ENTRY, and ensure `point' is inside that entry.
EXACT t means always move point to the beginning of ENTRY.

EXACT nil effectively lets you try to respect \"save-place\"
and other reasons that the user may not want point moved frivolously.

An error is signaled if ENTRY lacks an \"ID\" property and its buffer
has unsaved changes, unless ASSUME-SANE.
If ASSUME-SANE, this function can go to a very wrong buffer position."
  (cl-assert (org-mem-entry-p entry))
  (when (numberp exact)
    (error "Function org-node-goto no longer takes a position argument"))
  (if-let* ((file (org-mem-entry-file entry))
            (buf (or (get-truename-buffer file)
                     (find-buffer-visiting file)
                     (and (file-exists-p file)
                          (find-file-noselect file)))))
      (let* ((id (org-mem-entry-id entry))
             (pos (or (and id (with-current-buffer buf
                                (without-restriction
                                  (org-node--assert-transclusion-safe)
                                  (org-find-property "ID" id))))
                      (org-mem-entry-pos entry))))
        (when (and (not assume-sane) (not id) (buffer-modified-p buf))
          (error "org-node-goto: Cannot know correct position in modified buffer for entry with no ID: %S"
                 entry))
        (pop-to-buffer-same-window buf)
        (org-node--maybe-widen-and-goto pos assume-sane)
        (if exact (progn
                    (goto-char pos)
                    (org-fold-show-context)
                    (run-hooks 'org-node-after-exact-goto-hook)
                    (unless (= (point) pos)
                      (error "A function on org-node-after-exact-goto-hook moved point")))
          (run-hooks 'org-node-after-lax-goto-hook)))
    (org-mem-reset t "org-node: Didn't find file, resetting...")))

(defun org-node--maybe-widen-and-goto (entry-beg &optional assume-sane)
  "Ensure that `point' is inside the Org entry that starts at ENTRY-BEG.
Also ensure that ENTRY-BEG is visible, by scrolling the window to
bring it into view, if that is possible without moving point.

If these requirements cannot be met without moving point,
move point to ENTRY-BEG.

This function will also `widen' the buffer if the current narrow region
excludes any part of the entry.

With ASSUME-SANE, do not verify that ENTRY-BEG begins an entry."
  (let ((entry-end (save-excursion (without-restriction
                                     (goto-char entry-beg)
                                     (unless assume-sane
                                       (cl-assert (or (bobp) (org-at-heading-p)))
                                       (cl-assert (bolp)))
                                     (org-entry-end-position))))
        (here-end (without-restriction
                    (org-entry-end-position))))
    (when (or (< entry-beg (point-min)) (> entry-end (point-max)))
      (widen))
    (when (or (not (= here-end entry-end)) ;; Same end implies same entry.
              (org-invisible-p entry-beg) ;; In case entire tree is folded.
              (and$ (get-buffer-window nil t)
                    (with-selected-window $
                      (org-fold-show-entry)
                      (redisplay) ;; So `window-start' returns correct value.
                      (when (< entry-beg (window-start))
                        (if (save-window-excursion
                              (recenter -1)
                              (pos-visible-in-window-p entry-beg))
                            ;; Just scroll the window, if that would be enough.
                            (prog1 nil
                              (scroll-down (count-screen-lines entry-beg (window-start))))
                          t)))))
      (goto-char entry-beg)
      (org-fold-show-context))))

(defun org-node-goto-new-drawer-site ()
  "Go to just after properties drawer.
Actually, if before the first heading, also skip past any other drawer
that follows the file-level properties drawer."
  (if (org-before-first-heading-p)
      (org-node--after-drawers-before-keyword)
    (org-end-of-meta-data))
  nil)

;; Keyword lines work as a natural barrier, because Org expects file-level
;; :PROPERTIES: to come before #+title and other keyword lines.
(defun org-node--after-drawers-before-keyword ()
  "Move to `point-min', then forward past drawers, comments and whitespace.
Stops as soon as there is anything else, such as body text or a #+title."
  (goto-char (point-min))
  (let ((case-fold-search t)
        (bound (org-entry-end-position))
        (junk (rx (*? space) (or "# " "\n"))))
    ;; NOTE: We also skip any comments and blanklines in between
    ;; these drawers.  This implementation detail allows
    ;; `org-node-full-end-of-meta-data' to presume there are no more drawers.
    (while (or (looking-at-p junk)
               (and (looking-at-p org-drawer-regexp)
                    (or (re-search-forward "^[ \t]*:END:[ \t]*$" bound t)
                        (error "Missing :END: in %s" (buffer-name)))))
      (forward-line))
    ;; On a "final stretch" of comments and blanklines, go back to the first.
    (while (progn (forward-line -1)
                  (and (looking-at-p junk) (not (bobp)))))
    (forward-line))
  nil)

;; TODO: Patch upstream `org-end-of-meta-data'.
(defun org-node-full-end-of-meta-data (&optional _deprecated-arg)
  "Skip properties and other drawers, and at the file-level, skip keywords.

Like `org-end-of-meta-data' with argument FULL, but works even if
`org-before-first-heading-p'.

As in `org-end-of-meta-data', point always lands on a newline \(or the
end of buffer).  Since that newline may be the beginning of the next
heading, you should probably verify that `org-at-heading-p' is nil,
else do `backward-char' or `open-line' prior to inserting text."
  (if (org-before-first-heading-p)
      (progn
        (org-node--after-drawers-before-keyword)
        ;; Jump past #+keywords, comments and blank lines.
        (while (looking-at-p (rx (*? space) (or "#+" "# " "\n")))
          (forward-line))
        ;; On a "final stretch" of empty lines, go back to the first.
        (when (not (= 0 (skip-chars-backward "\n")))
          (forward-char)))
    ;; PERF: Override a bottleneck inside `org-end-of-meta-data'.
    (cl-letf (((symbol-function 'org-back-to-heading)
               #'org-node--back-to-heading-or-point-min))
      (org-end-of-meta-data t)))
  (point))

;; TODO: Patch upstream `org-back-to-heading-or-point-min'.
(defun org-node--back-to-heading-or-point-min (&optional invisible-ok)
  "Alternative to `org-back-to-heading-or-point-min'.
Argument INVISIBLE-OK as in that function.

Like `org-back-to-heading-or-point-min' but should be faster in the case
that an org-element cache has not been built for the buffer.  This can
be the case in a buffer spawned by `org-roam-with-temp-buffer'
or `org-node--work-buffer-for'."
  (let ((inlinetask-re (when (fboundp 'org-inlinetask-outline-regexp)
                         (org-inlinetask-outline-regexp))))
    (cl-loop until (and (org-at-heading-p (not invisible-ok))
                        (not (and inlinetask-re (looking-at-p inlinetask-re))))
             unless (re-search-backward org-outline-regexp-bol nil t)
             return (goto-char (point-min)))
    (point)))


;;;; CAPF (Completion-At-Point Function), aka. in-buffer completion

(defun org-node-complete-at-point ()
  "Expand word at point to a known node title, and linkify.
Designed for `completion-at-point-functions'."
  (when-let ((bounds (bounds-of-thing-at-point 'word)))
    (and (not (org-in-src-block-p))
         (not (save-match-data (org-in-regexp org-link-any-re)))
         (list (car bounds)
               (cdr bounds)
               org-node--title<>affixations
               :exclusive 'no
               :exit-function
               (lambda (text _)
                 (when-let ((id (gethash text org-mem--title<>id)))
                   (atomic-change-group
                     (delete-char (- (length text)))
                     (insert (org-link-make-string (concat "id:" id) text)))
                   (run-hooks 'org-node-insert-link-hook)))))))

(define-minor-mode org-node-complete-at-point-local-mode
  "Let completion at point insert links to nodes.

-----"
  :require 'org-node ;; ?
  (if org-node-complete-at-point-local-mode
      (if (not (derived-mode-p 'org-mode))
          (org-node-complete-at-point-local-mode 0)
        (add-hook 'completion-at-point-functions
                  #'org-node-complete-at-point nil t))
    (remove-hook 'completion-at-point-functions
                 #'org-node-complete-at-point t)))

;;;###autoload
(define-globalized-minor-mode org-node-complete-at-point-mode
  org-node-complete-at-point-local-mode
  org-node-complete-at-point-local-mode)


;;;; Misc features

(defun org-node-try-visit-ref-node ()
  "Designed for `org-open-at-point-functions'.

For the link at point, if there exists an ID-node that has
the same link in its ROAM_REFS property, visit that node rather than
following the link normally.

If already visiting that node, then follow the link normally."
  (when-let ((url (thing-at-point 'url)))
    ;; Rarely more than one valid target
    (let* ((target (car (org-mem--split-roam-refs-field url)))
           (found (cl-loop for node in (org-mem-all-id-nodes)
                           when (member target (org-mem-entry-roam-refs node))
                           return node)))
      (if (and found
               ;; Check that point is not already in said ref node (if so,
               ;; better to fallback to default `org-open-at-point' logic)
               (not (and (derived-mode-p 'org-mode)
                         (equal (org-entry-get-with-inheritance "ID")
                                (org-mem-entry-id found)))))
          (progn (org-node-goto found) t)
        nil))))


;;;; Detect modification

(defcustom org-node-modification-hook nil
  "Hook run with point at each modified ID-node before save."
  :type 'hook
  :options '((function-item org-node-update-mtime-property))
  :package-version '(org-node . "3.10.0"))

(defvar org-node--inhibit-flagging nil)
(defun org-node--flag-change (beg end _n-deleted-chars)
  "Add text property `org-node-flag' to region between BEG and END.

Designed for `after-change-functions', to this effectively flag
all areas where text is added/changed/deleted.  Where text was
purely deleted, this flags the preceding or succeeding char or both."
  (unless org-node--inhibit-flagging
    (with-silent-modifications
      (if (= beg end)
          (put-text-property (max (1- beg) (point-min))
                             (min (1+ end) (point-max))
                             'org-node-flag t)
        (put-text-property beg end 'org-node-flag t)))))

(define-error 'org-node-modification-hook-failed
              "A member of org-node-modification-hook signaled")

(defun org-node--eat-flags ()
  "Run `org-node-modification-hook' at each modified node.
Then undo the flags that marked them as modified."
  ;; Catch any error, because this runs at `before-save-hook' which MUST
  ;; fail gracefully and let the user save anyway.
  (condition-case err
      (save-excursion
        (without-restriction
          (with-undo-amalgamate
            (let ((end (make-marker))
                  handled-ids)
              (goto-char (point-min))
              (while-let ((flag (text-property-any
                                 (point) (point-max) 'org-node-flag t)))
                (goto-char flag)
                (set-marker end (org-entry-end-position))
                (let ((id (org-entry-get-with-inheritance "ID")))
                  (when (and id (not (member id handled-ids)))
                    (goto-char org-entry-property-inherited-from)
                    (unless (org-node--in-transclusion-p)
                      (push id handled-ids)
                      (condition-case err
                          (let ((org-node--inhibit-flagging t))
                            (run-hooks 'org-node-modification-hook))
                        (( error )
                         (signal 'org-node-modification-hook-failed err))))))
                (goto-char end))
              (set-marker end nil)))
          (with-silent-modifications
            (remove-text-properties (point-min) (point-max) '(org-node-flag)))))
    (( debug error )
     (with-silent-modifications
       (remove-text-properties (point-min) (point-max) '(org-node-flag)))
     (unless debug-on-error
       ;; Delay because `display-warning' in `before-save-hook' does not display.
       (push (list 'org-node--eat-flags (error-message-string err))
             delayed-warnings-list)))))

(define-minor-mode org-node--track-modifications-local-mode
  "Make available `org-node-modification-hook'."
  :interactive nil
  (if org-node--track-modifications-local-mode
      (progn
        (add-hook 'after-change-functions #'org-node--flag-change nil t)
        (add-hook 'before-save-hook       #'org-node--eat-flags nil t))
    (remove-hook 'after-change-functions  #'org-node--flag-change t)
    (remove-hook 'before-save-hook        #'org-node--eat-flags t)))

(defun org-node--track-modifications-local-turn-on ()
  (when (derived-mode-p 'org-mode)
    (org-node--track-modifications-local-mode)))

(define-globalized-minor-mode org-node-track-modifications-mode
  org-node--track-modifications-local-mode
  org-node--track-modifications-local-turn-on
  :require 'org-node) ;; See package-lint


;;;; Drawer subroutines

(defun org-node--delete-drawer (name)
  "In current entry, seek and destroy drawer named NAME."
  (save-excursion
    (save-restriction
      (when (org-node-narrow-to-drawer-p name)
        (delete-region (point-min) (point-max))
        (widen)
        (cl-assert (and (bolp) (eolp)))
        (delete-line)
        (org-remove-empty-drawer-at (point))))))

;; Org ships no general tool to find/create a drawer, so roll our own.
;; There's a trick used by org-super-links: temporarily set
;; `org-log-into-drawer' to "BACKLINKS", and then call `org-log-beginning'.
;; Only works under a heading though.
;; And our argument CREATE-WHERE turns out to be pretty handy.

(defun org-node-narrow-to-drawer-create (name &optional create-where)
  "Narrow to pre-existing drawer named NAME, creating it if necessary.
Search current entry only, via subroutine `org-node-narrow-to-drawer-p'.

When drawer is created, insert it near the beginning of the entry
\(after any properties drawer\), unless CREATE-WHERE is a function, in
which case call it and hope it moved `point' to some appropriate
position.  If CREATE-WHERE returns an integer or marker, go to that
position."
  (org-node-narrow-to-drawer-p name t create-where))

(defun org-node-narrow-to-drawer-p (name &optional create-missing create-where)
  "Seek a drawer named NAME in the current entry, then narrow to it.

If a drawer was found, return t.
Otherwise do not narrow, and return nil.

Narrow to the region between :NAME:\\n and \\n:END:, exclusive.
Place point at the beginning of that region, after any indentation.
If the drawer was empty, ensure one blank line.
\(Put another way, if you delete all visible buffer contents,
one blank line remains after un-narrowing.)

A way you might invoke this function:

    \(save-restriction
      \(if \(org-node-narrow-to-drawer-p \"MY_DRAWER\")
           ...edit the narrowed buffer...
        \(message \"No such drawer in this entry\")))

Instead of passing the optional arguments, consider calling
`org-node-narrow-to-drawer-create' instead, which is equivalent to
CREATE-MISSING t.  Also see that function for meaning of CREATE-WHERE."
  (let ((start (window-start))
        (point (window-point))
        (entry-end (org-entry-end-position))
        (case-fold-search t))
    (org-back-to-heading-or-point-min t)
    (if (cl-loop while (re-search-forward
                        (rx bol (* space) ":" (literal name) ":" (* space) eol)
                        entry-end
                        t)
                 unless (org-in-block-p '("src" "example"))
                 return t)
        ;; Found pre-existing drawer
        (let ((drawbeg (progn (forward-line) (point))))
          (unless (re-search-forward "^[ \t]*:END:[ \t]*$" entry-end t)
            (error "No :END: of drawer at %d in %s" (point) (buffer-name)))
          (goto-char (pos-bol))
          (if (= drawbeg (point))
              ;; Empty drawer with no newlines; add one newline
              ;; so the result looks similar to after `org-insert-drawer'.
              (progn (open-line 1)
                     (indent-according-to-mode))
            ;; Not an empty drawer, so it is safe to back up from :END: line
            (backward-char))
          (narrow-to-region drawbeg (point))
          (goto-char drawbeg)
          (back-to-indentation)
          t)
      (if create-missing
          ;; Create new
          (let ((where (if create-where (funcall create-where)
                         (org-node-goto-new-drawer-site))))
            (when (number-or-marker-p where) (goto-char where))
            (org-insert-drawer nil name)
            (narrow-to-region (point) (point))
            t)
        ;; Do nothing and restore scroll position
        (set-window-start (selected-window) start t)
        (set-window-point (selected-window) point)
        nil))))


;;;; API used by some submodule(s)

(defvar org-node--work-buffers nil
  "All buffers spawned by `org-node--work-buffer-for'.")

(defun org-node--kill-work-buffers ()
  "Kill all buffers in `org-node--work-buffers'."
  (while-let ((buf (pop org-node--work-buffers)))
    (when buf (kill-buffer buf))))

(defun org-node--work-buffer-for (file)
  "Get or create a hidden buffer, and read FILE contents into it.
Also enable `org-mode', but ignore `org-mode-hook' and startup options.

A buffer persists for each FILE, so calling again with the same FILE
skips the overhead of creation.  To clean up, call
`org-node--kill-work-buffers' explicitly."
  (let ((bufname (format " *org-node-work-%d*" (abs (sxhash file)))))
    (or (get-buffer bufname)
        (with-current-buffer (org-mem-scratch bufname)
          (push (current-buffer) org-node--work-buffers)
          (insert-file-contents file)
          ;; May be useful for `org-node-roam-accelerator-mode'.
          ;; No idea why `org-roam-with-temp-buffer' sets default directory,
          ;; but Chesterton's Fence.
          (setq-local default-directory (file-name-directory file))
          ;; Ensure that attempted edits trip an error, since the buffer may be
          ;; reused any number of times, and should always reflect FILE.
          (setq-local buffer-read-only t)
          (current-buffer)))))

;; Very important macro for the backlink mode, because backlink insertion opens
;; the target Org file in the background, and if doing that is laggy, then
;; every link insertion is laggy.
(defmacro org-node--with-quick-file-buffer (file &rest body)
  "Like `org-with-file-buffer' and `org-with-wide-buffer'.
Tries to execute minimal hooks in order to open and close FILE as
quickly as possible. In detail:

1. If a buffer was visiting FILE, reuse that buffer, else visit
   FILE in a new buffer, in which case ignore most of the Org
   startup checks and don\\='t ask about file-local variables.

2. Temporarily `widen' the buffer, execute BODY, then restore
   point.

3a. If a new buffer had to be opened: save and kill it.
    \(Mandatory because buffers opened in the quick way look
    \"wrong\", e.g. no indent-mode, no visual wrap etc.)  Also
    skip any save hooks and kill hooks.

3b. If a buffer had been open: leave it open and leave it
    unsaved."
  (declare (indent 1) (debug t))
  `(let ((enable-local-variables :safe)
         (org-inhibit-startup t) ;; Don't apply startup #+options
         (find-file-hook nil)
         (org-agenda-files nil)
         (kill-buffer-hook nil) ;; Inhibit save-place etc
         (kill-buffer-query-functions nil)
         (buffer-list-update-hook nil)
         (delay-mode-hooks t)
         (--file-- ,file))
     (when (file-directory-p --file--)
       (error "Is a directory: %s" --file--))
     (org-element-with-disabled-cache
       (let* ((--was-open-- (find-buffer-visiting --file--))
              (--buf-- (or --was-open--
                           (find-file-noselect --file--))))
         (when (bufferp --buf--)
           (with-current-buffer --buf--
             (save-excursion
               (without-restriction
                 (goto-char (point-min))
                 ,@body))
             (if --was-open--
                 ;; Because the cache gets confused by changes
                 (org-element-cache-reset)
               (when (buffer-modified-p)
                 (let ((before-save-hook nil)
                       (after-save-hook nil)
                       (save-silently t)
                       (inhibit-message t))
                   (save-buffer)))
               (kill-buffer))))))))

(defvar org-node--compiled-fn-tbl (make-hash-table :test 'equal))
(defun org-node--ensure-compiled (fn)
  "Return FN as a compiled function.

- If FN is already compiled, return FN.
- If FN is a symbol with uncompiled function definition, byte-compile it
  and return the same symbol.
- If FN is an anonymous lambda, compile it, cache the resulting
  bytecode, and return that bytecode.

Can be handy for user-provided lambdas that must be called a lot."
  (with-memoization (gethash fn org-node--compiled-fn-tbl)
    (let (byte-compile-warnings)
      (cond ((compiled-function-p fn) fn)
            ((symbolp fn)
             (unless (compiled-function-p (symbol-function fn))
               (byte-compile fn))
             fn)
            (t (byte-compile fn))))))


;;;; Transclusion safety

(defun org-node--in-transclusion-p (&optional pos)
  "Non-nil if POS is inside a transclude-region."
  (get-text-property (or pos (point)) 'org-transclusion-id))

(defun org-node--assert-transclusion-safe ()
  "Signal error if an active transclusion in buffer may affect Org-node.
If so, inform user how to configure \"org-transclusion\" to be safe.

Various Org-node commands use `org-entry-get-with-inheritance' or
`org-find-property' to find a node in a file, and assume on success
that it is the canonical node, not some mirror of it.
This helps keep that assumption safe."
  (when (boundp 'org-transclusion-exclude-elements)
    (save-excursion
      (without-restriction
        (goto-char (point-min))
        (let (danger-from-prop-drawer danger-from-keyword)
          (when (and (text-property-search-forward 'org-transclusion-id)
                     (or (and (not (memq 'property-drawer
                                         org-transclusion-exclude-elements))
                              (setq danger-from-prop-drawer t))
                         (and (not (memq 'keyword
                                         org-transclusion-exclude-elements))
                              (org-collect-keywords "PROPERTY")
                              (setq danger-from-keyword t))))
            (display-warning 'org-node
                             (concat "
Found active org-transclusion in buffer "
                                     (prin1-to-string (current-buffer))
                                     ".
To keep using them safely:"
                                     (and danger-from-prop-drawer
                                          "
- eval (add-to-list 'org-transclusion-exclude-elements 'property-drawer)")
                                     (and danger-from-keyword
                                          "
- do one of
  - remove existing #+property: lines
  - eval (add-to-list 'org-transclusion-exclude-elements 'keyword)")))
            (user-error "Active org-transclusion in buffer %S, quitting"
                        (current-buffer))))))))


;;;; Org-roam accelerator
;; TODO: Once Roam perf is fixed upstream, remove this section.

(defvar org-node--ad-roam-src-node nil)
(defun org-node--ad-roam-node-insert-section (orig-fn &rest args)
  "Designed as around-advice for `org-roam-node-insert-section'.

Run ORIG-FN with ARGS, while overriding
`org-roam-fontify-like-in-org-mode' so it does nothing.
While we\\='re at it, inspect ARGS for its SOURCE-NODE argument and
stash it in the variable `org-node--ad-roam-src-node'."
  (setq org-node--ad-roam-src-node
        (plist-get args :source-node))
  (cl-letf (((symbol-function 'org-roam-fontify-like-in-org-mode) #'identity))
    (apply orig-fn args)))

(defvar org-node--ad-roam--id<>previews (make-hash-table :test #'equal))
(defun org-node--ad-roam-preview-get-contents (file link-pos)
  "Designed as override for `org-roam-preview-get-contents'.

Normally the first time you open an org-roam buffer, Emacs hangs for as
long as a minute on a slow machine when huge files are involved, due to
having to fontify each file\\='s entire contents in a hidden buffer,
then applying #+startup:indent and other options, then org-element cache
has to do its thing even though the cache will be thrown away.

This tries to eliminate all those problems.

Aside from huge files, it is also slow when there are backlinks coming
from many sources.  To deal with that:

1. this reuses buffers if several backlinks originate from the same file
2. even if all originate from different files, this caches all snippets
   so that it should only be slow the first time."
  (let* ((src-id (org-roam-node-id org-node--ad-roam-src-node))
         (src (org-mem-entry-by-id src-id))
         (_ (unless src
              (error "Org-roam node unknown to Org-mem: %s" src-id)))
         (pos-diff (- link-pos (org-mem-entry-pos src))))
    (with-memoization
        (alist-get pos-diff (gethash src-id org-node--ad-roam--id<>previews))
      (let (snippet)
        (with-current-buffer (org-node--work-buffer-for file)
          (goto-char link-pos)
          ;; PERF: Override a bottleneck in `org-end-of-meta-data'.
          (cl-letf (((symbol-function 'org-back-to-heading-or-point-min)
                     #'org-node--back-to-heading-or-point-min))
            (setq snippet (funcall org-roam-preview-function))
            (dolist (fn org-roam-preview-postprocess-functions)
              (setq snippet (funcall fn snippet)))))
        (with-current-buffer (org-mem-scratch)
          (erase-buffer)
          (insert snippet)
          (font-lock-ensure)
          (buffer-string))))))

;;;###autoload
(define-minor-mode org-node-roam-accelerator-mode
  "Advise the \"*org-roam*\" buffer to be faster.
As a side effect, it can be used without the rest of org-roam."
  :global t
  (require 'org-mem-roamy)
  (if org-node-roam-accelerator-mode
      (progn
        (advice-add 'org-roam-node-insert-section :around    #'org-node--ad-roam-node-insert-section)
        (advice-add 'org-roam-preview-get-contents :override #'org-node--ad-roam-preview-get-contents)
        (advice-add 'org-roam-buffer-render-contents :after  #'org-node--kill-work-buffers)
        (advice-add 'org-roam-backlinks-get :override        #'org-mem-roamy-mk-backlinks)
        (advice-add 'org-roam-reflinks-get  :override        #'org-mem-roamy-mk-reflinks))
    (advice-remove 'org-roam-node-insert-section    #'org-node--ad-roam-node-insert-section)
    (advice-remove 'org-roam-preview-get-contents   #'org-node--ad-roam-preview-get-contents)
    (advice-remove 'org-roam-buffer-render-contents #'org-node--kill-work-buffers)
    (advice-remove 'org-roam-backlinks-get          #'org-mem-roamy-mk-backlinks)
    (advice-remove 'org-roam-reflinks-get           #'org-mem-roamy-mk-reflinks)))


;;;; Deprecated commands

(defvar org-node--warned nil)

;; Subtly broken & unfixable.  Hard to pick a `crm-separator' since user may
;; wish to yank something like [cite:... @key1 ... @key2 ...].
;; DEPRECATED 2026-03-01
(defun org-node-add-refs ()
  "Add link(s) to ROAM_REFS in in entry at `org-node-nearest-relevant'."
  (interactive () org-mode)
  (let* ((links (org-node--list-known-raw-links))
         (refs (completing-read-multiple
                "Add ref(s): " links nil nil nil 'org-node-link-hist)))
    (dolist (ref (mapcar #'string-trim refs))
      (org-node-add-ref ref)))
  (unless (memq 'org-node-add-refs org-node--warned)
    (push 'org-node-add-refs org-node--warned)
    (message "org-node-add-refs: This command will be removed in 2027, use org-node-add-ref")))

;; DEPRECATED 2026-03-01
(defun org-node-add-tags (&optional tags)
  "Add TAGS to the entry at `org-node-nearest-relevant'."
  (interactive "*" org-mode)
  (org-node--call-at-nearest-node #'org-node-add-tags-here tags))

;; DEPRECATED 2026-03-01
(defun org-node-add-tags-here (&optional tags)
  "Add TAGS to the entry at point."
  (interactive "*" org-mode)
  (let* ((crm-separator "[ \t]*:[ \t]*")
         (completion-extra-properties (append completion-extra-properties
                                              '(:category org-tag)))
         (tags (or (ensure-list tags)
                   (completing-read-multiple "Tags: "
                                             (org-node--get-all-known-tags)
                                             nil nil nil
                                             'org-tags-history))))
    (org-node-set-tags-here
     (seq-uniq (append (org-node-get-tags-here) tags))))
  (unless (memq 'org-node-add-tags org-node--warned)
    (push 'org-node-add-tags org-node--warned)
    (message "org-node-add-tags: This command will be removed in 2027, use org-node-set-tags")))

;; DEPRECATED 2026-03-02
(defun org-node-goto-id (id &optional exact buffer)
  "Go to ID in some buffer, without needing the file to exist yet.

This differs from `org-id-goto', which would throw an error.
That is, if `org-id-locations' has an entry for ID pointing to a
file-name that may not yet have been written to disk, but a buffer
visits it, switch to that unsaved buffer and move point to said entry.

Optional argument BUFFER is a specific buffer in which to look for ID,
in which case ID needs not be registered in `org-id-locations' at all.

Optional argument EXACT as in `org-node-goto'."
  (declare (obsolete nil "2026-03-02"))
  (if (buffer-live-p buffer)
      (progn
        (pop-to-buffer-same-window buffer)
        (if-let* ((pos (without-restriction
                         (org-node--assert-transclusion-safe)
                         (org-find-property "ID" id))))
            (org-node--maybe-widen-and-goto pos exact)
          (error "Could not find ID %S in buffer %S" id buffer)))
    (if-let* ((node (org-mem-entry-by-id id)))
        (org-node-goto node exact))))


;;;; API not used within this package

(defun org-node-at-point ()
  "Return the ID-node near point.

This may refer to the current Org heading, else an ancestor
heading, else the file-level node, whichever has an ID first."
  (org-mem-entry-by-id (org-entry-get-with-inheritance "ID")))

;; TODO: Add an extended variant that checks active region, like
;;       `org-node-insert-link' does.
(defun org-node-read (&optional prompt)
  "PROMPT for a known node and return it."
  (gethash (org-node-read-candidate prompt)
           org-node--candidate<>entry))

;; Debatable name
(defun org-node-p (entry)
  "Non-nil if ENTRY has an ID and satisfies `org-node-filter-fn'.
ENTRY should be an `org-mem-entry' object."
  (and (org-mem-entry-id entry)
       (funcall org-node-filter-fn entry)))

(defun org-node-guess-node-by-title (title)
  (and (gethash title org-node--title<>affixations)
       (org-mem-entry-by-id (gethash title org-mem--title<>id))))

(provide 'org-node)

;;; org-node.el ends here

;; Local Variables:
;; checkdoc-spellcheck-documentation-flag: nil
;; checkdoc-verb-check-experimental-flag: nil
;; emacs-lisp-docstring-fill-column: 72
;; read-symbol-shorthands: (("and$"      . "cond-let--and$")
;;                          ("and>"      . "cond-let--and>")
;;                          ("and-let"   . "cond-let--and-let")
;;                          ("if-let"    . "cond-let--if-let")
;;                          ("when$"     . "cond-let--when$")
;;                          ("when-let"  . "cond-let--when-let")
;;                          ("while-let" . "cond-let--while-let"))
;; End: