-
Notifications
You must be signed in to change notification settings - Fork 0
/
ork-get.el
211 lines (180 loc) · 8.95 KB
/
ork-get.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
;;; ork-get.el --- Org Roam Kasten: content retrieval "" -*- lexical-binding: t; -*-
;; Copyright (C) 2022 Amir Dekel
;; Author: Amir Dekel
;; URL: https://example.com/package-name.el
;; Version: 0.1-alpha
;; Package-Requires: ((org-roam "2.0.0"))
;; Keywords: org-mode roam convenience
;; This file is not part of GNU Emacs.
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; TODO
;;;; Variables
(defvar ork-entry-tag-re "^@.+"
"Tag defining zettelkasten entry nodes.
All entry nodes will be included in the completion buffer.")
(defvar ork-directory-file-node-re "0_.*"
"Regex for the file holding a file-level node for the directory.")
(defvar ork-tag-display-properties '()
"An Alist where each item's CAR is a string, representing a node tag,
and its CDR is a list of display properties for nodes matching that tag.
Valid display properties are: `children'.
The display properties which are the value of the first tag match will
be applied to the node. A special item whose key is `default' will apply
to all the nodes which don't have a matching tag.")
;;;; Functions
;;;;;; Predicates
(defun ork-get-entry-p (node)
"Query whether the node is an entry node.
An entry node is defined by having a tag that matches
`ork-entry-tag-re'."
(seq-filter (apply-partially 'string-match-p ork-entry-tag-re)
(org-roam-node-tags node)))
(defun ork-get--directory-node-p (node)
"Return non-nil if the current node is the current directory's directory-node."
(and (= 0 (org-roam-node-level node))
(string-match-p ork-directory-file-node-re
(file-name-nondirectory (org-roam-node-file node)))))
;;;;;; Retrieval of content, metadata, related nodes, etc.
(defun ork-get-node-content (node)
"Extract the content of NODE until the next sibling or child,
excluding the property drawer."
(org-with-point-at (org-roam-node-marker node)
(org-with-wide-buffer
(let* ((content-begin-re (if (= 0 (org-roam-node-level node))
"^[^#: ]"
":end:\n+"))
(content-begin (save-excursion
(re-search-forward content-begin-re nil t)))
(content-end (or (outline-next-heading)
(point-max))))
(if (<= content-end content-begin)
""
(buffer-substring-no-properties content-begin content-end))))))
(defun ork-get-display-properties (node)
"Determine the node's display properties based on its tags and
`ork-tag-display-properties'"
(or
(car (seq-filter 'consp
(mapcar (lambda (tag)
(cdr (assoc tag ork-tag-display-properties)))
(org-roam-node-tags node))))
(cdr (assoc 'default ork-tag-display-properties))))
(defun ork-get-next-node (node &optional prev same-level)
"Find the next node, corresponding to the next \"physical\" zettel.
If PREV is non-nil then find the previous node. If SAME-LEVEL is
non-nil then find the next or previous node at the same level under
the current parent heading."
(if (and same-level
(= 0 ork-buffer--current-level)) ;FIXME -- shouldn't refer to buffer
(ork-get--next-node-other-file node prev t)
(let ((begin (org-roam-node-point node))
(fn (cond ((and prev same-level) (lambda ()
(org-backward-heading-same-level 1)))
(same-level (lambda ()
(org-forward-heading-same-level 1)))
(prev #'outline-previous-heading)
(t #'outline-next-heading))))
(org-with-point-at (org-roam-node-marker node)
(org-with-wide-buffer
(while (and (funcall fn)
(not (org-entry-get (point) "ID"))))
(if (equal node (org-roam-node-at-point))
(ork-get--next-node-other-file node prev)
(org-roam-node-at-point)))))))
(defun ork-get--next-node-other-file (node &optional prev root)
"find the first node in a file next to that of NODE.
If PREV, find the last node in a previous file.
If ROOT, only consider level-0 nodes."
(let* ((node-file (org-roam-node-file node))
(dir-org-files (directory-files (file-name-directory node-file)
t "\\.org"))
(add (if prev -1 1))
(next-index (+ add (seq-position dir-org-files node-file)))
next-node)
(while (not (or (= next-index -1)
(= next-index (length dir-org-files))
next-node))
(let* ((query (vector :select [id level] :from 'nodes
:where `(= file ,(nth next-index dir-org-files))
:order :by 'pos))
(query-result (seq-filter (lambda (result)
(if root
(= 0 (cadr result)) t))
(org-roam-db-query query))))
(when query-result
(setq next-node (org-roam-node-from-id
(if prev
(caar (last query-result))
(caar query-result)))))
(setq next-index (+ add next-index))))
next-node))
(defun ork-get-child-nodes (node)
(org-with-point-at (org-roam-node-marker node)
(let* ((level (org-roam-node-level node))
(node-tree (org-map-entries 'org-roam-node-at-point nil
(if (= level 0) 'file 'tree)))
(heading-child-nodes (seq-filter (lambda (node)
(= (+ level 1) (org-roam-node-level node)))
node-tree)))
(if (ork-get--directory-node-p node)
(append (seq-filter (lambda (node) (not (ork-get--directory-node-p node)))
(mapcar (lambda (file)
(let ((query (vector :select 'id :from 'nodes
:where `(and (= level 0)
(= file ,file)))))
(org-roam-node-from-id (caar (org-roam-db-query query)))))
(directory-files (file-name-directory (org-roam-node-file node)) t "\\.org$")))
heading-child-nodes)
heading-child-nodes))))
(defun ork-get-sibling-titles (node)
"Returns the titles of all sibling nodes of NODE.
The titles are returned as a list of two lists, the first of
preceding nodes, the second of following nodes."
(org-with-point-at (org-roam-node-marker node)
(let ((level (org-roam-node-level node)))
(if (zerop level)
'(nil nil)
(let* ((nodes-at-level (org-map-entries (lambda ()
(org-roam-node-title (org-roam-node-at-point)))
(concat "+LEVEL=" (number-to-string level) "+ID={.+}")
'file))
(node-index (seq-position nodes-at-level (org-roam-node-title node))))
(list (seq-take nodes-at-level node-index) (seq-drop nodes-at-level (1+ node-index))))))))
(defun ork-get-parent-node (node)
(if (> (org-roam-node-level node) 0)
(org-with-point-at (org-roam-node-marker node)
(while (and
(org-up-heading-or-point-min)
(not (org-roam-node-at-point))))
(org-roam-node-at-point))
(let ((dir (file-name-directory (org-roam-node-file node)))
parent-node)
(when (ork-get--directory-node-p node)
(setq dir (file-name-directory (directory-file-name dir))))
(while (and (not parent-node)
(>= (length dir) (length (expand-file-name org-roam-directory))))
(setq parent-node (ork-get--directory-node dir))
(setq dir (file-name-directory (directory-file-name dir))))
parent-node)))
(defun ork-get--directory-node (directory)
"Find the directory node of DIRECTORY.
nil if none."
(let ((node-file (car (directory-files directory t ork-directory-file-node-re))))
(when node-file
(with-current-buffer (find-file-noselect node-file)
(org-with-wide-buffer
(goto-char (point-min))
(org-roam-node-at-point))))))
;;;; Footer
(provide 'ork-get)
;;; ork-get.el ends here