File
configf.scm
— part of check-in
[b077e2bbcd]
at
2012-04-12 16:14:02
on branch trunk
— Added helpful (hopefully) output on system and shell from config processing and launch processes
(user:
mrwellan
size: 15475)
0000: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
0010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0040: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 43 6f 70 79 ========.;; Copy
0050: 72 69 67 68 74 20 32 30 30 36 2d 32 30 31 32 2c right 2006-2012,
0060: 20 4d 61 74 74 68 65 77 20 57 65 6c 6c 61 6e 64 Matthew Welland
0070: 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68 69 73 20 70 ..;; .;; This p
0080: 72 6f 67 72 61 6d 20 69 73 20 6d 61 64 65 20 61 rogram is made a
0090: 76 61 69 6c 61 62 6c 65 20 75 6e 64 65 72 20 74 vailable under t
00a0: 68 65 20 47 4e 55 20 47 50 4c 20 76 65 72 73 69 he GNU GPL versi
00b0: 6f 6e 20 32 2e 30 20 6f 72 0a 3b 3b 20 20 67 72 on 2.0 or.;; gr
00c0: 65 61 74 65 72 2e 20 53 65 65 20 74 68 65 20 61 eater. See the a
00d0: 63 63 6f 6d 70 61 6e 79 69 6e 67 20 66 69 6c 65 ccompanying file
00e0: 20 43 4f 50 59 49 4e 47 20 66 6f 72 20 64 65 74 COPYING for det
00f0: 61 69 6c 73 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68 ails..;; .;; Th
0100: 69 73 20 70 72 6f 67 72 61 6d 20 69 73 20 64 69 is program is di
0110: 73 74 72 69 62 75 74 65 64 20 57 49 54 48 4f 55 stributed WITHOU
0120: 54 20 41 4e 59 20 57 41 52 52 41 4e 54 59 3b 20 T ANY WARRANTY;
0130: 77 69 74 68 6f 75 74 20 65 76 65 6e 20 74 68 65 without even the
0140: 0a 3b 3b 20 20 69 6d 70 6c 69 65 64 20 77 61 72 .;; implied war
0150: 72 61 6e 74 79 20 6f 66 20 4d 45 52 43 48 41 4e ranty of MERCHAN
0160: 54 41 42 49 4c 49 54 59 20 6f 72 20 46 49 54 4e TABILITY or FITN
0170: 45 53 53 20 46 4f 52 20 41 20 50 41 52 54 49 43 ESS FOR A PARTIC
0180: 55 4c 41 52 0a 3b 3b 20 20 50 55 52 50 4f 53 45 ULAR.;; PURPOSE
0190: 2e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
01a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 3d 3d ==========..;;==
01e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0200: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0210: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0220: 3d 3d 3d 3d 0a 3b 3b 20 43 6f 6e 66 69 67 20 66 ====.;; Config f
0230: 69 6c 65 20 68 61 6e 64 6c 69 6e 67 0a 3b 3b 3d ile handling.;;=
0240: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0250: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0260: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0270: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0280: 3d 3d 3d 3d 3d 0a 0a 28 75 73 65 20 72 65 67 65 =====..(use rege
0290: 78 20 72 65 67 65 78 2d 63 61 73 65 29 0a 28 64 x regex-case).(d
02a0: 65 63 6c 61 72 65 20 28 75 6e 69 74 20 63 6f 6e eclare (unit con
02b0: 66 69 67 66 29 29 0a 28 64 65 63 6c 61 72 65 20 figf)).(declare
02c0: 28 75 73 65 73 20 63 6f 6d 6d 6f 6e 29 29 0a 28 (uses common)).(
02d0: 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 70 72 declare (uses pr
02e0: 6f 63 65 73 73 29 29 0a 0a 28 69 6e 63 6c 75 64 ocess))..(includ
02f0: 65 20 22 63 6f 6d 6d 6f 6e 5f 72 65 63 6f 72 64 e "common_record
0300: 73 2e 73 63 6d 22 29 0a 0a 3b 3b 20 72 65 74 75 s.scm")..;; retu
0310: 72 6e 20 6c 69 73 74 20 28 70 61 74 68 20 66 75 rn list (path fu
0320: 6c 6c 70 61 74 68 20 63 6f 6e 66 69 67 6e 61 6d llpath confignam
0330: 65 29 0a 28 64 65 66 69 6e 65 20 28 66 69 6e 64 e).(define (find
0340: 2d 63 6f 6e 66 69 67 20 63 6f 6e 66 69 67 6e 61 -config configna
0350: 6d 65 29 0a 20 20 28 6c 65 74 2a 20 28 28 63 77 me). (let* ((cw
0360: 64 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 d (string-split
0370: 28 63 75 72 72 65 6e 74 2d 64 69 72 65 63 74 6f (current-directo
0380: 72 79 29 20 22 2f 22 29 29 29 0a 20 20 20 20 28 ry) "/"))). (
0390: 6c 65 74 20 6c 6f 6f 70 20 28 28 64 69 72 20 63 let loop ((dir c
03a0: 77 64 29 29 0a 20 20 20 20 20 20 28 6c 65 74 2a wd)). (let*
03b0: 20 28 28 70 61 74 68 20 20 20 20 20 28 63 6f 6e ((path (con
03c0: 63 20 22 2f 22 20 28 73 74 72 69 6e 67 2d 69 6e c "/" (string-in
03d0: 74 65 72 73 70 65 72 73 65 20 64 69 72 20 22 2f tersperse dir "/
03e0: 22 29 29 29 0a 09 20 20 20 20 20 28 66 75 6c 6c "))).. (full
03f0: 70 61 74 68 20 28 63 6f 6e 63 20 70 61 74 68 20 path (conc path
0400: 22 2f 22 20 63 6f 6e 66 69 67 6e 61 6d 65 29 29 "/" configname))
0410: 29 0a 09 28 69 66 20 28 66 69 6c 65 2d 65 78 69 )..(if (file-exi
0420: 73 74 73 3f 20 66 75 6c 6c 70 61 74 68 29 0a 09 sts? fullpath)..
0430: 20 20 20 20 28 6c 69 73 74 20 70 61 74 68 20 66 (list path f
0440: 75 6c 6c 70 61 74 68 20 63 6f 6e 66 69 67 6e 61 ullpath configna
0450: 6d 65 29 0a 09 20 20 20 20 28 6c 65 74 20 28 28 me).. (let ((
0460: 72 65 6d 63 77 64 20 28 74 61 6b 65 20 64 69 72 remcwd (take dir
0470: 20 28 2d 20 28 6c 65 6e 67 74 68 20 64 69 72 29 (- (length dir)
0480: 20 31 29 29 29 29 0a 09 20 20 20 20 20 20 28 69 1)))).. (i
0490: 66 20 28 6e 75 6c 6c 3f 20 72 65 6d 63 77 64 29 f (null? remcwd)
04a0: 0a 09 09 20 20 28 6c 69 73 74 20 23 66 20 23 66 ... (list #f #f
04b0: 20 23 66 29 20 3b 3b 20 20 23 66 20 23 66 29 20 #f) ;; #f #f)
04c0: 0a 09 09 20 20 28 6c 6f 6f 70 20 72 65 6d 63 77 ... (loop remcw
04d0: 64 29 29 29 29 29 29 29 29 0a 0a 28 64 65 66 69 d))))))))..(defi
04e0: 6e 65 20 28 63 6f 6e 66 69 67 3a 61 73 73 6f 63 ne (config:assoc
04f0: 2d 73 61 66 65 2d 61 64 64 20 61 6c 69 73 74 20 -safe-add alist
0500: 6b 65 79 20 76 61 6c 29 0a 20 20 28 6c 65 74 20 key val). (let
0510: 28 28 6e 65 77 61 6c 69 73 74 20 28 66 69 6c 74 ((newalist (filt
0520: 65 72 20 28 6c 61 6d 62 64 61 20 28 78 29 28 6e er (lambda (x)(n
0530: 6f 74 20 28 65 71 75 61 6c 3f 20 6b 65 79 20 28 ot (equal? key (
0540: 63 61 72 20 78 29 29 29 29 20 61 6c 69 73 74 29 car x)))) alist)
0550: 29 29 0a 20 20 20 20 28 61 70 70 65 6e 64 20 6e )). (append n
0560: 65 77 61 6c 69 73 74 20 28 6c 69 73 74 20 28 6c ewalist (list (l
0570: 69 73 74 20 6b 65 79 20 76 61 6c 29 29 29 29 29 ist key val)))))
0580: 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 ..(define (confi
0590: 67 3a 65 76 61 6c 2d 73 74 72 69 6e 67 2d 69 6e g:eval-string-in
05a0: 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 73 74 72 -environment str
05b0: 29 0a 20 20 28 6c 65 74 20 28 28 63 6d 64 72 65 ). (let ((cmdre
05c0: 73 20 28 63 6d 64 2d 72 75 6e 2d 3e 6c 69 73 74 s (cmd-run->list
05d0: 20 28 63 6f 6e 63 20 22 65 63 68 6f 20 22 20 73 (conc "echo " s
05e0: 74 72 29 29 29 29 0a 20 20 20 20 28 69 66 20 28 tr)))). (if (
05f0: 6e 75 6c 6c 3f 20 63 6d 64 72 65 73 29 20 22 22 null? cmdres) ""
0600: 0a 09 28 63 61 61 72 20 63 6d 64 72 65 73 29 29 ..(caar cmdres))
0610: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
0620: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0630: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0640: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0650: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
0660: 4d 61 6b 65 20 74 68 65 20 72 65 67 65 78 70 27 Make the regexp'
0670: 73 20 6e 65 65 64 65 64 20 67 6c 6f 62 61 6c 6c s needed globall
0680: 79 20 61 76 61 69 6c 61 62 6c 65 0a 3b 3b 3d 3d y available.;;==
0690: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
06a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
06b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
06c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
06d0: 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 63 6f ====..(define co
06e0: 6e 66 69 67 66 3a 69 6e 63 6c 75 64 65 2d 72 78 nfigf:include-rx
06f0: 20 28 72 65 67 65 78 70 20 22 5e 5c 5c 5b 69 6e (regexp "^\\[in
0700: 63 6c 75 64 65 5c 5c 73 2b 28 2e 2a 29 5c 5c 5d clude\\s+(.*)\\]
0710: 5c 5c 73 2a 24 22 29 29 0a 28 64 65 66 69 6e 65 \\s*$")).(define
0720: 20 63 6f 6e 66 69 67 66 3a 73 65 63 74 69 6f 6e configf:section
0730: 2d 72 78 20 28 72 65 67 65 78 70 20 22 5e 5c 5c -rx (regexp "^\\
0740: 5b 28 2e 2a 29 5c 5c 5d 5c 5c 73 2a 24 22 29 29 [(.*)\\]\\s*$"))
0750: 0a 28 64 65 66 69 6e 65 20 63 6f 6e 66 69 67 66 .(define configf
0760: 3a 62 6c 61 6e 6b 2d 6c 2d 72 78 20 28 72 65 67 :blank-l-rx (reg
0770: 65 78 70 20 22 5e 5c 5c 73 2a 24 22 29 29 0a 28 exp "^\\s*$")).(
0780: 64 65 66 69 6e 65 20 63 6f 6e 66 69 67 66 3a 6b define configf:k
0790: 65 79 2d 73 79 73 2d 70 72 20 28 72 65 67 65 78 ey-sys-pr (regex
07a0: 70 20 22 5e 28 5c 5c 53 2b 29 5c 5c 73 2b 5c 5c p "^(\\S+)\\s+\\
07b0: 5b 73 79 73 74 65 6d 5c 5c 73 2b 28 5c 5c 53 2b [system\\s+(\\S+
07c0: 2e 2a 29 5c 5c 5d 5c 5c 73 2a 24 22 29 29 0a 28 .*)\\]\\s*$")).(
07d0: 64 65 66 69 6e 65 20 63 6f 6e 66 69 67 66 3a 6b define configf:k
07e0: 65 79 2d 76 61 6c 2d 70 72 20 28 72 65 67 65 78 ey-val-pr (regex
07f0: 70 20 22 5e 28 5c 5c 53 2b 29 5c 5c 73 2b 28 2e p "^(\\S+)\\s+(.
0800: 2a 29 24 22 29 29 0a 28 64 65 66 69 6e 65 20 63 *)$")).(define c
0810: 6f 6e 66 69 67 66 3a 63 6f 6d 6d 65 6e 74 2d 72 onfigf:comment-r
0820: 78 20 28 72 65 67 65 78 70 20 22 5e 5c 5c 73 2a x (regexp "^\\s*
0830: 23 2e 2a 22 29 29 0a 28 64 65 66 69 6e 65 20 63 #.*")).(define c
0840: 6f 6e 66 69 67 66 3a 63 6f 6e 74 2d 6c 6e 2d 72 onfigf:cont-ln-r
0850: 78 20 28 72 65 67 65 78 70 20 22 5e 28 5c 5c 73 x (regexp "^(\\s
0860: 2b 29 28 5c 5c 53 2b 2e 2a 29 24 22 29 29 0a 0a +)(\\S+.*)$"))..
0870: 3b 3b 20 72 65 61 64 20 61 20 6c 69 6e 65 20 61 ;; read a line a
0880: 6e 64 20 70 72 6f 63 65 73 73 20 61 6e 79 20 23 nd process any #
0890: 7b 20 2e 2e 2e 20 7d 20 63 6f 6e 73 74 72 75 63 { ... } construc
08a0: 74 73 0a 0a 28 64 65 66 69 6e 65 20 63 6f 6e 66 ts..(define conf
08b0: 69 67 66 3a 76 61 72 2d 65 78 70 61 6e 64 2d 72 igf:var-expand-r
08c0: 65 67 65 78 20 28 72 65 67 65 78 70 20 22 5e 28 egex (regexp "^(
08d0: 2e 2a 29 23 5c 5c 7b 28 73 63 68 65 6d 65 7c 73 .*)#\\{(scheme|s
08e0: 79 73 74 65 6d 7c 73 68 65 6c 6c 7c 67 65 74 65 ystem|shell|gete
08f0: 6e 76 7c 67 65 74 7c 72 75 6e 63 6f 6e 66 69 67 nv|get|runconfig
0900: 73 2d 67 65 74 29 5c 5c 73 2b 28 5b 5e 5c 5c 7d s-get)\\s+([^\\}
0910: 5c 5c 7b 5d 2a 29 5c 5c 7d 28 2e 2a 29 22 29 29 \\{]*)\\}(.*)"))
0920: 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 .(define (config
0930: 66 3a 70 72 6f 63 65 73 73 2d 6c 69 6e 65 20 6c f:process-line l
0940: 20 68 74 29 0a 20 20 28 6c 65 74 20 6c 6f 6f 70 ht). (let loop
0950: 20 28 28 72 65 73 20 6c 29 29 0a 20 20 20 20 28 ((res l)). (
0960: 69 66 20 28 73 74 72 69 6e 67 3f 20 72 65 73 29 if (string? res)
0970: 0a 09 28 6c 65 74 20 28 28 6d 61 74 63 68 64 61 ..(let ((matchda
0980: 74 20 28 73 74 72 69 6e 67 2d 73 65 61 72 63 68 t (string-search
0990: 20 63 6f 6e 66 69 67 66 3a 76 61 72 2d 65 78 70 configf:var-exp
09a0: 61 6e 64 2d 72 65 67 65 78 20 72 65 73 29 29 29 and-regex res)))
09b0: 0a 09 20 20 28 69 66 20 6d 61 74 63 68 64 61 74 .. (if matchdat
09c0: 0a 09 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 .. (let* ((
09d0: 70 72 65 73 74 72 20 20 28 6c 69 73 74 2d 72 65 prestr (list-re
09e0: 66 20 6d 61 74 63 68 64 61 74 20 31 29 29 0a 09 f matchdat 1))..
09f0: 09 20 20 20 20 20 28 63 6d 64 74 79 70 65 20 28 . (cmdtype (
0a00: 6c 69 73 74 2d 72 65 66 20 6d 61 74 63 68 64 61 list-ref matchda
0a10: 74 20 32 29 29 20 3b 3b 20 65 76 61 6c 2c 20 73 t 2)) ;; eval, s
0a20: 79 73 74 65 6d 2c 20 73 68 65 6c 6c 2c 20 67 65 ystem, shell, ge
0a30: 74 65 6e 76 0a 09 09 20 20 20 20 20 28 63 6d 64 tenv... (cmd
0a40: 20 20 20 20 20 28 6c 69 73 74 2d 72 65 66 20 6d (list-ref m
0a50: 61 74 63 68 64 61 74 20 33 29 29 0a 09 09 20 20 atchdat 3))...
0a60: 20 20 20 28 70 6f 73 74 73 74 72 20 28 6c 69 73 (poststr (lis
0a70: 74 2d 72 65 66 20 6d 61 74 63 68 64 61 74 20 34 t-ref matchdat 4
0a80: 29 29 0a 09 09 20 20 20 20 20 28 72 65 73 75 6c ))... (resul
0a90: 74 20 20 23 66 29 0a 09 09 20 20 20 20 20 28 66 t #f)... (f
0aa0: 75 6c 6c 63 6d 64 20 28 63 61 73 65 20 28 73 74 ullcmd (case (st
0ab0: 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 63 6d 64 ring->symbol cmd
0ac0: 74 79 70 65 29 0a 09 09 09 09 28 28 73 63 68 65 type).....((sche
0ad0: 6d 65 29 28 63 6f 6e 63 20 22 28 6c 61 6d 62 64 me)(conc "(lambd
0ae0: 61 20 28 68 74 29 22 20 63 6d 64 20 22 29 22 29 a (ht)" cmd ")")
0af0: 29 0a 09 09 09 09 28 28 73 79 73 74 65 6d 29 28 ).....((system)(
0b00: 63 6f 6e 63 20 22 28 6c 61 6d 62 64 61 20 28 68 conc "(lambda (h
0b10: 74 29 28 73 79 73 74 65 6d 20 5c 22 22 20 63 6d t)(system \"" cm
0b20: 64 20 22 5c 22 29 29 22 29 29 0a 09 09 09 09 28 d "\"))")).....(
0b30: 28 73 68 65 6c 6c 29 20 28 63 6f 6e 63 20 22 28 (shell) (conc "(
0b40: 6c 61 6d 62 64 61 20 28 68 74 29 28 73 68 65 6c lambda (ht)(shel
0b50: 6c 20 5c 22 22 20 20 63 6d 64 20 22 5c 22 29 29 l \"" cmd "\"))
0b60: 22 29 29 0a 09 09 09 09 28 28 67 65 74 65 6e 76 ")).....((getenv
0b70: 29 28 63 6f 6e 63 20 22 28 6c 61 6d 62 64 61 20 )(conc "(lambda
0b80: 28 68 74 29 28 67 65 74 2d 65 6e 76 69 72 6f 6e (ht)(get-environ
0b90: 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 5c 22 ment-variable \"
0ba0: 22 20 63 6d 64 20 22 5c 22 29 29 22 29 29 0a 09 " cmd "\"))"))..
0bb0: 09 09 09 28 28 67 65 74 29 20 20 20 0a 09 09 09 ...((get) ....
0bc0: 09 20 28 6c 65 74 2a 20 28 28 70 61 72 74 73 20 . (let* ((parts
0bd0: 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 63 6d (string-split cm
0be0: 64 29 29 0a 09 09 09 09 09 28 73 65 63 74 20 20 d))......(sect
0bf0: 28 63 61 72 20 70 61 72 74 73 29 29 0a 09 09 09 (car parts))....
0c00: 09 09 28 76 61 72 20 20 20 28 63 61 64 72 20 70 ..(var (cadr p
0c10: 61 72 74 73 29 29 29 0a 09 09 09 09 20 20 20 28 arts)))..... (
0c20: 63 6f 6e 63 20 22 28 6c 61 6d 62 64 61 20 28 68 conc "(lambda (h
0c30: 74 29 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 t)(config-lookup
0c40: 20 68 74 20 5c 22 22 20 73 65 63 74 20 22 5c 22 ht \"" sect "\"
0c50: 20 5c 22 22 20 76 61 72 20 22 5c 22 29 29 22 29 \"" var "\"))")
0c60: 29 29 0a 09 09 09 09 28 28 72 75 6e 63 6f 6e 66 )).....((runconf
0c70: 69 67 73 2d 67 65 74 29 20 28 63 6f 6e 63 20 22 igs-get) (conc "
0c80: 28 6c 61 6d 62 64 61 20 28 68 74 29 28 72 75 6e (lambda (ht)(run
0c90: 63 6f 6e 66 69 67 73 2d 67 65 74 20 68 74 20 5c configs-get ht \
0ca0: 22 22 20 63 6d 64 20 22 5c 22 29 29 22 29 29 0a "" cmd "\"))")).
0cb0: 09 09 09 09 28 65 6c 73 65 20 22 28 6c 61 6d 62 ....(else "(lamb
0cc0: 64 61 20 28 68 74 29 28 70 72 69 6e 74 20 5c 22 da (ht)(print \"
0cd0: 45 52 52 4f 52 5c 22 29 20 5c 22 45 52 52 4f 52 ERROR\") \"ERROR
0ce0: 5c 22 29 22 29 29 29 29 0a 09 09 3b 3b 20 28 70 \")"))))...;; (p
0cf0: 72 69 6e 74 20 22 66 75 6c 6c 63 6d 64 3d 22 20 rint "fullcmd="
0d00: 66 75 6c 6c 63 6d 64 29 0a 09 09 28 77 69 74 68 fullcmd)...(with
0d10: 2d 69 6e 70 75 74 2d 66 72 6f 6d 2d 73 74 72 69 -input-from-stri
0d20: 6e 67 20 66 75 6c 6c 63 6d 64 0a 09 09 20 20 28 ng fullcmd... (
0d30: 6c 61 6d 62 64 61 20 28 29 0a 09 09 20 20 20 20 lambda ()...
0d40: 28 73 65 74 21 20 72 65 73 75 6c 74 20 28 28 65 (set! result ((e
0d50: 76 61 6c 20 28 72 65 61 64 29 29 20 68 74 29 29 val (read)) ht))
0d60: 29 29 0a 09 09 28 6c 6f 6f 70 20 28 63 6f 6e 63 ))...(loop (conc
0d70: 20 70 72 65 73 74 72 20 72 65 73 75 6c 74 20 70 prestr result p
0d80: 6f 73 74 73 74 72 29 29 29 0a 09 20 20 20 20 20 oststr)))..
0d90: 20 72 65 73 29 29 0a 09 72 65 73 29 29 29 0a 0a res))..res)))..
0da0: 3b 3b 20 52 75 6e 20 61 20 73 68 65 6c 6c 20 63 ;; Run a shell c
0db0: 6f 6d 6d 61 6e 64 20 61 6e 64 20 72 65 74 75 72 ommand and retur
0dc0: 6e 20 74 68 65 20 6f 75 74 70 75 74 20 61 73 20 n the output as
0dd0: 61 20 73 74 72 69 6e 67 0a 28 64 65 66 69 6e 65 a string.(define
0de0: 20 28 73 68 65 6c 6c 20 63 6d 64 29 0a 20 20 28 (shell cmd). (
0df0: 6c 65 74 2a 20 28 28 6f 75 74 70 75 74 20 28 63 let* ((output (c
0e00: 6d 64 2d 72 75 6e 2d 3e 6c 69 73 74 20 63 6d 64 md-run->list cmd
0e10: 29 29 0a 09 20 28 72 65 73 20 20 20 20 28 63 61 )).. (res (ca
0e20: 72 20 6f 75 74 70 75 74 29 29 0a 09 20 28 73 74 r output)).. (st
0e30: 61 74 75 73 20 28 63 61 64 72 20 6f 75 74 70 75 atus (cadr outpu
0e40: 74 29 29 29 0a 20 20 20 20 28 69 66 20 28 65 71 t))). (if (eq
0e50: 75 61 6c 3f 20 73 74 61 74 75 73 20 30 29 0a 09 ual? status 0)..
0e60: 28 6c 65 74 20 28 28 6f 75 74 72 65 73 20 28 73 (let ((outres (s
0e70: 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 tring-interspers
0e80: 65 20 0a 09 09 20 20 20 20 20 20 20 72 65 73 0a e ... res.
0e90: 09 09 20 20 20 20 20 20 20 22 5c 6e 22 29 29 29 .. "\n")))
0ea0: 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 .. (debug:print
0eb0: 20 34 20 22 49 4e 46 4f 3a 20 73 68 65 6c 6c 20 4 "INFO: shell
0ec0: 72 65 73 75 6c 74 3a 5c 6e 22 20 6f 75 74 72 65 result:\n" outre
0ed0: 73 29 0a 09 20 20 6f 75 74 72 65 73 29 0a 09 28 s).. outres)..(
0ee0: 62 65 67 69 6e 0a 09 20 20 28 77 69 74 68 2d 6f begin.. (with-o
0ef0: 75 74 70 75 74 2d 74 6f 2d 70 6f 72 74 20 28 63 utput-to-port (c
0f00: 75 72 72 65 6e 74 2d 65 72 72 6f 72 2d 70 6f 72 urrent-error-por
0f10: 74 29 0a 09 20 20 20 20 28 70 72 69 6e 74 20 22 t).. (print "
0f20: 45 52 52 4f 52 3a 20 22 20 63 6d 64 20 22 20 72 ERROR: " cmd " r
0f30: 65 74 75 72 6e 65 64 20 62 61 64 20 65 78 69 74 eturned bad exit
0f40: 20 63 6f 64 65 20 22 20 73 74 61 74 75 73 29 29 code " status))
0f50: 0a 09 20 20 22 22 29 29 29 29 0a 0a 3b 3b 20 4c .. ""))))..;; L
0f60: 6f 6f 6b 75 70 20 61 20 76 61 6c 75 65 20 69 6e ookup a value in
0f70: 20 72 75 6e 63 6f 6e 66 69 67 73 20 62 61 73 65 runconfigs base
0f80: 64 20 6f 6e 20 2d 72 65 71 74 61 72 67 20 6f 72 d on -reqtarg or
0f90: 20 2d 74 61 72 67 65 74 0a 28 64 65 66 69 6e 65 -target.(define
0fa0: 20 28 72 75 6e 63 6f 6e 66 69 67 73 2d 67 65 74 (runconfigs-get
0fb0: 20 63 6f 6e 66 69 67 20 76 61 72 29 0a 20 20 28 config var). (
0fc0: 6c 65 74 20 28 28 74 61 72 67 20 28 6f 72 20 28 let ((targ (or (
0fd0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
0fe0: 65 71 74 61 72 67 22 29 28 61 72 67 73 3a 67 65 eqtarg")(args:ge
0ff0: 74 2d 61 72 67 20 22 2d 74 61 72 67 65 74 22 29 t-arg "-target")
1000: 29 29 29 0a 20 20 20 20 28 69 66 20 74 61 72 67 ))). (if targ
1010: 0a 09 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 ..(config-lookup
1020: 20 63 6f 6e 66 69 67 20 74 61 72 67 20 76 61 72 config targ var
1030: 29 0a 09 23 66 29 29 29 0a 0a 28 64 65 66 69 6e )..#f)))..(defin
1040: 65 2d 69 6e 6c 69 6e 65 20 28 63 6f 6e 66 69 67 e-inline (config
1050: 66 3a 72 65 61 64 2d 6c 69 6e 65 20 70 20 68 74 f:read-line p ht
1060: 29 0a 20 20 28 63 6f 6e 66 69 67 66 3a 70 72 6f ). (configf:pro
1070: 63 65 73 73 2d 6c 69 6e 65 20 28 72 65 61 64 2d cess-line (read-
1080: 6c 69 6e 65 20 70 29 20 68 74 29 29 0a 0a 3b 3b line p) ht))..;;
1090: 20 72 65 61 64 20 61 20 63 6f 6e 66 69 67 20 66 read a config f
10a0: 69 6c 65 2c 20 72 65 74 75 72 6e 73 20 68 61 73 ile, returns has
10b0: 68 20 74 61 62 6c 65 20 6f 66 20 61 6c 69 73 74 h table of alist
10c0: 73 0a 0a 3b 3b 20 72 65 61 64 20 61 20 63 6f 6e s..;; read a con
10d0: 66 69 67 20 66 69 6c 65 2c 20 72 65 74 75 72 6e fig file, return
10e0: 73 20 68 61 73 68 20 74 61 62 6c 65 20 6f 66 20 s hash table of
10f0: 61 6c 69 73 74 73 0a 3b 3b 20 61 64 64 73 20 74 alists.;; adds t
1100: 6f 20 68 74 20 69 66 20 67 69 76 65 6e 20 28 6d o ht if given (m
1110: 75 73 74 20 62 65 20 23 66 20 6f 74 68 65 72 77 ust be #f otherw
1120: 69 73 65 29 0a 3b 3b 20 65 6e 76 69 6f 6e 2d 70 ise).;; envion-p
1130: 61 74 74 20 69 73 20 61 20 72 65 67 65 78 20 73 att is a regex s
1140: 70 65 63 20 74 68 61 74 20 69 64 65 6e 74 69 66 pec that identif
1150: 69 65 73 20 73 65 63 74 69 6f 6e 73 20 74 68 61 ies sections tha
1160: 74 20 77 69 6c 6c 20 62 65 20 65 76 61 6c 27 64 t will be eval'd
1170: 0a 3b 3b 20 69 6e 20 74 68 65 20 65 6e 76 69 72 .;; in the envir
1180: 6f 6e 6d 65 6e 74 20 6f 6e 20 74 68 65 20 66 6c onment on the fl
1190: 79 0a 0a 28 64 65 66 69 6e 65 20 28 72 65 61 64 y..(define (read
11a0: 2d 63 6f 6e 66 69 67 20 70 61 74 68 20 68 74 20 -config path ht
11b0: 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 23 21 6b allow-system #!k
11c0: 65 79 20 28 65 6e 76 69 72 6f 6e 2d 70 61 74 74 ey (environ-patt
11d0: 20 23 66 29 28 63 75 72 72 2d 73 65 63 74 69 6f #f)(curr-sectio
11e0: 6e 20 23 66 29 29 0a 20 20 28 64 65 62 75 67 3a n #f)). (debug:
11f0: 70 72 69 6e 74 20 34 20 22 49 4e 46 4f 3a 20 72 print 4 "INFO: r
1200: 65 61 64 2d 63 6f 6e 66 69 67 20 22 20 70 61 74 ead-config " pat
1210: 68 20 22 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d h " allow-system
1220: 20 22 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 " allow-system
1230: 22 20 65 6e 76 69 72 6f 6e 2d 70 61 74 74 20 22 " environ-patt "
1240: 20 65 6e 76 69 72 6f 6e 2d 70 61 74 74 20 22 20 environ-patt "
1250: 63 75 72 72 2d 73 65 63 74 69 6f 6e 3a 20 22 20 curr-section: "
1260: 63 75 72 72 2d 73 65 63 74 69 6f 6e 29 0a 20 20 curr-section).
1270: 28 69 66 20 28 6e 6f 74 20 28 66 69 6c 65 2d 65 (if (not (file-e
1280: 78 69 73 74 73 3f 20 70 61 74 68 29 29 0a 20 20 xists? path)).
1290: 20 20 20 20 28 62 65 67 69 6e 20 0a 09 28 64 65 (begin ..(de
12a0: 62 75 67 3a 70 72 69 6e 74 20 34 20 22 49 4e 46 bug:print 4 "INF
12b0: 4f 3a 20 72 65 61 64 2d 63 6f 6e 66 69 67 20 2d O: read-config -
12c0: 20 66 69 6c 65 20 6e 6f 74 20 66 6f 75 6e 64 20 file not found
12d0: 22 20 70 61 74 68 20 22 20 63 75 72 72 65 6e 74 " path " current
12e0: 20 70 61 74 68 3a 20 22 20 28 63 75 72 72 65 6e path: " (curren
12f0: 74 2d 64 69 72 65 63 74 6f 72 79 29 29 0a 09 28 t-directory))..(
1300: 69 66 20 28 6e 6f 74 20 68 74 29 28 6d 61 6b 65 if (not ht)(make
1310: 2d 68 61 73 68 2d 74 61 62 6c 65 29 20 68 74 29 -hash-table) ht)
1320: 29 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 69 ). (let ((i
1330: 6e 70 20 20 20 20 20 20 20 20 28 6f 70 65 6e 2d np (open-
1340: 69 6e 70 75 74 2d 66 69 6c 65 20 70 61 74 68 29 input-file path)
1350: 29 0a 09 20 20 20 20 28 72 65 73 20 20 20 20 20 ).. (res
1360: 20 20 20 28 69 66 20 28 6e 6f 74 20 68 74 29 28 (if (not ht)(
1370: 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 make-hash-table)
1380: 20 68 74 29 29 29 0a 09 28 6c 65 74 20 6c 6f 6f ht)))..(let loo
1390: 70 20 28 28 69 6e 6c 20 20 20 20 20 20 20 20 20 p ((inl
13a0: 20 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 72 (configf:r
13b0: 65 61 64 2d 6c 69 6e 65 20 69 6e 70 20 72 65 73 ead-line inp res
13c0: 29 29 20 3b 3b 20 28 72 65 61 64 2d 6c 69 6e 65 )) ;; (read-line
13d0: 20 69 6e 70 29 29 0a 09 09 20 20 20 28 63 75 72 inp))... (cur
13e0: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 28 r-section-name (
13f0: 69 66 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 20 if curr-section
1400: 63 75 72 72 2d 73 65 63 74 69 6f 6e 20 22 64 65 curr-section "de
1410: 66 61 75 6c 74 22 29 29 0a 09 09 20 20 20 28 76 fault"))... (v
1420: 61 72 2d 66 6c 61 67 20 23 66 29 3b 3b 20 74 75 ar-flag #f);; tu
1430: 72 6e 20 6f 6e 20 66 6f 72 20 6b 65 79 2d 76 61 rn on for key-va
1440: 72 2d 70 72 20 61 6e 64 20 63 6f 6e 74 2d 6c 6e r-pr and cont-ln
1450: 2d 72 78 2c 20 74 75 72 6e 20 6f 66 66 20 65 6c -rx, turn off el
1460: 73 65 77 68 65 72 65 0a 09 09 20 20 20 28 6c 65 sewhere... (le
1470: 61 64 20 20 20 20 20 23 66 29 29 0a 09 20 20 28 ad #f)).. (
1480: 69 66 20 28 65 6f 66 2d 6f 62 6a 65 63 74 3f 20 if (eof-object?
1490: 69 6e 6c 29 20 0a 09 20 20 20 20 20 20 28 62 65 inl) .. (be
14a0: 67 69 6e 0a 09 09 28 63 6c 6f 73 65 2d 69 6e 70 gin...(close-inp
14b0: 75 74 2d 70 6f 72 74 20 69 6e 70 29 0a 09 09 72 ut-port inp)...r
14c0: 65 73 29 0a 09 20 20 20 20 20 20 28 72 65 67 65 es).. (rege
14d0: 78 2d 63 61 73 65 20 0a 09 20 20 20 20 20 20 20 x-case ..
14e0: 69 6e 6c 20 0a 09 20 20 20 20 20 20 20 28 63 6f inl .. (co
14f0: 6e 66 69 67 66 3a 63 6f 6d 6d 65 6e 74 2d 72 78 nfigf:comment-rx
1500: 20 5f 20 20 20 20 20 20 20 20 20 20 20 20 20 20 _
1510: 20 20 20 20 28 6c 6f 6f 70 20 28 63 6f 6e 66 69 (loop (confi
1520: 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 gf:read-line inp
1530: 20 72 65 73 29 20 63 75 72 72 2d 73 65 63 74 69 res) curr-secti
1540: 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 66 29 29 0a on-name #f #f)).
1550: 09 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 66 . (configf
1560: 3a 62 6c 61 6e 6b 2d 6c 2d 72 78 20 5f 20 20 20 :blank-l-rx _
1570: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
1580: 6c 6f 6f 70 20 28 63 6f 6e 66 69 67 66 3a 72 65 loop (configf:re
1590: 61 64 2d 6c 69 6e 65 20 69 6e 70 20 72 65 73 29 ad-line inp res)
15a0: 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 curr-section-na
15b0: 6d 65 20 23 66 20 23 66 29 29 0a 09 20 20 20 20 me #f #f))..
15c0: 20 20 20 28 63 6f 6e 66 69 67 66 3a 69 6e 63 6c (configf:incl
15d0: 75 64 65 2d 72 78 20 28 20 78 20 69 6e 63 6c 75 ude-rx ( x inclu
15e0: 64 65 2d 66 69 6c 65 20 29 20 28 6c 65 74 20 28 de-file ) (let (
15f0: 28 63 75 72 72 2d 64 69 72 20 28 63 75 72 72 65 (curr-dir (curre
1600: 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 29 0a 09 nt-directory))..
1610: 09 09 09 09 09 09 20 20 20 20 28 63 6f 6e 66 2d ...... (conf-
1620: 64 69 72 20 20 28 70 61 74 68 6e 61 6d 65 2d 64 dir (pathname-d
1630: 69 72 65 63 74 6f 72 79 20 70 61 74 68 29 29 29 irectory path)))
1640: 0a 09 09 09 09 09 09 09 28 69 66 20 63 6f 6e 66 ........(if conf
1650: 2d 64 69 72 20 28 63 68 61 6e 67 65 2d 64 69 72 -dir (change-dir
1660: 65 63 74 6f 72 79 20 63 6f 6e 66 2d 64 69 72 29 ectory conf-dir)
1670: 29 0a 09 09 09 09 09 09 09 28 72 65 61 64 2d 63 )........(read-c
1680: 6f 6e 66 69 67 20 69 6e 63 6c 75 64 65 2d 66 69 onfig include-fi
1690: 6c 65 20 72 65 73 20 61 6c 6c 6f 77 2d 73 79 73 le res allow-sys
16a0: 74 65 6d 20 65 6e 76 69 72 6f 6e 2d 70 61 74 74 tem environ-patt
16b0: 3a 20 65 6e 76 69 72 6f 6e 2d 70 61 74 74 20 63 : environ-patt c
16c0: 75 72 72 2d 73 65 63 74 69 6f 6e 3a 20 63 75 72 urr-section: cur
16d0: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 29 0a r-section-name).
16e0: 09 09 09 09 09 09 09 28 63 68 61 6e 67 65 2d 64 .......(change-d
16f0: 69 72 65 63 74 6f 72 79 20 63 75 72 72 2d 64 69 irectory curr-di
1700: 72 29 0a 09 09 09 09 09 09 09 28 6c 6f 6f 70 20 r)........(loop
1710: 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d 6c 69 (configf:read-li
1720: 6e 65 20 69 6e 70 20 72 65 73 29 20 63 75 72 72 ne inp res) curr
1730: 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 -section-name #f
1740: 20 23 66 29 29 29 0a 09 20 20 20 20 20 20 20 28 #f))).. (
1750: 63 6f 6e 66 69 67 66 3a 73 65 63 74 69 6f 6e 2d configf:section-
1760: 72 78 20 28 20 78 20 73 65 63 74 69 6f 6e 2d 6e rx ( x section-n
1770: 61 6d 65 20 29 20 28 6c 6f 6f 70 20 28 63 6f 6e ame ) (loop (con
1780: 66 69 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 figf:read-line i
1790: 6e 70 20 72 65 73 29 20 73 65 63 74 69 6f 6e 2d np res) section-
17a0: 6e 61 6d 65 20 23 66 20 23 66 29 29 0a 09 20 20 name #f #f))..
17b0: 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 6b 65 (configf:ke
17c0: 79 2d 73 79 73 2d 70 72 20 28 20 78 20 6b 65 79 y-sys-pr ( x key
17d0: 20 63 6d 64 20 20 20 20 20 20 29 20 28 69 66 20 cmd ) (if
17e0: 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 0a 09 09 09 allow-system....
17f0: 09 09 09 09 20 20 28 6c 65 74 20 28 28 61 6c 69 .... (let ((ali
1800: 73 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 st (hash-table-r
1810: 65 66 2f 64 65 66 61 75 6c 74 20 72 65 73 20 63 ef/default res c
1820: 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 urr-section-name
1830: 20 27 28 29 29 29 0a 09 09 09 09 09 09 09 09 28 '())).........(
1840: 76 61 6c 2d 70 72 6f 63 20 28 6c 61 6d 62 64 61 val-proc (lambda
1850: 20 28 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 ()..........
1860: 20 28 6c 65 74 2a 20 28 28 63 6d 64 72 65 73 20 (let* ((cmdres
1870: 20 28 63 6d 64 2d 72 75 6e 2d 3e 6c 69 73 74 20 (cmd-run->list
1880: 63 6d 64 29 29 0a 09 09 09 09 09 09 09 09 09 09 cmd))...........
1890: 20 20 20 28 73 74 61 74 75 73 20 20 28 63 61 64 (status (cad
18a0: 72 20 63 6d 64 72 65 73 29 29 0a 09 09 09 09 09 r cmdres))......
18b0: 09 09 09 09 09 20 20 20 28 72 65 73 20 20 20 20 ..... (res
18c0: 20 28 63 61 72 20 20 63 6d 64 72 65 73 29 29 29 (car cmdres)))
18d0: 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 20 20 ..........
18e0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 22 (debug:print 4 "
18f0: 49 4e 46 4f 3a 20 22 20 69 6e 6c 20 22 5c 6e 20 INFO: " inl "\n
1900: 3d 3e 20 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 => " (string-int
1910: 65 72 73 70 65 72 73 65 20 72 65 73 20 22 5c 6e ersperse res "\n
1920: 22 29 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 "))..........
1930: 20 20 20 28 69 66 20 28 6e 6f 74 20 28 65 71 3f (if (not (eq?
1940: 20 73 74 61 74 75 73 20 30 29 29 0a 09 09 09 09 status 0)).....
1950: 09 09 09 09 09 09 20 20 28 62 65 67 69 6e 0a 09 ...... (begin..
1960: 09 09 09 09 09 09 09 09 09 20 20 20 20 28 64 65 ......... (de
1970: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 bug:print 0 "ERR
1980: 4f 52 3a 20 70 72 6f 62 6c 65 6d 20 77 69 74 68 OR: problem with
1990: 20 22 20 69 6e 6c 20 22 2c 20 72 65 74 75 72 6e " inl ", return
19a0: 20 63 6f 64 65 20 22 20 73 74 61 74 75 73 0a 09 code " status..
19b0: 09 09 09 09 09 09 09 09 09 09 09 20 22 20 6f 75 ........... " ou
19c0: 74 70 75 74 3a 20 22 20 63 6d 64 72 65 73 29 0a tput: " cmdres).
19d0: 09 09 09 09 09 09 09 09 09 09 20 20 20 20 28 65 .......... (e
19e0: 78 69 74 20 31 29 29 29 0a 09 09 09 09 09 09 09 xit 1)))........
19f0: 09 09 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c .. (if (nul
1a00: 6c 3f 20 72 65 73 29 0a 09 09 09 09 09 09 09 09 l? res).........
1a10: 09 09 20 20 22 22 0a 09 09 09 09 09 09 09 09 09 .. ""..........
1a20: 09 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 . (string-inter
1a30: 73 70 65 72 73 65 20 72 65 73 20 22 20 22 29 29 sperse res " "))
1a40: 29 29 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 ))))........
1a50: 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 (hash-table-set!
1a60: 20 72 65 73 20 63 75 72 72 2d 73 65 63 74 69 6f res curr-sectio
1a70: 6e 2d 6e 61 6d 65 20 0a 09 09 09 09 09 09 09 09 n-name .........
1a80: 09 20 20 20 20 20 28 63 6f 6e 66 69 67 3a 61 73 . (config:as
1a90: 73 6f 63 2d 73 61 66 65 2d 61 64 64 20 61 6c 69 soc-safe-add ali
1aa0: 73 74 0a 09 09 09 09 09 09 09 09 09 09 09 09 20 st.............
1ab0: 20 20 20 6b 65 79 20 0a 09 09 09 09 09 09 09 09 key .........
1ac0: 09 09 09 09 20 20 20 20 28 63 61 73 65 20 61 6c .... (case al
1ad0: 6c 6f 77 2d 73 79 73 74 65 6d 0a 09 09 09 09 09 low-system......
1ae0: 09 09 09 09 09 09 09 20 20 20 20 20 20 28 28 72 ....... ((r
1af0: 65 74 75 72 6e 2d 70 72 6f 63 73 29 20 76 61 6c eturn-procs) val
1b00: 2d 70 72 6f 63 29 0a 09 09 09 09 09 09 09 09 09 -proc)..........
1b10: 09 09 09 20 20 20 20 20 20 28 28 72 65 74 75 72 ... ((retur
1b20: 6e 2d 73 74 72 69 6e 67 29 20 63 6d 64 29 0a 09 n-string) cmd)..
1b30: 09 09 09 09 09 09 09 09 09 09 09 20 20 20 20 20 ...........
1b40: 20 28 65 6c 73 65 20 28 76 61 6c 2d 70 72 6f 63 (else (val-proc
1b50: 29 29 29 29 29 0a 09 09 09 09 09 09 09 20 20 20 )))))........
1b60: 20 28 6c 6f 6f 70 20 28 63 6f 6e 66 69 67 66 3a (loop (configf:
1b70: 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 20 72 65 read-line inp re
1b80: 73 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d s) curr-section-
1b90: 6e 61 6d 65 20 23 66 20 23 66 29 29 0a 09 09 09 name #f #f))....
1ba0: 09 09 09 09 20 20 28 6c 6f 6f 70 20 28 63 6f 6e .... (loop (con
1bb0: 66 69 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 figf:read-line i
1bc0: 6e 70 20 72 65 73 29 20 63 75 72 72 2d 73 65 63 np res) curr-sec
1bd0: 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 66 29 tion-name #f #f)
1be0: 29 29 0a 09 20 20 20 20 20 20 20 28 63 6f 6e 66 )).. (conf
1bf0: 69 67 66 3a 6b 65 79 2d 76 61 6c 2d 70 72 20 28 igf:key-val-pr (
1c00: 20 78 20 6b 65 79 20 76 61 6c 20 20 20 20 20 20 x key val
1c10: 29 20 28 6c 65 74 2a 20 28 28 61 6c 69 73 74 20 ) (let* ((alist
1c20: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 (hash-table-re
1c30: 66 2f 64 65 66 61 75 6c 74 20 72 65 73 20 63 75 f/default res cu
1c40: 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 rr-section-name
1c50: 27 28 29 29 29 0a 09 09 09 09 09 09 09 20 20 20 '()))........
1c60: 20 20 28 65 6e 76 61 72 20 20 20 28 61 6e 64 20 (envar (and
1c70: 65 6e 76 69 72 6f 6e 2d 70 61 74 74 20 28 73 74 environ-patt (st
1c80: 72 69 6e 67 2d 73 65 61 72 63 68 20 28 72 65 67 ring-search (reg
1c90: 65 78 70 20 65 6e 76 69 72 6f 6e 2d 70 61 74 74 exp environ-patt
1ca0: 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e ) curr-section-n
1cb0: 61 6d 65 29 29 29 0a 09 09 09 09 09 09 09 20 20 ame)))........
1cc0: 20 20 20 28 72 65 61 6c 76 61 6c 20 28 69 66 20 (realval (if
1cd0: 65 6e 76 61 72 0a 09 09 09 09 09 09 09 09 09 20 envar..........
1ce0: 20 28 63 6f 6e 66 69 67 3a 65 76 61 6c 2d 73 74 (config:eval-st
1cf0: 72 69 6e 67 2d 69 6e 2d 65 6e 76 69 72 6f 6e 6d ring-in-environm
1d00: 65 6e 74 20 76 61 6c 29 0a 09 09 09 09 09 09 09 ent val)........
1d10: 09 09 20 20 76 61 6c 29 29 29 0a 09 09 09 09 09 .. val)))......
1d20: 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 36 ..(debug:print 6
1d30: 20 22 49 4e 46 4f 3a 20 72 65 61 64 2d 63 6f 6e "INFO: read-con
1d40: 66 69 67 20 65 6e 76 20 73 65 74 74 69 6e 67 2c fig env setting,
1d50: 20 65 6e 76 61 72 3a 20 22 20 65 6e 76 61 72 20 envar: " envar
1d60: 22 20 72 65 61 6c 76 61 6c 3a 20 22 20 72 65 61 " realval: " rea
1d70: 6c 76 61 6c 20 22 20 76 61 6c 3a 20 22 20 76 61 lval " val: " va
1d80: 6c 20 22 20 6b 65 79 3a 20 22 20 6b 65 79 20 22 l " key: " key "
1d90: 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 curr-section-na
1da0: 6d 65 3a 20 22 20 63 75 72 72 2d 73 65 63 74 69 me: " curr-secti
1db0: 6f 6e 2d 6e 61 6d 65 29 0a 09 09 09 09 09 09 09 on-name)........
1dc0: 28 69 66 20 65 6e 76 61 72 0a 09 09 09 09 09 09 (if envar.......
1dd0: 09 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 09 . (begin.....
1de0: 09 09 09 20 20 20 20 20 20 3b 3b 20 28 64 65 62 ... ;; (deb
1df0: 75 67 3a 70 72 69 6e 74 20 34 20 22 49 4e 46 4f ug:print 4 "INFO
1e00: 3a 20 72 65 61 64 2d 63 6f 6e 66 69 67 20 6b 65 : read-config ke
1e10: 79 3d 22 20 6b 65 79 20 22 2c 20 76 61 6c 3d 22 y=" key ", val="
1e20: 20 76 61 6c 20 22 2c 20 72 65 61 6c 76 61 6c 3d val ", realval=
1e30: 22 20 72 65 61 6c 76 61 6c 29 0a 09 09 09 09 09 " realval)......
1e40: 09 09 20 20 20 20 20 20 28 73 65 74 65 6e 76 20 .. (setenv
1e50: 6b 65 79 20 72 65 61 6c 76 61 6c 29 29 29 0a 09 key realval)))..
1e60: 09 09 09 09 09 09 28 68 61 73 68 2d 74 61 62 6c ......(hash-tabl
1e70: 65 2d 73 65 74 21 20 72 65 73 20 63 75 72 72 2d e-set! res curr-
1e80: 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 0a 09 09 section-name ...
1e90: 09 09 09 09 09 09 09 20 28 63 6f 6e 66 69 67 3a ....... (config:
1ea0: 61 73 73 6f 63 2d 73 61 66 65 2d 61 64 64 20 61 assoc-safe-add a
1eb0: 6c 69 73 74 20 6b 65 79 20 72 65 61 6c 76 61 6c list key realval
1ec0: 29 29 0a 09 09 09 09 09 09 09 28 6c 6f 6f 70 20 ))........(loop
1ed0: 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d 6c 69 (configf:read-li
1ee0: 6e 65 20 69 6e 70 20 72 65 73 29 20 63 75 72 72 ne inp res) curr
1ef0: 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 6b 65 -section-name ke
1f00: 79 20 23 66 29 29 29 0a 09 20 20 20 20 20 20 20 y #f)))..
1f10: 3b 3b 20 69 66 20 61 20 63 6f 6e 74 69 6e 75 65 ;; if a continue
1f20: 64 20 6c 69 6e 65 0a 09 20 20 20 20 20 20 20 28 d line.. (
1f30: 63 6f 6e 66 69 67 66 3a 63 6f 6e 74 2d 6c 6e 2d configf:cont-ln-
1f40: 72 78 20 28 20 78 20 77 68 73 70 20 76 61 6c 20 rx ( x whsp val
1f50: 20 20 20 20 29 20 28 6c 65 74 20 28 28 61 6c 69 ) (let ((ali
1f60: 73 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 st (hash-table-r
1f70: 65 66 2f 64 65 66 61 75 6c 74 20 72 65 73 20 63 ef/default res c
1f80: 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 urr-section-name
1f90: 20 27 28 29 29 29 29 0a 09 09 09 09 09 09 28 69 '()))).......(i
1fa0: 66 20 76 61 72 2d 66 6c 61 67 20 20 20 20 20 20 f var-flag
1fb0: 20 20 20 20 20 20 20 3b 3b 20 69 66 20 73 65 74 ;; if set
1fc0: 20 74 6f 20 61 20 73 74 72 69 6e 67 20 74 68 65 to a string the
1fd0: 6e 20 77 65 20 68 61 76 65 20 61 20 63 6f 6e 74 n we have a cont
1fe0: 69 6e 75 65 64 20 76 61 72 0a 09 09 09 09 09 09 inued var.......
1ff0: 20 20 20 20 28 6c 65 74 20 28 28 6e 65 77 76 61 (let ((newva
2000: 6c 20 28 63 6f 6e 63 20 0a 09 09 09 09 09 09 09 l (conc ........
2010: 09 20 20 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b . (config-look
2020: 75 70 20 72 65 73 20 63 75 72 72 2d 73 65 63 74 up res curr-sect
2030: 69 6f 6e 2d 6e 61 6d 65 20 76 61 72 2d 66 6c 61 ion-name var-fla
2040: 67 29 20 22 5c 6e 22 0a 09 09 09 09 09 09 09 09 g) "\n".........
2050: 20 20 20 3b 3b 20 74 72 69 6d 20 6c 65 61 64 20 ;; trim lead
2060: 66 72 6f 6d 20 74 68 65 20 69 6e 63 6f 6d 69 6e from the incomin
2070: 67 20 77 68 73 70 20 74 6f 20 73 75 70 70 6f 72 g whsp to suppor
2080: 74 20 73 6f 6d 65 20 69 6e 64 65 6e 74 69 6e 67 t some indenting
2090: 2e 0a 09 09 09 09 09 09 09 09 20 20 20 28 69 66 .......... (if
20a0: 20 6c 65 61 64 0a 09 09 09 09 09 09 09 09 20 20 lead.........
20b0: 20 20 20 20 20 28 73 74 72 69 6e 67 2d 73 75 62 (string-sub
20c0: 73 74 69 74 75 74 65 20 28 72 65 67 65 78 70 20 stitute (regexp
20d0: 6c 65 61 64 29 20 22 22 20 77 68 73 70 29 0a 09 lead) "" whsp)..
20e0: 09 09 09 09 09 09 09 20 20 20 20 20 20 20 22 22 ....... ""
20f0: 29 0a 09 09 09 09 09 09 09 09 20 20 20 76 61 6c )......... val
2100: 29 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 ))).......
2110: 3b 3b 20 28 70 72 69 6e 74 20 22 76 61 6c 3a 20 ;; (print "val:
2120: 22 20 76 61 6c 20 22 5c 6e 6e 65 77 76 61 6c 3a " val "\nnewval:
2130: 20 5c 22 22 20 6e 65 77 76 61 6c 20 22 5c 22 5c \"" newval "\"\
2140: 6e 76 61 72 66 6c 61 67 3a 20 22 20 76 61 72 2d nvarflag: " var-
2150: 66 6c 61 67 29 0a 09 09 09 09 09 09 20 20 20 20 flag).......
2160: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 (hash-table-se
2170: 74 21 20 72 65 73 20 63 75 72 72 2d 73 65 63 74 t! res curr-sect
2180: 69 6f 6e 2d 6e 61 6d 65 20 0a 09 09 09 09 09 09 ion-name .......
2190: 09 09 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 .. (config
21a0: 3a 61 73 73 6f 63 2d 73 61 66 65 2d 61 64 64 20 :assoc-safe-add
21b0: 61 6c 69 73 74 20 76 61 72 2d 66 6c 61 67 20 6e alist var-flag n
21c0: 65 77 76 61 6c 29 29 0a 09 09 09 09 09 09 20 20 ewval)).......
21d0: 20 20 20 20 28 6c 6f 6f 70 20 28 63 6f 6e 66 69 (loop (confi
21e0: 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 gf:read-line inp
21f0: 20 72 65 73 29 20 63 75 72 72 2d 73 65 63 74 69 res) curr-secti
2200: 6f 6e 2d 6e 61 6d 65 20 76 61 72 2d 66 6c 61 67 on-name var-flag
2210: 20 28 69 66 20 6c 65 61 64 20 6c 65 61 64 20 77 (if lead lead w
2220: 68 73 70 29 29 29 0a 09 09 09 09 09 09 20 20 20 hsp))).......
2230: 20 28 6c 6f 6f 70 20 28 63 6f 6e 66 69 67 66 3a (loop (configf:
2240: 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 20 72 65 read-line inp re
2250: 73 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d s) curr-section-
2260: 6e 61 6d 65 20 23 66 20 23 66 29 29 29 29 0a 09 name #f #f))))..
2270: 20 20 20 20 20 20 20 28 65 6c 73 65 20 28 64 65 (else (de
2280: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 bug:print 0 "ERR
2290: 4f 52 3a 20 70 72 6f 62 6c 65 6d 20 70 61 72 73 OR: problem pars
22a0: 69 6e 67 20 22 20 70 61 74 68 20 22 2c 5c 6e 20 ing " path ",\n
22b0: 20 20 5c 22 22 20 69 6e 6c 20 22 5c 22 22 29 0a \"" inl "\"").
22c0: 09 09 20 20 20 20 20 28 73 65 74 21 20 76 61 72 .. (set! var
22d0: 2d 66 6c 61 67 20 23 66 29 0a 09 09 20 20 20 20 -flag #f)...
22e0: 20 28 6c 6f 6f 70 20 28 63 6f 6e 66 69 67 66 3a (loop (configf:
22f0: 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 20 72 65 read-line inp re
2300: 73 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d s) curr-section-
2310: 6e 61 6d 65 20 23 66 20 23 66 29 29 29 29 29 29 name #f #f))))))
2320: 29 29 0a 20 20 0a 28 64 65 66 69 6e 65 20 28 66 )). .(define (f
2330: 69 6e 64 2d 61 6e 64 2d 72 65 61 64 2d 63 6f 6e ind-and-read-con
2340: 66 69 67 20 66 6e 61 6d 65 20 23 21 6b 65 79 20 fig fname #!key
2350: 28 65 6e 76 69 72 6f 6e 2d 70 61 74 74 20 23 66 (environ-patt #f
2360: 29 29 0a 20 20 28 6c 65 74 2a 20 28 28 63 75 72 )). (let* ((cur
2370: 72 2d 64 69 72 20 20 20 28 63 75 72 72 65 6e 74 r-dir (current
2380: 2d 64 69 72 65 63 74 6f 72 79 29 29 0a 20 20 20 -directory)).
2390: 20 20 20 20 20 20 28 63 6f 6e 66 69 67 69 6e 66 (configinf
23a0: 6f 20 28 66 69 6e 64 2d 63 6f 6e 66 69 67 20 66 o (find-config f
23b0: 6e 61 6d 65 29 29 0a 09 20 28 74 6f 70 70 61 74 name)).. (toppat
23c0: 68 20 20 20 20 28 63 61 72 20 63 6f 6e 66 69 67 h (car config
23d0: 69 6e 66 6f 29 29 0a 09 20 28 63 6f 6e 66 69 67 info)).. (config
23e0: 66 69 6c 65 20 28 63 61 64 72 20 63 6f 6e 66 69 file (cadr confi
23f0: 67 69 6e 66 6f 29 29 29 0a 20 20 20 20 28 69 66 ginfo))). (if
2400: 20 74 6f 70 70 61 74 68 20 28 63 68 61 6e 67 65 toppath (change
2410: 2d 64 69 72 65 63 74 6f 72 79 20 74 6f 70 70 61 -directory toppa
2420: 74 68 29 29 20 0a 20 20 20 20 28 6c 65 74 20 28 th)) . (let (
2430: 28 63 6f 6e 66 69 67 64 61 74 20 20 28 69 66 20 (configdat (if
2440: 63 6f 6e 66 69 67 66 69 6c 65 20 28 72 65 61 64 configfile (read
2450: 2d 63 6f 6e 66 69 67 20 63 6f 6e 66 69 67 66 69 -config configfi
2460: 6c 65 20 23 66 20 23 74 20 65 6e 76 69 72 6f 6e le #f #t environ
2470: 2d 70 61 74 74 3a 20 65 6e 76 69 72 6f 6e 2d 70 -patt: environ-p
2480: 61 74 74 29 20 23 66 29 29 29 20 3b 3b 20 28 6d att) #f))) ;; (m
2490: 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 ake-hash-table))
24a0: 29 29 0a 20 20 20 20 20 20 28 69 66 20 74 6f 70 )). (if top
24b0: 70 61 74 68 20 28 63 68 61 6e 67 65 2d 64 69 72 path (change-dir
24c0: 65 63 74 6f 72 79 20 63 75 72 72 2d 64 69 72 29 ectory curr-dir)
24d0: 29 0a 20 20 20 20 20 20 28 6c 69 73 74 20 63 6f ). (list co
24e0: 6e 66 69 67 64 61 74 20 74 6f 70 70 61 74 68 20 nfigdat toppath
24f0: 63 6f 6e 66 69 67 66 69 6c 65 20 66 6e 61 6d 65 configfile fname
2500: 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 ))))..(define (c
2510: 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 63 66 67 onfig-lookup cfg
2520: 64 61 74 20 73 65 63 74 69 6f 6e 20 76 61 72 29 dat section var)
2530: 0a 20 20 28 6c 65 74 20 28 28 73 65 63 74 64 61 . (let ((sectda
2540: 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 t (hash-table-re
2550: 66 2f 64 65 66 61 75 6c 74 20 63 66 67 64 61 74 f/default cfgdat
2560: 20 73 65 63 74 69 6f 6e 20 27 28 29 29 29 29 0a section '()))).
2570: 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 73 (if (null? s
2580: 65 63 74 64 61 74 29 0a 09 23 66 0a 09 28 6c 65 ectdat)..#f..(le
2590: 74 20 28 28 6d 61 74 63 68 20 28 61 73 73 6f 63 t ((match (assoc
25a0: 20 76 61 72 20 73 65 63 74 64 61 74 29 29 29 0a var sectdat))).
25b0: 09 20 20 28 69 66 20 6d 61 74 63 68 20 3b 3b 20 . (if match ;;
25c0: 28 61 6e 64 20 6d 61 74 63 68 20 28 6c 69 73 74 (and match (list
25d0: 3f 20 6d 61 74 63 68 29 28 3e 20 28 6c 65 6e 67 ? match)(> (leng
25e0: 74 68 20 6d 61 74 63 68 29 20 31 29 29 0a 09 20 th match) 1))..
25f0: 20 20 20 20 20 28 63 61 64 72 20 6d 61 74 63 68 (cadr match
2600: 29 0a 09 20 20 20 20 20 20 23 66 29 29 0a 09 29 ).. #f))..)
2610: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e ))..(define (con
2620: 66 69 67 66 3a 73 65 63 74 69 6f 6e 2d 76 61 72 figf:section-var
2630: 73 20 63 66 67 64 61 74 20 73 65 63 74 69 6f 6e s cfgdat section
2640: 29 0a 20 20 28 6c 65 74 20 28 28 73 65 63 74 64 ). (let ((sectd
2650: 61 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 at (hash-table-r
2660: 65 66 2f 64 65 66 61 75 6c 74 20 63 66 67 64 61 ef/default cfgda
2670: 74 20 73 65 63 74 69 6f 6e 20 27 28 29 29 29 29 t section '())))
2680: 0a 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 . (if (null?
2690: 73 65 63 74 64 61 74 29 0a 09 27 28 29 0a 09 28 sectdat)..'()..(
26a0: 6d 61 70 20 63 61 72 20 73 65 63 74 64 61 74 29 map car sectdat)
26b0: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 73 65 )))..(define (se
26c0: 74 75 70 29 0a 20 20 28 6c 65 74 2a 20 28 28 63 tup). (let* ((c
26d0: 6f 6e 66 69 67 66 20 28 66 69 6e 64 2d 63 6f 6e onfigf (find-con
26e0: 66 69 67 29 29 0a 09 20 28 63 6f 6e 66 69 67 20 fig)).. (config
26f0: 20 28 69 66 20 63 6f 6e 66 69 67 66 20 28 72 65 (if configf (re
2700: 61 64 2d 63 6f 6e 66 69 67 20 63 6f 6e 66 69 67 ad-config config
2710: 66 20 23 66 20 23 74 29 20 23 66 29 29 29 0a 20 f #f #t) #f))).
2720: 20 20 20 28 69 66 20 63 6f 6e 66 69 67 0a 09 28 (if config..(
2730: 73 65 74 65 6e 76 20 22 52 55 4e 5f 41 52 45 41 setenv "RUN_AREA
2740: 5f 48 4f 4d 45 22 20 28 70 61 74 68 6e 61 6d 65 _HOME" (pathname
2750: 2d 64 69 72 65 63 74 6f 72 79 20 63 6f 6e 66 69 -directory confi
2760: 67 66 29 29 29 0a 20 20 20 20 63 6f 6e 66 69 67 gf))). config
2770: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
2780: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2790: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
27a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
27b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
27c0: 4e 6f 6e 20 64 65 73 74 72 75 63 74 69 76 65 20 Non destructive
27d0: 77 72 69 74 69 6e 67 20 6f 66 20 63 6f 6e 66 69 writing of confi
27e0: 67 20 66 69 6c 65 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d g file.;;=======
27f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2800: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2810: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2820: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
2830: 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 .(define (config
2840: 66 3a 63 6f 6d 70 72 65 73 73 2d 6d 75 6c 74 69 f:compress-multi
2850: 2d 6c 69 6e 65 73 20 66 64 61 74 29 0a 20 20 3b -lines fdat). ;
2860: 3b 20 73 74 65 70 20 31 2e 35 20 2d 20 63 6f 6d ; step 1.5 - com
2870: 70 72 65 73 73 20 61 6e 79 20 63 6f 6e 74 69 6e press any contin
2880: 75 65 64 20 6c 69 6e 65 73 0a 20 20 28 69 66 20 ued lines. (if
2890: 28 6e 75 6c 6c 3f 20 66 64 61 74 29 20 66 64 61 (null? fdat) fda
28a0: 74 0a 09 28 6c 65 74 20 6c 6f 6f 70 20 28 28 68 t..(let loop ((h
28b0: 65 64 20 28 63 61 72 20 66 64 61 74 29 29 0a 09 ed (car fdat))..
28c0: 09 20 20 20 28 74 61 6c 20 28 63 64 72 20 66 64 . (tal (cdr fd
28d0: 61 74 29 29 0a 09 09 20 20 20 28 63 75 72 20 22 at))... (cur "
28e0: 22 29 0a 09 09 20 20 20 28 6c 65 64 20 23 66 29 ")... (led #f)
28f0: 0a 09 09 20 20 20 28 72 65 73 20 27 28 29 29 29 ... (res '()))
2900: 0a 09 20 20 3b 3b 20 41 4c 4c 20 57 48 49 54 45 .. ;; ALL WHITE
2910: 53 50 41 43 45 20 4c 45 41 44 49 4e 47 20 4c 49 SPACE LEADING LI
2920: 4e 45 53 20 41 52 45 20 54 41 43 4b 45 44 20 4f NES ARE TACKED O
2930: 4e 21 21 0a 09 20 20 3b 3b 20 20 31 2e 20 72 65 N!!.. ;; 1. re
2940: 6d 6f 76 65 20 6c 65 64 20 77 68 69 74 65 73 70 move led whitesp
2950: 61 63 65 0a 09 20 20 3b 3b 20 20 32 2e 20 74 61 ace.. ;; 2. ta
2960: 63 6b 20 6f 6e 20 74 6f 20 68 65 64 20 77 69 74 ck on to hed wit
2970: 68 20 22 5c 6e 22 0a 09 20 20 28 6c 65 74 20 28 h "\n".. (let (
2980: 28 6d 61 74 63 68 20 28 73 74 72 69 6e 67 2d 6d (match (string-m
2990: 61 74 63 68 20 63 6f 6e 66 69 67 66 3a 63 6f 6e atch configf:con
29a0: 74 2d 6c 6e 2d 72 78 20 68 65 64 29 29 29 0a 09 t-ln-rx hed)))..
29b0: 20 20 20 20 28 69 66 20 6d 61 74 63 68 20 3b 3b (if match ;;
29c0: 20 62 6c 61 73 74 21 20 68 61 76 65 20 74 6f 20 blast! have to
29d0: 64 65 61 6c 20 77 69 74 68 20 61 20 6d 75 6c 74 deal with a mult
29e0: 69 6c 69 6e 65 0a 09 09 28 6c 65 74 2a 20 28 28 iline...(let* ((
29f0: 6c 65 61 64 20 28 63 61 64 72 20 6d 61 74 63 68 lead (cadr match
2a00: 29 29 0a 09 09 20 20 20 20 20 20 20 28 6c 76 61 ))... (lva
2a10: 6c 20 28 63 61 64 64 72 20 6d 61 74 63 68 29 29 l (caddr match))
2a20: 0a 09 09 20 20 20 20 20 20 20 28 6e 65 77 6c 20 ... (newl
2a30: 28 63 6f 6e 63 20 63 75 72 20 22 5c 6e 22 20 6c (conc cur "\n" l
2a40: 76 61 6c 29 29 29 0a 09 09 20 20 28 69 66 20 28 val)))... (if (
2a50: 6e 6f 74 20 6c 65 64 29 28 73 65 74 21 20 6c 65 not led)(set! le
2a60: 64 20 6c 65 61 64 29 29 0a 09 09 20 20 28 69 66 d lead))... (if
2a70: 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 20 0a 09 09 (null? tal) ...
2a80: 20 20 20 20 20 20 28 73 65 74 21 20 66 64 61 74 (set! fdat
2a90: 20 28 61 70 70 65 6e 64 20 66 64 61 74 20 28 6c (append fdat (l
2aa0: 69 73 74 20 6e 65 77 6c 29 29 29 0a 09 09 20 20 ist newl)))...
2ab0: 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 74 (loop (car t
2ac0: 61 6c 29 28 63 64 72 20 74 61 6c 29 20 6e 65 77 al)(cdr tal) new
2ad0: 6c 20 6c 65 64 20 72 65 73 29 29 29 20 3b 3b 20 l led res))) ;;
2ae0: 4e 42 2f 2f 20 6e 6f 74 20 74 61 63 6b 69 6e 67 NB// not tacking
2af0: 20 6e 65 77 6c 20 6f 6e 74 6f 20 72 65 73 0a 09 newl onto res..
2b00: 09 28 6c 65 74 20 28 28 6e 65 77 72 65 73 20 28 .(let ((newres (
2b10: 69 66 20 6c 65 64 20 0a 09 09 09 09 20 20 28 61 if led ..... (a
2b20: 70 70 65 6e 64 20 72 65 73 20 28 6c 69 73 74 20 ppend res (list
2b30: 63 75 72 20 68 65 64 29 29 0a 09 09 09 09 20 20 cur hed)).....
2b40: 28 61 70 70 65 6e 64 20 72 65 73 20 28 6c 69 73 (append res (lis
2b50: 74 20 68 65 64 29 29 29 29 29 0a 09 09 20 20 3b t hed)))))... ;
2b60: 3b 20 70 72 65 76 20 77 61 73 20 61 20 6d 75 6c ; prev was a mul
2b70: 74 69 6c 69 6e 65 0a 09 09 20 20 28 69 66 20 28 tiline... (if (
2b80: 6e 75 6c 6c 3f 20 74 61 6c 29 0a 09 09 20 20 20 null? tal)...
2b90: 20 20 20 6e 65 77 72 65 73 0a 09 09 20 20 20 20 newres...
2ba0: 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c (loop (car tal
2bb0: 29 28 63 64 72 20 74 61 6c 29 20 22 22 20 23 66 )(cdr tal) "" #f
2bc0: 20 6e 65 77 72 65 73 29 29 29 29 29 29 29 29 0a newres)))))))).
2bd0: 0a 3b 3b 20 6e 6f 74 65 3a 20 49 27 6d 20 63 68 .;; note: I'm ch
2be0: 65 61 74 69 6e 67 20 61 20 6c 69 74 74 6c 65 20 eating a little
2bf0: 68 65 72 65 2e 20 49 20 6d 65 72 65 6c 79 20 72 here. I merely r
2c00: 65 70 6c 61 63 65 20 22 5c 6e 22 20 77 69 74 68 eplace "\n" with
2c10: 20 22 5c 6e 20 20 20 20 20 20 20 20 20 22 0a 28 "\n ".(
2c20: 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a define (configf:
2c30: 65 78 70 61 6e 64 2d 6d 75 6c 74 69 2d 6c 69 6e expand-multi-lin
2c40: 65 73 20 66 64 61 74 29 0a 20 20 3b 3b 20 73 74 es fdat). ;; st
2c50: 65 70 20 31 2e 35 20 2d 20 63 6f 6d 70 72 65 73 ep 1.5 - compres
2c60: 73 20 61 6e 79 20 63 6f 6e 74 69 6e 75 65 64 20 s any continued
2c70: 6c 69 6e 65 73 0a 20 20 28 69 66 20 28 6e 75 6c lines. (if (nul
2c80: 6c 3f 20 66 64 61 74 29 20 66 64 61 74 0a 20 20 l? fdat) fdat.
2c90: 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 (let loop ((
2ca0: 68 65 64 20 28 63 61 72 20 66 64 61 74 29 29 0a hed (car fdat)).
2cb0: 09 09 20 28 74 61 6c 20 28 63 64 72 20 66 64 61 .. (tal (cdr fda
2cc0: 74 29 29 0a 09 09 20 28 72 65 73 20 27 28 29 29 t))... (res '())
2cd0: 29 0a 09 28 6c 65 74 20 28 28 6e 65 77 72 65 73 )..(let ((newres
2ce0: 20 28 61 70 70 65 6e 64 20 72 65 73 20 28 6c 69 (append res (li
2cf0: 73 74 20 28 73 74 72 69 6e 67 2d 73 75 62 73 74 st (string-subst
2d00: 69 74 75 74 65 20 28 72 65 67 65 78 70 20 22 5c itute (regexp "\
2d10: 6e 22 29 20 22 5c 6e 20 20 20 20 20 20 20 20 20 n") "\n
2d20: 22 20 68 65 64 20 23 74 29 29 29 29 29 0a 09 20 " hed #t)))))..
2d30: 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 (if (null? tal)
2d40: 0a 09 20 20 20 20 20 20 6e 65 77 72 65 73 0a 09 .. newres..
2d50: 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 (loop (car
2d60: 20 74 61 6c 29 28 63 64 72 20 74 61 6c 29 20 6e tal)(cdr tal) n
2d70: 65 77 72 65 73 29 29 29 29 29 29 0a 0a 28 64 65 ewres))))))..(de
2d80: 66 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a 66 69 fine (configf:fi
2d90: 6c 65 2d 3e 6c 69 73 74 20 66 6e 61 6d 65 29 0a le->list fname).
2da0: 20 20 28 69 66 20 28 66 69 6c 65 2d 65 78 69 73 (if (file-exis
2db0: 74 73 3f 20 66 6e 61 6d 65 29 0a 20 20 20 20 20 ts? fname).
2dc0: 20 28 6c 65 74 20 28 28 69 6e 70 20 28 6f 70 65 (let ((inp (ope
2dd0: 6e 2d 69 6e 70 75 74 2d 66 69 6c 65 20 66 6e 61 n-input-file fna
2de0: 6d 65 29 29 29 0a 09 28 6c 65 74 20 6c 6f 6f 70 me)))..(let loop
2df0: 20 28 28 69 6e 6c 20 28 72 65 61 64 2d 6c 69 6e ((inl (read-lin
2e00: 65 20 69 6e 70 29 29 0a 09 09 20 20 20 28 72 65 e inp))... (re
2e10: 73 20 27 28 29 29 29 0a 09 20 20 28 69 66 20 28 s '())).. (if (
2e20: 65 6f 66 2d 6f 62 6a 65 63 74 3f 20 69 6e 6c 29 eof-object? inl)
2e30: 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 .. (begin..
2e40: 09 28 63 6c 6f 73 65 2d 69 6e 70 75 74 2d 70 6f .(close-input-po
2e50: 72 74 20 69 6e 70 29 0a 09 09 28 72 65 76 65 72 rt inp)...(rever
2e60: 73 65 20 72 65 73 29 29 0a 09 20 20 20 20 20 20 se res))..
2e70: 28 6c 6f 6f 70 20 28 72 65 61 64 2d 6c 69 6e 65 (loop (read-line
2e80: 20 69 6e 70 29 28 63 6f 6e 73 20 69 6e 6c 29 29 inp)(cons inl))
2e90: 29 29 29 0a 20 20 20 20 20 20 27 28 29 29 29 0a ))). '())).
2ea0: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
2eb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2ec0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2ed0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2ee0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 57 72 69 =========.;; Wri
2ef0: 74 65 20 61 20 63 6f 6e 66 69 67 0a 3b 3b 20 20 te a config.;;
2f00: 20 30 2e 20 47 69 76 65 6e 20 61 20 72 65 66 65 0. Given a refe
2f10: 72 65 72 65 6e 63 65 20 64 61 74 61 20 73 74 72 rerence data str
2f20: 75 63 74 75 72 65 20 22 69 6e 64 61 74 22 0a 3b ucture "indat".;
2f30: 3b 20 20 20 31 2e 20 4f 70 65 6e 20 74 68 65 20 ; 1. Open the
2f40: 6f 75 74 70 75 74 20 66 69 6c 65 20 61 6e 64 20 output file and
2f50: 72 65 61 64 20 69 74 20 69 6e 74 6f 20 61 20 6c read it into a l
2f60: 69 73 74 0a 3b 3b 20 20 20 32 2e 20 46 6c 61 74 ist.;; 2. Flat
2f70: 74 65 6e 20 61 6e 79 20 6d 75 6c 74 69 6c 69 6e ten any multilin
2f80: 65 20 65 6e 74 72 69 65 73 0a 3b 3b 20 20 20 33 e entries.;; 3
2f90: 2e 20 4d 6f 64 69 66 79 20 76 61 6c 75 65 73 20 . Modify values
2fa0: 70 65 72 20 63 6f 6e 74 65 6e 74 73 20 6f 66 20 per contents of
2fb0: 22 69 6e 64 61 74 22 20 61 6e 64 20 72 65 6d 6f "indat" and remo
2fc0: 76 65 20 61 62 73 65 6e 74 20 76 61 6c 75 65 73 ve absent values
2fd0: 0a 3b 3b 20 20 20 34 2e 20 41 70 70 65 6e 64 20 .;; 4. Append
2fe0: 6e 65 77 20 76 61 6c 75 65 73 20 74 6f 20 74 68 new values to th
2ff0: 65 20 73 65 63 74 69 6f 6e 20 28 69 6d 6d 65 64 e section (immed
3000: 69 61 74 65 6c 79 20 61 66 74 65 72 20 6c 61 73 iately after las
3010: 74 20 6c 65 67 69 74 20 65 6e 74 72 79 29 0a 3b t legit entry).;
3020: 3b 20 20 20 35 2e 20 57 72 69 74 65 20 6f 75 74 ; 5. Write out
3030: 20 74 68 65 20 6e 65 77 20 6c 69 73 74 20 0a 3b the new list .;
3040: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
3050: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3060: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3070: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3080: 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 =======..(define
3090: 20 28 63 6f 6e 66 69 67 66 3a 77 72 69 74 65 2d (configf:write-
30a0: 63 6f 6e 66 69 67 20 69 6e 64 61 74 20 66 6e 61 config indat fna
30b0: 6d 65 20 23 21 6b 65 79 20 28 72 65 71 75 69 72 me #!key (requir
30c0: 65 64 2d 73 65 63 74 69 6f 6e 73 20 27 28 29 29 ed-sections '())
30d0: 29 0a 20 20 28 6c 65 74 2a 20 28 3b 3b 20 73 74 ). (let* (;; st
30e0: 65 70 20 31 3a 20 4f 70 65 6e 20 74 68 65 20 6f ep 1: Open the o
30f0: 75 74 70 75 74 20 66 69 6c 65 20 61 6e 64 20 72 utput file and r
3100: 65 61 64 20 69 74 20 69 6e 74 6f 20 61 20 6c 69 ead it into a li
3110: 73 74 0a 09 20 28 66 64 61 74 20 20 20 20 20 20 st.. (fdat
3120: 20 28 63 6f 6e 66 69 67 66 3a 66 69 6c 65 2d 3e (configf:file->
3130: 6c 69 73 74 20 66 6e 61 6d 65 29 29 0a 09 20 28 list fname)).. (
3140: 72 65 66 64 61 74 20 20 28 6d 61 6b 65 2d 68 61 refdat (make-ha
3150: 73 68 2d 74 61 62 6c 65 29 29 0a 09 20 28 73 65 sh-table)).. (se
3160: 63 68 61 73 68 20 28 6d 61 6b 65 2d 68 61 73 68 chash (make-hash
3170: 2d 74 61 62 6c 65 29 29 20 3b 3b 20 63 75 72 72 -table)) ;; curr
3180: 65 6e 74 20 73 65 63 74 69 6f 6e 20 68 61 73 68 ent section hash
3190: 2c 20 69 6e 69 74 20 77 69 74 68 20 68 61 73 68 , init with hash
31a0: 20 66 6f 72 20 22 64 65 66 61 75 6c 74 22 20 73 for "default" s
31b0: 65 63 74 69 6f 6e 0a 09 20 28 6e 65 77 20 20 20 ection.. (new
31c0: 20 20 23 66 29 20 3b 3b 20 70 75 74 20 74 68 65 #f) ;; put the
31d0: 20 6c 69 6e 65 20 74 6f 20 62 65 20 75 73 65 64 line to be used
31e0: 20 69 6e 20 6e 65 77 2c 20 69 66 20 69 74 20 69 in new, if it i
31f0: 73 20 74 6f 20 62 65 20 64 65 6c 65 74 65 64 20 s to be deleted
3200: 74 68 65 20 73 65 74 20 6e 65 77 20 74 6f 20 23 the set new to #
3210: 66 0a 09 20 28 73 65 63 6e 61 6d 65 20 23 66 29 f.. (secname #f)
3220: 29 0a 0a 20 20 20 20 3b 3b 20 73 74 65 70 20 32 ).. ;; step 2
3230: 3a 20 46 6c 61 74 74 65 6e 20 6d 75 6c 74 69 6c : Flatten multil
3240: 69 6e 65 20 65 6e 74 72 69 65 73 0a 20 20 20 20 ine entries.
3250: 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 (if (not (null?
3260: 66 64 61 74 29 29 28 73 65 74 21 20 66 64 61 74 fdat))(set! fdat
3270: 20 28 63 6f 6e 66 69 67 66 3a 63 6f 6d 70 72 65 (configf:compre
3280: 73 73 2d 6d 75 6c 74 69 2d 6c 69 6e 65 20 66 64 ss-multi-line fd
3290: 61 74 29 29 29 0a 0a 20 20 20 20 3b 3b 20 73 74 at))).. ;; st
32a0: 65 70 20 33 3a 20 4d 6f 64 69 66 79 20 76 61 6c ep 3: Modify val
32b0: 75 65 73 20 70 65 72 20 63 6f 6e 74 65 6e 74 73 ues per contents
32c0: 20 6f 66 20 22 69 6e 64 61 74 22 20 61 6e 64 20 of "indat" and
32d0: 72 65 6d 6f 76 65 20 61 62 73 65 6e 74 20 76 61 remove absent va
32e0: 6c 75 65 73 0a 20 20 20 20 28 69 66 20 28 6e 6f lues. (if (no
32f0: 74 20 28 6e 75 6c 6c 3f 20 66 64 61 74 29 29 0a t (null? fdat)).
3300: 09 28 6c 65 74 20 6c 6f 6f 70 20 28 28 68 65 64 .(let loop ((hed
3310: 20 20 28 63 61 72 20 66 64 61 74 29 29 0a 09 09 (car fdat))...
3320: 20 20 20 28 74 61 6c 20 20 28 63 61 64 72 20 66 (tal (cadr f
3330: 64 61 74 29 29 0a 09 09 20 20 20 28 72 65 73 20 dat))... (res
3340: 20 27 28 29 29 0a 09 09 20 20 20 28 6c 6e 75 6d '())... (lnum
3350: 20 30 29 29 0a 09 20 20 28 72 65 67 65 78 2d 63 0)).. (regex-c
3360: 61 73 65 20 0a 09 20 20 20 68 65 64 0a 09 20 20 ase .. hed..
3370: 20 28 63 6f 6e 66 69 67 66 3a 63 6f 6d 6d 65 6e (configf:commen
3380: 74 2d 72 78 20 5f 20 20 20 20 20 20 20 20 20 20 t-rx _
3390: 20 20 20 20 20 20 20 20 28 73 65 74 21 20 72 65 (set! re
33a0: 73 20 28 61 70 70 65 6e 64 20 72 65 73 20 28 6c s (append res (l
33b0: 69 73 74 20 68 65 64 29 29 29 29 20 3b 3b 20 28 ist hed)))) ;; (
33c0: 6c 6f 6f 70 20 28 72 65 61 64 2d 6c 69 6e 65 20 loop (read-line
33d0: 69 6e 70 29 20 63 75 72 72 2d 73 65 63 74 69 6f inp) curr-sectio
33e0: 6e 2d 6e 61 6d 65 20 23 66 20 23 66 29 29 0a 09 n-name #f #f))..
33f0: 20 20 20 28 63 6f 6e 66 69 67 66 3a 62 6c 61 6e (configf:blan
3400: 6b 2d 6c 2d 72 78 20 5f 20 20 20 20 20 20 20 20 k-l-rx _
3410: 20 20 20 20 20 20 20 20 20 20 28 73 65 74 21 20 (set!
3420: 72 65 73 20 28 61 70 70 65 6e 64 20 72 65 73 20 res (append res
3430: 28 6c 69 73 74 20 68 65 64 29 29 29 29 20 3b 3b (list hed)))) ;;
3440: 20 28 6c 6f 6f 70 20 28 72 65 61 64 2d 6c 69 6e (loop (read-lin
3450: 65 20 69 6e 70 29 20 63 75 72 72 2d 73 65 63 74 e inp) curr-sect
3460: 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 66 29 29 ion-name #f #f))
3470: 0a 09 20 20 20 28 63 6f 6e 66 69 67 66 3a 73 65 .. (configf:se
3480: 63 74 69 6f 6e 2d 72 78 20 28 20 78 20 73 65 63 ction-rx ( x sec
3490: 74 69 6f 6e 2d 6e 61 6d 65 20 29 20 28 6c 65 74 tion-name ) (let
34a0: 20 28 28 73 65 63 74 69 6f 6e 2d 68 61 73 68 20 ((section-hash
34b0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/
34c0: 64 65 66 61 75 6c 74 20 72 65 66 64 61 74 20 73 default refdat s
34d0: 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 29 29 ection-name #f))
34e0: 29 0a 09 09 09 09 09 20 20 20 20 28 69 66 20 28 )...... (if (
34f0: 6e 6f 74 20 73 65 63 74 69 6f 6e 2d 68 61 73 68 not section-hash
3500: 29 0a 09 09 09 09 09 09 28 6c 65 74 20 28 28 6e ).......(let ((n
3510: 65 77 68 61 73 68 20 28 6d 61 6b 65 2d 68 61 73 ewhash (make-has
3520: 68 2d 74 61 62 6c 65 29 29 29 0a 09 09 09 09 09 h-table)))......
3530: 09 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 . (hash-table-s
3540: 65 74 21 20 72 65 66 68 61 73 68 20 73 65 63 74 et! refhash sect
3550: 69 6f 6e 2d 6e 61 6d 65 20 6e 65 77 68 61 73 68 ion-name newhash
3560: 29 0a 09 09 09 09 09 09 20 20 28 73 65 74 21 20 )....... (set!
3570: 73 65 63 68 61 73 68 20 6e 65 77 68 61 73 68 29 sechash newhash)
3580: 29 0a 09 09 09 09 09 09 28 73 65 74 21 20 73 65 ).......(set! se
3590: 63 68 61 73 68 20 73 65 63 74 69 6f 6e 2d 68 61 chash section-ha
35a0: 73 68 29 29 0a 09 09 09 09 09 20 20 20 20 28 73 sh))...... (s
35b0: 65 74 21 20 6e 65 77 20 68 65 64 29 20 3b 3b 20 et! new hed) ;;
35c0: 77 69 6c 6c 20 61 70 70 65 6e 64 20 74 68 69 73 will append this
35d0: 20 61 74 20 74 68 65 20 62 6f 74 74 6f 6d 20 6f at the bottom o
35e0: 66 20 74 68 65 20 6c 6f 6f 70 0a 09 09 09 09 09 f the loop......
35f0: 20 20 20 20 28 73 65 74 21 20 73 65 63 6e 61 6d (set! secnam
3600: 65 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 29 0a e section-name).
3610: 09 09 09 09 09 20 20 20 20 29 29 0a 09 20 20 20 ..... ))..
3620: 3b 3b 20 4e 6f 20 6e 65 65 64 20 74 6f 20 70 72 ;; No need to pr
3630: 6f 63 65 73 73 20 6b 65 79 20 63 6d 64 2c 20 6c ocess key cmd, l
3640: 65 74 20 69 74 20 66 61 6c 6c 20 74 68 6f 75 67 et it fall thoug
3650: 68 20 74 6f 20 6b 65 79 20 76 61 6c 0a 09 20 20 h to key val..
3660: 20 28 63 6f 6e 66 69 67 66 3a 6b 65 79 2d 76 61 (configf:key-va
3670: 6c 2d 70 72 20 28 20 78 20 6b 65 79 20 76 61 6c l-pr ( x key val
3680: 20 20 20 20 20 20 29 0a 09 09 20 20 20 20 20 20 )...
3690: 20 28 6c 65 74 20 28 28 6e 65 77 76 61 6c 20 28 (let ((newval (
36a0: 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 69 6e config-lookup in
36b0: 64 61 74 20 73 65 63 20 6b 65 79 29 29 29 0a 09 dat sec key)))..
36c0: 09 09 20 3b 3b 20 63 61 6e 20 68 61 6e 64 6c 65 .. ;; can handle
36d0: 20 6e 65 77 76 61 6c 20 3d 3d 20 23 66 20 68 65 newval == #f he
36e0: 72 65 20 3d 3e 20 74 68 61 74 20 6d 65 61 6e 73 re => that means
36f0: 20 6b 65 79 20 69 73 20 72 65 6d 6f 76 65 64 0a key is removed.
3700: 09 09 09 20 28 63 6f 6e 64 20 0a 09 09 09 20 20 ... (cond ....
3710: 28 28 65 71 75 61 6c 3f 20 6e 65 77 76 61 6c 20 ((equal? newval
3720: 76 61 6c 29 0a 09 09 09 20 20 20 28 73 65 74 21 val).... (set!
3730: 20 72 65 73 20 28 61 70 70 65 6e 64 20 72 65 73 res (append res
3740: 20 28 6c 69 73 74 20 68 65 64 29 29 29 29 0a 09 (list hed))))..
3750: 09 09 20 20 28 28 6e 6f 74 20 6e 65 77 76 61 6c .. ((not newval
3760: 29 20 3b 3b 20 6b 65 79 20 68 61 73 20 62 65 65 ) ;; key has bee
3770: 6e 20 72 65 6d 6f 76 65 64 0a 09 09 09 20 20 20 n removed....
3780: 28 73 65 74 21 20 6e 65 77 20 23 66 29 29 0a 09 (set! new #f))..
3790: 09 09 20 20 28 28 6e 6f 74 20 28 65 71 75 61 6c .. ((not (equal
37a0: 3f 20 6e 65 77 76 61 6c 20 76 61 6c 29 29 0a 09 ? newval val))..
37b0: 09 09 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 .. (hash-tab
37c0: 6c 65 2d 73 65 74 21 20 73 65 63 68 61 73 68 20 le-set! sechash
37d0: 6b 65 79 20 6e 65 77 76 61 6c 29 0a 09 09 09 20 key newval)....
37e0: 20 20 20 20 28 73 65 74 21 20 6e 65 77 20 28 63 (set! new (c
37f0: 6f 6e 63 20 6b 65 79 20 22 20 22 20 6e 65 77 76 onc key " " newv
3800: 61 6c 29 29 29 0a 09 09 09 20 20 28 65 6c 73 65 al))).... (else
3810: 0a 09 09 09 20 20 20 28 64 65 62 75 67 3a 70 72 .... (debug:pr
3820: 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 70 72 int 0 "ERROR: pr
3830: 6f 62 6c 65 6d 20 70 61 72 73 69 6e 67 20 6c 69 oblem parsing li
3840: 6e 65 20 6e 75 6d 62 65 72 20 22 20 6c 6e 75 6d ne number " lnum
3850: 20 22 5c 22 22 20 68 65 64 20 22 5c 22 22 29 29 "\"" hed "\""))
3860: 29 29 29 0a 09 20 20 20 28 65 6c 73 65 0a 09 20 ))).. (else..
3870: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
3880: 30 20 22 45 52 52 4f 52 3a 20 50 72 6f 62 6c 65 0 "ERROR: Proble
3890: 6d 20 70 61 72 73 69 6e 67 20 6c 69 6e 65 20 6e m parsing line n
38a0: 75 6d 20 22 20 6c 6e 75 6d 20 22 20 3a 5c 6e 20 um " lnum " :\n
38b0: 20 20 22 20 68 65 64 20 29 29 29 0a 09 20 20 28 " hed ))).. (
38c0: 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 74 if (not (null? t
38d0: 61 6c 29 29 0a 09 20 20 20 20 20 20 28 6c 6f 6f al)).. (loo
38e0: 70 20 28 63 61 72 20 74 61 6c 29 28 63 64 72 20 p (car tal)(cdr
38f0: 74 61 6c 29 28 69 66 20 6e 65 77 20 28 61 70 70 tal)(if new (app
3900: 65 6e 64 20 72 65 73 20 28 6c 69 73 74 20 6e 65 end res (list ne
3910: 77 29 29 20 72 65 73 29 28 2b 20 6c 6e 75 6d 20 w)) res)(+ lnum
3920: 31 29 29 29 0a 09 20 20 3b 3b 20 64 72 6f 70 20 1))).. ;; drop
3930: 74 6f 20 68 65 72 65 20 77 68 65 6e 20 64 6f 6e to here when don
3940: 65 20 70 72 6f 63 65 73 73 69 6e 67 2c 20 72 65 e processing, re
3950: 73 20 63 6f 6e 74 61 69 6e 73 20 6d 6f 64 69 66 s contains modif
3960: 69 65 64 20 6c 69 73 74 20 6f 66 20 6c 69 6e 65 ied list of line
3970: 73 0a 09 20 20 28 73 65 74 21 20 66 64 61 74 20 s.. (set! fdat
3980: 72 65 73 29 29 29 0a 0a 20 20 20 20 3b 3b 20 73 res))).. ;; s
3990: 74 65 70 20 34 3a 20 41 70 70 65 6e 64 20 6e 65 tep 4: Append ne
39a0: 77 20 76 61 6c 75 65 73 20 74 6f 20 74 68 65 20 w values to the
39b0: 73 65 63 74 69 6f 6e 0a 20 20 20 20 28 66 6f 72 section. (for
39c0: 2d 65 61 63 68 20 0a 20 20 20 20 20 28 6c 61 6d -each . (lam
39d0: 62 64 61 20 28 73 65 63 74 69 6f 6e 29 0a 20 20 bda (section).
39e0: 20 20 20 20 20 28 6c 65 74 20 28 28 73 64 61 74 (let ((sdat
39f0: 20 20 20 27 28 29 29 20 3b 3b 20 61 70 70 65 6e '()) ;; appen
3a00: 64 20 6e 65 65 64 65 64 20 62 69 74 73 20 68 65 d needed bits he
3a10: 72 65 0a 09 20 20 20 20 20 28 73 76 61 72 73 20 re.. (svars
3a20: 20 28 63 6f 6e 66 69 67 66 3a 73 65 63 74 69 6f (configf:sectio
3a30: 6e 2d 76 61 72 73 20 69 6e 64 61 74 20 73 65 63 n-vars indat sec
3a40: 74 69 6f 6e 29 29 29 0a 09 20 28 66 6f 72 2d 65 tion))).. (for-e
3a50: 61 63 68 20 0a 09 20 20 28 6c 61 6d 62 64 61 20 ach .. (lambda
3a60: 28 76 61 72 29 0a 09 20 20 20 20 28 6c 65 74 20 (var).. (let
3a70: 28 28 76 61 6c 20 28 63 6f 6e 66 69 67 2d 6c 6f ((val (config-lo
3a80: 6f 6b 75 70 20 72 65 66 64 61 74 20 73 65 63 74 okup refdat sect
3a90: 69 6f 6e 20 76 61 72 29 29 29 0a 09 20 20 20 20 ion var)))..
3aa0: 20 20 28 69 66 20 28 6e 6f 74 20 76 61 6c 29 20 (if (not val)
3ab0: 3b 3b 20 74 68 69 73 20 6f 6e 65 20 69 73 20 6e ;; this one is n
3ac0: 65 77 0a 09 09 20 20 28 62 65 67 69 6e 0a 09 09 ew... (begin...
3ad0: 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 73 (if (null? s
3ae0: 64 61 74 29 28 73 65 74 21 20 73 64 61 74 20 28 dat)(set! sdat (
3af0: 6c 69 73 74 20 28 63 6f 6e 63 20 22 5b 22 20 73 list (conc "[" s
3b00: 65 63 74 69 6f 6e 20 22 5d 22 29 29 29 29 0a 09 ection "]"))))..
3b10: 09 20 20 20 20 28 73 65 74 21 20 73 64 61 74 20 . (set! sdat
3b20: 28 61 70 70 65 6e 64 20 73 64 61 74 20 28 6c 69 (append sdat (li
3b30: 73 74 20 28 63 6f 6e 63 20 76 61 72 20 22 20 22 st (conc var " "
3b40: 20 76 61 6c 29 29 29 29 29 29 29 29 0a 09 20 20 val))))))))..
3b50: 73 76 61 72 73 29 0a 09 20 28 73 65 74 21 20 66 svars).. (set! f
3b60: 64 61 74 20 28 61 70 70 65 6e 64 20 66 64 61 74 dat (append fdat
3b70: 20 73 64 61 74 29 29 29 29 0a 20 20 20 20 20 28 sdat)))). (
3b80: 64 65 6c 65 74 65 2d 64 75 70 6c 69 63 61 74 65 delete-duplicate
3b90: 73 20 28 61 70 70 65 6e 64 20 72 65 71 75 69 72 s (append requir
3ba0: 65 2d 73 65 63 74 69 6f 6e 73 20 28 68 61 73 68 e-sections (hash
3bb0: 2d 74 61 62 6c 65 2d 6b 65 79 73 20 69 6e 64 61 -table-keys inda
3bc0: 74 29 29 29 29 0a 0a 20 20 20 20 3b 3b 20 73 74 t)))).. ;; st
3bd0: 65 70 20 35 3a 20 57 72 69 74 65 20 6f 75 74 20 ep 5: Write out
3be0: 6e 65 77 20 66 69 6c 65 0a 20 20 20 20 28 77 69 new file. (wi
3bf0: 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 69 6c th-output-to-fil
3c00: 65 20 66 6e 61 6d 65 20 0a 20 20 20 20 20 20 28 e fname . (
3c10: 6c 61 6d 62 64 61 20 28 29 0a 09 28 66 6f 72 2d lambda ()..(for-
3c20: 65 61 63 68 20 0a 09 20 28 6c 61 6d 62 64 61 20 each .. (lambda
3c30: 28 6c 69 6e 65 29 0a 09 20 20 20 28 70 72 69 6e (line).. (prin
3c40: 74 20 6c 69 6e 65 29 29 0a 09 20 28 63 6f 6e 66 t line)).. (conf
3c50: 69 67 66 3a 65 78 70 61 6e 64 2d 6d 75 6c 74 69 igf:expand-multi
3c60: 2d 6c 69 6e 65 73 20 66 64 61 74 29 29 29 29 29 -lines fdat)))))
3c70: 29 0a 0a )..