-
Notifications
You must be signed in to change notification settings - Fork 6
/
org-node.el
4014 lines (3554 loc) · 169 KB
/
org-node.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
;;; org-node.el --- Link org-id entries into a network -*- lexical-binding: t; -*-
;; Copyright (C) 2024 Martin Edström
;;
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; For a full copy of the GNU General Public License
;; see <http://www.gnu.org/licenses/>.
;; Author: Martin Edström <meedstrom91@gmail.com>
;; Created: 2024-04-13
;; Keywords: org, hypermedia
;; Package-Requires: ((emacs "28.1") (compat "30") (el-job "0.3.2") (llama))
;; URL: https://github.com/meedstrom/org-node
;; NOTE: Looking for Package-Version?
;; Consult your package manager, or the Git tag.
;;; Commentary:
;; What is Org-node?
;; If you were the sort of person to prefer "id:" links over "file:"
;; links or any other type of link, you're in the right place!
;; Now you can rely on IDs and worry less about mentally tracking your
;; subtree hierarchies and directory structures. As long as 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.
;; Pretty soon you've forgot that your files have names.
;; Anyway, that's just the core of it as described to someone not
;; familiar with zettelkasten-ish packages. In fact, out of the
;; simplicity arises something powerful, more to be experienced than
;; explained.
;; Compared to org-roam:
;; - Same idea, compatible disk format
;; - Faster
;; - Does not need SQLite
;; - Does not support "roam:" links
;; - Lets you opt out of those file-level property drawers
;; - Ships extra commands to e.g. auto-rename files and links
;; - Tries to rely in a bare-metal way on upstream org-id and org-capture
;; As a drawback of relying on org-id-locations, if a heading in some
;; vendor README.org or whatever has an ID, it's considered part of
;; your collection -- simply because if it's known to org-id, it's
;; known to org-node.
;; These headings can be filtered after-the-fact.
;; Compared to denote:
;; - Org only, no Markdown nor other file types
;; - Does not support "denote:" links
;; - Filenames have no meaning (can match the Denote format if you like)
;; - You can have as many "notes" as you want inside one file. You
;; could possibly use Denote to search files and org-node
;; as a more granular search.
;;; Code:
;; Built-in
(require 'seq)
(require 'cl-lib)
(require 'subr-x)
(require 'bytecomp)
(require 'transient)
(require 'ucs-normalize)
(require 'org)
(require 'org-id)
(require 'org-macs)
(require 'org-element)
;; External
(require 'llama)
(require 'compat)
(require 'org-node-parser)
(require 'org-node-changes)
(require 'el-job)
;; Satisfy compiler
(defvar org-roam-directory)
(defvar org-roam-dailies-directory)
(defvar consult-ripgrep-args)
(defvar org-node-backlink-mode)
(declare-function org-node-backlink--fix-entry-here "org-node-backlink")
(declare-function profiler-report "profiler")
(declare-function profiler-stop "profiler")
(declare-function tramp-tramp-file-p "tramp")
(declare-function org-lint "org-lint")
(declare-function consult--grep "consult")
(declare-function consult--grep-make-builder "consult")
(declare-function consult--ripgrep-make-builder "consult")
;;;; Options
(defgroup org-node nil
"Support a zettelkasten of org-id files and subtrees."
:group 'org)
(defcustom org-node-rescan-functions nil
"Hook run after scanning specific files.
Not run after a full cache reset, only after e.g. a file is
saved or renamed causing an incremental update to the cache.
Called with one argument: the list of files re-scanned. It may
include deleted files."
:type 'hook)
(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)
(defcustom org-node-link-types
'("http" "https" "id")
"Link types that may count as backlinks.
Types other than \"id\" only result in a backlink when there is
some node with the same link in its ROAM_REFS property.
Having fewer types results in a faster \\[org-node-reset].
Tip: eval `(org-link-types)' to see all possible types.
There is no need to add the \"cite\" type."
:type '(repeat string))
(defvar org-node-inject-variables (list)
"Alist of variable-value pairs that child processes should set.
May be useful for injecting your authinfo and EasyPG settings so
that org-node can scan for ID nodes inside .org.gpg files. Also,
`org-node-perf-keep-file-name-handlers' should include the EPG
handler.
I do not use EPG, so that is probably not enough to make it work.
Report an issue on https://github.com/meedstrom/org-node/issues
or drop me a line on Mastodon: @meedstrom@hachyderm.io"
;; Reverted to defvar for now
;; :type 'alist
)
(defvar org-node-perf-keep-file-name-handlers nil
"Which file handlers to respect while scanning for ID nodes.
Normally, `file-name-handler-alist' changes the behavior of many Emacs
functions when passed some file names: TRAMP paths, compressed files or
.org.gpg files.
It slows down the access of very many files, since it is a series of
regexps applied to every file name passed. The fewer items in this
list, the faster `org-node-reset'.
There is probably no point adding items for now, as org-node will
need other changes to support TRAMP and encryption."
;; Reverted to defvar for now
;; :type '(set
;; (function-item jka-compr-handler)
;; (function-item epa-file-handler)
;; ;; REVIEW: Chesterton's Fence. I don't understand why
;; ;; `tramp-archive-autoload-file-name-handler' exists
;; ;; (check emacs -Q), when these two already have autoloads?
;; (function-item tramp-file-name-handler)
;; (function-item tramp-archive-file-name-handler)
;; (function-item file-name-non-special))
)
(defcustom org-node-perf-assume-coding-system nil
"Coding system to assume while scanning ID nodes.
Picking a specific coding system can speed up `org-node-reset'.
Set nil to let Emacs figure it out anew on every file.
For now, this setting is likely only noticeable if
`el-job--cores' is 1 or very low.
Otherwise overhead is a much larger component of the execute time.
On MS Windows this probably should be nil. Same if you access
your files from multiple platforms.
Modern GNU/Linux, BSD and MacOS systems almost always encode new
files as `utf-8-unix'. You can verify with a helper command
\\[org-node-list-file-coding-systems]."
:type '(choice coding-system (const nil)))
(defcustom org-node-perf-eagerly-update-link-tables t
"Update backlink tables on every save.
A setting of t MAY slow down saving a big file containing
thousands of links on constrained devices.
Fortunately it is rarely needed, since the insert-link advices of
`org-node-cache-mode' will already record links added during
normal usage!
Other issues are corrected when `org-node--idle-timer' fires.
These temporary issues are:
1. deleted links remain in the table, leading to undead backlinks
2. link positions can desync, which can affect the org-roam buffer
A user of `org-node-backlink-mode' is recommended to enable this as
well as `org-node-backlink-aggressive'."
:type 'boolean)
(defun org-node--set-and-remind-reset (sym val)
"Set SYM to VAL."
(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-node-reset after configuring %S" sym)))
(custom-set-default sym val))
(defcustom org-node-filter-fn
(lambda (node)
(not (assoc "ROAM_EXCLUDE" (org-node-get-properties node))))
"Predicate returning non-nil to include a node, or nil to exclude it.
The filtering only has an impact on the table
`org-node--candidate<>node', which forms the basis for
completions in the minibuffer, and `org-node--title<>id', used
by `org-node-complete-at-point-mode'.
In other words, passing nil means the user cannot autocomplete to the
node, but Lisp code can still find it in the \"main\" table
`org-node--id<>node', 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 object which form
you can observe in examples from \\[org-node-peek] and specified
in the type `org-node' (C-h o org-node RET).
See the following example for a way to filter out nodes with a
ROAM_EXCLUDE property, or that have any kind of TODO state, or
are tagged :drill:, or where the full file path contains a
directory named \"archive\".
\(setq org-node-filter-fn
(lambda (node)
(not (or (assoc \"ROAM_EXCLUDE\" (org-node-get-properties node))
(org-node-get-todo node)
(string-search \"/archive/\" (org-node-get-file-path node))
(member \"drill\" (org-node-get-tags-local node))))))"
:type 'function
:set #'org-node--set-and-remind-reset)
(defcustom org-node-insert-link-hook '()
"Hook run after inserting a link to an Org-ID node.
Called with point in the new link."
:type 'hook)
(defcustom org-node-creation-hook '(org-node-put-created)
"Hook run with point in the newly created buffer or entry.
Applied by `org-node-new-file', `org-node-capture-target',
`org-node-insert-heading', `org-node-nodeify-entry' and
`org-node-extract-subtree'.
NOT applied by `org-node-fakeroam-new-via-roam-capture' -- see
org-roam\\='s `org-roam-capture-new-node-hook' instead.
A good function for this hook is `org-node-put-created', since
the default `org-node-datestamp-format' is empty. In the
author\\='s experience, recording the creation-date somewhere may
prove useful later on, e.g. when publishing to a blog."
:type 'hook)
(defcustom org-node-extra-id-dirs nil
"Directories in which to search Org files for IDs.
Essentially like variable `org-id-extra-files', but take directories.
You could already do this by adding directories to `org-agenda-files',
but that only checks the directories once. This variable causes the
directories to be checked again over time in order to find new files
that have appeared, e.g. files moved by terminal commands or created by
other instances of Emacs.
These directories are only checked as long as `org-node-cache-mode' is
active. They are checked recursively (looking in subdirectories,
sub-subdirectories etc).
EXCEPTION: Subdirectories that start with a dot, such as \".emacs.d/\",
are not checked. To check these, add them explicitly.
To avoid accidentally picking up duplicate files such as versioned
backups, causing org-id to complain about duplicate IDs, configure
`org-node-extra-id-dirs-exclude'."
:type '(repeat directory)
:set #'org-node--set-and-remind-reset)
;; TODO: Figure out how to permit .org.gpg and fail gracefully if
;; the EPG settings are insufficient. easier to test with .org.gz first
(defcustom org-node-extra-id-dirs-exclude
'("/logseq/bak/"
"/logseq/version-files/"
"/node_modules/"
".sync-conflict-")
"Path substrings of files that should not be searched for IDs.
This option only influences which files under `org-node-extra-id-dirs'
should be scanned. It is meant as a way to avoid collecting IDs inside
versioned backup files or other noise.
For all other \"excludey\" purposes, you probably mean to configure
`org-node-filter-fn' instead.
If you have accidentally let org-id add a directory of backup files, try
\\[org-node-forget-dir].
It is not necessary to exclude backups or autosaves that end in ~ or #
or .bak, since the workhorse `org-node-list-files' only considers files
that end in precisely \".org\" anyway.
You can eke out a performance boost by excluding directories with a
humongous amount of files, such as the infamous \"node_modules\", even
if they contain no Org files. However, directories that start with a
period are always ignored, so no need to specify e.g. \"~/.local/\" or
\".git/\" for that reason."
:type '(repeat string))
;;;; 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, at least
so long as `org-node-affixation-fn' is set to `org-node-prefix-with-olp'
\(default).
\(Tip: users of the orderless library from July 2024 do not need this
setting, they can match the prefix and suffix via
`orderless-annotation', bound to the character \& by default.)
Another consequence is it lifts the uniqueness constraint on note
titles: you\\='ll be able to have two headings with the same name so
long as their prefix or suffix differ.
After changing this setting, please run \\[org-node-reset]."
:type 'boolean
:set #'org-node--set-and-remind-reset)
(defcustom org-node-affixation-fn #'org-node-prefix-with-olp
"Function to give prefix and suffix to completion candidates.
The results will style the appearance of completions during
\\[org-node-find], \\[org-node-insert-link] et al.
To read more about affixations, see docstring of
`completion-extra-properties', however this function operates on
one candidate at a time, not the whole collection.
It receives two arguments: NODE and TITLE, and it must return a
list of three strings: title, prefix and suffix. The prefix and
suffix can be nil. Title should be TITLE unmodified.
NODE is an object which form you can observe in examples from
\\[org-node-peek] and specified in type `org-node'
\(type \\[describe-symbol] org-node RET).
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-prefix-with-olp)
(function-item org-node-prefix-with-tags)
(function-item org-node-affix-with-olp-and-tags)
(function :tag "Custom function"))
:package-version "0.9"
:set #'org-node--set-and-remind-reset)
(defun org-node-affix-bare (_node title)
"Use TITLE as-is.
For use as `org-node-affixation-fn'."
(list title nil nil))
(defun org-node-prefix-with-tags (node title)
"Prepend NODE's tags to TITLE.
For use as `org-node-affixation-fn'."
(list title
(when-let ((tags (if org-use-tag-inheritance
(org-node-get-tags-with-inheritance node)
(org-node-get-tags-local node))))
(propertize (concat "(" (string-join tags ", ") ") ")
'face 'org-tag))
nil))
(defun org-node-prefix-with-olp (node title)
"Prepend NODE's outline path to TITLE.
For use as `org-node-affixation-fn'."
(list title
(when (org-node-get-is-subtree node)
(let ((ancestors (cons (org-node-get-file-title-or-basename node)
(org-node-get-olp node)))
(result nil))
(dolist (anc ancestors)
(push (propertize anc 'face 'completions-annotations) result)
(push " > " result))
(apply #'concat (nreverse result))))
nil))
(defun org-node-affix-with-olp-and-tags (node title)
"Prepend NODE's outline path to TITLE, and append NODE's tags.
For use as `org-node-affixation-fn'."
(let ((prefix-len 0))
(list title
(when (org-node-get-is-subtree node)
(let ((ancestors (cons (org-node-get-file-title-or-basename node)
(org-node-get-olp node)))
(result nil))
(dolist (anc ancestors)
(push (propertize anc 'face 'completions-annotations) result)
(push " > " result))
(prog1 (setq result (apply #'concat (nreverse result)))
(setq prefix-len (length result)))))
(when-let ((tags (org-node-get-tags-local node)))
(setq tags (propertize (concat (string-join tags ":"))
'face 'org-tag))
(concat (make-string
(max 2 (- (default-value 'fill-column)
(+ prefix-len (length title) (length tags))))
?\s)
tags)))))
(defvar org-node--title<>affixation-triplet (make-hash-table :test #'equal)
"1:1 table mapping titles or aliases to affixation triplets.")
(defun org-node--affixate-collection (coll)
"From list COLL, make an alist of affixated members."
(cl-loop for title in coll
collect (gethash title org-node--title<>affixation-triplet)))
;; TODO: Assign a category `org-node', then add an embark action to embark?
;; TODO: Bind a custom exporter to `embark-export'
(defun org-node-collection (str pred action)
"Custom COLLECTION for `completing-read'.
Ahead of time, org-node takes titles and aliases from
`org-node--title<>id', runs `org-node-affixation-fn' on each, and
depending on the user option `org-node-alter-candidates' it
either saves the affixed thing directly into
`org-node--candidate<>node' or into a secondary table
`org-node--title<>affixation-triplet'. Finally, this function
then either simply reads candidates off the candidates table or
attaches the affixations in realtime.
Regardless of which, all completions are guaranteed to be keys of
`org-node--candidate<>node', 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,
read more at Info node `(elisp)Programmed Completion'."
(if (eq action 'metadata)
(cons 'metadata (unless org-node-alter-candidates
(list (cons 'affixation-function
#'org-node--affixate-collection))))
(complete-with-action action org-node--candidate<>node str pred)))
(defvar org-node-hist nil
"Minibuffer history.")
;; Boost this completion hist to at least 1000 elements, unless user has nerfed
;; the global `history-length'.
(and (>= history-length (car (get 'history-length 'standard-value)))
(< history-length 1000)
(put 'org-node-hist 'history-length 1000))
;;;; The metadata struct
(cl-defstruct (org-node (:constructor org-node--make-obj)
(:copier nil)
(:conc-name org-node-get-))
"An org-node object holds information about an Org ID node.
By the term \"Org ID node\", we mean either a subtree with
an ID property, or a file with a file-level ID property. The
information is stored in slots listed below.
For each slot, there exists a getter function
\"org-node-get-FIELD\".
For example, the field \"deadline\" has a getter
`org-node-get-deadline'. So you would type
\"(org-node-get-deadline NODE)\", where NODE is one of the
elements of \"(hash-table-values org-node--id<>node)\".
For real-world usage of these getters, see examples in the
documentation of `org-node-filter-fn' or Info node `(org-node)'."
(aliases nil :read-only t :type list :documentation
"Return list of ROAM_ALIASES registered on the node.")
(deadline nil :read-only t :type string :documentation
"Return node's DEADLINE state.")
(file-path nil :read-only t :type string :documentation
"Return node's full file path.")
(file-title nil :read-only t :type string :documentation
"Return the #+title of the file where this node is. May be nil.")
(id nil :read-only t :type string :documentation
"Return node's ID property.")
(level nil :read-only t :type integer :documentation
"Return number of stars in the node heading. File-level node always 0.")
(olp nil :read-only t :type list :documentation
"Return list of ancestor headings to this node.")
(pos nil :read-only t :type integer :documentation
"Return char position of the node. File-level node always 1.")
(priority nil :read-only t :type string :documentation
"Return priority such as [#A], as a string.")
(properties nil :read-only t :type alist :documentation
"Return alist of properties from the :PROPERTIES: drawer.")
(refs nil :read-only t :type list :documentation
"Return list of ROAM_REFS registered on the node.")
(scheduled nil :read-only t :type string :documentation
"Return node's SCHEDULED state.")
(tags-local nil :read-only t :type list :documentation
"Return list of tags local to the node.")
;; REVIEW: Maybe this can be a function that combines tags with a new field
;; called inherited-tags. That might cause slowdowns
;; though due to consing on every call.
(tags-with-inheritance nil :read-only t :type list :documentation
"Return list of tags, including inherited tags.")
(title nil :read-only t :type string :documentation
"Return the node's heading, or #+title if it is not a subtree.")
(todo nil :read-only t :type string :documentation
"Return node's TODO state."))
;; Used to be part of the struct
(defun org-node-get-file-title-or-basename (node)
"Return either the #+title of file where NODE is, or bare file name."
(or (org-node-get-file-title node)
(file-name-nondirectory (org-node-get-file-path node))))
(defun org-node-get-is-subtree (node)
"Return t if NODE is a subtree instead of a file."
(> (org-node-get-level node) 0))
;; It's safe to alias an accessor, because they are all read only
(defalias 'org-node-get-props #'org-node-get-properties)
;; (defalias 'org-node-get-prio #'org-node-get-priority)
;; (defalias 'org-node-get-sched #'org-node-get-scheduled)
;; (defalias 'org-node-get-file #'org-node-get-file-path)
;; (defalias 'org-node-get-lvl #'org-node-get-level)
;; API transition underway: get-tags will include inherited tags in future
(define-obsolete-function-alias 'org-node-get-tags #'org-node-get-tags-local
"2024-10-22")
(cl-defstruct (org-node-link (:constructor org-node-link--make-obj)
(:copier nil))
"Please see docstring of `org-node-get-id-links-to'."
origin
pos
type
dest)
;;;; Tables
(defvaralias 'org-nodes 'org-node--id<>node)
(defvar org-node--id<>node (make-hash-table :test #'equal)
"1:1 table mapping IDs to nodes.
To peek on the contents, try \\[org-node-peek] a few times, which
can demonstrate the data format. See also the type `org-node'.")
(defvar org-node--candidate<>node (make-hash-table :test #'equal)
"1:1 table mapping completion candidates to nodes.")
(defvar org-node--title<>id (make-hash-table :test #'equal)
"1:1 table mapping raw titles (and ROAM_ALIASES) to IDs.")
(defvar org-node--ref<>id (make-hash-table :test #'equal)
"1:1 table mapping ROAM_REFS members to the ID property near.")
(defvar org-node--ref-path<>ref-type (make-hash-table :test #'equal)
"1:1 table mapping //paths to types:.
While the same path can be found with multiple types \(e.g. http and
https), this table will in that case store a random one of these, since
that is good enough to make completions look less outlandish.
This is a smaller table than you might think, since it only contains
entries for links found in a :ROAM_REFS: field, instead of all links
found anywhere.
To see all links found, try \\[org-node-list-reflinks].")
(defvar org-node--dest<>links (make-hash-table :test #'equal)
"1:N table of links.
The table keys are destinations (org-ids, URI paths or citekeys),
and the corresponding table value is a list of `org-node-link'
records describing each link to that destination, with info such
as from which ID-node the link originates. See
`org-node-get-id-links-to' for more info.")
;; As of 2024-10-06, the MTIME is not used for anything except supporting
;; `org-node-fakeroam-db-feed-mode'. However, it has many conceivable
;; downstream or future applications.
(defvar org-node--file<>mtime (make-hash-table :test #'equal)
"1:1 table mapping file paths to values (MTIME . ELAPSED).
MTIME is the file\\='s last-modification time \(as an integer Unix
epoch) and ELAPSED how long it took to scan the file last time \(as a
float, usually a tiny fraction of a second).")
(defun org-node-get-id-links-to (node)
"Get list of ID-link objects pointing to NODE.
Each object is of type `org-node-link' with these fields:
origin - ID of origin node (where the link was found)
pos - buffer position where the link was found
dest - ID of destination node, or a ref that belongs to it
type - link type, such as \"https\", \"ftp\", \"info\" or
\"man\". For ID-links this is always \"id\". For a
citation this is always nil.
This function only returns ID-links, so you can expect the :dest
to always equal the ID of NODE. To see other link types, use
`org-node-get-reflinks-to'."
(gethash (org-node-get-id node) org-node--dest<>links))
(defun org-node-get-reflinks-to (node)
"Get list of reflink objects pointing to NODE.
Typical reflinks are URLs or @citekeys occurring in any document,
and they are considered to point to NODE when NODE has a
:ROAM_REFS: property that includes that same string.
The reflink object has the same shape as an ID-link object (see
`org-node-get-id-links-to'), but instead of an ID in the DEST field,
you have a ref string such an URL. Common gotcha: for a web
address such as \"http://gnu.org\", the DEST field holds only
\"//gnu.org\", and the \"http\" part goes into the TYPE
field. Colon is not stored anywhere.
Citations such as \"@gelman2001\" have TYPE nil, so you can
distinguish citations from other links this way."
(cl-loop for ref in (org-node-get-refs node)
append (gethash ref org-node--dest<>links)))
(defun org-node-peek (&optional ht)
"Print some random rows of table `org-nodes'.
For reference, see type `org-node'.
When called from Lisp, peek on any hash table HT."
(interactive)
(let ((rows (hash-table-values (or ht org-nodes)))
(print-length nil))
(dotimes (_ 3)
(print '----------------------------)
(cl-prin1 (nth (random (length rows)) rows)))))
;;;; The mode
;;;###autoload
(define-minor-mode org-node-cache-mode
"Instruct various hooks to keep the cache updated.
-----"
:global t
(remove-hook 'org-mode-hook #'org-node-cache-mode) ;; Old install instruction
(if org-node-cache-mode
(progn
;; FIXME: A dirty-added node eventually disappears if its buffer is
;; never saved, and then the series stops working
(add-hook 'org-node-creation-hook #'org-node--add-series-item 90)
(add-hook 'org-node-creation-hook #'org-node--dirty-ensure-node-known -50)
(add-hook 'org-node-insert-link-hook #'org-node--dirty-ensure-link-known -50)
(add-hook 'org-roam-post-node-insert-hook #'org-node--dirty-ensure-link-known -50)
(advice-add 'org-insert-link :after #'org-node--dirty-ensure-link-known)
(add-hook 'calendar-today-invisible-hook #'org-node--mark-days 5)
(add-hook 'calendar-today-visible-hook #'org-node--mark-days 5)
(add-hook 'window-buffer-change-functions #'org-node--kill-blank-unsaved-buffers)
(add-hook 'after-save-hook #'org-node--handle-save)
(advice-add 'rename-file :after #'org-node--handle-rename)
(advice-add 'delete-file :after #'org-node--handle-delete)
(org-node-cache-ensure 'must-async t)
(org-node--maybe-adjust-idle-timer))
(cancel-timer org-node--idle-timer)
(remove-hook 'org-node-creation-hook #'org-node--add-series-item)
(remove-hook 'org-node-creation-hook #'org-node--dirty-ensure-node-known)
(remove-hook 'org-node-insert-link-hook #'org-node--dirty-ensure-link-known)
(remove-hook 'org-roam-post-node-insert-hook #'org-node--dirty-ensure-link-known)
(advice-remove 'org-insert-link #'org-node--dirty-ensure-link-known)
(remove-hook 'calendar-today-invisible-hook #'org-node--mark-days)
(remove-hook 'calendar-today-visible-hook #'org-node--mark-days)
(remove-hook 'window-buffer-change-functions #'org-node--kill-blank-unsaved-buffers)
(remove-hook 'after-save-hook #'org-node--handle-save)
(advice-remove 'rename-file #'org-node--handle-rename)
(advice-remove 'delete-file #'org-node--handle-delete)))
(defun org-node--tramp-file-p (file)
"Pass FILE to `tramp-tramp-file-p' if Tramp is loaded."
(when (featurep 'tramp)
(tramp-tramp-file-p file)))
(defun org-node--handle-rename (file newname &rest _)
"Arrange to scan NEWNAME for nodes and links, and forget FILE."
(org-node--scan-targeted
(thread-last (list file newname)
(seq-filter (##string-suffix-p ".org" %))
(seq-remove #'backup-file-name-p)
(seq-remove #'org-node--tramp-file-p)
(mapcar #'file-truename)
(org-node-abbrev-file-names))))
(defun org-node--handle-delete (file &rest _)
"Arrange to forget nodes and links in FILE."
(when (string-suffix-p ".org" file)
(unless (org-node--tramp-file-p file)
(org-node--scan-targeted file))))
(defun org-node--handle-save ()
"Arrange to re-scan nodes and links in current buffer."
(when (and (string-suffix-p ".org" buffer-file-truename)
(not (backup-file-name-p buffer-file-truename))
(not (org-node--tramp-file-p buffer-file-truename)))
(org-node--scan-targeted buffer-file-truename)))
(defvar org-node--idle-timer (timer-create)
"Timer for intermittently checking `org-node-extra-id-dirs'.
for new, changed or deleted files, then resetting the cache.
This redundant behavior helps detect changes made by something
other than the current instance of Emacs, such as an user typing
rm on the command line instead of using \\[delete-file].
This timer is set by `org-node--maybe-adjust-idle-timer'.
Override that function to configure timer behavior.")
(defun org-node--maybe-adjust-idle-timer ()
"Adjust `org-node--idle-timer' based on duration of last scan.
If not running, start it."
(let ((new-delay (* 25 (1+ org-node--time-elapsed))))
(when (or (not (member org-node--idle-timer timer-idle-list))
;; Don't enter an infinite loop (idle timers are footguns)
(not (> (float-time (or (current-idle-time) 0))
new-delay)))
(cancel-timer org-node--idle-timer)
(setq org-node--idle-timer
(run-with-idle-timer new-delay t #'org-node--scan-all)))))
;; FIXME: The idle timer will detect new files appearing, created by other
;; emacsen, but won't run the hook `org-node-rescan-functions' on them,
;; which would be good to do. So check for new files and then try to
;; use `org-node--scan-targeted', since that runs the hook, but it is
;; easy to imagine a pitfall where the list of new files is just all
;; files, and then we do NOT want to run the hook. So use a heuristic
;; cutoff like 10 files.
;; (defun org-node--catch-unknown-modifications ()
;; (let ((new (-difference (org-node-list-files) (org-node-list-files t)))))
;; (if (> 10 )
;; (org-node--scan-all)
;; (org-node--scan-targeted))
;; )
(defvar org-node--not-yet-saved nil
"List of buffers created to hold a new node.")
(defun org-node--kill-blank-unsaved-buffers (&rest _)
"Kill buffers created by org-node that have become blank.
This exists to allow you to create a node, especially a journal
note for today, change your mind, do an undo to empty the buffer,
then browse to the previous day\\='s note. When later you want
to create today\\='s note after all, the series :creator function
should be made to run again, but will only do so if the buffer
has been properly deleted since, thus this hook."
(unless (minibufferp)
(dolist (buf org-node--not-yet-saved)
(if (or (not (buffer-live-p buf))
(file-exists-p (buffer-file-name buf)))
(setq org-node--not-yet-saved (delq buf org-node--not-yet-saved))
(and (not (get-buffer-window buf t)) ;; buffer not visible
(string-blank-p (with-current-buffer buf (buffer-string)))
(kill-buffer buf))))))
(defun org-node-cache-ensure (&optional synchronous force)
"Ensure that org-node is ready for use.
Specifically, do the following:
- Run `org-node--init-ids'.
- \(Re-)build the cache if it is empty, or if FORCE is t.
The primary use case is at the start of autoloaded commands.
Optional argument SYNCHRONOUS t means that if a cache build is
needed or already ongoing, block Emacs until it is done.
When SYNCHRONOUS is nil, return immediately and let the caching
proceed in the background. As that may take a few seconds, that
would mean that the `org-node--id<>node' table could be still outdated
by the time you query it, but that is acceptable in many
situations such as in an user command since the table is mostly
correct - and fully correct by the time of the next invocation.
If the `org-node--id<>node' table is currently empty, behave as if
SYNCHRONOUS t, unless SYNCHRONOUS is the symbol `must-async'."
(unless (eq synchronous 'must-async)
;; The warn-function becomes a no-op after the first run, so gotta
;; run it as late as possible in case of late variable settings. By
;; running it here, we've waited until the user runs a command.
(org-node-changes--warn-and-copy))
(org-node--init-ids)
(when (hash-table-empty-p org-nodes)
(setq synchronous (if (eq synchronous 'must-async) nil t))
(setq force t))
(when force
;; Launch the async processes
(org-node--scan-all))
(when (eq t synchronous)
;; Block until all processes finish
(if org-node-cache-mode
(el-job--await 'org-node 9 "org-node first-time caching...")
(el-job--await 'org-node 9 "org-node caching... (Hint: Avoid this hang by enabling org-node-cache-mode early)"))))
;; BUG: A heisenbug lurks inside (or is revealed by) org-id.
;; https://emacs.stackexchange.com/questions/81794/
;; When it appears, backtrace will show this, which makes no sense -- it's
;; clearly called on a list:
;; Debugger entered--Lisp error: (wrong-type-argument listp #<hash-table equal 3142/5277) 0x190d581ba129>
;; org-id-alist-to-hash((("/home/kept/roam/semantic-tabs-in-2024.org" "f21c984c-13f3-428c-8223-0dc1a2a694df") ("/home/kept/roam/semicolons-make-javascript-h..." "b40a0757-bff4-4188-b212-e17e3fc54e13") ...))
;; org-node--init-ids()
;; ...
(defun org-node--init-ids ()
"Ensure that org-id is ready for use.
In broad strokes:
- Run `org-id-locations-load' if needed.
- Ensure `org-id-locations' is a hash table and not an alist.
- Throw error if `org-id-locations' is still empty after this,
unless `org-node-extra-id-dirs' has members.
- Wipe `org-id-locations' if it appears afflicted by a known bug that
makes the symbol value an indeterminate superposition of one of two
possible values \(a hash table or an alist) depending on which code
accesses it -- like Schrödinger\\='s cat -- and tell the user to
rebuild the value, since even org-id\\='s internal functions are
unable to fix it."
(require 'org-id)
(when (not org-id-track-globally)
(user-error "Org-node requires `org-id-track-globally'"))
(when (null org-id-locations)
(when (file-exists-p org-id-locations-file)
(ignore-errors (org-id-locations-load))))
(when (listp org-id-locations)
(ignore-errors
(setq org-id-locations (org-id-alist-to-hash org-id-locations))))
(when (listp org-id-locations)
(setq org-id-locations nil)
(org-node--die
"Found org-id heisenbug! Wiped org-id-locations, repair with `org-node-reset' or `org-roam-update-org-id-locations'"))
(when (hash-table-p org-id-locations)
(when (hash-table-empty-p org-id-locations)
(org-id-locations-load)
(when (and (hash-table-empty-p org-id-locations)
(null org-node-extra-id-dirs))
(org-node--die
(concat
"No org-ids found. If this was unexpected, try M-x `org-id-update-id-locations' or M-x `org-roam-update-org-id-locations'.
\tIf this is your first time using org-id, first assign an ID to some
\trandom heading with M-x `org-id-get-create', so that at least one exists
\ton disk, then do M-x `org-node-reset' and it should work from then on."))))))
(define-advice org-id-locations-load
(:after () org-node--abbrev-org-id-locations)
"Maybe abbreviate all filenames in `org-id-locations'.
Due to an oversight, org-id does not abbreviate after reconstructing
filenames if `org-id-locations-file-relative' is t.
https://lists.gnu.org/archive/html/emacs-orgmode/2024-09/msg00305.html"
(when org-id-locations-file-relative
(maphash (lambda (id file)
(puthash id (org-node-abbrev-file-names file) org-id-locations))
org-id-locations)))
;;;; Scanning
(defvar org-node--time-at-begin-full-scan nil)
(defun org-node--scan-all ()
"Arrange a full scan."
(unless (el-job-is-busy 'org-node)
(setq org-node--time-at-begin-full-scan (time-convert nil t))
(el-job-launch
:id 'org-node
:if-busy 'noop
:load 'org-node-parser
:inject-vars (append org-node-inject-variables (org-node--mk-work-vars))
:eval-once "(org-node-parser--init)"
:funcall #'org-node-parser--collect-dangerously
:inputs #'org-node-list-files
:wrapup #'org-node--finalize-full)))
(defun org-node--scan-targeted (files)
"Arrange to scan FILES."
(when files
(el-job-launch
:id 'org-node-targeted
:method 'reap
:if-busy 'wait
:skip-benchmark t
:load 'org-node-parser
:inject-vars (append org-node-inject-variables (org-node--mk-work-vars))
:eval-once "(org-node-parser--init)"
:funcall #'org-node-parser--collect-dangerously
:inputs (ensure-list files)
:wrapup #'org-node--finalize-modified)))
(defun org-node--mk-work-vars ()
"Return an alist of symbols and values to set in subprocesses."
(let ((reduced-plain-re (org-node--mk-plain-re org-node-link-types)))
(list
;; NOTE: The $sigil-prefixed names visually distinguish these
;; variables in the body of `org-node-parser--collect-dangerously'.
(cons '$plain-re reduced-plain-re)
(cons '$merged-re (concat org-link-bracket-re "\\|" reduced-plain-re))
(cons '$assume-coding-system org-node-perf-assume-coding-system)
(cons '$inlinetask-min-level (bound-and-true-p org-inlinetask-min-level))
(cons '$file-todo-option-re
(rx bol (* space) (or "#+todo: " "#+seq_todo: " "#+typ_todo: ")))
(cons '$global-todo-re
(let ((default (default-value 'org-todo-keywords)))
(org-node-parser--make-todo-regexp
(string-join (if (stringp (car default))
default
(apply #'append (mapcar #'cdr default)))
" "))))
(cons '$file-name-handler-alist
(cl-remove-if-not
(##memq % org-node-perf-keep-file-name-handlers)
file-name-handler-alist :key #'cdr))
(cons '$backlink-drawer-re
(concat "^[\t\s]*:"
(or (and (require 'org-super-links nil t)
(boundp 'org-super-links-backlink-into-drawer)
(stringp org-super-links-backlink-into-drawer)
org-super-links-backlink-into-drawer)
"backlinks")
":")))))
;; Copied from part of `org-link-make-regexps'
(defun org-node--mk-plain-re (link-types)
"Build a moral equivalent to `org-link-plain-re'.
Make it target only LINK-TYPES instead of all the cars of
`org-link-parameters'."
(let* ((non-space-bracket "[^][ \t\n()<>]")
(parenthesis
`(seq (any "<([")
(0+ (or (regex ,non-space-bracket)
(seq (any "<([")
(0+ (regex ,non-space-bracket))
(any "])>"))))
(any "])>"))))
(rx-to-string
`(seq word-start
(regexp ,(regexp-opt link-types t))
":"
(group
(1+ (or (regex ,non-space-bracket)
,parenthesis))