Artifact 4590f7c8750e57bb3335dd6c1f70c74fd7fc60e7:
- File configf.scm — part of check-in [b71bf64192] at 2011-11-02 18:09:28 on branch envhandling — envvar handling is not reentrant. Need a better solution. Putting this stuff on a branch for now (user: mrwellan size: 6242)
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 31 2c right 2006-2011, 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 20 72 65 61 64 20 61 20 63 6f ))..;; read a co 0620: 6e 66 69 67 20 66 69 6c 65 2c 20 72 65 74 75 72 nfig file, retur 0630: 6e 73 20 68 61 73 68 20 74 61 62 6c 65 20 6f 66 ns hash table of 0640: 20 61 6c 69 73 74 73 0a 3b 3b 20 61 64 64 73 20 alists.;; adds 0650: 74 6f 20 68 74 20 69 66 20 67 69 76 65 6e 20 28 to ht if given ( 0660: 6d 75 73 74 20 62 65 20 23 66 20 6f 74 68 65 72 must be #f other 0670: 77 69 73 65 29 0a 3b 3b 20 65 6e 76 69 6f 6e 2d wise).;; envion- 0680: 70 61 74 74 20 69 73 20 61 20 72 65 67 65 78 20 patt is a regex 0690: 73 70 65 63 20 74 68 61 74 20 69 64 65 6e 74 69 spec that identi 06a0: 66 69 65 73 20 73 65 63 74 69 6f 6e 73 20 74 68 fies sections th 06b0: 61 74 20 77 69 6c 6c 20 62 65 20 65 76 61 6c 27 at will be eval' 06c0: 64 0a 3b 3b 20 69 6e 20 74 68 65 20 65 6e 76 69 d.;; in the envi 06d0: 72 6f 6e 6d 65 6e 74 20 6f 6e 20 74 68 65 20 66 ronment on the f 06e0: 6c 79 0a 0a 28 64 65 66 69 6e 65 20 28 72 65 61 ly..(define (rea 06f0: 64 2d 63 6f 6e 66 69 67 20 70 61 74 68 20 68 74 d-config path ht 0700: 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 23 21 allow-system #! 0710: 6b 65 79 20 28 65 6e 76 69 72 6f 6e 2d 70 61 74 key (environ-pat 0720: 74 20 23 66 29 29 0a 20 20 28 64 65 62 75 67 3a t #f)). (debug: 0730: 70 72 69 6e 74 20 34 20 22 49 4e 46 4f 3a 20 72 print 4 "INFO: r 0740: 65 61 64 2d 63 6f 6e 66 69 67 20 22 20 70 61 74 ead-config " pat 0750: 68 20 22 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d h " allow-system 0760: 20 22 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 " allow-system 0770: 22 20 65 6e 76 69 72 6f 6e 2d 70 61 74 74 20 22 " environ-patt " 0780: 20 65 6e 76 69 72 6f 6e 2d 70 61 74 74 29 0a 20 environ-patt). 0790: 20 28 69 66 20 28 6e 6f 74 20 28 66 69 6c 65 2d (if (not (file- 07a0: 65 78 69 73 74 73 3f 20 70 61 74 68 29 29 0a 20 exists? path)). 07b0: 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 68 74 (if (not ht 07c0: 29 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c )(make-hash-tabl 07d0: 65 29 20 68 74 29 0a 20 20 20 20 20 20 28 6c 65 e) ht). (le 07e0: 74 20 28 28 69 6e 70 20 20 20 20 20 20 20 20 28 t ((inp ( 07f0: 6f 70 65 6e 2d 69 6e 70 75 74 2d 66 69 6c 65 20 open-input-file 0800: 70 61 74 68 29 29 0a 09 20 20 20 20 28 72 65 73 path)).. (res 0810: 20 20 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 (if (not 0820: 20 68 74 29 28 6d 61 6b 65 2d 68 61 73 68 2d 74 ht)(make-hash-t 0830: 61 62 6c 65 29 20 68 74 29 29 0a 09 20 20 20 20 able) ht)).. 0840: 28 69 6e 63 6c 75 64 65 2d 72 78 20 28 72 65 67 (include-rx (reg 0850: 65 78 70 20 22 5e 5c 5c 5b 69 6e 63 6c 75 64 65 exp "^\\[include 0860: 5c 5c 73 2b 28 2e 2a 29 5c 5c 5d 5c 5c 73 2a 24 \\s+(.*)\\]\\s*$ 0870: 22 29 29 0a 09 20 20 20 20 28 73 65 63 74 69 6f ")).. (sectio 0880: 6e 2d 72 78 20 28 72 65 67 65 78 70 20 22 5e 5c n-rx (regexp "^\ 0890: 5c 5b 28 2e 2a 29 5c 5c 5d 5c 5c 73 2a 24 22 29 \[(.*)\\]\\s*$") 08a0: 29 0a 09 20 20 20 20 28 62 6c 61 6e 6b 2d 6c 2d ).. (blank-l- 08b0: 72 78 20 28 72 65 67 65 78 70 20 22 5e 5c 5c 73 rx (regexp "^\\s 08c0: 2a 24 22 29 29 0a 09 20 20 20 20 28 6b 65 79 2d *$")).. (key- 08d0: 73 79 73 2d 70 72 20 28 72 65 67 65 78 70 20 22 sys-pr (regexp " 08e0: 5e 28 5c 5c 53 2b 29 5c 5c 73 2b 5c 5c 5b 73 79 ^(\\S+)\\s+\\[sy 08f0: 73 74 65 6d 5c 5c 73 2b 28 5c 5c 53 2b 2e 2a 29 stem\\s+(\\S+.*) 0900: 5c 5c 5d 5c 5c 73 2a 24 22 29 29 0a 09 20 20 20 \\]\\s*$")).. 0910: 20 28 6b 65 79 2d 76 61 6c 2d 70 72 20 28 72 65 (key-val-pr (re 0920: 67 65 78 70 20 22 5e 28 5c 5c 53 2b 29 5c 5c 73 gexp "^(\\S+)\\s 0930: 2b 28 2e 2a 29 24 22 29 29 0a 09 20 20 20 20 28 +(.*)$")).. ( 0940: 63 6f 6d 6d 65 6e 74 2d 72 78 20 28 72 65 67 65 comment-rx (rege 0950: 78 70 20 22 5e 5c 5c 73 2a 23 2e 2a 22 29 29 0a xp "^\\s*#.*")). 0960: 09 20 20 20 20 28 63 6f 6e 74 2d 6c 6e 2d 72 78 . (cont-ln-rx 0970: 20 28 72 65 67 65 78 70 20 22 5e 28 5c 5c 73 2b (regexp "^(\\s+ 0980: 29 28 5c 5c 53 2b 2e 2a 29 24 22 29 29 29 0a 09 )(\\S+.*)$"))).. 0990: 28 6c 65 74 20 6c 6f 6f 70 20 28 28 69 6e 6c 20 (let loop ((inl 09a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 72 (r 09b0: 65 61 64 2d 6c 69 6e 65 20 69 6e 70 29 29 0a 09 ead-line inp)).. 09c0: 09 20 20 20 28 63 75 72 72 2d 73 65 63 74 69 6f . (curr-sectio 09d0: 6e 2d 6e 61 6d 65 20 22 64 65 66 61 75 6c 74 22 n-name "default" 09e0: 29 0a 09 09 20 20 20 28 76 61 72 2d 66 6c 61 67 )... (var-flag 09f0: 20 23 66 29 3b 3b 20 74 75 72 6e 20 6f 6e 20 66 #f);; turn on f 0a00: 6f 72 20 6b 65 79 2d 76 61 72 2d 70 72 20 61 6e or key-var-pr an 0a10: 64 20 63 6f 6e 74 2d 6c 6e 2d 72 78 2c 20 74 75 d cont-ln-rx, tu 0a20: 72 6e 20 6f 66 66 20 65 6c 73 65 77 68 65 72 65 rn off elsewhere 0a30: 0a 09 09 20 20 20 28 6c 65 61 64 20 20 20 20 20 ... (lead 0a40: 23 66 29 29 0a 09 20 20 28 69 66 20 28 65 6f 66 #f)).. (if (eof 0a50: 2d 6f 62 6a 65 63 74 3f 20 69 6e 6c 29 20 0a 09 -object? inl) .. 0a60: 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 28 (begin...( 0a70: 63 6c 6f 73 65 2d 69 6e 70 75 74 2d 70 6f 72 74 close-input-port 0a80: 20 69 6e 70 29 0a 09 09 72 65 73 29 0a 09 20 20 inp)...res).. 0a90: 20 20 20 20 28 72 65 67 65 78 2d 63 61 73 65 20 (regex-case 0aa0: 0a 09 20 20 20 20 20 20 20 69 6e 6c 20 0a 09 20 .. inl .. 0ab0: 20 20 20 20 20 20 28 63 6f 6d 6d 65 6e 74 2d 72 (comment-r 0ac0: 78 20 5f 20 20 20 20 20 20 20 20 20 20 20 20 20 x _ 0ad0: 20 20 20 20 20 28 6c 6f 6f 70 20 28 72 65 61 64 (loop (read 0ae0: 2d 6c 69 6e 65 20 69 6e 70 29 20 63 75 72 72 2d -line inp) curr- 0af0: 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 section-name #f 0b00: 23 66 29 29 0a 09 20 20 20 20 20 20 20 28 62 6c #f)).. (bl 0b10: 61 6e 6b 2d 6c 2d 72 78 20 5f 20 20 20 20 20 20 ank-l-rx _ 0b20: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f (loo 0b30: 70 20 28 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 p (read-line inp 0b40: 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e ) curr-section-n 0b50: 61 6d 65 20 23 66 20 23 66 29 29 0a 09 20 20 20 ame #f #f)).. 0b60: 20 20 20 20 28 69 6e 63 6c 75 64 65 2d 72 78 20 (include-rx 0b70: 28 20 78 20 69 6e 63 6c 75 64 65 2d 66 69 6c 65 ( x include-file 0b80: 20 29 20 28 62 65 67 69 6e 0a 09 09 09 09 09 09 ) (begin....... 0b90: 28 72 65 61 64 2d 63 6f 6e 66 69 67 20 69 6e 63 (read-config inc 0ba0: 6c 75 64 65 2d 66 69 6c 65 20 72 65 73 20 61 6c lude-file res al 0bb0: 6c 6f 77 2d 73 79 73 74 65 6d 20 65 6e 76 69 72 low-system envir 0bc0: 6f 6e 2d 70 61 74 74 3a 20 65 6e 76 69 72 6f 6e on-patt: environ 0bd0: 2d 70 61 74 74 29 0a 09 09 09 09 09 09 28 6c 6f -patt).......(lo 0be0: 6f 70 20 28 72 65 61 64 2d 6c 69 6e 65 20 69 6e op (read-line in 0bf0: 70 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d p) curr-section- 0c00: 6e 61 6d 65 20 23 66 20 23 66 29 29 29 0a 09 20 name #f #f))).. 0c10: 20 20 20 20 20 20 28 73 65 63 74 69 6f 6e 2d 72 (section-r 0c20: 78 20 28 20 78 20 73 65 63 74 69 6f 6e 2d 6e 61 x ( x section-na 0c30: 6d 65 20 29 20 28 6c 6f 6f 70 20 28 72 65 61 64 me ) (loop (read 0c40: 2d 6c 69 6e 65 20 69 6e 70 29 20 73 65 63 74 69 -line inp) secti 0c50: 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 66 29 29 0a on-name #f #f)). 0c60: 09 20 20 20 20 20 20 20 28 6b 65 79 2d 73 79 73 . (key-sys 0c70: 2d 70 72 20 28 20 78 20 6b 65 79 20 63 6d 64 20 -pr ( x key cmd 0c80: 20 20 20 20 20 29 20 28 69 66 20 61 6c 6c 6f 77 ) (if allow 0c90: 2d 73 79 73 74 65 6d 0a 09 09 09 09 09 09 20 20 -system....... 0ca0: 28 6c 65 74 20 28 28 61 6c 69 73 74 20 28 68 61 (let ((alist (ha 0cb0: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def 0cc0: 61 75 6c 74 20 72 65 73 20 63 75 72 72 2d 73 65 ault res curr-se 0cd0: 63 74 69 6f 6e 2d 6e 61 6d 65 20 27 28 29 29 29 ction-name '())) 0ce0: 0a 09 09 09 09 09 09 09 28 76 61 6c 20 20 20 28 ........(val ( 0cf0: 6c 65 74 2a 20 28 28 63 6d 64 72 65 73 20 20 28 let* ((cmdres ( 0d00: 63 6d 64 2d 72 75 6e 2d 3e 6c 69 73 74 20 63 6d cmd-run->list cm 0d10: 64 29 29 0a 09 09 09 09 09 09 09 09 20 20 20 20 d))......... 0d20: 20 20 28 73 74 61 74 75 73 20 20 28 63 61 64 72 (status (cadr 0d30: 20 63 6d 64 72 65 73 29 29 0a 09 09 09 09 09 09 cmdres))....... 0d40: 09 09 20 20 20 20 20 20 28 72 65 73 20 20 20 20 .. (res 0d50: 20 28 63 61 72 20 20 63 6d 64 72 65 73 29 29 29 (car cmdres))) 0d60: 0a 09 09 09 09 09 09 09 09 20 28 69 66 20 28 6e ......... (if (n 0d70: 6f 74 20 28 65 71 3f 20 73 74 61 74 75 73 20 30 ot (eq? status 0 0d80: 29 29 0a 09 09 09 09 09 09 09 09 20 20 20 20 20 ))......... 0d90: 28 62 65 67 69 6e 0a 09 09 09 09 09 09 09 09 20 (begin......... 0da0: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri 0db0: 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 70 72 6f nt 0 "ERROR: pro 0dc0: 62 6c 65 6d 20 77 69 74 68 20 22 20 69 6e 6c 20 blem with " inl 0dd0: 22 2c 20 72 65 74 75 72 6e 20 63 6f 64 65 20 22 ", return code " 0de0: 20 73 74 61 74 75 73 29 0a 09 09 09 09 09 09 09 status)........ 0df0: 09 20 20 20 20 20 20 20 28 65 78 69 74 20 31 29 . (exit 1) 0e00: 29 29 0a 09 09 09 09 09 09 09 09 20 28 69 66 20 ))......... (if 0e10: 28 6e 75 6c 6c 3f 20 72 65 73 29 0a 09 09 09 09 (null? res)..... 0e20: 09 09 09 09 20 20 20 20 20 22 22 0a 09 09 09 09 .... ""..... 0e30: 09 09 09 09 20 20 20 20 20 28 73 74 72 69 6e 67 .... (string 0e40: 2d 69 6e 74 65 72 73 70 65 72 73 65 20 72 65 73 -intersperse res 0e50: 20 22 20 22 29 29 29 29 29 0a 09 09 09 09 09 09 " ")))))....... 0e60: 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (hash-table- 0e70: 73 65 74 21 20 72 65 73 20 63 75 72 72 2d 73 65 set! res curr-se 0e80: 63 74 69 6f 6e 2d 6e 61 6d 65 20 0a 09 09 09 09 ction-name ..... 0e90: 09 09 09 09 20 20 20 20 20 28 63 6f 6e 66 69 67 .... (config 0ea0: 3a 61 73 73 6f 63 2d 73 61 66 65 2d 61 64 64 20 :assoc-safe-add 0eb0: 61 6c 69 73 74 20 6b 65 79 20 76 61 6c 29 29 0a alist key val)). 0ec0: 09 09 09 09 09 09 20 20 20 20 28 6c 6f 6f 70 20 ...... (loop 0ed0: 28 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 29 20 (read-line inp) 0ee0: 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d curr-section-nam 0ef0: 65 20 23 66 20 23 66 29 29 0a 09 09 09 09 09 09 e #f #f))....... 0f00: 20 20 28 6c 6f 6f 70 20 28 72 65 61 64 2d 6c 69 (loop (read-li 0f10: 6e 65 20 69 6e 70 29 20 63 75 72 72 2d 73 65 63 ne inp) curr-sec 0f20: 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 66 29 tion-name #f #f) 0f30: 29 29 0a 09 20 20 20 20 20 20 20 28 6b 65 79 2d )).. (key- 0f40: 76 61 6c 2d 70 72 20 28 20 78 20 6b 65 79 20 76 val-pr ( x key v 0f50: 61 6c 20 20 20 20 20 20 29 20 28 6c 65 74 20 28 al ) (let ( 0f60: 28 61 6c 69 73 74 20 20 20 28 68 61 73 68 2d 74 (alist (hash-t 0f70: 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 able-ref/default 0f80: 20 72 65 73 20 63 75 72 72 2d 73 65 63 74 69 6f res curr-sectio 0f90: 6e 2d 6e 61 6d 65 20 27 28 29 29 29 0a 09 09 09 n-name '())).... 0fa0: 09 09 09 20 20 20 20 28 72 65 61 6c 76 61 6c 20 ... (realval 0fb0: 28 69 66 20 28 61 6e 64 20 65 6e 76 69 72 6f 6e (if (and environ 0fc0: 2d 70 61 74 74 20 28 73 74 72 69 6e 67 2d 6d 61 -patt (string-ma 0fd0: 74 63 68 20 28 72 65 67 65 78 70 20 65 6e 76 69 tch (regexp envi 0fe0: 72 6f 6e 2d 70 61 74 74 29 20 63 75 72 72 2d 73 ron-patt) curr-s 0ff0: 65 63 74 69 6f 6e 2d 6e 61 6d 65 29 29 0a 09 09 ection-name))... 1000: 09 09 09 09 09 09 20 28 63 6f 6e 66 69 67 3a 65 ...... (config:e 1010: 76 61 6c 2d 73 74 72 69 6e 67 2d 69 6e 2d 65 6e val-string-in-en 1020: 76 69 72 6f 6e 6d 65 6e 74 20 76 61 6c 29 0a 09 vironment val).. 1030: 09 09 09 09 09 09 09 20 76 61 6c 29 29 29 0a 09 ....... val))).. 1040: 09 09 09 09 09 28 73 65 74 65 6e 76 20 6b 65 79 .....(setenv key 1050: 20 72 65 61 6c 76 61 6c 29 0a 09 09 09 09 09 09 realval)....... 1060: 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 (hash-table-set! 1070: 20 72 65 73 20 63 75 72 72 2d 73 65 63 74 69 6f res curr-sectio 1080: 6e 2d 6e 61 6d 65 20 0a 09 09 09 09 09 09 09 09 n-name ......... 1090: 20 28 63 6f 6e 66 69 67 3a 61 73 73 6f 63 2d 73 (config:assoc-s 10a0: 61 66 65 2d 61 64 64 20 61 6c 69 73 74 20 6b 65 afe-add alist ke 10b0: 79 20 72 65 61 6c 76 61 6c 29 29 0a 09 09 09 09 y realval))..... 10c0: 09 09 28 6c 6f 6f 70 20 28 72 65 61 64 2d 6c 69 ..(loop (read-li 10d0: 6e 65 20 69 6e 70 29 20 63 75 72 72 2d 73 65 63 ne inp) curr-sec 10e0: 74 69 6f 6e 2d 6e 61 6d 65 20 6b 65 79 20 23 66 tion-name key #f 10f0: 29 29 29 0a 09 20 20 20 20 20 20 20 3b 3b 20 69 ))).. ;; i 1100: 66 20 61 20 63 6f 6e 74 69 6e 75 65 64 20 6c 69 f a continued li 1110: 6e 65 0a 09 20 20 20 20 20 20 20 28 63 6f 6e 74 ne.. (cont 1120: 2d 6c 6e 2d 72 78 20 28 20 78 20 77 68 73 70 20 -ln-rx ( x whsp 1130: 76 61 6c 20 20 20 20 20 29 20 28 6c 65 74 20 28 val ) (let ( 1140: 28 61 6c 69 73 74 20 28 68 61 73 68 2d 74 61 62 (alist (hash-tab 1150: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 72 le-ref/default r 1160: 65 73 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d es curr-section- 1170: 6e 61 6d 65 20 27 28 29 29 29 29 0a 09 09 09 09 name '())))..... 1180: 09 09 28 69 66 20 76 61 72 2d 66 6c 61 67 20 20 ..(if var-flag 1190: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 69 66 ;; if 11a0: 20 73 65 74 20 74 6f 20 61 20 73 74 72 69 6e 67 set to a string 11b0: 20 74 68 65 6e 20 77 65 20 68 61 76 65 20 61 20 then we have a 11c0: 63 6f 6e 74 69 6e 75 65 64 20 76 61 72 0a 09 09 continued var... 11d0: 09 09 09 09 20 20 20 20 28 6c 65 74 20 28 28 6e .... (let ((n 11e0: 65 77 76 61 6c 20 28 63 6f 6e 63 20 0a 09 09 09 ewval (conc .... 11f0: 09 09 09 09 09 20 20 20 28 63 6f 6e 66 69 67 2d ..... (config- 1200: 6c 6f 6f 6b 75 70 20 72 65 73 20 63 75 72 72 2d lookup res curr- 1210: 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 76 61 72 section-name var 1220: 2d 66 6c 61 67 29 20 22 5c 6e 22 0a 09 09 09 09 -flag) "\n"..... 1230: 09 09 09 09 20 20 20 3b 3b 20 74 72 69 6d 20 6c .... ;; trim l 1240: 65 61 64 20 66 72 6f 6d 20 74 68 65 20 69 6e 63 ead from the inc 1250: 6f 6d 69 6e 67 20 77 68 73 70 20 74 6f 20 73 75 oming whsp to su 1260: 70 70 6f 72 74 20 73 6f 6d 65 20 69 6e 64 65 6e pport some inden 1270: 74 69 6e 67 2e 0a 09 09 09 09 09 09 09 09 20 20 ting.......... 1280: 20 28 69 66 20 6c 65 61 64 0a 09 09 09 09 09 09 (if lead....... 1290: 09 09 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 .. (string 12a0: 2d 73 75 62 73 74 69 74 75 74 65 20 28 72 65 67 -substitute (reg 12b0: 65 78 70 20 6c 65 61 64 29 20 22 22 20 77 68 73 exp lead) "" whs 12c0: 70 29 0a 09 09 09 09 09 09 09 09 20 20 20 20 20 p)......... 12d0: 20 20 22 22 29 0a 09 09 09 09 09 09 09 09 20 20 "")......... 12e0: 20 76 61 6c 29 29 29 0a 09 09 09 09 09 09 20 20 val)))....... 12f0: 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 76 ;; (print "v 1300: 61 6c 3a 20 22 20 76 61 6c 20 22 5c 6e 6e 65 77 al: " val "\nnew 1310: 76 61 6c 3a 20 5c 22 22 20 6e 65 77 76 61 6c 20 val: \"" newval 1320: 22 5c 22 5c 6e 76 61 72 66 6c 61 67 3a 20 22 20 "\"\nvarflag: " 1330: 76 61 72 2d 66 6c 61 67 29 0a 09 09 09 09 09 09 var-flag)....... 1340: 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c (hash-tabl 1350: 65 2d 73 65 74 21 20 72 65 73 20 63 75 72 72 2d e-set! res curr- 1360: 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 0a 09 09 section-name ... 1370: 09 09 09 09 09 09 20 20 20 20 20 20 20 28 63 6f ...... (co 1380: 6e 66 69 67 3a 61 73 73 6f 63 2d 73 61 66 65 2d nfig:assoc-safe- 1390: 61 64 64 20 61 6c 69 73 74 20 76 61 72 2d 66 6c add alist var-fl 13a0: 61 67 20 6e 65 77 76 61 6c 29 29 0a 09 09 09 09 ag newval))..... 13b0: 09 09 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 72 .. (loop (r 13c0: 65 61 64 2d 6c 69 6e 65 20 69 6e 70 29 20 63 75 ead-line inp) cu 13d0: 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 rr-section-name 13e0: 76 61 72 2d 66 6c 61 67 20 28 69 66 20 6c 65 61 var-flag (if lea 13f0: 64 20 6c 65 61 64 20 77 68 73 70 29 29 29 0a 09 d lead whsp))).. 1400: 09 09 09 09 09 20 20 20 20 28 6c 6f 6f 70 20 28 ..... (loop ( 1410: 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 29 20 63 read-line inp) c 1420: 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 urr-section-name 1430: 20 23 66 20 23 66 29 29 29 29 0a 09 20 20 20 20 #f #f)))).. 1440: 20 20 20 28 65 6c 73 65 20 28 64 65 62 75 67 3a (else (debug: 1450: 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 print 0 "ERROR: 1460: 70 72 6f 62 6c 65 6d 20 70 61 72 73 69 6e 67 20 problem parsing 1470: 22 20 70 61 74 68 20 22 2c 5c 6e 20 20 20 5c 22 " path ",\n \" 1480: 22 20 69 6e 6c 20 22 5c 22 22 29 0a 09 09 20 20 " inl "\"")... 1490: 20 20 20 28 73 65 74 21 20 76 61 72 2d 66 6c 61 (set! var-fla 14a0: 67 20 23 66 29 0a 09 09 20 20 20 20 20 28 6c 6f g #f)... (lo 14b0: 6f 70 20 28 72 65 61 64 2d 6c 69 6e 65 20 69 6e op (read-line in 14c0: 70 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d p) curr-section- 14d0: 6e 61 6d 65 20 23 66 20 23 66 29 29 29 29 29 29 name #f #f)))))) 14e0: 29 29 0a 20 20 0a 28 64 65 66 69 6e 65 20 28 66 )). .(define (f 14f0: 69 6e 64 2d 61 6e 64 2d 72 65 61 64 2d 63 6f 6e ind-and-read-con 1500: 66 69 67 20 66 6e 61 6d 65 20 23 21 6b 65 79 20 fig fname #!key 1510: 28 65 6e 76 69 72 6f 6e 2d 70 61 74 74 20 23 66 (environ-patt #f 1520: 29 29 0a 20 20 28 6c 65 74 2a 20 28 28 63 75 72 )). (let* ((cur 1530: 72 2d 64 69 72 20 20 20 28 63 75 72 72 65 6e 74 r-dir (current 1540: 2d 64 69 72 65 63 74 6f 72 79 29 29 0a 20 20 20 -directory)). 1550: 20 20 20 20 20 20 28 63 6f 6e 66 69 67 69 6e 66 (configinf 1560: 6f 20 28 66 69 6e 64 2d 63 6f 6e 66 69 67 20 66 o (find-config f 1570: 6e 61 6d 65 29 29 0a 09 20 28 74 6f 70 70 61 74 name)).. (toppat 1580: 68 20 20 20 20 28 63 61 72 20 63 6f 6e 66 69 67 h (car config 1590: 69 6e 66 6f 29 29 0a 09 20 28 63 6f 6e 66 69 67 info)).. (config 15a0: 66 69 6c 65 20 28 63 61 64 72 20 63 6f 6e 66 69 file (cadr confi 15b0: 67 69 6e 66 6f 29 29 29 0a 20 20 20 20 28 69 66 ginfo))). (if 15c0: 20 74 6f 70 70 61 74 68 20 28 63 68 61 6e 67 65 toppath (change 15d0: 2d 64 69 72 65 63 74 6f 72 79 20 74 6f 70 70 61 -directory toppa 15e0: 74 68 29 29 20 0a 20 20 20 20 28 6c 65 74 20 28 th)) . (let ( 15f0: 28 63 6f 6e 66 69 67 64 61 74 20 20 28 69 66 20 (configdat (if 1600: 63 6f 6e 66 69 67 66 69 6c 65 20 28 72 65 61 64 configfile (read 1610: 2d 63 6f 6e 66 69 67 20 63 6f 6e 66 69 67 66 69 -config configfi 1620: 6c 65 20 23 66 20 23 74 20 65 6e 76 69 72 6f 6e le #f #t environ 1630: 2d 70 61 74 74 3a 20 65 6e 76 69 72 6f 6e 2d 70 -patt: environ-p 1640: 61 74 74 29 20 23 66 29 29 29 20 3b 3b 20 28 6d att) #f))) ;; (m 1650: 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 ake-hash-table)) 1660: 29 29 0a 20 20 20 20 20 20 28 69 66 20 74 6f 70 )). (if top 1670: 70 61 74 68 20 28 63 68 61 6e 67 65 2d 64 69 72 path (change-dir 1680: 65 63 74 6f 72 79 20 63 75 72 72 2d 64 69 72 29 ectory curr-dir) 1690: 29 0a 20 20 20 20 20 20 28 6c 69 73 74 20 63 6f ). (list co 16a0: 6e 66 69 67 64 61 74 20 74 6f 70 70 61 74 68 20 nfigdat toppath 16b0: 63 6f 6e 66 69 67 66 69 6c 65 20 66 6e 61 6d 65 configfile fname 16c0: 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 ))))..(define (c 16d0: 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 63 66 67 onfig-lookup cfg 16e0: 64 61 74 20 73 65 63 74 69 6f 6e 20 76 61 72 29 dat section var) 16f0: 0a 20 20 28 6c 65 74 20 28 28 73 65 63 74 64 61 . (let ((sectda 1700: 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 t (hash-table-re 1710: 66 2f 64 65 66 61 75 6c 74 20 63 66 67 64 61 74 f/default cfgdat 1720: 20 73 65 63 74 69 6f 6e 20 27 28 29 29 29 29 0a section '()))). 1730: 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 73 (if (null? s 1740: 65 63 74 64 61 74 29 0a 09 23 66 0a 09 28 6c 65 ectdat)..#f..(le 1750: 74 20 28 28 6d 61 74 63 68 20 28 61 73 73 6f 63 t ((match (assoc 1760: 20 76 61 72 20 73 65 63 74 64 61 74 29 29 29 0a var sectdat))). 1770: 09 20 20 28 69 66 20 6d 61 74 63 68 0a 09 20 20 . (if match.. 1780: 20 20 20 20 28 63 61 64 72 20 6d 61 74 63 68 29 (cadr match) 1790: 0a 09 20 20 20 20 20 20 23 66 29 29 0a 09 29 29 .. #f))..)) 17a0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 73 65 74 75 )..(define (setu 17b0: 70 29 0a 20 20 28 6c 65 74 2a 20 28 28 63 6f 6e p). (let* ((con 17c0: 66 69 67 66 20 28 66 69 6e 64 2d 63 6f 6e 66 69 figf (find-confi 17d0: 67 29 29 0a 09 20 28 63 6f 6e 66 69 67 20 20 28 g)).. (config ( 17e0: 69 66 20 63 6f 6e 66 69 67 66 20 28 72 65 61 64 if configf (read 17f0: 2d 63 6f 6e 66 69 67 20 63 6f 6e 66 69 67 66 20 -config configf 1800: 23 66 20 23 74 29 20 23 66 29 29 29 0a 20 20 20 #f #t) #f))). 1810: 20 28 69 66 20 63 6f 6e 66 69 67 0a 09 28 73 65 (if config..(se 1820: 74 65 6e 76 20 22 52 55 4e 5f 41 52 45 41 5f 48 tenv "RUN_AREA_H 1830: 4f 4d 45 22 20 28 70 61 74 68 6e 61 6d 65 2d 64 OME" (pathname-d 1840: 69 72 65 63 74 6f 72 79 20 63 6f 6e 66 69 67 66 irectory configf 1850: 29 29 29 0a 20 20 20 20 63 6f 6e 66 69 67 29 29 ))). config)) 1860: 0a 0a ..