Artifact e31d2a9565823c2f390435967d84cf4477a45855:
- File configf.scm — part of check-in [3aeabde95d] at 2011-11-20 22:36:08 on branch reorg-runs-code — commit of re-hacked run code. completely torn to shreds and rewritten (user: matt size: 6525)
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 2d 70 72 6f ........(val-pro 0cf0: 63 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 c (lambda ().... 0d00: 09 09 09 09 09 20 20 20 20 28 6c 65 74 2a 20 28 ..... (let* ( 0d10: 28 63 6d 64 72 65 73 20 20 28 63 6d 64 2d 72 75 (cmdres (cmd-ru 0d20: 6e 2d 3e 6c 69 73 74 20 63 6d 64 29 29 0a 09 09 n->list cmd))... 0d30: 09 09 09 09 09 09 09 20 20 20 28 73 74 61 74 75 ....... (statu 0d40: 73 20 20 28 63 61 64 72 20 63 6d 64 72 65 73 29 s (cadr cmdres) 0d50: 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 28 72 ).......... (r 0d60: 65 73 20 20 20 20 20 28 63 61 72 20 20 63 6d 64 es (car cmd 0d70: 72 65 73 29 29 29 0a 09 09 09 09 09 09 09 09 20 res)))......... 0d80: 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 65 (if (not (e 0d90: 71 3f 20 73 74 61 74 75 73 20 30 29 29 0a 09 09 q? status 0))... 0da0: 09 09 09 09 09 09 09 20 20 28 62 65 67 69 6e 0a ....... (begin. 0db0: 09 09 09 09 09 09 09 09 09 20 20 20 20 28 64 65 ......... (de 0dc0: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 bug:print 0 "ERR 0dd0: 4f 52 3a 20 70 72 6f 62 6c 65 6d 20 77 69 74 68 OR: problem with 0de0: 20 22 20 69 6e 6c 20 22 2c 20 72 65 74 75 72 6e " inl ", return 0df0: 20 63 6f 64 65 20 22 20 73 74 61 74 75 73 29 0a code " status). 0e00: 09 09 09 09 09 09 09 09 09 20 20 20 20 28 65 78 ......... (ex 0e10: 69 74 20 31 29 29 29 0a 09 09 09 09 09 09 09 09 it 1)))......... 0e20: 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f (if (null? 0e30: 20 72 65 73 29 0a 09 09 09 09 09 09 09 09 09 20 res).......... 0e40: 20 22 22 0a 09 09 09 09 09 09 09 09 09 20 20 28 "".......... ( 0e50: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper 0e60: 73 65 20 72 65 73 20 22 20 22 29 29 29 29 29 29 se res " ")))))) 0e70: 0a 09 09 09 09 09 09 20 20 20 20 28 68 61 73 68 ....... (hash 0e80: 2d 74 61 62 6c 65 2d 73 65 74 21 20 72 65 73 20 -table-set! res 0e90: 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d curr-section-nam 0ea0: 65 20 0a 09 09 09 09 09 09 09 09 20 20 20 20 20 e ......... 0eb0: 28 63 6f 6e 66 69 67 3a 61 73 73 6f 63 2d 73 61 (config:assoc-sa 0ec0: 66 65 2d 61 64 64 20 61 6c 69 73 74 0a 09 09 09 fe-add alist.... 0ed0: 09 09 09 09 09 09 09 09 20 20 20 20 6b 65 79 20 ........ key 0ee0: 0a 09 09 09 09 09 09 09 09 09 09 09 20 20 20 20 ............ 0ef0: 28 69 66 20 28 65 71 3f 20 61 6c 6c 6f 77 2d 73 (if (eq? allow-s 0f00: 79 73 74 65 6d 20 27 72 65 74 75 72 6e 2d 70 72 ystem 'return-pr 0f10: 6f 63 73 29 0a 09 09 09 09 09 09 09 09 09 09 09 ocs)............ 0f20: 09 76 61 6c 0a 09 09 09 09 09 09 09 09 09 09 09 .val............ 0f30: 09 28 76 61 6c 29 29 29 29 0a 09 09 09 09 09 09 .(val))))....... 0f40: 20 20 20 20 28 6c 6f 6f 70 20 28 72 65 61 64 2d (loop (read- 0f50: 6c 69 6e 65 20 69 6e 70 29 20 63 75 72 72 2d 73 line inp) curr-s 0f60: 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 ection-name #f # 0f70: 66 29 29 0a 09 09 09 09 09 09 20 20 28 6c 6f 6f f))....... (loo 0f80: 70 20 28 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 p (read-line inp 0f90: 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e ) curr-section-n 0fa0: 61 6d 65 20 23 66 20 23 66 29 29 29 0a 09 20 20 ame #f #f))).. 0fb0: 20 20 20 20 20 28 6b 65 79 2d 76 61 6c 2d 70 72 (key-val-pr 0fc0: 20 28 20 78 20 6b 65 79 20 76 61 6c 20 20 20 20 ( x key val 0fd0: 20 20 29 20 28 6c 65 74 2a 20 28 28 61 6c 69 73 ) (let* ((alis 0fe0: 74 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d t (hash-table- 0ff0: 72 65 66 2f 64 65 66 61 75 6c 74 20 72 65 73 20 ref/default res 1000: 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d curr-section-nam 1010: 65 20 27 28 29 29 29 0a 09 09 09 09 09 09 20 20 e '()))....... 1020: 20 20 20 28 65 6e 76 61 72 20 20 20 28 61 6e 64 (envar (and 1030: 20 65 6e 76 69 72 6f 6e 2d 70 61 74 74 20 28 73 environ-patt (s 1040: 74 72 69 6e 67 2d 6d 61 74 63 68 20 28 72 65 67 tring-match (reg 1050: 65 78 70 20 65 6e 76 69 72 6f 6e 2d 70 61 74 74 exp environ-patt 1060: 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e ) curr-section-n 1070: 61 6d 65 29 29 29 0a 09 09 09 09 09 09 20 20 20 ame)))....... 1080: 20 20 28 72 65 61 6c 76 61 6c 20 28 69 66 20 65 (realval (if e 1090: 6e 76 61 72 0a 09 09 09 09 09 09 09 09 20 28 63 nvar......... (c 10a0: 6f 6e 66 69 67 3a 65 76 61 6c 2d 73 74 72 69 6e onfig:eval-strin 10b0: 67 2d 69 6e 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 g-in-environment 10c0: 20 76 61 6c 29 0a 09 09 09 09 09 09 09 09 20 76 val)......... v 10d0: 61 6c 29 29 29 0a 09 09 09 09 09 09 28 69 66 20 al))).......(if 10e0: 65 6e 76 61 72 0a 09 09 09 09 09 09 20 20 20 20 envar....... 10f0: 28 62 65 67 69 6e 0a 09 09 09 09 09 09 20 20 20 (begin....... 1100: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print 1110: 34 20 22 49 4e 46 4f 3a 20 72 65 61 64 2d 63 6f 4 "INFO: read-co 1120: 6e 66 69 67 20 6b 65 79 3d 22 20 6b 65 79 20 22 nfig key=" key " 1130: 2c 20 76 61 6c 3d 22 20 76 61 6c 20 22 2c 20 72 , val=" val ", r 1140: 65 61 6c 76 61 6c 3d 22 20 72 65 61 6c 76 61 6c ealval=" realval 1150: 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 28 73 )....... (s 1160: 65 74 65 6e 76 20 6b 65 79 20 72 65 61 6c 76 61 etenv key realva 1170: 6c 29 29 29 0a 09 09 09 09 09 09 28 68 61 73 68 l))).......(hash 1180: 2d 74 61 62 6c 65 2d 73 65 74 21 20 72 65 73 20 -table-set! res 1190: 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d curr-section-nam 11a0: 65 20 0a 09 09 09 09 09 09 09 09 20 28 63 6f 6e e ......... (con 11b0: 66 69 67 3a 61 73 73 6f 63 2d 73 61 66 65 2d 61 fig:assoc-safe-a 11c0: 64 64 20 61 6c 69 73 74 20 6b 65 79 20 72 65 61 dd alist key rea 11d0: 6c 76 61 6c 29 29 0a 09 09 09 09 09 09 28 6c 6f lval)).......(lo 11e0: 6f 70 20 28 72 65 61 64 2d 6c 69 6e 65 20 69 6e op (read-line in 11f0: 70 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d p) curr-section- 1200: 6e 61 6d 65 20 6b 65 79 20 23 66 29 29 29 0a 09 name key #f))).. 1210: 20 20 20 20 20 20 20 3b 3b 20 69 66 20 61 20 63 ;; if a c 1220: 6f 6e 74 69 6e 75 65 64 20 6c 69 6e 65 0a 09 20 ontinued line.. 1230: 20 20 20 20 20 20 28 63 6f 6e 74 2d 6c 6e 2d 72 (cont-ln-r 1240: 78 20 28 20 78 20 77 68 73 70 20 76 61 6c 20 20 x ( x whsp val 1250: 20 20 20 29 20 28 6c 65 74 20 28 28 61 6c 69 73 ) (let ((alis 1260: 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 t (hash-table-re 1270: 66 2f 64 65 66 61 75 6c 74 20 72 65 73 20 63 75 f/default res cu 1280: 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 rr-section-name 1290: 27 28 29 29 29 29 0a 09 09 09 09 09 09 28 69 66 '()))).......(if 12a0: 20 76 61 72 2d 66 6c 61 67 20 20 20 20 20 20 20 var-flag 12b0: 20 20 20 20 20 20 3b 3b 20 69 66 20 73 65 74 20 ;; if set 12c0: 74 6f 20 61 20 73 74 72 69 6e 67 20 74 68 65 6e to a string then 12d0: 20 77 65 20 68 61 76 65 20 61 20 63 6f 6e 74 69 we have a conti 12e0: 6e 75 65 64 20 76 61 72 0a 09 09 09 09 09 09 20 nued var....... 12f0: 20 20 20 28 6c 65 74 20 28 28 6e 65 77 76 61 6c (let ((newval 1300: 20 28 63 6f 6e 63 20 0a 09 09 09 09 09 09 09 09 (conc ......... 1310: 20 20 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 (config-looku 1320: 70 20 72 65 73 20 63 75 72 72 2d 73 65 63 74 69 p res curr-secti 1330: 6f 6e 2d 6e 61 6d 65 20 76 61 72 2d 66 6c 61 67 on-name var-flag 1340: 29 20 22 5c 6e 22 0a 09 09 09 09 09 09 09 09 20 ) "\n"......... 1350: 20 20 3b 3b 20 74 72 69 6d 20 6c 65 61 64 20 66 ;; trim lead f 1360: 72 6f 6d 20 74 68 65 20 69 6e 63 6f 6d 69 6e 67 rom the incoming 1370: 20 77 68 73 70 20 74 6f 20 73 75 70 70 6f 72 74 whsp to support 1380: 20 73 6f 6d 65 20 69 6e 64 65 6e 74 69 6e 67 2e some indenting. 1390: 0a 09 09 09 09 09 09 09 09 20 20 20 28 69 66 20 ......... (if 13a0: 6c 65 61 64 0a 09 09 09 09 09 09 09 09 20 20 20 lead......... 13b0: 20 20 20 20 28 73 74 72 69 6e 67 2d 73 75 62 73 (string-subs 13c0: 74 69 74 75 74 65 20 28 72 65 67 65 78 70 20 6c titute (regexp l 13d0: 65 61 64 29 20 22 22 20 77 68 73 70 29 0a 09 09 ead) "" whsp)... 13e0: 09 09 09 09 09 09 20 20 20 20 20 20 20 22 22 29 ...... "") 13f0: 0a 09 09 09 09 09 09 09 09 20 20 20 76 61 6c 29 ......... val) 1400: 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 3b ))....... ; 1410: 3b 20 28 70 72 69 6e 74 20 22 76 61 6c 3a 20 22 ; (print "val: " 1420: 20 76 61 6c 20 22 5c 6e 6e 65 77 76 61 6c 3a 20 val "\nnewval: 1430: 5c 22 22 20 6e 65 77 76 61 6c 20 22 5c 22 5c 6e \"" newval "\"\n 1440: 76 61 72 66 6c 61 67 3a 20 22 20 76 61 72 2d 66 varflag: " var-f 1450: 6c 61 67 29 0a 09 09 09 09 09 09 20 20 20 20 20 lag)....... 1460: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 (hash-table-set 1470: 21 20 72 65 73 20 63 75 72 72 2d 73 65 63 74 69 ! res curr-secti 1480: 6f 6e 2d 6e 61 6d 65 20 0a 09 09 09 09 09 09 09 on-name ........ 1490: 09 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 3a . (config: 14a0: 61 73 73 6f 63 2d 73 61 66 65 2d 61 64 64 20 61 assoc-safe-add a 14b0: 6c 69 73 74 20 76 61 72 2d 66 6c 61 67 20 6e 65 list var-flag ne 14c0: 77 76 61 6c 29 29 0a 09 09 09 09 09 09 20 20 20 wval))....... 14d0: 20 20 20 28 6c 6f 6f 70 20 28 72 65 61 64 2d 6c (loop (read-l 14e0: 69 6e 65 20 69 6e 70 29 20 63 75 72 72 2d 73 65 ine inp) curr-se 14f0: 63 74 69 6f 6e 2d 6e 61 6d 65 20 76 61 72 2d 66 ction-name var-f 1500: 6c 61 67 20 28 69 66 20 6c 65 61 64 20 6c 65 61 lag (if lead lea 1510: 64 20 77 68 73 70 29 29 29 0a 09 09 09 09 09 09 d whsp)))....... 1520: 20 20 20 20 28 6c 6f 6f 70 20 28 72 65 61 64 2d (loop (read- 1530: 6c 69 6e 65 20 69 6e 70 29 20 63 75 72 72 2d 73 line inp) curr-s 1540: 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 ection-name #f # 1550: 66 29 29 29 29 0a 09 20 20 20 20 20 20 20 28 65 f)))).. (e 1560: 6c 73 65 20 28 64 65 62 75 67 3a 70 72 69 6e 74 lse (debug:print 1570: 20 30 20 22 45 52 52 4f 52 3a 20 70 72 6f 62 6c 0 "ERROR: probl 1580: 65 6d 20 70 61 72 73 69 6e 67 20 22 20 70 61 74 em parsing " pat 1590: 68 20 22 2c 5c 6e 20 20 20 5c 22 22 20 69 6e 6c h ",\n \"" inl 15a0: 20 22 5c 22 22 29 0a 09 09 20 20 20 20 20 28 73 "\"")... (s 15b0: 65 74 21 20 76 61 72 2d 66 6c 61 67 20 23 66 29 et! var-flag #f) 15c0: 0a 09 09 20 20 20 20 20 28 6c 6f 6f 70 20 28 72 ... (loop (r 15d0: 65 61 64 2d 6c 69 6e 65 20 69 6e 70 29 20 63 75 ead-line inp) cu 15e0: 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 rr-section-name 15f0: 23 66 20 23 66 29 29 29 29 29 29 29 29 0a 20 20 #f #f)))))))). 1600: 0a 28 64 65 66 69 6e 65 20 28 66 69 6e 64 2d 61 .(define (find-a 1610: 6e 64 2d 72 65 61 64 2d 63 6f 6e 66 69 67 20 66 nd-read-config f 1620: 6e 61 6d 65 20 23 21 6b 65 79 20 28 65 6e 76 69 name #!key (envi 1630: 72 6f 6e 2d 70 61 74 74 20 23 66 29 29 0a 20 20 ron-patt #f)). 1640: 28 6c 65 74 2a 20 28 28 63 75 72 72 2d 64 69 72 (let* ((curr-dir 1650: 20 20 20 28 63 75 72 72 65 6e 74 2d 64 69 72 65 (current-dire 1660: 63 74 6f 72 79 29 29 0a 20 20 20 20 20 20 20 20 ctory)). 1670: 20 28 63 6f 6e 66 69 67 69 6e 66 6f 20 28 66 69 (configinfo (fi 1680: 6e 64 2d 63 6f 6e 66 69 67 20 66 6e 61 6d 65 29 nd-config fname) 1690: 29 0a 09 20 28 74 6f 70 70 61 74 68 20 20 20 20 ).. (toppath 16a0: 28 63 61 72 20 63 6f 6e 66 69 67 69 6e 66 6f 29 (car configinfo) 16b0: 29 0a 09 20 28 63 6f 6e 66 69 67 66 69 6c 65 20 ).. (configfile 16c0: 28 63 61 64 72 20 63 6f 6e 66 69 67 69 6e 66 6f (cadr configinfo 16d0: 29 29 29 0a 20 20 20 20 28 69 66 20 74 6f 70 70 ))). (if topp 16e0: 61 74 68 20 28 63 68 61 6e 67 65 2d 64 69 72 65 ath (change-dire 16f0: 63 74 6f 72 79 20 74 6f 70 70 61 74 68 29 29 20 ctory toppath)) 1700: 0a 20 20 20 20 28 6c 65 74 20 28 28 63 6f 6e 66 . (let ((conf 1710: 69 67 64 61 74 20 20 28 69 66 20 63 6f 6e 66 69 igdat (if confi 1720: 67 66 69 6c 65 20 28 72 65 61 64 2d 63 6f 6e 66 gfile (read-conf 1730: 69 67 20 63 6f 6e 66 69 67 66 69 6c 65 20 23 66 ig configfile #f 1740: 20 23 74 20 65 6e 76 69 72 6f 6e 2d 70 61 74 74 #t environ-patt 1750: 3a 20 65 6e 76 69 72 6f 6e 2d 70 61 74 74 29 20 : environ-patt) 1760: 23 66 29 29 29 20 3b 3b 20 28 6d 61 6b 65 2d 68 #f))) ;; (make-h 1770: 61 73 68 2d 74 61 62 6c 65 29 29 29 29 0a 20 20 ash-table)))). 1780: 20 20 20 20 28 69 66 20 74 6f 70 70 61 74 68 20 (if toppath 1790: 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 (change-director 17a0: 79 20 63 75 72 72 2d 64 69 72 29 29 0a 20 20 20 y curr-dir)). 17b0: 20 20 20 28 6c 69 73 74 20 63 6f 6e 66 69 67 64 (list configd 17c0: 61 74 20 74 6f 70 70 61 74 68 20 63 6f 6e 66 69 at toppath confi 17d0: 67 66 69 6c 65 20 66 6e 61 6d 65 29 29 29 29 0a gfile fname)))). 17e0: 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 .(define (config 17f0: 2d 6c 6f 6f 6b 75 70 20 63 66 67 64 61 74 20 73 -lookup cfgdat s 1800: 65 63 74 69 6f 6e 20 76 61 72 29 0a 20 20 28 6c ection var). (l 1810: 65 74 20 28 28 73 65 63 74 64 61 74 20 28 68 61 et ((sectdat (ha 1820: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def 1830: 61 75 6c 74 20 63 66 67 64 61 74 20 73 65 63 74 ault cfgdat sect 1840: 69 6f 6e 20 27 28 29 29 29 29 0a 20 20 20 20 28 ion '()))). ( 1850: 69 66 20 28 6e 75 6c 6c 3f 20 73 65 63 74 64 61 if (null? sectda 1860: 74 29 0a 09 23 66 0a 09 28 6c 65 74 20 28 28 6d t)..#f..(let ((m 1870: 61 74 63 68 20 28 61 73 73 6f 63 20 76 61 72 20 atch (assoc var 1880: 73 65 63 74 64 61 74 29 29 29 0a 09 20 20 28 69 sectdat))).. (i 1890: 66 20 6d 61 74 63 68 0a 09 20 20 20 20 20 20 28 f match.. ( 18a0: 63 61 64 72 20 6d 61 74 63 68 29 0a 09 20 20 20 cadr match).. 18b0: 20 20 20 23 66 29 29 0a 09 29 29 29 0a 0a 28 64 #f))..)))..(d 18c0: 65 66 69 6e 65 20 28 73 65 74 75 70 29 0a 20 20 efine (setup). 18d0: 28 6c 65 74 2a 20 28 28 63 6f 6e 66 69 67 66 20 (let* ((configf 18e0: 28 66 69 6e 64 2d 63 6f 6e 66 69 67 29 29 0a 09 (find-config)).. 18f0: 20 28 63 6f 6e 66 69 67 20 20 28 69 66 20 63 6f (config (if co 1900: 6e 66 69 67 66 20 28 72 65 61 64 2d 63 6f 6e 66 nfigf (read-conf 1910: 69 67 20 63 6f 6e 66 69 67 66 20 23 66 20 23 74 ig configf #f #t 1920: 29 20 23 66 29 29 29 0a 20 20 20 20 28 69 66 20 ) #f))). (if 1930: 63 6f 6e 66 69 67 0a 09 28 73 65 74 65 6e 76 20 config..(setenv 1940: 22 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 22 20 "RUN_AREA_HOME" 1950: 28 70 61 74 68 6e 61 6d 65 2d 64 69 72 65 63 74 (pathname-direct 1960: 6f 72 79 20 63 6f 6e 66 69 67 66 29 29 29 0a 20 ory configf))). 1970: 20 20 20 63 6f 6e 66 69 67 29 29 0a 0a config))..