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
|
(declare (unit configf))
(declare (uses common))
(declare (uses process))
(include "common_records.scm")
;; return list (path fullpath configname)
(define (find-config configname)
(let* ((cwd (string-split (current-directory) "/")))
(let loop ((dir cwd))
(let* ((path (conc "/" (string-intersperse dir "/")))
(fullpath (conc path "/" configname)))
(if (file-exists? fullpath)
(list path fullpath configname)
(let ((remcwd (take dir (- (length dir) 1))))
(if (null? remcwd)
(list #f #f #f) ;; #f #f)
(loop remcwd))))))))
(define (config:assoc-safe-add alist key val)
(let ((newalist (filter (lambda (x)(not (equal? key (car x)))) alist)))
(append newalist (list (list key val)))))
(define (config:eval-string-in-environment str)
(let ((cmdres (cmd-run->list (conc "echo " str))))
|
|
>
>
>
>
>
|
|
|
|
|
|
|
|
|
|
|
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
|
(declare (unit configf))
(declare (uses common))
(declare (uses process))
(include "common_records.scm")
;; return list (path fullpath configname)
(define (find-config configname #!key (toppath #f))
(if toppath
(let ((cfname (conc toppath "/" configname)))
(if (file-exists? cfname)
(list toppath cfname configname)
(list #f #f #f)))
(let* ((cwd (string-split (current-directory) "/")))
(let loop ((dir cwd))
(let* ((path (conc "/" (string-intersperse dir "/")))
(fullpath (conc path "/" configname)))
(if (file-exists? fullpath)
(list path fullpath configname)
(let ((remcwd (take dir (- (length dir) 1))))
(if (null? remcwd)
(list #f #f #f) ;; #f #f)
(loop remcwd)))))))))
(define (config:assoc-safe-add alist key val)
(let ((newalist (filter (lambda (x)(not (equal? key (car x)))) alist)))
(append newalist (list (list key val)))))
(define (config:eval-string-in-environment str)
(let ((cmdres (cmd-run->list (conc "echo " str))))
|
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
|
(config:assoc-safe-add alist var-flag newval))
(loop (configf:read-line inp res) curr-section-name var-flag (if lead lead whsp)))
(loop (configf:read-line inp res) curr-section-name #f #f))))
(else (debug:print 0 "ERROR: problem parsing " path ",\n \"" inl "\"")
(set! var-flag #f)
(loop (configf:read-line inp res) curr-section-name #f #f))))))))
(define (find-and-read-config fname #!key (environ-patt #f))
(let* ((curr-dir (current-directory))
(configinfo (find-config fname))
(toppath (car configinfo))
(configfile (cadr configinfo)))
(if toppath (change-directory toppath))
(let ((configdat (if configfile (read-config configfile #f #t environ-patt: environ-patt) #f))) ;; (make-hash-table))))
(if toppath (change-directory curr-dir))
(list configdat toppath configfile fname))))
|
|
|
|
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
|
(config:assoc-safe-add alist var-flag newval))
(loop (configf:read-line inp res) curr-section-name var-flag (if lead lead whsp)))
(loop (configf:read-line inp res) curr-section-name #f #f))))
(else (debug:print 0 "ERROR: problem parsing " path ",\n \"" inl "\"")
(set! var-flag #f)
(loop (configf:read-line inp res) curr-section-name #f #f))))))))
(define (find-and-read-config fname #!key (environ-patt #f)(given-toppath #f))
(let* ((curr-dir (current-directory))
(configinfo (find-config fname toppath: given-toppath))
(toppath (car configinfo))
(configfile (cadr configinfo)))
(if toppath (change-directory toppath))
(let ((configdat (if configfile (read-config configfile #f #t environ-patt: environ-patt) #f))) ;; (make-hash-table))))
(if toppath (change-directory curr-dir))
(list configdat toppath configfile fname))))
|