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
|
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
|
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
(configf:comment-rx _ (loop (read-line inp) curr-section-name #f #f))
(configf:blank-l-rx _ (loop (read-line inp) curr-section-name #f #f))
(configf:include-rx ( x include-file ) (begin
(read-config include-file res allow-system environ-patt: environ-patt)
(loop (read-line inp) curr-section-name #f #f)))
(configf:section-rx ( x section-name ) (loop (read-line inp) section-name #f #f))
(configf:key-sys-pr ( x key cmd ) (if allow-system
(let ((alist (hash-table-ref/default res curr-section-name '()))
(val-proc (lambda ()
(let* ((cmdres (cmd-run->list cmd))
(status (cadr cmdres))
(res (car cmdres)))
(if (not (eq? status 0))
(begin
(debug:print 0 "ERROR: problem with " inl ", return code " status)
(exit 1)))
(if (null? res)
""
(string-intersperse res " "))))))
(hash-table-set! res curr-section-name
(config:assoc-safe-add alist
key
(if (eq? allow-system 'return-procs)
val-proc
(val-proc))))
(loop (read-line inp) curr-section-name #f #f))
(loop (read-line inp) curr-section-name #f #f)))
(let ((alist (hash-table-ref/default res curr-section-name '()))
(val-proc (lambda ()
(let* ((cmdres (cmd-run->list cmd))
(status (cadr cmdres))
(res (car cmdres)))
(if (not (eq? status 0))
(begin
(debug:print 0 "ERROR: problem with " inl ", return code " status)
(exit 1)))
(if (null? res)
""
(string-intersperse res " "))))))
(hash-table-set! res curr-section-name
(config:assoc-safe-add alist
key
(case allow-system
((return-procs) val-proc)
((return-string) cmd)
(else (val-proc)))))
(loop (read-line inp) curr-section-name #f #f))
(loop (read-line inp) curr-section-name #f #f)))
(configf:key-val-pr ( x key val ) (let* ((alist (hash-table-ref/default res curr-section-name '()))
(envar (and environ-patt (string-match (regexp environ-patt) curr-section-name)))
(realval (if envar
(config:eval-string-in-environment val)
val)))
(if envar
(begin
|