-
Notifications
You must be signed in to change notification settings - Fork 2
/
Copy pathreorg-leo.el
93 lines (84 loc) · 2.24 KB
/
reorg-leo.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
;; -*- lexical-binding: t; -*-
(require 'reorg)
(defun reorg-leo--render-func (&optional id buffer)
"render func"
(let ((id (or id (reorg--get-prop 'id)))
(buffer (or buffer (reorg--get-prop 'buffer))))
(reorg--select-main-window buffer)
;; (switch-to-buffer buffer)
(widen)
(goto-char (point-min))
(re-search-forward (concat "<t tx=\""
id
"\">"))
(setq b (match-end 0))
(goto-char (match-beginning 0))
(re-search-forward "</t>")
(setq e (match-beginning 0))
(goto-char b)
(narrow-to-region b e)))
;;(reorg--select-tree-window)))
(reorg-create-class-type
:name leo
:getter
(cl-loop for each in
(cl-flet ((get-t (x) (cdar (nth 1 x)))
(get-vh (x) (nth 2 (nth 2 x))))
(let* ((level 0)
(buffer (find-file-noselect SOURCE))
(data (with-current-buffer buffer
(widen)
(libxml-parse-xml-region (point-min)
(point-max))))
(vnodes (cddar (cdddr (cdddar (cdddr data))))))
(cl-labels ((zzz (d l n)
(cl-loop for each in d
collect
(list
(cons 'leo-level l)
(cons 'body (car
(last
(car
(dom-elements
data 'tx (get-t each))))))
(cons 'id (get-t each))
(cons 'headline (get-vh each))
(cons 'buffer buffer)
(cons 'order (cl-incf n)))
append (when (subseq each 3)
(zzz (subseq each 3) (1+ l) n)))))
(zzz vnodes level 1))))
collect (PARSER each))
:render-func reorg-leo--render-func)
(reorg-create-data-type
:class leo
:name at-node
:parse (and (s-starts-with-p "@" (alist-get 'headline data))
(string-match "^@\\([^[:space:]]+\\)" (alist-get 'headline data))
(match-string 1 (alist-get 'headline data))))
(reorg-create-data-type
:class leo
:name leo-level
:parse (alist-get 'leo-level data))
(reorg-create-data-type
:class leo
:name body
:parse (alist-get 'body data))
(reorg-create-data-type
:class leo
:name headline
:parse (alist-get 'headline data))
(reorg-create-data-type
:class leo
:name buffer
:parse (alist-get 'buffer data))
(reorg-create-data-type
:class leo
:name order
:parse (alist-get 'order data))
(reorg-create-data-type
:class leo
:name id
:disable t
:parse (alist-get 'id data))
(provide 'reorg-leo)