Artifact a8e7a14c9a72acaf20616526b93ee61ee2b09fe6:
- File configf.scm — part of check-in [a1e072dbd2] at 2011-11-20 23:13:08 on branch reorg-runs-code — Incrementally putting stuff back in place for re-written runs. (user: matt size: 6535) [more...]
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 2d 70 72 6f 63 0a 09 09 09 09 09 09 .val-proc....... 0f30: 09 09 09 09 09 09 28 76 61 6c 2d 70 72 6f 63 29 ......(val-proc) 0f40: 29 29 29 0a 09 09 09 09 09 09 20 20 20 20 28 6c )))....... (l 0f50: 6f 6f 70 20 28 72 65 61 64 2d 6c 69 6e 65 20 69 oop (read-line i 0f60: 6e 70 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e np) curr-section 0f70: 2d 6e 61 6d 65 20 23 66 20 23 66 29 29 0a 09 09 -name #f #f))... 0f80: 09 09 09 09 20 20 28 6c 6f 6f 70 20 28 72 65 61 .... (loop (rea 0f90: 64 2d 6c 69 6e 65 20 69 6e 70 29 20 63 75 72 72 d-line inp) curr 0fa0: 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 -section-name #f 0fb0: 20 23 66 29 29 29 0a 09 20 20 20 20 20 20 20 28 #f))).. ( 0fc0: 6b 65 79 2d 76 61 6c 2d 70 72 20 28 20 78 20 6b key-val-pr ( x k 0fd0: 65 79 20 76 61 6c 20 20 20 20 20 20 29 20 28 6c ey val ) (l 0fe0: 65 74 2a 20 28 28 61 6c 69 73 74 20 20 20 28 68 et* ((alist (h 0ff0: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de 1000: 66 61 75 6c 74 20 72 65 73 20 63 75 72 72 2d 73 fault res curr-s 1010: 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 27 28 29 29 ection-name '()) 1020: 29 0a 09 09 09 09 09 09 20 20 20 20 20 28 65 6e )....... (en 1030: 76 61 72 20 20 20 28 61 6e 64 20 65 6e 76 69 72 var (and envir 1040: 6f 6e 2d 70 61 74 74 20 28 73 74 72 69 6e 67 2d on-patt (string- 1050: 6d 61 74 63 68 20 28 72 65 67 65 78 70 20 65 6e match (regexp en 1060: 76 69 72 6f 6e 2d 70 61 74 74 29 20 63 75 72 72 viron-patt) curr 1070: 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 29 29 29 -section-name))) 1080: 0a 09 09 09 09 09 09 20 20 20 20 20 28 72 65 61 ....... (rea 1090: 6c 76 61 6c 20 28 69 66 20 65 6e 76 61 72 0a 09 lval (if envar.. 10a0: 09 09 09 09 09 09 09 20 28 63 6f 6e 66 69 67 3a ....... (config: 10b0: 65 76 61 6c 2d 73 74 72 69 6e 67 2d 69 6e 2d 65 eval-string-in-e 10c0: 6e 76 69 72 6f 6e 6d 65 6e 74 20 76 61 6c 29 0a nvironment val). 10d0: 09 09 09 09 09 09 09 09 20 76 61 6c 29 29 29 0a ........ val))). 10e0: 09 09 09 09 09 09 28 69 66 20 65 6e 76 61 72 0a ......(if envar. 10f0: 09 09 09 09 09 09 20 20 20 20 28 62 65 67 69 6e ...... (begin 1100: 0a 09 09 09 09 09 09 20 20 20 20 20 20 28 64 65 ....... (de 1110: 62 75 67 3a 70 72 69 6e 74 20 34 20 22 49 4e 46 bug:print 4 "INF 1120: 4f 3a 20 72 65 61 64 2d 63 6f 6e 66 69 67 20 6b O: read-config k 1130: 65 79 3d 22 20 6b 65 79 20 22 2c 20 76 61 6c 3d ey=" key ", val= 1140: 22 20 76 61 6c 20 22 2c 20 72 65 61 6c 76 61 6c " val ", realval 1150: 3d 22 20 72 65 61 6c 76 61 6c 29 0a 09 09 09 09 =" realval)..... 1160: 09 09 20 20 20 20 20 20 28 73 65 74 65 6e 76 20 .. (setenv 1170: 6b 65 79 20 72 65 61 6c 76 61 6c 29 29 29 0a 09 key realval))).. 1180: 09 09 09 09 09 28 68 61 73 68 2d 74 61 62 6c 65 .....(hash-table 1190: 2d 73 65 74 21 20 72 65 73 20 63 75 72 72 2d 73 -set! res curr-s 11a0: 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 0a 09 09 09 ection-name .... 11b0: 09 09 09 09 09 20 28 63 6f 6e 66 69 67 3a 61 73 ..... (config:as 11c0: 73 6f 63 2d 73 61 66 65 2d 61 64 64 20 61 6c 69 soc-safe-add ali 11d0: 73 74 20 6b 65 79 20 72 65 61 6c 76 61 6c 29 29 st key realval)) 11e0: 0a 09 09 09 09 09 09 28 6c 6f 6f 70 20 28 72 65 .......(loop (re 11f0: 61 64 2d 6c 69 6e 65 20 69 6e 70 29 20 63 75 72 ad-line inp) cur 1200: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 6b r-section-name k 1210: 65 79 20 23 66 29 29 29 0a 09 20 20 20 20 20 20 ey #f))).. 1220: 20 3b 3b 20 69 66 20 61 20 63 6f 6e 74 69 6e 75 ;; if a continu 1230: 65 64 20 6c 69 6e 65 0a 09 20 20 20 20 20 20 20 ed line.. 1240: 28 63 6f 6e 74 2d 6c 6e 2d 72 78 20 28 20 78 20 (cont-ln-rx ( x 1250: 77 68 73 70 20 76 61 6c 20 20 20 20 20 29 20 28 whsp val ) ( 1260: 6c 65 74 20 28 28 61 6c 69 73 74 20 28 68 61 73 let ((alist (has 1270: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa 1280: 75 6c 74 20 72 65 73 20 63 75 72 72 2d 73 65 63 ult res curr-sec 1290: 74 69 6f 6e 2d 6e 61 6d 65 20 27 28 29 29 29 29 tion-name '()))) 12a0: 0a 09 09 09 09 09 09 28 69 66 20 76 61 72 2d 66 .......(if var-f 12b0: 6c 61 67 20 20 20 20 20 20 20 20 20 20 20 20 20 lag 12c0: 3b 3b 20 69 66 20 73 65 74 20 74 6f 20 61 20 73 ;; if set to a s 12d0: 74 72 69 6e 67 20 74 68 65 6e 20 77 65 20 68 61 tring then we ha 12e0: 76 65 20 61 20 63 6f 6e 74 69 6e 75 65 64 20 76 ve a continued v 12f0: 61 72 0a 09 09 09 09 09 09 20 20 20 20 28 6c 65 ar....... (le 1300: 74 20 28 28 6e 65 77 76 61 6c 20 28 63 6f 6e 63 t ((newval (conc 1310: 20 0a 09 09 09 09 09 09 09 09 20 20 20 28 63 6f ......... (co 1320: 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 72 65 73 20 nfig-lookup res 1330: 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d curr-section-nam 1340: 65 20 76 61 72 2d 66 6c 61 67 29 20 22 5c 6e 22 e var-flag) "\n" 1350: 0a 09 09 09 09 09 09 09 09 20 20 20 3b 3b 20 74 ......... ;; t 1360: 72 69 6d 20 6c 65 61 64 20 66 72 6f 6d 20 74 68 rim lead from th 1370: 65 20 69 6e 63 6f 6d 69 6e 67 20 77 68 73 70 20 e incoming whsp 1380: 74 6f 20 73 75 70 70 6f 72 74 20 73 6f 6d 65 20 to support some 1390: 69 6e 64 65 6e 74 69 6e 67 2e 0a 09 09 09 09 09 indenting....... 13a0: 09 09 09 20 20 20 28 69 66 20 6c 65 61 64 0a 09 ... (if lead.. 13b0: 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 73 ....... (s 13c0: 74 72 69 6e 67 2d 73 75 62 73 74 69 74 75 74 65 tring-substitute 13d0: 20 28 72 65 67 65 78 70 20 6c 65 61 64 29 20 22 (regexp lead) " 13e0: 22 20 77 68 73 70 29 0a 09 09 09 09 09 09 09 09 " whsp)......... 13f0: 20 20 20 20 20 20 20 22 22 29 0a 09 09 09 09 09 "")...... 1400: 09 09 09 20 20 20 76 61 6c 29 29 29 0a 09 09 09 ... val))).... 1410: 09 09 09 20 20 20 20 20 20 3b 3b 20 28 70 72 69 ... ;; (pri 1420: 6e 74 20 22 76 61 6c 3a 20 22 20 76 61 6c 20 22 nt "val: " val " 1430: 5c 6e 6e 65 77 76 61 6c 3a 20 5c 22 22 20 6e 65 \nnewval: \"" ne 1440: 77 76 61 6c 20 22 5c 22 5c 6e 76 61 72 66 6c 61 wval "\"\nvarfla 1450: 67 3a 20 22 20 76 61 72 2d 66 6c 61 67 29 0a 09 g: " var-flag).. 1460: 09 09 09 09 09 20 20 20 20 20 20 28 68 61 73 68 ..... (hash 1470: 2d 74 61 62 6c 65 2d 73 65 74 21 20 72 65 73 20 -table-set! res 1480: 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d curr-section-nam 1490: 65 20 0a 09 09 09 09 09 09 09 09 20 20 20 20 20 e ......... 14a0: 20 20 28 63 6f 6e 66 69 67 3a 61 73 73 6f 63 2d (config:assoc- 14b0: 73 61 66 65 2d 61 64 64 20 61 6c 69 73 74 20 76 safe-add alist v 14c0: 61 72 2d 66 6c 61 67 20 6e 65 77 76 61 6c 29 29 ar-flag newval)) 14d0: 0a 09 09 09 09 09 09 20 20 20 20 20 20 28 6c 6f ....... (lo 14e0: 6f 70 20 28 72 65 61 64 2d 6c 69 6e 65 20 69 6e op (read-line in 14f0: 70 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d p) curr-section- 1500: 6e 61 6d 65 20 76 61 72 2d 66 6c 61 67 20 28 69 name var-flag (i 1510: 66 20 6c 65 61 64 20 6c 65 61 64 20 77 68 73 70 f lead lead whsp 1520: 29 29 29 0a 09 09 09 09 09 09 20 20 20 20 28 6c )))....... (l 1530: 6f 6f 70 20 28 72 65 61 64 2d 6c 69 6e 65 20 69 oop (read-line i 1540: 6e 70 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e np) curr-section 1550: 2d 6e 61 6d 65 20 23 66 20 23 66 29 29 29 29 0a -name #f #f)))). 1560: 09 20 20 20 20 20 20 20 28 65 6c 73 65 20 28 64 . (else (d 1570: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 ebug:print 0 "ER 1580: 52 4f 52 3a 20 70 72 6f 62 6c 65 6d 20 70 61 72 ROR: problem par 1590: 73 69 6e 67 20 22 20 70 61 74 68 20 22 2c 5c 6e sing " path ",\n 15a0: 20 20 20 5c 22 22 20 69 6e 6c 20 22 5c 22 22 29 \"" inl "\"") 15b0: 0a 09 09 20 20 20 20 20 28 73 65 74 21 20 76 61 ... (set! va 15c0: 72 2d 66 6c 61 67 20 23 66 29 0a 09 09 20 20 20 r-flag #f)... 15d0: 20 20 28 6c 6f 6f 70 20 28 72 65 61 64 2d 6c 69 (loop (read-li 15e0: 6e 65 20 69 6e 70 29 20 63 75 72 72 2d 73 65 63 ne inp) curr-sec 15f0: 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 66 29 tion-name #f #f) 1600: 29 29 29 29 29 29 29 0a 20 20 0a 28 64 65 66 69 ))))))). .(defi 1610: 6e 65 20 28 66 69 6e 64 2d 61 6e 64 2d 72 65 61 ne (find-and-rea 1620: 64 2d 63 6f 6e 66 69 67 20 66 6e 61 6d 65 20 23 d-config fname # 1630: 21 6b 65 79 20 28 65 6e 76 69 72 6f 6e 2d 70 61 !key (environ-pa 1640: 74 74 20 23 66 29 29 0a 20 20 28 6c 65 74 2a 20 tt #f)). (let* 1650: 28 28 63 75 72 72 2d 64 69 72 20 20 20 28 63 75 ((curr-dir (cu 1660: 72 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 rrent-directory) 1670: 29 0a 20 20 20 20 20 20 20 20 20 28 63 6f 6e 66 ). (conf 1680: 69 67 69 6e 66 6f 20 28 66 69 6e 64 2d 63 6f 6e iginfo (find-con 1690: 66 69 67 20 66 6e 61 6d 65 29 29 0a 09 20 28 74 fig fname)).. (t 16a0: 6f 70 70 61 74 68 20 20 20 20 28 63 61 72 20 63 oppath (car c 16b0: 6f 6e 66 69 67 69 6e 66 6f 29 29 0a 09 20 28 63 onfiginfo)).. (c 16c0: 6f 6e 66 69 67 66 69 6c 65 20 28 63 61 64 72 20 onfigfile (cadr 16d0: 63 6f 6e 66 69 67 69 6e 66 6f 29 29 29 0a 20 20 configinfo))). 16e0: 20 20 28 69 66 20 74 6f 70 70 61 74 68 20 28 63 (if toppath (c 16f0: 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 hange-directory 1700: 74 6f 70 70 61 74 68 29 29 20 0a 20 20 20 20 28 toppath)) . ( 1710: 6c 65 74 20 28 28 63 6f 6e 66 69 67 64 61 74 20 let ((configdat 1720: 20 28 69 66 20 63 6f 6e 66 69 67 66 69 6c 65 20 (if configfile 1730: 28 72 65 61 64 2d 63 6f 6e 66 69 67 20 63 6f 6e (read-config con 1740: 66 69 67 66 69 6c 65 20 23 66 20 23 74 20 65 6e figfile #f #t en 1750: 76 69 72 6f 6e 2d 70 61 74 74 3a 20 65 6e 76 69 viron-patt: envi 1760: 72 6f 6e 2d 70 61 74 74 29 20 23 66 29 29 29 20 ron-patt) #f))) 1770: 3b 3b 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 ;; (make-hash-ta 1780: 62 6c 65 29 29 29 29 0a 20 20 20 20 20 20 28 69 ble)))). (i 1790: 66 20 74 6f 70 70 61 74 68 20 28 63 68 61 6e 67 f toppath (chang 17a0: 65 2d 64 69 72 65 63 74 6f 72 79 20 63 75 72 72 e-directory curr 17b0: 2d 64 69 72 29 29 0a 20 20 20 20 20 20 28 6c 69 -dir)). (li 17c0: 73 74 20 63 6f 6e 66 69 67 64 61 74 20 74 6f 70 st configdat top 17d0: 70 61 74 68 20 63 6f 6e 66 69 67 66 69 6c 65 20 path configfile 17e0: 66 6e 61 6d 65 29 29 29 29 0a 0a 28 64 65 66 69 fname))))..(defi 17f0: 6e 65 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 ne (config-looku 1800: 70 20 63 66 67 64 61 74 20 73 65 63 74 69 6f 6e p cfgdat section 1810: 20 76 61 72 29 0a 20 20 28 6c 65 74 20 28 28 73 var). (let ((s 1820: 65 63 74 64 61 74 20 28 68 61 73 68 2d 74 61 62 ectdat (hash-tab 1830: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 63 le-ref/default c 1840: 66 67 64 61 74 20 73 65 63 74 69 6f 6e 20 27 28 fgdat section '( 1850: 29 29 29 29 0a 20 20 20 20 28 69 66 20 28 6e 75 )))). (if (nu 1860: 6c 6c 3f 20 73 65 63 74 64 61 74 29 0a 09 23 66 ll? sectdat)..#f 1870: 0a 09 28 6c 65 74 20 28 28 6d 61 74 63 68 20 28 ..(let ((match ( 1880: 61 73 73 6f 63 20 76 61 72 20 73 65 63 74 64 61 assoc var sectda 1890: 74 29 29 29 0a 09 20 20 28 69 66 20 6d 61 74 63 t))).. (if matc 18a0: 68 0a 09 20 20 20 20 20 20 28 63 61 64 72 20 6d h.. (cadr m 18b0: 61 74 63 68 29 0a 09 20 20 20 20 20 20 23 66 29 atch).. #f) 18c0: 29 0a 09 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 )..)))..(define 18d0: 28 73 65 74 75 70 29 0a 20 20 28 6c 65 74 2a 20 (setup). (let* 18e0: 28 28 63 6f 6e 66 69 67 66 20 28 66 69 6e 64 2d ((configf (find- 18f0: 63 6f 6e 66 69 67 29 29 0a 09 20 28 63 6f 6e 66 config)).. (conf 1900: 69 67 20 20 28 69 66 20 63 6f 6e 66 69 67 66 20 ig (if configf 1910: 28 72 65 61 64 2d 63 6f 6e 66 69 67 20 63 6f 6e (read-config con 1920: 66 69 67 66 20 23 66 20 23 74 29 20 23 66 29 29 figf #f #t) #f)) 1930: 29 0a 20 20 20 20 28 69 66 20 63 6f 6e 66 69 67 ). (if config 1940: 0a 09 28 73 65 74 65 6e 76 20 22 52 55 4e 5f 41 ..(setenv "RUN_A 1950: 52 45 41 5f 48 4f 4d 45 22 20 28 70 61 74 68 6e REA_HOME" (pathn 1960: 61 6d 65 2d 64 69 72 65 63 74 6f 72 79 20 63 6f ame-directory co 1970: 6e 66 69 67 66 29 29 29 0a 20 20 20 20 63 6f 6e nfigf))). con 1980: 66 69 67 29 29 0a 0a fig))..