Artifact ef264b880e908b667afb404299ea513de98df09a:
- File configf.scm — part of check-in [0f355e8087] at 2011-11-02 21:58:28 on branch envhandling — Hacked to get vars working ok. NOT REENTRANT. Must rework :( (user: matt size: 6403) [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 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 2a 20 al ) (let* 0f60: 28 28 61 6c 69 73 74 20 20 20 28 68 61 73 68 2d ((alist (hash- 0f70: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul 0f80: 74 20 72 65 73 20 63 75 72 72 2d 73 65 63 74 69 t res curr-secti 0f90: 6f 6e 2d 6e 61 6d 65 20 27 28 29 29 29 0a 09 09 on-name '()))... 0fa0: 09 09 09 09 20 20 20 20 20 28 65 6e 76 61 72 20 .... (envar 0fb0: 20 20 28 61 6e 64 20 65 6e 76 69 72 6f 6e 2d 70 (and environ-p 0fc0: 61 74 74 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 att (string-matc 0fd0: 68 20 28 72 65 67 65 78 70 20 65 6e 76 69 72 6f h (regexp enviro 0fe0: 6e 2d 70 61 74 74 29 20 63 75 72 72 2d 73 65 63 n-patt) curr-sec 0ff0: 74 69 6f 6e 2d 6e 61 6d 65 29 29 29 0a 09 09 09 tion-name))).... 1000: 09 09 09 20 20 20 20 20 28 72 65 61 6c 76 61 6c ... (realval 1010: 20 28 69 66 20 65 6e 76 61 72 0a 09 09 09 09 09 (if envar...... 1020: 09 09 09 20 28 63 6f 6e 66 69 67 3a 65 76 61 6c ... (config:eval 1030: 2d 73 74 72 69 6e 67 2d 69 6e 2d 65 6e 76 69 72 -string-in-envir 1040: 6f 6e 6d 65 6e 74 20 76 61 6c 29 0a 09 09 09 09 onment val)..... 1050: 09 09 09 09 20 76 61 6c 29 29 29 0a 09 09 09 09 .... val)))..... 1060: 09 09 28 69 66 20 65 6e 76 61 72 0a 09 09 09 09 ..(if envar..... 1070: 09 09 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 .. (begin.... 1080: 09 09 09 20 20 20 20 20 20 28 64 65 62 75 67 3a ... (debug: 1090: 70 72 69 6e 74 20 34 20 22 49 4e 46 4f 3a 20 72 print 4 "INFO: r 10a0: 65 61 64 2d 63 6f 6e 66 69 67 20 6b 65 79 3d 22 ead-config key=" 10b0: 20 6b 65 79 20 22 2c 20 76 61 6c 3d 22 20 76 61 key ", val=" va 10c0: 6c 20 22 2c 20 72 65 61 6c 76 61 6c 3d 22 20 72 l ", realval=" r 10d0: 65 61 6c 76 61 6c 29 0a 09 09 09 09 09 09 20 20 ealval)....... 10e0: 20 20 20 20 28 73 65 74 65 6e 76 20 6b 65 79 20 (setenv key 10f0: 72 65 61 6c 76 61 6c 29 29 29 0a 09 09 09 09 09 realval)))...... 1100: 09 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 .(hash-table-set 1110: 21 20 72 65 73 20 63 75 72 72 2d 73 65 63 74 69 ! res curr-secti 1120: 6f 6e 2d 6e 61 6d 65 20 0a 09 09 09 09 09 09 09 on-name ........ 1130: 09 20 28 63 6f 6e 66 69 67 3a 61 73 73 6f 63 2d . (config:assoc- 1140: 73 61 66 65 2d 61 64 64 20 61 6c 69 73 74 20 6b safe-add alist k 1150: 65 79 20 72 65 61 6c 76 61 6c 29 29 0a 09 09 09 ey realval)).... 1160: 09 09 09 28 6c 6f 6f 70 20 28 72 65 61 64 2d 6c ...(loop (read-l 1170: 69 6e 65 20 69 6e 70 29 20 63 75 72 72 2d 73 65 ine inp) curr-se 1180: 63 74 69 6f 6e 2d 6e 61 6d 65 20 6b 65 79 20 23 ction-name key # 1190: 66 29 29 29 0a 09 20 20 20 20 20 20 20 3b 3b 20 f))).. ;; 11a0: 69 66 20 61 20 63 6f 6e 74 69 6e 75 65 64 20 6c if a continued l 11b0: 69 6e 65 0a 09 20 20 20 20 20 20 20 28 63 6f 6e ine.. (con 11c0: 74 2d 6c 6e 2d 72 78 20 28 20 78 20 77 68 73 70 t-ln-rx ( x whsp 11d0: 20 76 61 6c 20 20 20 20 20 29 20 28 6c 65 74 20 val ) (let 11e0: 28 28 61 6c 69 73 74 20 28 68 61 73 68 2d 74 61 ((alist (hash-ta 11f0: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default 1200: 72 65 73 20 63 75 72 72 2d 73 65 63 74 69 6f 6e res curr-section 1210: 2d 6e 61 6d 65 20 27 28 29 29 29 29 0a 09 09 09 -name '()))).... 1220: 09 09 09 28 69 66 20 76 61 72 2d 66 6c 61 67 20 ...(if var-flag 1230: 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 69 ;; i 1240: 66 20 73 65 74 20 74 6f 20 61 20 73 74 72 69 6e f set to a strin 1250: 67 20 74 68 65 6e 20 77 65 20 68 61 76 65 20 61 g then we have a 1260: 20 63 6f 6e 74 69 6e 75 65 64 20 76 61 72 0a 09 continued var.. 1270: 09 09 09 09 09 20 20 20 20 28 6c 65 74 20 28 28 ..... (let (( 1280: 6e 65 77 76 61 6c 20 28 63 6f 6e 63 20 0a 09 09 newval (conc ... 1290: 09 09 09 09 09 09 20 20 20 28 63 6f 6e 66 69 67 ...... (config 12a0: 2d 6c 6f 6f 6b 75 70 20 72 65 73 20 63 75 72 72 -lookup res curr 12b0: 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 76 61 -section-name va 12c0: 72 2d 66 6c 61 67 29 20 22 5c 6e 22 0a 09 09 09 r-flag) "\n".... 12d0: 09 09 09 09 09 20 20 20 3b 3b 20 74 72 69 6d 20 ..... ;; trim 12e0: 6c 65 61 64 20 66 72 6f 6d 20 74 68 65 20 69 6e lead from the in 12f0: 63 6f 6d 69 6e 67 20 77 68 73 70 20 74 6f 20 73 coming whsp to s 1300: 75 70 70 6f 72 74 20 73 6f 6d 65 20 69 6e 64 65 upport some inde 1310: 6e 74 69 6e 67 2e 0a 09 09 09 09 09 09 09 09 20 nting.......... 1320: 20 20 28 69 66 20 6c 65 61 64 0a 09 09 09 09 09 (if lead...... 1330: 09 09 09 20 20 20 20 20 20 20 28 73 74 72 69 6e ... (strin 1340: 67 2d 73 75 62 73 74 69 74 75 74 65 20 28 72 65 g-substitute (re 1350: 67 65 78 70 20 6c 65 61 64 29 20 22 22 20 77 68 gexp lead) "" wh 1360: 73 70 29 0a 09 09 09 09 09 09 09 09 20 20 20 20 sp)......... 1370: 20 20 20 22 22 29 0a 09 09 09 09 09 09 09 09 20 "")......... 1380: 20 20 76 61 6c 29 29 29 0a 09 09 09 09 09 09 20 val)))....... 1390: 20 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 ;; (print " 13a0: 76 61 6c 3a 20 22 20 76 61 6c 20 22 5c 6e 6e 65 val: " val "\nne 13b0: 77 76 61 6c 3a 20 5c 22 22 20 6e 65 77 76 61 6c wval: \"" newval 13c0: 20 22 5c 22 5c 6e 76 61 72 66 6c 61 67 3a 20 22 "\"\nvarflag: " 13d0: 20 76 61 72 2d 66 6c 61 67 29 0a 09 09 09 09 09 var-flag)...... 13e0: 09 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 . (hash-tab 13f0: 6c 65 2d 73 65 74 21 20 72 65 73 20 63 75 72 72 le-set! res curr 1400: 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 0a 09 -section-name .. 1410: 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 63 ....... (c 1420: 6f 6e 66 69 67 3a 61 73 73 6f 63 2d 73 61 66 65 onfig:assoc-safe 1430: 2d 61 64 64 20 61 6c 69 73 74 20 76 61 72 2d 66 -add alist var-f 1440: 6c 61 67 20 6e 65 77 76 61 6c 29 29 0a 09 09 09 lag newval)).... 1450: 09 09 09 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 ... (loop ( 1460: 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 29 20 63 read-line inp) c 1470: 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 urr-section-name 1480: 20 76 61 72 2d 66 6c 61 67 20 28 69 66 20 6c 65 var-flag (if le 1490: 61 64 20 6c 65 61 64 20 77 68 73 70 29 29 29 0a ad lead whsp))). 14a0: 09 09 09 09 09 09 20 20 20 20 28 6c 6f 6f 70 20 ...... (loop 14b0: 28 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 29 20 (read-line inp) 14c0: 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d curr-section-nam 14d0: 65 20 23 66 20 23 66 29 29 29 29 0a 09 20 20 20 e #f #f)))).. 14e0: 20 20 20 20 28 65 6c 73 65 20 28 64 65 62 75 67 (else (debug 14f0: 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a :print 0 "ERROR: 1500: 20 70 72 6f 62 6c 65 6d 20 70 61 72 73 69 6e 67 problem parsing 1510: 20 22 20 70 61 74 68 20 22 2c 5c 6e 20 20 20 5c " path ",\n \ 1520: 22 22 20 69 6e 6c 20 22 5c 22 22 29 0a 09 09 20 "" inl "\"")... 1530: 20 20 20 20 28 73 65 74 21 20 76 61 72 2d 66 6c (set! var-fl 1540: 61 67 20 23 66 29 0a 09 09 20 20 20 20 20 28 6c ag #f)... (l 1550: 6f 6f 70 20 28 72 65 61 64 2d 6c 69 6e 65 20 69 oop (read-line i 1560: 6e 70 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e np) curr-section 1570: 2d 6e 61 6d 65 20 23 66 20 23 66 29 29 29 29 29 -name #f #f))))) 1580: 29 29 29 0a 20 20 0a 28 64 65 66 69 6e 65 20 28 ))). .(define ( 1590: 66 69 6e 64 2d 61 6e 64 2d 72 65 61 64 2d 63 6f find-and-read-co 15a0: 6e 66 69 67 20 66 6e 61 6d 65 20 23 21 6b 65 79 nfig fname #!key 15b0: 20 28 65 6e 76 69 72 6f 6e 2d 70 61 74 74 20 23 (environ-patt # 15c0: 66 29 29 0a 20 20 28 6c 65 74 2a 20 28 28 63 75 f)). (let* ((cu 15d0: 72 72 2d 64 69 72 20 20 20 28 63 75 72 72 65 6e rr-dir (curren 15e0: 74 2d 64 69 72 65 63 74 6f 72 79 29 29 0a 20 20 t-directory)). 15f0: 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 69 6e (configin 1600: 66 6f 20 28 66 69 6e 64 2d 63 6f 6e 66 69 67 20 fo (find-config 1610: 66 6e 61 6d 65 29 29 0a 09 20 28 74 6f 70 70 61 fname)).. (toppa 1620: 74 68 20 20 20 20 28 63 61 72 20 63 6f 6e 66 69 th (car confi 1630: 67 69 6e 66 6f 29 29 0a 09 20 28 63 6f 6e 66 69 ginfo)).. (confi 1640: 67 66 69 6c 65 20 28 63 61 64 72 20 63 6f 6e 66 gfile (cadr conf 1650: 69 67 69 6e 66 6f 29 29 29 0a 20 20 20 20 28 69 iginfo))). (i 1660: 66 20 74 6f 70 70 61 74 68 20 28 63 68 61 6e 67 f toppath (chang 1670: 65 2d 64 69 72 65 63 74 6f 72 79 20 74 6f 70 70 e-directory topp 1680: 61 74 68 29 29 20 0a 20 20 20 20 28 6c 65 74 20 ath)) . (let 1690: 28 28 63 6f 6e 66 69 67 64 61 74 20 20 28 69 66 ((configdat (if 16a0: 20 63 6f 6e 66 69 67 66 69 6c 65 20 28 72 65 61 configfile (rea 16b0: 64 2d 63 6f 6e 66 69 67 20 63 6f 6e 66 69 67 66 d-config configf 16c0: 69 6c 65 20 23 66 20 23 74 20 65 6e 76 69 72 6f ile #f #t enviro 16d0: 6e 2d 70 61 74 74 3a 20 65 6e 76 69 72 6f 6e 2d n-patt: environ- 16e0: 70 61 74 74 29 20 23 66 29 29 29 20 3b 3b 20 28 patt) #f))) ;; ( 16f0: 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 make-hash-table) 1700: 29 29 29 0a 20 20 20 20 20 20 28 69 66 20 74 6f ))). (if to 1710: 70 70 61 74 68 20 28 63 68 61 6e 67 65 2d 64 69 ppath (change-di 1720: 72 65 63 74 6f 72 79 20 63 75 72 72 2d 64 69 72 rectory curr-dir 1730: 29 29 0a 20 20 20 20 20 20 28 6c 69 73 74 20 63 )). (list c 1740: 6f 6e 66 69 67 64 61 74 20 74 6f 70 70 61 74 68 onfigdat toppath 1750: 20 63 6f 6e 66 69 67 66 69 6c 65 20 66 6e 61 6d configfile fnam 1760: 65 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 e))))..(define ( 1770: 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 63 66 config-lookup cf 1780: 67 64 61 74 20 73 65 63 74 69 6f 6e 20 76 61 72 gdat section var 1790: 29 0a 20 20 28 6c 65 74 20 28 28 73 65 63 74 64 ). (let ((sectd 17a0: 61 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 at (hash-table-r 17b0: 65 66 2f 64 65 66 61 75 6c 74 20 63 66 67 64 61 ef/default cfgda 17c0: 74 20 73 65 63 74 69 6f 6e 20 27 28 29 29 29 29 t section '()))) 17d0: 0a 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 . (if (null? 17e0: 73 65 63 74 64 61 74 29 0a 09 23 66 0a 09 28 6c sectdat)..#f..(l 17f0: 65 74 20 28 28 6d 61 74 63 68 20 28 61 73 73 6f et ((match (asso 1800: 63 20 76 61 72 20 73 65 63 74 64 61 74 29 29 29 c var sectdat))) 1810: 0a 09 20 20 28 69 66 20 6d 61 74 63 68 0a 09 20 .. (if match.. 1820: 20 20 20 20 20 28 63 61 64 72 20 6d 61 74 63 68 (cadr match 1830: 29 0a 09 20 20 20 20 20 20 23 66 29 29 0a 09 29 ).. #f))..) 1840: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 73 65 74 ))..(define (set 1850: 75 70 29 0a 20 20 28 6c 65 74 2a 20 28 28 63 6f up). (let* ((co 1860: 6e 66 69 67 66 20 28 66 69 6e 64 2d 63 6f 6e 66 nfigf (find-conf 1870: 69 67 29 29 0a 09 20 28 63 6f 6e 66 69 67 20 20 ig)).. (config 1880: 28 69 66 20 63 6f 6e 66 69 67 66 20 28 72 65 61 (if configf (rea 1890: 64 2d 63 6f 6e 66 69 67 20 63 6f 6e 66 69 67 66 d-config configf 18a0: 20 23 66 20 23 74 29 20 23 66 29 29 29 0a 20 20 #f #t) #f))). 18b0: 20 20 28 69 66 20 63 6f 6e 66 69 67 0a 09 28 73 (if config..(s 18c0: 65 74 65 6e 76 20 22 52 55 4e 5f 41 52 45 41 5f etenv "RUN_AREA_ 18d0: 48 4f 4d 45 22 20 28 70 61 74 68 6e 61 6d 65 2d HOME" (pathname- 18e0: 64 69 72 65 63 74 6f 72 79 20 63 6f 6e 66 69 67 directory config 18f0: 66 29 29 29 0a 20 20 20 20 63 6f 6e 66 69 67 29 f))). config) 1900: 29 0a 0a )..