Artifact 4a3f07b3f32ca937582d25b1f6a8fda258f0bc88:
- File configf.scm — part of check-in [ff05a10939] at 2011-11-02 15:32:18 on branch trunk — Checking in partial fix for envvar handling (user: mrwellan size: 6110)
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 72 20 63 6d 64 72 65 73 29 29 29 ..(car cmdres))) 0610: 29 0a 0a 3b 3b 20 72 65 61 64 20 61 20 63 6f 6e )..;; read a con 0620: 66 69 67 20 66 69 6c 65 2c 20 72 65 74 75 72 6e fig file, return 0630: 73 20 68 61 73 68 20 74 61 62 6c 65 20 6f 66 20 s hash table of 0640: 61 6c 69 73 74 73 0a 3b 3b 20 61 64 64 73 20 74 alists.;; adds t 0650: 6f 20 68 74 20 69 66 20 67 69 76 65 6e 20 28 6d o ht if given (m 0660: 75 73 74 20 62 65 20 23 66 20 6f 74 68 65 72 77 ust be #f otherw 0670: 69 73 65 29 0a 3b 3b 20 65 6e 76 69 6f 6e 2d 70 ise).;; envion-p 0680: 61 74 74 20 69 73 20 61 20 72 65 67 65 78 20 73 att is a regex s 0690: 70 65 63 20 74 68 61 74 20 69 64 65 6e 74 69 66 pec that identif 06a0: 69 65 73 20 73 65 63 74 69 6f 6e 73 20 74 68 61 ies sections tha 06b0: 74 20 77 69 6c 6c 20 62 65 20 65 76 61 6c 27 64 t will be eval'd 06c0: 0a 3b 3b 20 69 6e 20 74 68 65 20 65 6e 76 69 72 .;; in the envir 06d0: 6f 6e 6d 65 6e 74 20 6f 6e 20 74 68 65 20 66 6c onment on the fl 06e0: 79 0a 0a 28 64 65 66 69 6e 65 20 28 72 65 61 64 y..(define (read 06f0: 2d 63 6f 6e 66 69 67 20 70 61 74 68 20 68 74 20 -config path ht 0700: 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 23 21 6b allow-system #!k 0710: 65 79 20 28 65 6e 76 69 72 6f 6e 2d 70 61 74 74 ey (environ-patt 0720: 20 23 66 29 29 0a 20 20 28 69 66 20 28 6e 6f 74 #f)). (if (not 0730: 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 70 (file-exists? p 0740: 61 74 68 29 29 0a 20 20 20 20 20 20 28 69 66 20 ath)). (if 0750: 28 6e 6f 74 20 68 74 29 28 6d 61 6b 65 2d 68 61 (not ht)(make-ha 0760: 73 68 2d 74 61 62 6c 65 29 20 68 74 29 0a 20 20 sh-table) ht). 0770: 20 20 20 20 28 6c 65 74 20 28 28 69 6e 70 20 20 (let ((inp 0780: 20 20 20 20 20 20 28 6f 70 65 6e 2d 69 6e 70 75 (open-inpu 0790: 74 2d 66 69 6c 65 20 70 61 74 68 29 29 0a 09 20 t-file path)).. 07a0: 20 20 20 28 72 65 73 20 20 20 20 20 20 20 20 28 (res ( 07b0: 69 66 20 28 6e 6f 74 20 68 74 29 28 6d 61 6b 65 if (not ht)(make 07c0: 2d 68 61 73 68 2d 74 61 62 6c 65 29 20 68 74 29 -hash-table) ht) 07d0: 29 0a 09 20 20 20 20 28 69 6e 63 6c 75 64 65 2d ).. (include- 07e0: 72 78 20 28 72 65 67 65 78 70 20 22 5e 5c 5c 5b rx (regexp "^\\[ 07f0: 69 6e 63 6c 75 64 65 5c 5c 73 2b 28 2e 2a 29 5c include\\s+(.*)\ 0800: 5c 5d 5c 5c 73 2a 24 22 29 29 0a 09 20 20 20 20 \]\\s*$")).. 0810: 28 73 65 63 74 69 6f 6e 2d 72 78 20 28 72 65 67 (section-rx (reg 0820: 65 78 70 20 22 5e 5c 5c 5b 28 2e 2a 29 5c 5c 5d exp "^\\[(.*)\\] 0830: 5c 5c 73 2a 24 22 29 29 0a 09 20 20 20 20 28 62 \\s*$")).. (b 0840: 6c 61 6e 6b 2d 6c 2d 72 78 20 28 72 65 67 65 78 lank-l-rx (regex 0850: 70 20 22 5e 5c 5c 73 2a 24 22 29 29 0a 09 20 20 p "^\\s*$")).. 0860: 20 20 28 6b 65 79 2d 73 79 73 2d 70 72 20 28 72 (key-sys-pr (r 0870: 65 67 65 78 70 20 22 5e 28 5c 5c 53 2b 29 5c 5c egexp "^(\\S+)\\ 0880: 73 2b 5c 5c 5b 73 79 73 74 65 6d 5c 5c 73 2b 28 s+\\[system\\s+( 0890: 5c 5c 53 2b 2e 2a 29 5c 5c 5d 5c 5c 73 2a 24 22 \\S+.*)\\]\\s*$" 08a0: 29 29 0a 09 20 20 20 20 28 6b 65 79 2d 76 61 6c )).. (key-val 08b0: 2d 70 72 20 28 72 65 67 65 78 70 20 22 5e 28 5c -pr (regexp "^(\ 08c0: 5c 53 2b 29 5c 5c 73 2b 28 2e 2a 29 24 22 29 29 \S+)\\s+(.*)$")) 08d0: 0a 09 20 20 20 20 28 63 6f 6d 6d 65 6e 74 2d 72 .. (comment-r 08e0: 78 20 28 72 65 67 65 78 70 20 22 5e 5c 5c 73 2a x (regexp "^\\s* 08f0: 23 2e 2a 22 29 29 0a 09 20 20 20 20 28 63 6f 6e #.*")).. (con 0900: 74 2d 6c 6e 2d 72 78 20 28 72 65 67 65 78 70 20 t-ln-rx (regexp 0910: 22 5e 28 5c 5c 73 2b 29 28 5c 5c 53 2b 2e 2a 29 "^(\\s+)(\\S+.*) 0920: 24 22 29 29 29 0a 09 28 6c 65 74 20 6c 6f 6f 70 $")))..(let loop 0930: 20 28 28 69 6e 6c 20 20 20 20 20 20 20 20 20 20 ((inl 0940: 20 20 20 20 20 28 72 65 61 64 2d 6c 69 6e 65 20 (read-line 0950: 69 6e 70 29 29 0a 09 09 20 20 20 28 63 75 72 72 inp))... (curr 0960: 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 22 64 -section-name "d 0970: 65 66 61 75 6c 74 22 29 0a 09 09 20 20 20 28 76 efault")... (v 0980: 61 72 2d 66 6c 61 67 20 23 66 29 3b 3b 20 74 75 ar-flag #f);; tu 0990: 72 6e 20 6f 6e 20 66 6f 72 20 6b 65 79 2d 76 61 rn on for key-va 09a0: 72 2d 70 72 20 61 6e 64 20 63 6f 6e 74 2d 6c 6e r-pr and cont-ln 09b0: 2d 72 78 2c 20 74 75 72 6e 20 6f 66 66 20 65 6c -rx, turn off el 09c0: 73 65 77 68 65 72 65 0a 09 09 20 20 20 28 6c 65 sewhere... (le 09d0: 61 64 20 20 20 20 20 23 66 29 29 0a 09 20 20 28 ad #f)).. ( 09e0: 69 66 20 28 65 6f 66 2d 6f 62 6a 65 63 74 3f 20 if (eof-object? 09f0: 69 6e 6c 29 20 0a 09 20 20 20 20 20 20 28 62 65 inl) .. (be 0a00: 67 69 6e 0a 09 09 28 63 6c 6f 73 65 2d 69 6e 70 gin...(close-inp 0a10: 75 74 2d 70 6f 72 74 20 69 6e 70 29 0a 09 09 72 ut-port inp)...r 0a20: 65 73 29 0a 09 20 20 20 20 20 20 28 72 65 67 65 es).. (rege 0a30: 78 2d 63 61 73 65 20 0a 09 20 20 20 20 20 20 20 x-case .. 0a40: 69 6e 6c 20 0a 09 20 20 20 20 20 20 20 28 63 6f inl .. (co 0a50: 6d 6d 65 6e 74 2d 72 78 20 5f 20 20 20 20 20 20 mment-rx _ 0a60: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f (loo 0a70: 70 20 28 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 p (read-line inp 0a80: 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e ) curr-section-n 0a90: 61 6d 65 20 23 66 20 23 66 29 29 0a 09 20 20 20 ame #f #f)).. 0aa0: 20 20 20 20 28 62 6c 61 6e 6b 2d 6c 2d 72 78 20 (blank-l-rx 0ab0: 5f 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 _ 0ac0: 20 20 20 28 6c 6f 6f 70 20 28 72 65 61 64 2d 6c (loop (read-l 0ad0: 69 6e 65 20 69 6e 70 29 20 63 75 72 72 2d 73 65 ine inp) curr-se 0ae0: 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 66 ction-name #f #f 0af0: 29 29 0a 09 20 20 20 20 20 20 20 28 69 6e 63 6c )).. (incl 0b00: 75 64 65 2d 72 78 20 28 20 78 20 69 6e 63 6c 75 ude-rx ( x inclu 0b10: 64 65 2d 66 69 6c 65 20 29 20 28 62 65 67 69 6e de-file ) (begin 0b20: 0a 09 09 09 09 09 09 28 72 65 61 64 2d 63 6f 6e .......(read-con 0b30: 66 69 67 20 69 6e 63 6c 75 64 65 2d 66 69 6c 65 fig include-file 0b40: 20 72 65 73 20 61 6c 6c 6f 77 2d 73 79 73 74 65 res allow-syste 0b50: 6d 20 65 6e 76 69 72 6f 6e 2d 70 61 74 74 3a 20 m environ-patt: 0b60: 65 6e 76 69 72 6f 6e 2d 70 61 74 74 29 0a 09 09 environ-patt)... 0b70: 09 09 09 09 28 6c 6f 6f 70 20 28 72 65 61 64 2d ....(loop (read- 0b80: 6c 69 6e 65 20 69 6e 70 29 20 63 75 72 72 2d 73 line inp) curr-s 0b90: 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 ection-name #f # 0ba0: 66 29 29 29 0a 09 20 20 20 20 20 20 20 28 73 65 f))).. (se 0bb0: 63 74 69 6f 6e 2d 72 78 20 28 20 78 20 73 65 63 ction-rx ( x sec 0bc0: 74 69 6f 6e 2d 6e 61 6d 65 20 29 20 28 6c 6f 6f tion-name ) (loo 0bd0: 70 20 28 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 p (read-line inp 0be0: 29 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 ) section-name # 0bf0: 66 20 23 66 29 29 0a 09 20 20 20 20 20 20 20 28 f #f)).. ( 0c00: 6b 65 79 2d 73 79 73 2d 70 72 20 28 20 78 20 6b key-sys-pr ( x k 0c10: 65 79 20 63 6d 64 20 20 20 20 20 20 29 20 28 69 ey cmd ) (i 0c20: 66 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 0a 09 f allow-system.. 0c30: 09 09 09 09 09 20 20 28 6c 65 74 20 28 28 61 6c ..... (let ((al 0c40: 69 73 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d ist (hash-table- 0c50: 72 65 66 2f 64 65 66 61 75 6c 74 20 72 65 73 20 ref/default res 0c60: 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d curr-section-nam 0c70: 65 20 27 28 29 29 29 0a 09 09 09 09 09 09 09 28 e '()))........( 0c80: 76 61 6c 20 20 20 28 6c 65 74 2a 20 28 28 63 6d val (let* ((cm 0c90: 64 72 65 73 20 20 28 63 6d 64 2d 72 75 6e 2d 3e dres (cmd-run-> 0ca0: 6c 69 73 74 20 63 6d 64 29 29 0a 09 09 09 09 09 list cmd))...... 0cb0: 09 09 09 20 20 20 20 20 20 28 73 74 61 74 75 73 ... (status 0cc0: 20 20 28 63 61 64 72 20 63 6d 64 72 65 73 29 29 (cadr cmdres)) 0cd0: 0a 09 09 09 09 09 09 09 09 20 20 20 20 20 20 28 ......... ( 0ce0: 72 65 73 20 20 20 20 20 28 63 61 72 20 20 63 6d res (car cm 0cf0: 64 72 65 73 29 29 29 0a 09 09 09 09 09 09 09 09 dres)))......... 0d00: 20 28 69 66 20 28 6e 6f 74 20 28 65 71 3f 20 73 (if (not (eq? s 0d10: 74 61 74 75 73 20 30 29 29 0a 09 09 09 09 09 09 tatus 0))....... 0d20: 09 09 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 .. (begin... 0d30: 09 09 09 09 09 09 20 20 20 20 20 20 20 28 64 65 ...... (de 0d40: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 bug:print 0 "ERR 0d50: 4f 52 3a 20 70 72 6f 62 6c 65 6d 20 77 69 74 68 OR: problem with 0d60: 20 22 20 69 6e 6c 20 22 2c 20 72 65 74 75 72 6e " inl ", return 0d70: 20 63 6f 64 65 20 22 20 73 74 61 74 75 73 29 0a code " status). 0d80: 09 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 ........ ( 0d90: 65 78 69 74 20 31 29 29 29 0a 09 09 09 09 09 09 exit 1)))....... 0da0: 09 09 20 28 69 66 20 28 6e 75 6c 6c 3f 20 72 65 .. (if (null? re 0db0: 73 29 0a 09 09 09 09 09 09 09 09 20 20 20 20 20 s)......... 0dc0: 22 22 0a 09 09 09 09 09 09 09 09 20 20 20 20 20 ""......... 0dd0: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe 0de0: 72 73 65 20 72 65 73 20 22 20 22 29 29 29 29 29 rse res " "))))) 0df0: 0a 09 09 09 09 09 09 20 20 20 20 28 68 61 73 68 ....... (hash 0e00: 2d 74 61 62 6c 65 2d 73 65 74 21 20 72 65 73 20 -table-set! res 0e10: 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d curr-section-nam 0e20: 65 20 0a 09 09 09 09 09 09 09 09 20 20 20 20 20 e ......... 0e30: 28 63 6f 6e 66 69 67 3a 61 73 73 6f 63 2d 73 61 (config:assoc-sa 0e40: 66 65 2d 61 64 64 20 61 6c 69 73 74 20 6b 65 79 fe-add alist key 0e50: 20 76 61 6c 29 29 0a 09 09 09 09 09 09 20 20 20 val))....... 0e60: 20 28 6c 6f 6f 70 20 28 72 65 61 64 2d 6c 69 6e (loop (read-lin 0e70: 65 20 69 6e 70 29 20 63 75 72 72 2d 73 65 63 74 e inp) curr-sect 0e80: 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 66 29 29 ion-name #f #f)) 0e90: 0a 09 09 09 09 09 09 20 20 28 6c 6f 6f 70 20 28 ....... (loop ( 0ea0: 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 29 20 63 read-line inp) c 0eb0: 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 urr-section-name 0ec0: 20 23 66 20 23 66 29 29 29 0a 09 20 20 20 20 20 #f #f))).. 0ed0: 20 20 28 6b 65 79 2d 76 61 6c 2d 70 72 20 28 20 (key-val-pr ( 0ee0: 78 20 6b 65 79 20 76 61 6c 20 20 20 20 20 20 29 x key val ) 0ef0: 20 28 6c 65 74 20 28 28 61 6c 69 73 74 20 20 20 (let ((alist 0f00: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/ 0f10: 64 65 66 61 75 6c 74 20 72 65 73 20 63 75 72 72 default res curr 0f20: 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 27 28 -section-name '( 0f30: 29 29 29 0a 09 09 09 09 09 09 20 20 20 20 28 72 )))....... (r 0f40: 65 61 6c 76 61 6c 20 28 69 66 20 28 61 6e 64 20 ealval (if (and 0f50: 65 6e 76 69 72 6f 6e 2d 70 61 74 74 20 28 73 74 environ-patt (st 0f60: 72 69 6e 67 2d 6d 61 74 63 68 20 28 72 65 67 65 ring-match (rege 0f70: 78 70 20 65 6e 76 69 72 6f 6e 2d 70 61 74 74 29 xp environ-patt) 0f80: 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 curr-section-na 0f90: 6d 65 29 29 0a 09 09 09 09 09 09 09 09 20 28 63 me))......... (c 0fa0: 6f 6e 66 69 67 3a 65 76 61 6c 2d 73 74 72 69 6e onfig:eval-strin 0fb0: 67 2d 69 6e 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 g-in-environment 0fc0: 20 76 61 6c 29 0a 09 09 09 09 09 09 09 09 20 76 val)......... v 0fd0: 61 6c 29 29 29 0a 09 09 09 09 09 09 28 68 61 73 al))).......(has 0fe0: 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 72 65 73 h-table-set! res 0ff0: 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 curr-section-na 1000: 6d 65 20 0a 09 09 09 09 09 09 09 09 20 28 63 6f me ......... (co 1010: 6e 66 69 67 3a 61 73 73 6f 63 2d 73 61 66 65 2d nfig:assoc-safe- 1020: 61 64 64 20 61 6c 69 73 74 20 6b 65 79 20 72 65 add alist key re 1030: 61 6c 76 61 6c 29 29 0a 09 09 09 09 09 09 28 6c alval)).......(l 1040: 6f 6f 70 20 28 72 65 61 64 2d 6c 69 6e 65 20 69 oop (read-line i 1050: 6e 70 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e np) curr-section 1060: 2d 6e 61 6d 65 20 6b 65 79 20 23 66 29 29 29 0a -name key #f))). 1070: 09 20 20 20 20 20 20 20 3b 3b 20 69 66 20 61 20 . ;; if a 1080: 63 6f 6e 74 69 6e 75 65 64 20 6c 69 6e 65 0a 09 continued line.. 1090: 20 20 20 20 20 20 20 28 63 6f 6e 74 2d 6c 6e 2d (cont-ln- 10a0: 72 78 20 28 20 78 20 77 68 73 70 20 76 61 6c 20 rx ( x whsp val 10b0: 20 20 20 20 29 20 28 6c 65 74 20 28 28 61 6c 69 ) (let ((ali 10c0: 73 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 st (hash-table-r 10d0: 65 66 2f 64 65 66 61 75 6c 74 20 72 65 73 20 63 ef/default res c 10e0: 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 urr-section-name 10f0: 20 27 28 29 29 29 29 0a 09 09 09 09 09 09 28 69 '()))).......(i 1100: 66 20 76 61 72 2d 66 6c 61 67 20 20 20 20 20 20 f var-flag 1110: 20 20 20 20 20 20 20 3b 3b 20 69 66 20 73 65 74 ;; if set 1120: 20 74 6f 20 61 20 73 74 72 69 6e 67 20 74 68 65 to a string the 1130: 6e 20 77 65 20 68 61 76 65 20 61 20 63 6f 6e 74 n we have a cont 1140: 69 6e 75 65 64 20 76 61 72 0a 09 09 09 09 09 09 inued var....... 1150: 20 20 20 20 28 6c 65 74 20 28 28 6e 65 77 76 61 (let ((newva 1160: 6c 20 28 63 6f 6e 63 20 0a 09 09 09 09 09 09 09 l (conc ........ 1170: 09 20 20 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b . (config-look 1180: 75 70 20 72 65 73 20 63 75 72 72 2d 73 65 63 74 up res curr-sect 1190: 69 6f 6e 2d 6e 61 6d 65 20 76 61 72 2d 66 6c 61 ion-name var-fla 11a0: 67 29 20 22 5c 6e 22 0a 09 09 09 09 09 09 09 09 g) "\n"......... 11b0: 20 20 20 3b 3b 20 74 72 69 6d 20 6c 65 61 64 20 ;; trim lead 11c0: 66 72 6f 6d 20 74 68 65 20 69 6e 63 6f 6d 69 6e from the incomin 11d0: 67 20 77 68 73 70 20 74 6f 20 73 75 70 70 6f 72 g whsp to suppor 11e0: 74 20 73 6f 6d 65 20 69 6e 64 65 6e 74 69 6e 67 t some indenting 11f0: 2e 0a 09 09 09 09 09 09 09 09 20 20 20 28 69 66 .......... (if 1200: 20 6c 65 61 64 0a 09 09 09 09 09 09 09 09 20 20 lead......... 1210: 20 20 20 20 20 28 73 74 72 69 6e 67 2d 73 75 62 (string-sub 1220: 73 74 69 74 75 74 65 20 28 72 65 67 65 78 70 20 stitute (regexp 1230: 6c 65 61 64 29 20 22 22 20 77 68 73 70 29 0a 09 lead) "" whsp).. 1240: 09 09 09 09 09 09 09 20 20 20 20 20 20 20 22 22 ....... "" 1250: 29 0a 09 09 09 09 09 09 09 09 20 20 20 76 61 6c )......... val 1260: 29 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 )))....... 1270: 3b 3b 20 28 70 72 69 6e 74 20 22 76 61 6c 3a 20 ;; (print "val: 1280: 22 20 76 61 6c 20 22 5c 6e 6e 65 77 76 61 6c 3a " val "\nnewval: 1290: 20 5c 22 22 20 6e 65 77 76 61 6c 20 22 5c 22 5c \"" newval "\"\ 12a0: 6e 76 61 72 66 6c 61 67 3a 20 22 20 76 61 72 2d nvarflag: " var- 12b0: 66 6c 61 67 29 0a 09 09 09 09 09 09 20 20 20 20 flag)....... 12c0: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 (hash-table-se 12d0: 74 21 20 72 65 73 20 63 75 72 72 2d 73 65 63 74 t! res curr-sect 12e0: 69 6f 6e 2d 6e 61 6d 65 20 0a 09 09 09 09 09 09 ion-name ....... 12f0: 09 09 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 .. (config 1300: 3a 61 73 73 6f 63 2d 73 61 66 65 2d 61 64 64 20 :assoc-safe-add 1310: 61 6c 69 73 74 20 76 61 72 2d 66 6c 61 67 20 6e alist var-flag n 1320: 65 77 76 61 6c 29 29 0a 09 09 09 09 09 09 20 20 ewval))....... 1330: 20 20 20 20 28 6c 6f 6f 70 20 28 72 65 61 64 2d (loop (read- 1340: 6c 69 6e 65 20 69 6e 70 29 20 63 75 72 72 2d 73 line inp) curr-s 1350: 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 76 61 72 2d ection-name var- 1360: 66 6c 61 67 20 28 69 66 20 6c 65 61 64 20 6c 65 flag (if lead le 1370: 61 64 20 77 68 73 70 29 29 29 0a 09 09 09 09 09 ad whsp)))...... 1380: 09 20 20 20 20 28 6c 6f 6f 70 20 28 72 65 61 64 . (loop (read 1390: 2d 6c 69 6e 65 20 69 6e 70 29 20 63 75 72 72 2d -line inp) curr- 13a0: 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 section-name #f 13b0: 23 66 29 29 29 29 0a 09 20 20 20 20 20 20 20 28 #f)))).. ( 13c0: 65 6c 73 65 20 28 64 65 62 75 67 3a 70 72 69 6e else (debug:prin 13d0: 74 20 30 20 22 45 52 52 4f 52 3a 20 70 72 6f 62 t 0 "ERROR: prob 13e0: 6c 65 6d 20 70 61 72 73 69 6e 67 20 22 20 70 61 lem parsing " pa 13f0: 74 68 20 22 2c 5c 6e 20 20 20 5c 22 22 20 69 6e th ",\n \"" in 1400: 6c 20 22 5c 22 22 29 0a 09 09 20 20 20 20 20 28 l "\"")... ( 1410: 73 65 74 21 20 76 61 72 2d 66 6c 61 67 20 23 66 set! var-flag #f 1420: 29 0a 09 09 20 20 20 20 20 28 6c 6f 6f 70 20 28 )... (loop ( 1430: 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 29 20 63 read-line inp) c 1440: 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 urr-section-name 1450: 20 23 66 20 23 66 29 29 29 29 29 29 29 29 0a 20 #f #f)))))))). 1460: 20 0a 28 64 65 66 69 6e 65 20 28 66 69 6e 64 2d .(define (find- 1470: 61 6e 64 2d 72 65 61 64 2d 63 6f 6e 66 69 67 20 and-read-config 1480: 66 6e 61 6d 65 20 23 21 6b 65 79 20 28 65 6e 76 fname #!key (env 1490: 69 72 6f 6e 2d 70 61 74 74 20 23 66 29 29 0a 20 iron-patt #f)). 14a0: 20 28 6c 65 74 2a 20 28 28 63 75 72 72 2d 64 69 (let* ((curr-di 14b0: 72 20 20 20 28 63 75 72 72 65 6e 74 2d 64 69 72 r (current-dir 14c0: 65 63 74 6f 72 79 29 29 0a 20 20 20 20 20 20 20 ectory)). 14d0: 20 20 28 63 6f 6e 66 69 67 69 6e 66 6f 20 28 66 (configinfo (f 14e0: 69 6e 64 2d 63 6f 6e 66 69 67 20 66 6e 61 6d 65 ind-config fname 14f0: 29 29 0a 09 20 28 74 6f 70 70 61 74 68 20 20 20 )).. (toppath 1500: 20 28 63 61 72 20 63 6f 6e 66 69 67 69 6e 66 6f (car configinfo 1510: 29 29 0a 09 20 28 63 6f 6e 66 69 67 66 69 6c 65 )).. (configfile 1520: 20 28 63 61 64 72 20 63 6f 6e 66 69 67 69 6e 66 (cadr configinf 1530: 6f 29 29 29 0a 20 20 20 20 28 69 66 20 74 6f 70 o))). (if top 1540: 70 61 74 68 20 28 63 68 61 6e 67 65 2d 64 69 72 path (change-dir 1550: 65 63 74 6f 72 79 20 74 6f 70 70 61 74 68 29 29 ectory toppath)) 1560: 20 0a 20 20 20 20 28 6c 65 74 20 28 28 63 6f 6e . (let ((con 1570: 66 69 67 64 61 74 20 20 28 69 66 20 63 6f 6e 66 figdat (if conf 1580: 69 67 66 69 6c 65 20 28 72 65 61 64 2d 63 6f 6e igfile (read-con 1590: 66 69 67 20 63 6f 6e 66 69 67 66 69 6c 65 20 23 fig configfile # 15a0: 66 20 23 74 20 65 6e 76 69 72 6f 6e 2d 70 61 74 f #t environ-pat 15b0: 74 3a 20 65 6e 76 69 72 6f 6e 2d 70 61 74 74 29 t: environ-patt) 15c0: 20 23 66 29 29 29 20 3b 3b 20 28 6d 61 6b 65 2d #f))) ;; (make- 15d0: 68 61 73 68 2d 74 61 62 6c 65 29 29 29 29 0a 20 hash-table)))). 15e0: 20 20 20 20 20 28 69 66 20 74 6f 70 70 61 74 68 (if toppath 15f0: 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f (change-directo 1600: 72 79 20 63 75 72 72 2d 64 69 72 29 29 0a 20 20 ry curr-dir)). 1610: 20 20 20 20 28 6c 69 73 74 20 63 6f 6e 66 69 67 (list config 1620: 64 61 74 20 74 6f 70 70 61 74 68 20 63 6f 6e 66 dat toppath conf 1630: 69 67 66 69 6c 65 20 66 6e 61 6d 65 29 29 29 29 igfile fname)))) 1640: 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 ..(define (confi 1650: 67 2d 6c 6f 6f 6b 75 70 20 63 66 67 64 61 74 20 g-lookup cfgdat 1660: 73 65 63 74 69 6f 6e 20 76 61 72 29 0a 20 20 28 section var). ( 1670: 6c 65 74 20 28 28 73 65 63 74 64 61 74 20 28 68 let ((sectdat (h 1680: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de 1690: 66 61 75 6c 74 20 63 66 67 64 61 74 20 73 65 63 fault cfgdat sec 16a0: 74 69 6f 6e 20 27 28 29 29 29 29 0a 20 20 20 20 tion '()))). 16b0: 28 69 66 20 28 6e 75 6c 6c 3f 20 73 65 63 74 64 (if (null? sectd 16c0: 61 74 29 0a 09 23 66 0a 09 28 6c 65 74 20 28 28 at)..#f..(let (( 16d0: 6d 61 74 63 68 20 28 61 73 73 6f 63 20 76 61 72 match (assoc var 16e0: 20 73 65 63 74 64 61 74 29 29 29 0a 09 20 20 28 sectdat))).. ( 16f0: 69 66 20 6d 61 74 63 68 0a 09 20 20 20 20 20 20 if match.. 1700: 28 63 61 64 72 20 6d 61 74 63 68 29 0a 09 20 20 (cadr match).. 1710: 20 20 20 20 23 66 29 29 0a 09 29 29 29 0a 0a 28 #f))..)))..( 1720: 64 65 66 69 6e 65 20 28 73 65 74 75 70 29 0a 20 define (setup). 1730: 20 28 6c 65 74 2a 20 28 28 63 6f 6e 66 69 67 66 (let* ((configf 1740: 20 28 66 69 6e 64 2d 63 6f 6e 66 69 67 29 29 0a (find-config)). 1750: 09 20 28 63 6f 6e 66 69 67 20 20 28 69 66 20 63 . (config (if c 1760: 6f 6e 66 69 67 66 20 28 72 65 61 64 2d 63 6f 6e onfigf (read-con 1770: 66 69 67 20 63 6f 6e 66 69 67 66 20 23 66 20 23 fig configf #f # 1780: 74 29 20 23 66 29 29 29 0a 20 20 20 20 28 69 66 t) #f))). (if 1790: 20 63 6f 6e 66 69 67 0a 09 28 73 65 74 65 6e 76 config..(setenv 17a0: 20 22 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 22 "RUN_AREA_HOME" 17b0: 20 28 70 61 74 68 6e 61 6d 65 2d 64 69 72 65 63 (pathname-direc 17c0: 74 6f 72 79 20 63 6f 6e 66 69 67 66 29 29 29 0a tory configf))). 17d0: 20 20 20 20 63 6f 6e 66 69 67 29 29 0a 0a config))..