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
|
(if (not (file-exists? path))
(if (null? ht)(make-hash-table) (car ht))
(let ((inp (open-input-file path))
(res (if (null? ht)(make-hash-table)(car ht)))
(include-rx (regexp "^\\[include\\s+(.*)\\]\\s*$"))
(section-rx (regexp "^\\[(.*)\\]\\s*$"))
(blank-l-rx (regexp "^\\s*$"))
(key-val-pr (regexp "^(\\S+)\\s+(.*)$"))
(comment-rx (regexp "^\\s*#.*")))
(let loop ((inl (read-line inp))
(curr-section-name "default"))
(if (eof-object? inl) res
(regex-case
inl
(comment-rx _ (loop (read-line inp) curr-section-name))
(blank-l-rx _ (loop (read-line inp) curr-section-name))
(include-rx ( x include-file ) (begin
(read-config include-file res)
(loop (read-line inp) curr-section-name)))
(section-rx ( x section-name ) (loop (read-line inp) section-name))
(key-val-pr ( x key val ) (let ((alist (hash-table-ref/default res curr-section-name '())))
(hash-table-set! res curr-section-name
(config:assoc-safe-add alist key val))
;; (append alist (list (list key val))))
(loop (read-line inp) curr-section-name)))
(else (print "ERROR: Should not get here,\n \"" inl "\"")
(loop (read-line inp) curr-section-name))))))))
|
>
>
>
>
>
>
>
>
>
>
|
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
|
(if (not (file-exists? path))
(if (null? ht)(make-hash-table) (car ht))
(let ((inp (open-input-file path))
(res (if (null? ht)(make-hash-table)(car ht)))
(include-rx (regexp "^\\[include\\s+(.*)\\]\\s*$"))
(section-rx (regexp "^\\[(.*)\\]\\s*$"))
(blank-l-rx (regexp "^\\s*$"))
(key-sys-pr (regexp "^(\\S+)\\s+\\[system\\s+(\\S+.*)\\]\\s*$"))
(key-val-pr (regexp "^(\\S+)\\s+(.*)$"))
(comment-rx (regexp "^\\s*#.*")))
(let loop ((inl (read-line inp))
(curr-section-name "default"))
(if (eof-object? inl) res
(regex-case
inl
(comment-rx _ (loop (read-line inp) curr-section-name))
(blank-l-rx _ (loop (read-line inp) curr-section-name))
(include-rx ( x include-file ) (begin
(read-config include-file res)
(loop (read-line inp) curr-section-name)))
(section-rx ( x section-name ) (loop (read-line inp) section-name))
(key-sys-pr ( x key cmd ) (let ((alist (hash-table-ref/default res curr-section-name '()))
(val (let ((res (car (cmd-run->list cmd))))
(if (null? res)
""
(string-intersperse res " ")))))
(hash-table-set! res curr-section-name
(config:assoc-safe-add alist key val))
;; (append alist (list (list key val))))
(loop (read-line inp) curr-section-name)))
(key-val-pr ( x key val ) (let ((alist (hash-table-ref/default res curr-section-name '())))
(hash-table-set! res curr-section-name
(config:assoc-safe-add alist key val))
;; (append alist (list (list key val))))
(loop (read-line inp) curr-section-name)))
(else (print "ERROR: Should not get here,\n \"" inl "\"")
(loop (read-line inp) curr-section-name))))))))
|