blob: a5ad54a35a1439d877f857cc5525d4fe61e988df (
plain)
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
|
;;;; This file is part of cfpeek
;;;; Copyright (C) 2011 Sergey Poznyakoff
;;;;
;;;; Cfpeek 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.
;;;;
;;;; Cfpeek 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 cfpeek. If not, see <http://www.gnu.org/licenses/>.
;;;;
;;;; This sample extension script converts input file into GIT configuration
;;;; file format.
;;;;
;;;; Usage: cfpeek -f togit.scm FILE .
;;;;
;;;; Notice the final dot, which refers to the parse tree root node.
;;;;
(define (print-section node delim)
"Print a Git section header for the given node.
End it with delim.
The function recursively calls itself until the topmost
node is reached.
"
(cond
((grecs-node-up? node)
;; Ascend to the parent node
(print-section (grecs-node-up node) #\space)
;; Print its identifier, ...
(display (grecs-node-ident node))
(if (grecs-node-has-value? node)
;; ... value,
(begin
(display " ")
(display (grecs-node-value node))))
;; ... and delimiter
(display delim))
(else ;; mark the root node
(display "[")))) ;; with a [
(define (cfpeek node)
"Main entry point. Calls itself recursively to descend
into subordinate nodes and to iterate over nodes on the
same nesting level (tail recursion)."
(let loop ((node node))
(if node
(let ((type (grecs-node-type node)))
(cond
((= type grecs-node-root)
(let ((dn (grecs-node-down node)))
;; Each statement in a Git config file must
;; belong to a section. If the first node
;; is not a block statement, provide the
;; default [core] section:
(if (not (= (grecs-node-type dn)
grecs-node-block))
(display "[core]\n"))
;; Continue from the first node
(loop dn)))
((= type grecs-node-block)
;; print the section header
(print-section node #\])
(newline)
;; descend into subnodes
(loop (grecs-node-down node))
;; continue from the next node
(loop (grecs-node-next node)))
((= type grecs-node-stmt)
;; print the simple statement
(display #\tab)
(display (grecs-node-ident node))
(display " = ")
(display (grecs-node-value node))
(newline)
;; continue from the next node
(loop (grecs-node-next node))))))))
|
