Artifact 9adef42084094ceb3b4ccefb5adbb76bdf52c3d4:
- File configf.scm — part of check-in [428bbd9b36] at 2011-12-05 12:34:03 on branch trunk — Fixed bug with continuing to launch tests for a run after first pass though the list (user: mrwellan size: 12517) [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 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;========== 0620: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0630: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0640: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0650: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;; 0660: 4d 61 6b 65 20 74 68 65 20 72 65 67 65 78 70 27 Make the regexp' 0670: 73 20 6e 65 65 64 65 64 20 67 6c 6f 62 61 6c 6c s needed globall 0680: 79 20 61 76 61 69 6c 61 62 6c 65 0a 3b 3b 3d 3d y available.;;== 0690: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 06a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 06b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 06c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 06d0: 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 63 6f ====..(define co 06e0: 6e 66 69 67 66 3a 69 6e 63 6c 75 64 65 2d 72 78 nfigf:include-rx 06f0: 20 28 72 65 67 65 78 70 20 22 5e 5c 5c 5b 69 6e (regexp "^\\[in 0700: 63 6c 75 64 65 5c 5c 73 2b 28 2e 2a 29 5c 5c 5d clude\\s+(.*)\\] 0710: 5c 5c 73 2a 24 22 29 29 0a 28 64 65 66 69 6e 65 \\s*$")).(define 0720: 20 63 6f 6e 66 69 67 66 3a 73 65 63 74 69 6f 6e configf:section 0730: 2d 72 78 20 28 72 65 67 65 78 70 20 22 5e 5c 5c -rx (regexp "^\\ 0740: 5b 28 2e 2a 29 5c 5c 5d 5c 5c 73 2a 24 22 29 29 [(.*)\\]\\s*$")) 0750: 0a 28 64 65 66 69 6e 65 20 63 6f 6e 66 69 67 66 .(define configf 0760: 3a 62 6c 61 6e 6b 2d 6c 2d 72 78 20 28 72 65 67 :blank-l-rx (reg 0770: 65 78 70 20 22 5e 5c 5c 73 2a 24 22 29 29 0a 28 exp "^\\s*$")).( 0780: 64 65 66 69 6e 65 20 63 6f 6e 66 69 67 66 3a 6b define configf:k 0790: 65 79 2d 73 79 73 2d 70 72 20 28 72 65 67 65 78 ey-sys-pr (regex 07a0: 70 20 22 5e 28 5c 5c 53 2b 29 5c 5c 73 2b 5c 5c p "^(\\S+)\\s+\\ 07b0: 5b 73 79 73 74 65 6d 5c 5c 73 2b 28 5c 5c 53 2b [system\\s+(\\S+ 07c0: 2e 2a 29 5c 5c 5d 5c 5c 73 2a 24 22 29 29 0a 28 .*)\\]\\s*$")).( 07d0: 64 65 66 69 6e 65 20 63 6f 6e 66 69 67 66 3a 6b define configf:k 07e0: 65 79 2d 76 61 6c 2d 70 72 20 28 72 65 67 65 78 ey-val-pr (regex 07f0: 70 20 22 5e 28 5c 5c 53 2b 29 5c 5c 73 2b 28 2e p "^(\\S+)\\s+(. 0800: 2a 29 24 22 29 29 0a 28 64 65 66 69 6e 65 20 63 *)$")).(define c 0810: 6f 6e 66 69 67 66 3a 63 6f 6d 6d 65 6e 74 2d 72 onfigf:comment-r 0820: 78 20 28 72 65 67 65 78 70 20 22 5e 5c 5c 73 2a x (regexp "^\\s* 0830: 23 2e 2a 22 29 29 0a 28 64 65 66 69 6e 65 20 63 #.*")).(define c 0840: 6f 6e 66 69 67 66 3a 63 6f 6e 74 2d 6c 6e 2d 72 onfigf:cont-ln-r 0850: 78 20 28 72 65 67 65 78 70 20 22 5e 28 5c 5c 73 x (regexp "^(\\s 0860: 2b 29 28 5c 5c 53 2b 2e 2a 29 24 22 29 29 0a 0a +)(\\S+.*)$")).. 0870: 3b 3b 20 72 65 61 64 20 61 20 63 6f 6e 66 69 67 ;; read a config 0880: 20 66 69 6c 65 2c 20 72 65 74 75 72 6e 73 20 68 file, returns h 0890: 61 73 68 20 74 61 62 6c 65 20 6f 66 20 61 6c 69 ash table of ali 08a0: 73 74 73 0a 3b 3b 20 61 64 64 73 20 74 6f 20 68 sts.;; adds to h 08b0: 74 20 69 66 20 67 69 76 65 6e 20 28 6d 75 73 74 t if given (must 08c0: 20 62 65 20 23 66 20 6f 74 68 65 72 77 69 73 65 be #f otherwise 08d0: 29 0a 3b 3b 20 65 6e 76 69 6f 6e 2d 70 61 74 74 ).;; envion-patt 08e0: 20 69 73 20 61 20 72 65 67 65 78 20 73 70 65 63 is a regex spec 08f0: 20 74 68 61 74 20 69 64 65 6e 74 69 66 69 65 73 that identifies 0900: 20 73 65 63 74 69 6f 6e 73 20 74 68 61 74 20 77 sections that w 0910: 69 6c 6c 20 62 65 20 65 76 61 6c 27 64 0a 3b 3b ill be eval'd.;; 0920: 20 69 6e 20 74 68 65 20 65 6e 76 69 72 6f 6e 6d in the environm 0930: 65 6e 74 20 6f 6e 20 74 68 65 20 66 6c 79 0a 0a ent on the fly.. 0940: 28 64 65 66 69 6e 65 20 28 72 65 61 64 2d 63 6f (define (read-co 0950: 6e 66 69 67 20 70 61 74 68 20 68 74 20 61 6c 6c nfig path ht all 0960: 6f 77 2d 73 79 73 74 65 6d 20 23 21 6b 65 79 20 ow-system #!key 0970: 28 65 6e 76 69 72 6f 6e 2d 70 61 74 74 20 23 66 (environ-patt #f 0980: 29 29 0a 20 20 28 64 65 62 75 67 3a 70 72 69 6e )). (debug:prin 0990: 74 20 34 20 22 49 4e 46 4f 3a 20 72 65 61 64 2d t 4 "INFO: read- 09a0: 63 6f 6e 66 69 67 20 22 20 70 61 74 68 20 22 20 config " path " 09b0: 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 22 20 61 allow-system " a 09c0: 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 22 20 65 6e llow-system " en 09d0: 76 69 72 6f 6e 2d 70 61 74 74 20 22 20 65 6e 76 viron-patt " env 09e0: 69 72 6f 6e 2d 70 61 74 74 29 0a 20 20 28 69 66 iron-patt). (if 09f0: 20 28 6e 6f 74 20 28 66 69 6c 65 2d 65 78 69 73 (not (file-exis 0a00: 74 73 3f 20 70 61 74 68 29 29 0a 20 20 20 20 20 ts? path)). 0a10: 20 28 69 66 20 28 6e 6f 74 20 68 74 29 28 6d 61 (if (not ht)(ma 0a20: 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 20 68 ke-hash-table) h 0a30: 74 29 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 t). (let (( 0a40: 69 6e 70 20 20 20 20 20 20 20 20 28 6f 70 65 6e inp (open 0a50: 2d 69 6e 70 75 74 2d 66 69 6c 65 20 70 61 74 68 -input-file path 0a60: 29 29 0a 09 20 20 20 20 28 72 65 73 20 20 20 20 )).. (res 0a70: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 68 74 29 (if (not ht) 0a80: 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 (make-hash-table 0a90: 29 20 68 74 29 29 29 0a 09 28 6c 65 74 20 6c 6f ) ht)))..(let lo 0aa0: 6f 70 20 28 28 69 6e 6c 20 20 20 20 20 20 20 20 op ((inl 0ab0: 20 20 20 20 20 20 20 28 72 65 61 64 2d 6c 69 6e (read-lin 0ac0: 65 20 69 6e 70 29 29 0a 09 09 20 20 20 28 63 75 e inp))... (cu 0ad0: 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 rr-section-name 0ae0: 22 64 65 66 61 75 6c 74 22 29 0a 09 09 20 20 20 "default")... 0af0: 28 76 61 72 2d 66 6c 61 67 20 23 66 29 3b 3b 20 (var-flag #f);; 0b00: 74 75 72 6e 20 6f 6e 20 66 6f 72 20 6b 65 79 2d turn on for key- 0b10: 76 61 72 2d 70 72 20 61 6e 64 20 63 6f 6e 74 2d var-pr and cont- 0b20: 6c 6e 2d 72 78 2c 20 74 75 72 6e 20 6f 66 66 20 ln-rx, turn off 0b30: 65 6c 73 65 77 68 65 72 65 0a 09 09 20 20 20 28 elsewhere... ( 0b40: 6c 65 61 64 20 20 20 20 20 23 66 29 29 0a 09 20 lead #f)).. 0b50: 20 28 69 66 20 28 65 6f 66 2d 6f 62 6a 65 63 74 (if (eof-object 0b60: 3f 20 69 6e 6c 29 20 0a 09 20 20 20 20 20 20 28 ? inl) .. ( 0b70: 62 65 67 69 6e 0a 09 09 28 63 6c 6f 73 65 2d 69 begin...(close-i 0b80: 6e 70 75 74 2d 70 6f 72 74 20 69 6e 70 29 0a 09 nput-port inp).. 0b90: 09 72 65 73 29 0a 09 20 20 20 20 20 20 28 72 65 .res).. (re 0ba0: 67 65 78 2d 63 61 73 65 20 0a 09 20 20 20 20 20 gex-case .. 0bb0: 20 20 69 6e 6c 20 0a 09 20 20 20 20 20 20 20 28 inl .. ( 0bc0: 63 6f 6e 66 69 67 66 3a 63 6f 6d 6d 65 6e 74 2d configf:comment- 0bd0: 72 78 20 5f 20 20 20 20 20 20 20 20 20 20 20 20 rx _ 0be0: 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 72 65 61 (loop (rea 0bf0: 64 2d 6c 69 6e 65 20 69 6e 70 29 20 63 75 72 72 d-line inp) curr 0c00: 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 -section-name #f 0c10: 20 23 66 29 29 0a 09 20 20 20 20 20 20 20 28 63 #f)).. (c 0c20: 6f 6e 66 69 67 66 3a 62 6c 61 6e 6b 2d 6c 2d 72 onfigf:blank-l-r 0c30: 78 20 5f 20 20 20 20 20 20 20 20 20 20 20 20 20 x _ 0c40: 20 20 20 20 20 28 6c 6f 6f 70 20 28 72 65 61 64 (loop (read 0c50: 2d 6c 69 6e 65 20 69 6e 70 29 20 63 75 72 72 2d -line inp) curr- 0c60: 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 section-name #f 0c70: 23 66 29 29 0a 09 20 20 20 20 20 20 20 28 63 6f #f)).. (co 0c80: 6e 66 69 67 66 3a 69 6e 63 6c 75 64 65 2d 72 78 nfigf:include-rx 0c90: 20 28 20 78 20 69 6e 63 6c 75 64 65 2d 66 69 6c ( x include-fil 0ca0: 65 20 29 20 28 62 65 67 69 6e 0a 09 09 09 09 09 e ) (begin...... 0cb0: 09 28 72 65 61 64 2d 63 6f 6e 66 69 67 20 69 6e .(read-config in 0cc0: 63 6c 75 64 65 2d 66 69 6c 65 20 72 65 73 20 61 clude-file res a 0cd0: 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 65 6e 76 69 llow-system envi 0ce0: 72 6f 6e 2d 70 61 74 74 3a 20 65 6e 76 69 72 6f ron-patt: enviro 0cf0: 6e 2d 70 61 74 74 29 0a 09 09 09 09 09 09 28 6c n-patt).......(l 0d00: 6f 6f 70 20 28 72 65 61 64 2d 6c 69 6e 65 20 69 oop (read-line i 0d10: 6e 70 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e np) curr-section 0d20: 2d 6e 61 6d 65 20 23 66 20 23 66 29 29 29 0a 09 -name #f #f))).. 0d30: 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a (configf: 0d40: 73 65 63 74 69 6f 6e 2d 72 78 20 28 20 78 20 73 section-rx ( x s 0d50: 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 29 20 28 6c ection-name ) (l 0d60: 6f 6f 70 20 28 72 65 61 64 2d 6c 69 6e 65 20 69 oop (read-line i 0d70: 6e 70 29 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 np) section-name 0d80: 20 23 66 20 23 66 29 29 0a 09 20 20 20 20 20 20 #f #f)).. 0d90: 20 28 63 6f 6e 66 69 67 66 3a 6b 65 79 2d 73 79 (configf:key-sy 0da0: 73 2d 70 72 20 28 20 78 20 6b 65 79 20 63 6d 64 s-pr ( x key cmd 0db0: 20 20 20 20 20 20 29 20 28 69 66 20 61 6c 6c 6f ) (if allo 0dc0: 77 2d 73 79 73 74 65 6d 0a 09 09 09 09 09 09 09 w-system........ 0dd0: 20 20 28 6c 65 74 20 28 28 61 6c 69 73 74 20 28 (let ((alist ( 0de0: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d 0df0: 65 66 61 75 6c 74 20 72 65 73 20 63 75 72 72 2d efault res curr- 0e00: 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 27 28 29 section-name '() 0e10: 29 29 0a 09 09 09 09 09 09 09 09 28 76 61 6c 2d )).........(val- 0e20: 70 72 6f 63 20 28 6c 61 6d 62 64 61 20 28 29 0a proc (lambda (). 0e30: 09 09 09 09 09 09 09 09 09 20 20 20 20 28 6c 65 ......... (le 0e40: 74 2a 20 28 28 63 6d 64 72 65 73 20 20 28 63 6d t* ((cmdres (cm 0e50: 64 2d 72 75 6e 2d 3e 6c 69 73 74 20 63 6d 64 29 d-run->list cmd) 0e60: 29 0a 09 09 09 09 09 09 09 09 09 09 20 20 20 28 )........... ( 0e70: 73 74 61 74 75 73 20 20 28 63 61 64 72 20 63 6d status (cadr cm 0e80: 64 72 65 73 29 29 0a 09 09 09 09 09 09 09 09 09 dres)).......... 0e90: 09 20 20 20 28 72 65 73 20 20 20 20 20 28 63 61 . (res (ca 0ea0: 72 20 20 63 6d 64 72 65 73 29 29 29 0a 09 09 09 r cmdres))).... 0eb0: 09 09 09 09 09 09 20 20 20 20 20 20 28 69 66 20 ...... (if 0ec0: 28 6e 6f 74 20 28 65 71 3f 20 73 74 61 74 75 73 (not (eq? status 0ed0: 20 30 29 29 0a 09 09 09 09 09 09 09 09 09 09 20 0))........... 0ee0: 20 28 62 65 67 69 6e 0a 09 09 09 09 09 09 09 09 (begin......... 0ef0: 09 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 .. (debug:pri 0f00: 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 70 72 6f nt 0 "ERROR: pro 0f10: 62 6c 65 6d 20 77 69 74 68 20 22 20 69 6e 6c 20 blem with " inl 0f20: 22 2c 20 72 65 74 75 72 6e 20 63 6f 64 65 20 22 ", return code " 0f30: 20 73 74 61 74 75 73 29 0a 09 09 09 09 09 09 09 status)........ 0f40: 09 09 09 20 20 20 20 28 65 78 69 74 20 31 29 29 ... (exit 1)) 0f50: 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 20 ).......... 0f60: 20 28 69 66 20 28 6e 75 6c 6c 3f 20 72 65 73 29 (if (null? res) 0f70: 0a 09 09 09 09 09 09 09 09 09 09 20 20 22 22 0a ........... "". 0f80: 09 09 09 09 09 09 09 09 09 09 20 20 28 73 74 72 .......... (str 0f90: 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 ing-intersperse 0fa0: 72 65 73 20 22 20 22 29 29 29 29 29 29 0a 09 09 res " "))))))... 0fb0: 09 09 09 09 09 20 20 20 20 28 68 61 73 68 2d 74 ..... (hash-t 0fc0: 61 62 6c 65 2d 73 65 74 21 20 72 65 73 20 63 75 able-set! res cu 0fd0: 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 rr-section-name 0fe0: 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 20 28 .......... ( 0ff0: 63 6f 6e 66 69 67 3a 61 73 73 6f 63 2d 73 61 66 config:assoc-saf 1000: 65 2d 61 64 64 20 61 6c 69 73 74 0a 09 09 09 09 e-add alist..... 1010: 09 09 09 09 09 09 09 09 20 20 20 20 6b 65 79 20 ........ key 1020: 0a 09 09 09 09 09 09 09 09 09 09 09 09 20 20 20 ............. 1030: 20 28 63 61 73 65 20 61 6c 6c 6f 77 2d 73 79 73 (case allow-sys 1040: 74 65 6d 0a 09 09 09 09 09 09 09 09 09 09 09 09 tem............. 1050: 20 20 20 20 20 20 28 28 72 65 74 75 72 6e 2d 70 ((return-p 1060: 72 6f 63 73 29 20 76 61 6c 2d 70 72 6f 63 29 0a rocs) val-proc). 1070: 09 09 09 09 09 09 09 09 09 09 09 09 20 20 20 20 ............ 1080: 20 20 28 28 72 65 74 75 72 6e 2d 73 74 72 69 6e ((return-strin 1090: 67 29 20 63 6d 64 29 0a 09 09 09 09 09 09 09 09 g) cmd)......... 10a0: 09 09 09 09 20 20 20 20 20 20 28 65 6c 73 65 20 .... (else 10b0: 28 76 61 6c 2d 70 72 6f 63 29 29 29 29 29 0a 09 (val-proc))))).. 10c0: 09 09 09 09 09 09 20 20 20 20 28 6c 6f 6f 70 20 ...... (loop 10d0: 28 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 29 20 (read-line inp) 10e0: 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d curr-section-nam 10f0: 65 20 23 66 20 23 66 29 29 0a 09 09 09 09 09 09 e #f #f))....... 1100: 09 20 20 28 6c 6f 6f 70 20 28 72 65 61 64 2d 6c . (loop (read-l 1110: 69 6e 65 20 69 6e 70 29 20 63 75 72 72 2d 73 65 ine inp) curr-se 1120: 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 66 ction-name #f #f 1130: 29 29 29 0a 09 20 20 20 20 20 20 20 28 63 6f 6e ))).. (con 1140: 66 69 67 66 3a 6b 65 79 2d 76 61 6c 2d 70 72 20 figf:key-val-pr 1150: 28 20 78 20 6b 65 79 20 76 61 6c 20 20 20 20 20 ( x key val 1160: 20 29 20 28 6c 65 74 2a 20 28 28 61 6c 69 73 74 ) (let* ((alist 1170: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 (hash-table-r 1180: 65 66 2f 64 65 66 61 75 6c 74 20 72 65 73 20 63 ef/default res c 1190: 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 urr-section-name 11a0: 20 27 28 29 29 29 0a 09 09 09 09 09 09 20 20 20 '()))....... 11b0: 20 20 28 65 6e 76 61 72 20 20 20 28 61 6e 64 20 (envar (and 11c0: 65 6e 76 69 72 6f 6e 2d 70 61 74 74 20 28 73 74 environ-patt (st 11d0: 72 69 6e 67 2d 6d 61 74 63 68 20 28 72 65 67 65 ring-match (rege 11e0: 78 70 20 65 6e 76 69 72 6f 6e 2d 70 61 74 74 29 xp environ-patt) 11f0: 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 curr-section-na 1200: 6d 65 29 29 29 0a 09 09 09 09 09 09 20 20 20 20 me)))....... 1210: 20 28 72 65 61 6c 76 61 6c 20 28 69 66 20 65 6e (realval (if en 1220: 76 61 72 0a 09 09 09 09 09 09 09 09 20 28 63 6f var......... (co 1230: 6e 66 69 67 3a 65 76 61 6c 2d 73 74 72 69 6e 67 nfig:eval-string 1240: 2d 69 6e 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 -in-environment 1250: 76 61 6c 29 0a 09 09 09 09 09 09 09 09 20 76 61 val)......... va 1260: 6c 29 29 29 0a 09 09 09 09 09 09 28 69 66 20 65 l))).......(if e 1270: 6e 76 61 72 0a 09 09 09 09 09 09 20 20 20 20 28 nvar....... ( 1280: 62 65 67 69 6e 0a 09 09 09 09 09 09 20 20 20 20 begin....... 1290: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 (debug:print 4 12a0: 20 22 49 4e 46 4f 3a 20 72 65 61 64 2d 63 6f 6e "INFO: read-con 12b0: 66 69 67 20 6b 65 79 3d 22 20 6b 65 79 20 22 2c fig key=" key ", 12c0: 20 76 61 6c 3d 22 20 76 61 6c 20 22 2c 20 72 65 val=" val ", re 12d0: 61 6c 76 61 6c 3d 22 20 72 65 61 6c 76 61 6c 29 alval=" realval) 12e0: 0a 09 09 09 09 09 09 20 20 20 20 20 20 28 73 65 ....... (se 12f0: 74 65 6e 76 20 6b 65 79 20 72 65 61 6c 76 61 6c tenv key realval 1300: 29 29 29 0a 09 09 09 09 09 09 28 68 61 73 68 2d ))).......(hash- 1310: 74 61 62 6c 65 2d 73 65 74 21 20 72 65 73 20 63 table-set! res c 1320: 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 urr-section-name 1330: 20 0a 09 09 09 09 09 09 09 09 20 28 63 6f 6e 66 ......... (conf 1340: 69 67 3a 61 73 73 6f 63 2d 73 61 66 65 2d 61 64 ig:assoc-safe-ad 1350: 64 20 61 6c 69 73 74 20 6b 65 79 20 72 65 61 6c d alist key real 1360: 76 61 6c 29 29 0a 09 09 09 09 09 09 28 6c 6f 6f val)).......(loo 1370: 70 20 28 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 p (read-line inp 1380: 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e ) curr-section-n 1390: 61 6d 65 20 6b 65 79 20 23 66 29 29 29 0a 09 20 ame key #f))).. 13a0: 20 20 20 20 20 20 3b 3b 20 69 66 20 61 20 63 6f ;; if a co 13b0: 6e 74 69 6e 75 65 64 20 6c 69 6e 65 0a 09 20 20 ntinued line.. 13c0: 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 63 6f (configf:co 13d0: 6e 74 2d 6c 6e 2d 72 78 20 28 20 78 20 77 68 73 nt-ln-rx ( x whs 13e0: 70 20 76 61 6c 20 20 20 20 20 29 20 28 6c 65 74 p val ) (let 13f0: 20 28 28 61 6c 69 73 74 20 28 68 61 73 68 2d 74 ((alist (hash-t 1400: 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 able-ref/default 1410: 20 72 65 73 20 63 75 72 72 2d 73 65 63 74 69 6f res curr-sectio 1420: 6e 2d 6e 61 6d 65 20 27 28 29 29 29 29 0a 09 09 n-name '())))... 1430: 09 09 09 09 28 69 66 20 76 61 72 2d 66 6c 61 67 ....(if var-flag 1440: 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 ;; 1450: 69 66 20 73 65 74 20 74 6f 20 61 20 73 74 72 69 if set to a stri 1460: 6e 67 20 74 68 65 6e 20 77 65 20 68 61 76 65 20 ng then we have 1470: 61 20 63 6f 6e 74 69 6e 75 65 64 20 76 61 72 0a a continued var. 1480: 09 09 09 09 09 09 20 20 20 20 28 6c 65 74 20 28 ...... (let ( 1490: 28 6e 65 77 76 61 6c 20 28 63 6f 6e 63 20 0a 09 (newval (conc .. 14a0: 09 09 09 09 09 09 09 20 20 20 28 63 6f 6e 66 69 ....... (confi 14b0: 67 2d 6c 6f 6f 6b 75 70 20 72 65 73 20 63 75 72 g-lookup res cur 14c0: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 76 r-section-name v 14d0: 61 72 2d 66 6c 61 67 29 20 22 5c 6e 22 0a 09 09 ar-flag) "\n"... 14e0: 09 09 09 09 09 09 20 20 20 3b 3b 20 74 72 69 6d ...... ;; trim 14f0: 20 6c 65 61 64 20 66 72 6f 6d 20 74 68 65 20 69 lead from the i 1500: 6e 63 6f 6d 69 6e 67 20 77 68 73 70 20 74 6f 20 ncoming whsp to 1510: 73 75 70 70 6f 72 74 20 73 6f 6d 65 20 69 6e 64 support some ind 1520: 65 6e 74 69 6e 67 2e 0a 09 09 09 09 09 09 09 09 enting.......... 1530: 20 20 20 28 69 66 20 6c 65 61 64 0a 09 09 09 09 (if lead..... 1540: 09 09 09 09 20 20 20 20 20 20 20 28 73 74 72 69 .... (stri 1550: 6e 67 2d 73 75 62 73 74 69 74 75 74 65 20 28 72 ng-substitute (r 1560: 65 67 65 78 70 20 6c 65 61 64 29 20 22 22 20 77 egexp lead) "" w 1570: 68 73 70 29 0a 09 09 09 09 09 09 09 09 20 20 20 hsp)......... 1580: 20 20 20 20 22 22 29 0a 09 09 09 09 09 09 09 09 "")......... 1590: 20 20 20 76 61 6c 29 29 29 0a 09 09 09 09 09 09 val)))....... 15a0: 20 20 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 ;; (print 15b0: 22 76 61 6c 3a 20 22 20 76 61 6c 20 22 5c 6e 6e "val: " val "\nn 15c0: 65 77 76 61 6c 3a 20 5c 22 22 20 6e 65 77 76 61 ewval: \"" newva 15d0: 6c 20 22 5c 22 5c 6e 76 61 72 66 6c 61 67 3a 20 l "\"\nvarflag: 15e0: 22 20 76 61 72 2d 66 6c 61 67 29 0a 09 09 09 09 " var-flag)..... 15f0: 09 09 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 .. (hash-ta 1600: 62 6c 65 2d 73 65 74 21 20 72 65 73 20 63 75 72 ble-set! res cur 1610: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 0a r-section-name . 1620: 09 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 ........ ( 1630: 63 6f 6e 66 69 67 3a 61 73 73 6f 63 2d 73 61 66 config:assoc-saf 1640: 65 2d 61 64 64 20 61 6c 69 73 74 20 76 61 72 2d e-add alist var- 1650: 66 6c 61 67 20 6e 65 77 76 61 6c 29 29 0a 09 09 flag newval))... 1660: 09 09 09 09 20 20 20 20 20 20 28 6c 6f 6f 70 20 .... (loop 1670: 28 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 29 20 (read-line inp) 1680: 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d curr-section-nam 1690: 65 20 76 61 72 2d 66 6c 61 67 20 28 69 66 20 6c e var-flag (if l 16a0: 65 61 64 20 6c 65 61 64 20 77 68 73 70 29 29 29 ead lead whsp))) 16b0: 0a 09 09 09 09 09 09 20 20 20 20 28 6c 6f 6f 70 ....... (loop 16c0: 20 28 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 29 (read-line inp) 16d0: 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 curr-section-na 16e0: 6d 65 20 23 66 20 23 66 29 29 29 29 0a 09 20 20 me #f #f)))).. 16f0: 20 20 20 20 20 28 65 6c 73 65 20 28 64 65 62 75 (else (debu 1700: 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 g:print 0 "ERROR 1710: 3a 20 70 72 6f 62 6c 65 6d 20 70 61 72 73 69 6e : problem parsin 1720: 67 20 22 20 70 61 74 68 20 22 2c 5c 6e 20 20 20 g " path ",\n 1730: 5c 22 22 20 69 6e 6c 20 22 5c 22 22 29 0a 09 09 \"" inl "\"")... 1740: 20 20 20 20 20 28 73 65 74 21 20 76 61 72 2d 66 (set! var-f 1750: 6c 61 67 20 23 66 29 0a 09 09 20 20 20 20 20 28 lag #f)... ( 1760: 6c 6f 6f 70 20 28 72 65 61 64 2d 6c 69 6e 65 20 loop (read-line 1770: 69 6e 70 29 20 63 75 72 72 2d 73 65 63 74 69 6f inp) curr-sectio 1780: 6e 2d 6e 61 6d 65 20 23 66 20 23 66 29 29 29 29 n-name #f #f)))) 1790: 29 29 29 29 0a 20 20 0a 28 64 65 66 69 6e 65 20 )))). .(define 17a0: 28 66 69 6e 64 2d 61 6e 64 2d 72 65 61 64 2d 63 (find-and-read-c 17b0: 6f 6e 66 69 67 20 66 6e 61 6d 65 20 23 21 6b 65 onfig fname #!ke 17c0: 79 20 28 65 6e 76 69 72 6f 6e 2d 70 61 74 74 20 y (environ-patt 17d0: 23 66 29 29 0a 20 20 28 6c 65 74 2a 20 28 28 63 #f)). (let* ((c 17e0: 75 72 72 2d 64 69 72 20 20 20 28 63 75 72 72 65 urr-dir (curre 17f0: 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 29 0a 20 nt-directory)). 1800: 20 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 69 (configi 1810: 6e 66 6f 20 28 66 69 6e 64 2d 63 6f 6e 66 69 67 nfo (find-config 1820: 20 66 6e 61 6d 65 29 29 0a 09 20 28 74 6f 70 70 fname)).. (topp 1830: 61 74 68 20 20 20 20 28 63 61 72 20 63 6f 6e 66 ath (car conf 1840: 69 67 69 6e 66 6f 29 29 0a 09 20 28 63 6f 6e 66 iginfo)).. (conf 1850: 69 67 66 69 6c 65 20 28 63 61 64 72 20 63 6f 6e igfile (cadr con 1860: 66 69 67 69 6e 66 6f 29 29 29 0a 20 20 20 20 28 figinfo))). ( 1870: 69 66 20 74 6f 70 70 61 74 68 20 28 63 68 61 6e if toppath (chan 1880: 67 65 2d 64 69 72 65 63 74 6f 72 79 20 74 6f 70 ge-directory top 1890: 70 61 74 68 29 29 20 0a 20 20 20 20 28 6c 65 74 path)) . (let 18a0: 20 28 28 63 6f 6e 66 69 67 64 61 74 20 20 28 69 ((configdat (i 18b0: 66 20 63 6f 6e 66 69 67 66 69 6c 65 20 28 72 65 f configfile (re 18c0: 61 64 2d 63 6f 6e 66 69 67 20 63 6f 6e 66 69 67 ad-config config 18d0: 66 69 6c 65 20 23 66 20 23 74 20 65 6e 76 69 72 file #f #t envir 18e0: 6f 6e 2d 70 61 74 74 3a 20 65 6e 76 69 72 6f 6e on-patt: environ 18f0: 2d 70 61 74 74 29 20 23 66 29 29 29 20 3b 3b 20 -patt) #f))) ;; 1900: 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 (make-hash-table 1910: 29 29 29 29 0a 20 20 20 20 20 20 28 69 66 20 74 )))). (if t 1920: 6f 70 70 61 74 68 20 28 63 68 61 6e 67 65 2d 64 oppath (change-d 1930: 69 72 65 63 74 6f 72 79 20 63 75 72 72 2d 64 69 irectory curr-di 1940: 72 29 29 0a 20 20 20 20 20 20 28 6c 69 73 74 20 r)). (list 1950: 63 6f 6e 66 69 67 64 61 74 20 74 6f 70 70 61 74 configdat toppat 1960: 68 20 63 6f 6e 66 69 67 66 69 6c 65 20 66 6e 61 h configfile fna 1970: 6d 65 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 me))))..(define 1980: 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 63 (config-lookup c 1990: 66 67 64 61 74 20 73 65 63 74 69 6f 6e 20 76 61 fgdat section va 19a0: 72 29 0a 20 20 28 6c 65 74 20 28 28 73 65 63 74 r). (let ((sect 19b0: 64 61 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d dat (hash-table- 19c0: 72 65 66 2f 64 65 66 61 75 6c 74 20 63 66 67 64 ref/default cfgd 19d0: 61 74 20 73 65 63 74 69 6f 6e 20 27 28 29 29 29 at section '())) 19e0: 29 0a 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f ). (if (null? 19f0: 20 73 65 63 74 64 61 74 29 0a 09 23 66 0a 09 28 sectdat)..#f..( 1a00: 6c 65 74 20 28 28 6d 61 74 63 68 20 28 61 73 73 let ((match (ass 1a10: 6f 63 20 76 61 72 20 73 65 63 74 64 61 74 29 29 oc var sectdat)) 1a20: 29 0a 09 20 20 28 69 66 20 6d 61 74 63 68 20 3b ).. (if match ; 1a30: 3b 20 28 61 6e 64 20 6d 61 74 63 68 20 28 6c 69 ; (and match (li 1a40: 73 74 3f 20 6d 61 74 63 68 29 28 3e 20 28 6c 65 st? match)(> (le 1a50: 6e 67 74 68 20 6d 61 74 63 68 29 20 31 29 29 0a ngth match) 1)). 1a60: 09 20 20 20 20 20 20 28 63 61 64 72 20 6d 61 74 . (cadr mat 1a70: 63 68 29 0a 09 20 20 20 20 20 20 23 66 29 29 0a ch).. #f)). 1a80: 09 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 .)))..(define (c 1a90: 6f 6e 66 69 67 66 3a 73 65 63 74 69 6f 6e 2d 76 onfigf:section-v 1aa0: 61 72 73 20 63 66 67 64 61 74 20 73 65 63 74 69 ars cfgdat secti 1ab0: 6f 6e 29 0a 20 20 28 6c 65 74 20 28 28 73 65 63 on). (let ((sec 1ac0: 74 64 61 74 20 28 68 61 73 68 2d 74 61 62 6c 65 tdat (hash-table 1ad0: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 63 66 67 -ref/default cfg 1ae0: 64 61 74 20 73 65 63 74 69 6f 6e 20 27 28 29 29 dat section '()) 1af0: 29 29 0a 20 20 20 20 28 69 66 20 28 6e 75 6c 6c )). (if (null 1b00: 3f 20 73 65 63 74 64 61 74 29 0a 09 27 28 29 0a ? sectdat)..'(). 1b10: 09 28 6d 61 70 20 63 61 72 20 73 65 63 74 64 61 .(map car sectda 1b20: 74 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 t))))..(define ( 1b30: 73 65 74 75 70 29 0a 20 20 28 6c 65 74 2a 20 28 setup). (let* ( 1b40: 28 63 6f 6e 66 69 67 66 20 28 66 69 6e 64 2d 63 (configf (find-c 1b50: 6f 6e 66 69 67 29 29 0a 09 20 28 63 6f 6e 66 69 onfig)).. (confi 1b60: 67 20 20 28 69 66 20 63 6f 6e 66 69 67 66 20 28 g (if configf ( 1b70: 72 65 61 64 2d 63 6f 6e 66 69 67 20 63 6f 6e 66 read-config conf 1b80: 69 67 66 20 23 66 20 23 74 29 20 23 66 29 29 29 igf #f #t) #f))) 1b90: 0a 20 20 20 20 28 69 66 20 63 6f 6e 66 69 67 0a . (if config. 1ba0: 09 28 73 65 74 65 6e 76 20 22 52 55 4e 5f 41 52 .(setenv "RUN_AR 1bb0: 45 41 5f 48 4f 4d 45 22 20 28 70 61 74 68 6e 61 EA_HOME" (pathna 1bc0: 6d 65 2d 64 69 72 65 63 74 6f 72 79 20 63 6f 6e me-directory con 1bd0: 66 69 67 66 29 29 29 0a 20 20 20 20 63 6f 6e 66 figf))). conf 1be0: 69 67 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d ig))..;;======== 1bf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1c00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1c10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1c20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.; 1c30: 3b 20 4e 6f 6e 20 64 65 73 74 72 75 63 74 69 76 ; Non destructiv 1c40: 65 20 77 72 69 74 69 6e 67 20 6f 66 20 63 6f 6e e writing of con 1c50: 66 69 67 20 66 69 6c 65 0a 3b 3b 3d 3d 3d 3d 3d fig file.;;===== 1c60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1c70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1c80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1c90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1ca0: 3d 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 =..(define (conf 1cb0: 69 67 66 3a 63 6f 6d 70 72 65 73 73 2d 6d 75 6c igf:compress-mul 1cc0: 74 69 2d 6c 69 6e 65 73 20 66 64 61 74 29 0a 20 ti-lines fdat). 1cd0: 20 3b 3b 20 73 74 65 70 20 31 2e 35 20 2d 20 63 ;; step 1.5 - c 1ce0: 6f 6d 70 72 65 73 73 20 61 6e 79 20 63 6f 6e 74 ompress any cont 1cf0: 69 6e 75 65 64 20 6c 69 6e 65 73 0a 20 20 28 69 inued lines. (i 1d00: 66 20 28 6e 75 6c 6c 3f 20 66 64 61 74 29 20 66 f (null? fdat) f 1d10: 64 61 74 0a 09 28 6c 65 74 20 6c 6f 6f 70 20 28 dat..(let loop ( 1d20: 28 68 65 64 20 28 63 61 72 20 66 64 61 74 29 29 (hed (car fdat)) 1d30: 0a 09 09 20 20 20 28 74 61 6c 20 28 63 64 72 20 ... (tal (cdr 1d40: 66 64 61 74 29 29 0a 09 09 20 20 20 28 63 75 72 fdat))... (cur 1d50: 20 22 22 29 0a 09 09 20 20 20 28 6c 65 64 20 23 "")... (led # 1d60: 66 29 0a 09 09 20 20 20 28 72 65 73 20 27 28 29 f)... (res '() 1d70: 29 29 0a 09 20 20 3b 3b 20 41 4c 4c 20 57 48 49 )).. ;; ALL WHI 1d80: 54 45 53 50 41 43 45 20 4c 45 41 44 49 4e 47 20 TESPACE LEADING 1d90: 4c 49 4e 45 53 20 41 52 45 20 54 41 43 4b 45 44 LINES ARE TACKED 1da0: 20 4f 4e 21 21 0a 09 20 20 3b 3b 20 20 31 2e 20 ON!!.. ;; 1. 1db0: 72 65 6d 6f 76 65 20 6c 65 64 20 77 68 69 74 65 remove led white 1dc0: 73 70 61 63 65 0a 09 20 20 3b 3b 20 20 32 2e 20 space.. ;; 2. 1dd0: 74 61 63 6b 20 6f 6e 20 74 6f 20 68 65 64 20 77 tack on to hed w 1de0: 69 74 68 20 22 5c 6e 22 0a 09 20 20 28 6c 65 74 ith "\n".. (let 1df0: 20 28 28 6d 61 74 63 68 20 28 73 74 72 69 6e 67 ((match (string 1e00: 2d 6d 61 74 63 68 20 63 6f 6e 66 69 67 66 3a 63 -match configf:c 1e10: 6f 6e 74 2d 6c 6e 2d 72 78 20 68 65 64 29 29 29 ont-ln-rx hed))) 1e20: 0a 09 20 20 20 20 28 69 66 20 6d 61 74 63 68 20 .. (if match 1e30: 3b 3b 20 62 6c 61 73 74 21 20 68 61 76 65 20 74 ;; blast! have t 1e40: 6f 20 64 65 61 6c 20 77 69 74 68 20 61 20 6d 75 o deal with a mu 1e50: 6c 74 69 6c 69 6e 65 0a 09 09 28 6c 65 74 2a 20 ltiline...(let* 1e60: 28 28 6c 65 61 64 20 28 63 61 64 72 20 6d 61 74 ((lead (cadr mat 1e70: 63 68 29 29 0a 09 09 20 20 20 20 20 20 20 28 6c ch))... (l 1e80: 76 61 6c 20 28 63 61 64 64 72 20 6d 61 74 63 68 val (caddr match 1e90: 29 29 0a 09 09 20 20 20 20 20 20 20 28 6e 65 77 ))... (new 1ea0: 6c 20 28 63 6f 6e 63 20 63 75 72 20 22 5c 6e 22 l (conc cur "\n" 1eb0: 20 6c 76 61 6c 29 29 29 0a 09 09 20 20 28 69 66 lval)))... (if 1ec0: 20 28 6e 6f 74 20 6c 65 64 29 28 73 65 74 21 20 (not led)(set! 1ed0: 6c 65 64 20 6c 65 61 64 29 29 0a 09 09 20 20 28 led lead))... ( 1ee0: 69 66 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 20 0a if (null? tal) . 1ef0: 09 09 20 20 20 20 20 20 28 73 65 74 21 20 66 64 .. (set! fd 1f00: 61 74 20 28 61 70 70 65 6e 64 20 66 64 61 74 20 at (append fdat 1f10: 28 6c 69 73 74 20 6e 65 77 6c 29 29 29 0a 09 09 (list newl)))... 1f20: 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 (loop (car 1f30: 20 74 61 6c 29 28 63 64 72 20 74 61 6c 29 20 6e tal)(cdr tal) n 1f40: 65 77 6c 20 6c 65 64 20 72 65 73 29 29 29 20 3b ewl led res))) ; 1f50: 3b 20 4e 42 2f 2f 20 6e 6f 74 20 74 61 63 6b 69 ; NB// not tacki 1f60: 6e 67 20 6e 65 77 6c 20 6f 6e 74 6f 20 72 65 73 ng newl onto res 1f70: 0a 09 09 28 6c 65 74 20 28 28 6e 65 77 72 65 73 ...(let ((newres 1f80: 20 28 69 66 20 6c 65 64 20 0a 09 09 09 09 20 20 (if led ..... 1f90: 28 61 70 70 65 6e 64 20 72 65 73 20 28 6c 69 73 (append res (lis 1fa0: 74 20 63 75 72 20 68 65 64 29 29 0a 09 09 09 09 t cur hed))..... 1fb0: 20 20 28 61 70 70 65 6e 64 20 72 65 73 20 28 6c (append res (l 1fc0: 69 73 74 20 68 65 64 29 29 29 29 29 0a 09 09 20 ist hed)))))... 1fd0: 20 3b 3b 20 70 72 65 76 20 77 61 73 20 61 20 6d ;; prev was a m 1fe0: 75 6c 74 69 6c 69 6e 65 0a 09 09 20 20 28 69 66 ultiline... (if 1ff0: 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 0a 09 09 20 (null? tal)... 2000: 20 20 20 20 20 6e 65 77 72 65 73 0a 09 09 20 20 newres... 2010: 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 74 (loop (car t 2020: 61 6c 29 28 63 64 72 20 74 61 6c 29 20 22 22 20 al)(cdr tal) "" 2030: 23 66 20 6e 65 77 72 65 73 29 29 29 29 29 29 29 #f newres))))))) 2040: 29 0a 0a 3b 3b 20 6e 6f 74 65 3a 20 49 27 6d 20 )..;; note: I'm 2050: 63 68 65 61 74 69 6e 67 20 61 20 6c 69 74 74 6c cheating a littl 2060: 65 20 68 65 72 65 2e 20 49 20 6d 65 72 65 6c 79 e here. I merely 2070: 20 72 65 70 6c 61 63 65 20 22 5c 6e 22 20 77 69 replace "\n" wi 2080: 74 68 20 22 5c 6e 20 20 20 20 20 20 20 20 20 22 th "\n " 2090: 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 .(define (config 20a0: 66 3a 65 78 70 61 6e 64 2d 6d 75 6c 74 69 2d 6c f:expand-multi-l 20b0: 69 6e 65 73 20 66 64 61 74 29 0a 20 20 3b 3b 20 ines fdat). ;; 20c0: 73 74 65 70 20 31 2e 35 20 2d 20 63 6f 6d 70 72 step 1.5 - compr 20d0: 65 73 73 20 61 6e 79 20 63 6f 6e 74 69 6e 75 65 ess any continue 20e0: 64 20 6c 69 6e 65 73 0a 20 20 28 69 66 20 28 6e d lines. (if (n 20f0: 75 6c 6c 3f 20 66 64 61 74 29 20 66 64 61 74 0a ull? fdat) fdat. 2100: 20 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 (let loop 2110: 28 28 68 65 64 20 28 63 61 72 20 66 64 61 74 29 ((hed (car fdat) 2120: 29 0a 09 09 20 28 74 61 6c 20 28 63 64 72 20 66 )... (tal (cdr f 2130: 64 61 74 29 29 0a 09 09 20 28 72 65 73 20 27 28 dat))... (res '( 2140: 29 29 29 0a 09 28 6c 65 74 20 28 28 6e 65 77 72 )))..(let ((newr 2150: 65 73 20 28 61 70 70 65 6e 64 20 72 65 73 20 28 es (append res ( 2160: 6c 69 73 74 20 28 73 74 72 69 6e 67 2d 73 75 62 list (string-sub 2170: 73 74 69 74 75 74 65 20 28 72 65 67 65 78 70 20 stitute (regexp 2180: 22 5c 6e 22 29 20 22 5c 6e 20 20 20 20 20 20 20 "\n") "\n 2190: 20 20 22 20 68 65 64 20 23 74 29 29 29 29 29 0a " hed #t))))). 21a0: 09 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 61 . (if (null? ta 21b0: 6c 29 0a 09 20 20 20 20 20 20 6e 65 77 72 65 73 l).. newres 21c0: 0a 09 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 .. (loop (c 21d0: 61 72 20 74 61 6c 29 28 63 64 72 20 74 61 6c 29 ar tal)(cdr tal) 21e0: 20 6e 65 77 72 65 73 29 29 29 29 29 29 0a 0a 28 newres))))))..( 21f0: 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a define (configf: 2200: 66 69 6c 65 2d 3e 6c 69 73 74 20 66 6e 61 6d 65 file->list fname 2210: 29 0a 20 20 28 69 66 20 28 66 69 6c 65 2d 65 78 ). (if (file-ex 2220: 69 73 74 73 3f 20 66 6e 61 6d 65 29 0a 20 20 20 ists? fname). 2230: 20 20 20 28 6c 65 74 20 28 28 69 6e 70 20 28 6f (let ((inp (o 2240: 70 65 6e 2d 69 6e 70 75 74 2d 66 69 6c 65 20 66 pen-input-file f 2250: 6e 61 6d 65 29 29 29 0a 09 28 6c 65 74 20 6c 6f name)))..(let lo 2260: 6f 70 20 28 28 69 6e 6c 20 28 72 65 61 64 2d 6c op ((inl (read-l 2270: 69 6e 65 20 69 6e 70 29 29 0a 09 09 20 20 20 28 ine inp))... ( 2280: 72 65 73 20 27 28 29 29 29 0a 09 20 20 28 69 66 res '())).. (if 2290: 20 28 65 6f 66 2d 6f 62 6a 65 63 74 3f 20 69 6e (eof-object? in 22a0: 6c 29 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e l).. (begin 22b0: 0a 09 09 28 63 6c 6f 73 65 2d 69 6e 70 75 74 2d ...(close-input- 22c0: 70 6f 72 74 20 69 6e 70 29 0a 09 09 28 72 65 76 port inp)...(rev 22d0: 65 72 73 65 20 72 65 73 29 29 0a 09 20 20 20 20 erse res)).. 22e0: 20 20 28 6c 6f 6f 70 20 28 72 65 61 64 2d 6c 69 (loop (read-li 22f0: 6e 65 20 69 6e 70 29 28 63 6f 6e 73 20 69 6e 6c ne inp)(cons inl 2300: 29 29 29 29 29 0a 20 20 20 20 20 20 27 28 29 29 ))))). '()) 2310: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;=========== 2320: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 2330: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 2340: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 2350: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 57 ===========.;; W 2360: 72 69 74 65 20 61 20 63 6f 6e 66 69 67 0a 3b 3b rite a config.;; 2370: 20 20 20 30 2e 20 47 69 76 65 6e 20 61 20 72 65 0. Given a re 2380: 66 65 72 65 72 65 6e 63 65 20 64 61 74 61 20 73 fererence data s 2390: 74 72 75 63 74 75 72 65 20 22 69 6e 64 61 74 22 tructure "indat" 23a0: 0a 3b 3b 20 20 20 31 2e 20 4f 70 65 6e 20 74 68 .;; 1. Open th 23b0: 65 20 6f 75 74 70 75 74 20 66 69 6c 65 20 61 6e e output file an 23c0: 64 20 72 65 61 64 20 69 74 20 69 6e 74 6f 20 61 d read it into a 23d0: 20 6c 69 73 74 0a 3b 3b 20 20 20 32 2e 20 46 6c list.;; 2. Fl 23e0: 61 74 74 65 6e 20 61 6e 79 20 6d 75 6c 74 69 6c atten any multil 23f0: 69 6e 65 20 65 6e 74 72 69 65 73 0a 3b 3b 20 20 ine entries.;; 2400: 20 33 2e 20 4d 6f 64 69 66 79 20 76 61 6c 75 65 3. Modify value 2410: 73 20 70 65 72 20 63 6f 6e 74 65 6e 74 73 20 6f s per contents o 2420: 66 20 22 69 6e 64 61 74 22 20 61 6e 64 20 72 65 f "indat" and re 2430: 6d 6f 76 65 20 61 62 73 65 6e 74 20 76 61 6c 75 move absent valu 2440: 65 73 0a 3b 3b 20 20 20 34 2e 20 41 70 70 65 6e es.;; 4. Appen 2450: 64 20 6e 65 77 20 76 61 6c 75 65 73 20 74 6f 20 d new values to 2460: 74 68 65 20 73 65 63 74 69 6f 6e 20 28 69 6d 6d the section (imm 2470: 65 64 69 61 74 65 6c 79 20 61 66 74 65 72 20 6c ediately after l 2480: 61 73 74 20 6c 65 67 69 74 20 65 6e 74 72 79 29 ast legit entry) 2490: 0a 3b 3b 20 20 20 35 2e 20 57 72 69 74 65 20 6f .;; 5. Write o 24a0: 75 74 20 74 68 65 20 6e 65 77 20 6c 69 73 74 20 ut the new list 24b0: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;============= 24c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 24d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 24e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 24f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 =========..(defi 2500: 6e 65 20 28 63 6f 6e 66 69 67 66 3a 77 72 69 74 ne (configf:writ 2510: 65 2d 63 6f 6e 66 69 67 20 69 6e 64 61 74 20 66 e-config indat f 2520: 6e 61 6d 65 20 23 21 6b 65 79 20 28 72 65 71 75 name #!key (requ 2530: 69 72 65 64 2d 73 65 63 74 69 6f 6e 73 20 27 28 ired-sections '( 2540: 29 29 29 0a 20 20 28 6c 65 74 2a 20 28 3b 3b 20 ))). (let* (;; 2550: 73 74 65 70 20 31 3a 20 4f 70 65 6e 20 74 68 65 step 1: Open the 2560: 20 6f 75 74 70 75 74 20 66 69 6c 65 20 61 6e 64 output file and 2570: 20 72 65 61 64 20 69 74 20 69 6e 74 6f 20 61 20 read it into a 2580: 6c 69 73 74 0a 09 20 28 66 64 61 74 20 20 20 20 list.. (fdat 2590: 20 20 20 28 63 6f 6e 66 69 67 66 3a 66 69 6c 65 (configf:file 25a0: 2d 3e 6c 69 73 74 20 66 6e 61 6d 65 29 29 0a 09 ->list fname)).. 25b0: 20 28 72 65 66 64 61 74 20 20 28 6d 61 6b 65 2d (refdat (make- 25c0: 68 61 73 68 2d 74 61 62 6c 65 29 29 0a 09 20 28 hash-table)).. ( 25d0: 73 65 63 68 61 73 68 20 28 6d 61 6b 65 2d 68 61 sechash (make-ha 25e0: 73 68 2d 74 61 62 6c 65 29 29 20 3b 3b 20 63 75 sh-table)) ;; cu 25f0: 72 72 65 6e 74 20 73 65 63 74 69 6f 6e 20 68 61 rrent section ha 2600: 73 68 2c 20 69 6e 69 74 20 77 69 74 68 20 68 61 sh, init with ha 2610: 73 68 20 66 6f 72 20 22 64 65 66 61 75 6c 74 22 sh for "default" 2620: 20 73 65 63 74 69 6f 6e 0a 09 20 28 6e 65 77 20 section.. (new 2630: 20 20 20 20 23 66 29 20 3b 3b 20 70 75 74 20 74 #f) ;; put t 2640: 68 65 20 6c 69 6e 65 20 74 6f 20 62 65 20 75 73 he line to be us 2650: 65 64 20 69 6e 20 6e 65 77 2c 20 69 66 20 69 74 ed in new, if it 2660: 20 69 73 20 74 6f 20 62 65 20 64 65 6c 65 74 65 is to be delete 2670: 64 20 74 68 65 20 73 65 74 20 6e 65 77 20 74 6f d the set new to 2680: 20 23 66 0a 09 20 28 73 65 63 6e 61 6d 65 20 23 #f.. (secname # 2690: 66 29 29 0a 0a 20 20 20 20 3b 3b 20 73 74 65 70 f)).. ;; step 26a0: 20 32 3a 20 46 6c 61 74 74 65 6e 20 6d 75 6c 74 2: Flatten mult 26b0: 69 6c 69 6e 65 20 65 6e 74 72 69 65 73 0a 20 20 iline entries. 26c0: 20 20 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c (if (not (null 26d0: 3f 20 66 64 61 74 29 29 28 73 65 74 21 20 66 64 ? fdat))(set! fd 26e0: 61 74 20 28 63 6f 6e 66 69 67 66 3a 63 6f 6d 70 at (configf:comp 26f0: 72 65 73 73 2d 6d 75 6c 74 69 2d 6c 69 6e 65 20 ress-multi-line 2700: 66 64 61 74 29 29 29 0a 0a 20 20 20 20 3b 3b 20 fdat))).. ;; 2710: 73 74 65 70 20 33 3a 20 4d 6f 64 69 66 79 20 76 step 3: Modify v 2720: 61 6c 75 65 73 20 70 65 72 20 63 6f 6e 74 65 6e alues per conten 2730: 74 73 20 6f 66 20 22 69 6e 64 61 74 22 20 61 6e ts of "indat" an 2740: 64 20 72 65 6d 6f 76 65 20 61 62 73 65 6e 74 20 d remove absent 2750: 76 61 6c 75 65 73 0a 20 20 20 20 28 69 66 20 28 values. (if ( 2760: 6e 6f 74 20 28 6e 75 6c 6c 3f 20 66 64 61 74 29 not (null? fdat) 2770: 29 0a 09 28 6c 65 74 20 6c 6f 6f 70 20 28 28 68 )..(let loop ((h 2780: 65 64 20 20 28 63 61 72 20 66 64 61 74 29 29 0a ed (car fdat)). 2790: 09 09 20 20 20 28 74 61 6c 20 20 28 63 61 64 72 .. (tal (cadr 27a0: 20 66 64 61 74 29 29 0a 09 09 20 20 20 28 72 65 fdat))... (re 27b0: 73 20 20 27 28 29 29 0a 09 09 20 20 20 28 6c 6e s '())... (ln 27c0: 75 6d 20 30 29 29 0a 09 20 20 28 72 65 67 65 78 um 0)).. (regex 27d0: 2d 63 61 73 65 20 0a 09 20 20 20 68 65 64 0a 09 -case .. hed.. 27e0: 20 20 20 28 63 6f 6e 66 69 67 66 3a 63 6f 6d 6d (configf:comm 27f0: 65 6e 74 2d 72 78 20 5f 20 20 20 20 20 20 20 20 ent-rx _ 2800: 20 20 20 20 20 20 20 20 20 20 28 73 65 74 21 20 (set! 2810: 72 65 73 20 28 61 70 70 65 6e 64 20 72 65 73 20 res (append res 2820: 28 6c 69 73 74 20 68 65 64 29 29 29 29 20 3b 3b (list hed)))) ;; 2830: 20 28 6c 6f 6f 70 20 28 72 65 61 64 2d 6c 69 6e (loop (read-lin 2840: 65 20 69 6e 70 29 20 63 75 72 72 2d 73 65 63 74 e inp) curr-sect 2850: 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 66 29 29 ion-name #f #f)) 2860: 0a 09 20 20 20 28 63 6f 6e 66 69 67 66 3a 62 6c .. (configf:bl 2870: 61 6e 6b 2d 6c 2d 72 78 20 5f 20 20 20 20 20 20 ank-l-rx _ 2880: 20 20 20 20 20 20 20 20 20 20 20 20 28 73 65 74 (set 2890: 21 20 72 65 73 20 28 61 70 70 65 6e 64 20 72 65 ! res (append re 28a0: 73 20 28 6c 69 73 74 20 68 65 64 29 29 29 29 20 s (list hed)))) 28b0: 3b 3b 20 28 6c 6f 6f 70 20 28 72 65 61 64 2d 6c ;; (loop (read-l 28c0: 69 6e 65 20 69 6e 70 29 20 63 75 72 72 2d 73 65 ine inp) curr-se 28d0: 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 66 ction-name #f #f 28e0: 29 29 0a 09 20 20 20 28 63 6f 6e 66 69 67 66 3a )).. (configf: 28f0: 73 65 63 74 69 6f 6e 2d 72 78 20 28 20 78 20 73 section-rx ( x s 2900: 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 29 20 28 6c ection-name ) (l 2910: 65 74 20 28 28 73 65 63 74 69 6f 6e 2d 68 61 73 et ((section-has 2920: 68 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 h (hash-table-re 2930: 66 2f 64 65 66 61 75 6c 74 20 72 65 66 64 61 74 f/default refdat 2940: 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 section-name #f 2950: 29 29 29 0a 09 09 09 09 09 20 20 20 20 28 69 66 )))...... (if 2960: 20 28 6e 6f 74 20 73 65 63 74 69 6f 6e 2d 68 61 (not section-ha 2970: 73 68 29 0a 09 09 09 09 09 09 28 6c 65 74 20 28 sh).......(let ( 2980: 28 6e 65 77 68 61 73 68 20 28 6d 61 6b 65 2d 68 (newhash (make-h 2990: 61 73 68 2d 74 61 62 6c 65 29 29 29 0a 09 09 09 ash-table))).... 29a0: 09 09 09 20 20 28 68 61 73 68 2d 74 61 62 6c 65 ... (hash-table 29b0: 2d 73 65 74 21 20 72 65 66 68 61 73 68 20 73 65 -set! refhash se 29c0: 63 74 69 6f 6e 2d 6e 61 6d 65 20 6e 65 77 68 61 ction-name newha 29d0: 73 68 29 0a 09 09 09 09 09 09 20 20 28 73 65 74 sh)....... (set 29e0: 21 20 73 65 63 68 61 73 68 20 6e 65 77 68 61 73 ! sechash newhas 29f0: 68 29 29 0a 09 09 09 09 09 09 28 73 65 74 21 20 h)).......(set! 2a00: 73 65 63 68 61 73 68 20 73 65 63 74 69 6f 6e 2d sechash section- 2a10: 68 61 73 68 29 29 0a 09 09 09 09 09 20 20 20 20 hash))...... 2a20: 28 73 65 74 21 20 6e 65 77 20 68 65 64 29 20 3b (set! new hed) ; 2a30: 3b 20 77 69 6c 6c 20 61 70 70 65 6e 64 20 74 68 ; will append th 2a40: 69 73 20 61 74 20 74 68 65 20 62 6f 74 74 6f 6d is at the bottom 2a50: 20 6f 66 20 74 68 65 20 6c 6f 6f 70 0a 09 09 09 of the loop.... 2a60: 09 09 20 20 20 20 28 73 65 74 21 20 73 65 63 6e .. (set! secn 2a70: 61 6d 65 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 ame section-name 2a80: 29 0a 09 09 09 09 09 20 20 20 20 29 29 0a 09 20 )...... )).. 2a90: 20 20 3b 3b 20 4e 6f 20 6e 65 65 64 20 74 6f 20 ;; No need to 2aa0: 70 72 6f 63 65 73 73 20 6b 65 79 20 63 6d 64 2c process key cmd, 2ab0: 20 6c 65 74 20 69 74 20 66 61 6c 6c 20 74 68 6f let it fall tho 2ac0: 75 67 68 20 74 6f 20 6b 65 79 20 76 61 6c 0a 09 ugh to key val.. 2ad0: 20 20 20 28 63 6f 6e 66 69 67 66 3a 6b 65 79 2d (configf:key- 2ae0: 76 61 6c 2d 70 72 20 28 20 78 20 6b 65 79 20 76 val-pr ( x key v 2af0: 61 6c 20 20 20 20 20 20 29 0a 09 09 20 20 20 20 al )... 2b00: 20 20 20 28 6c 65 74 20 28 28 6e 65 77 76 61 6c (let ((newval 2b10: 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 (config-lookup 2b20: 69 6e 64 61 74 20 73 65 63 20 6b 65 79 29 29 29 indat sec key))) 2b30: 0a 09 09 09 20 3b 3b 20 63 61 6e 20 68 61 6e 64 .... ;; can hand 2b40: 6c 65 20 6e 65 77 76 61 6c 20 3d 3d 20 23 66 20 le newval == #f 2b50: 68 65 72 65 20 3d 3e 20 74 68 61 74 20 6d 65 61 here => that mea 2b60: 6e 73 20 6b 65 79 20 69 73 20 72 65 6d 6f 76 65 ns key is remove 2b70: 64 0a 09 09 09 20 28 63 6f 6e 64 20 0a 09 09 09 d.... (cond .... 2b80: 20 20 28 28 65 71 75 61 6c 3f 20 6e 65 77 76 61 ((equal? newva 2b90: 6c 20 76 61 6c 29 0a 09 09 09 20 20 20 28 73 65 l val).... (se 2ba0: 74 21 20 72 65 73 20 28 61 70 70 65 6e 64 20 72 t! res (append r 2bb0: 65 73 20 28 6c 69 73 74 20 68 65 64 29 29 29 29 es (list hed)))) 2bc0: 0a 09 09 09 20 20 28 28 6e 6f 74 20 6e 65 77 76 .... ((not newv 2bd0: 61 6c 29 20 3b 3b 20 6b 65 79 20 68 61 73 20 62 al) ;; key has b 2be0: 65 65 6e 20 72 65 6d 6f 76 65 64 0a 09 09 09 20 een removed.... 2bf0: 20 20 28 73 65 74 21 20 6e 65 77 20 23 66 29 29 (set! new #f)) 2c00: 0a 09 09 09 20 20 28 28 6e 6f 74 20 28 65 71 75 .... ((not (equ 2c10: 61 6c 3f 20 6e 65 77 76 61 6c 20 76 61 6c 29 29 al? newval val)) 2c20: 0a 09 09 09 20 20 20 20 20 28 68 61 73 68 2d 74 .... (hash-t 2c30: 61 62 6c 65 2d 73 65 74 21 20 73 65 63 68 61 73 able-set! sechas 2c40: 68 20 6b 65 79 20 6e 65 77 76 61 6c 29 0a 09 09 h key newval)... 2c50: 09 20 20 20 20 20 28 73 65 74 21 20 6e 65 77 20 . (set! new 2c60: 28 63 6f 6e 63 20 6b 65 79 20 22 20 22 20 6e 65 (conc key " " ne 2c70: 77 76 61 6c 29 29 29 0a 09 09 09 20 20 28 65 6c wval))).... (el 2c80: 73 65 0a 09 09 09 20 20 20 28 64 65 62 75 67 3a se.... (debug: 2c90: 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 print 0 "ERROR: 2ca0: 70 72 6f 62 6c 65 6d 20 70 61 72 73 69 6e 67 20 problem parsing 2cb0: 6c 69 6e 65 20 6e 75 6d 62 65 72 20 22 20 6c 6e line number " ln 2cc0: 75 6d 20 22 5c 22 22 20 68 65 64 20 22 5c 22 22 um "\"" hed "\"" 2cd0: 29 29 29 29 29 0a 09 20 20 20 28 65 6c 73 65 0a ))))).. (else. 2ce0: 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin 2cf0: 74 20 30 20 22 45 52 52 4f 52 3a 20 50 72 6f 62 t 0 "ERROR: Prob 2d00: 6c 65 6d 20 70 61 72 73 69 6e 67 20 6c 69 6e 65 lem parsing line 2d10: 20 6e 75 6d 20 22 20 6c 6e 75 6d 20 22 20 3a 5c num " lnum " :\ 2d20: 6e 20 20 20 22 20 68 65 64 20 29 29 29 0a 09 20 n " hed ))).. 2d30: 20 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f (if (not (null? 2d40: 20 74 61 6c 29 29 0a 09 20 20 20 20 20 20 28 6c tal)).. (l 2d50: 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 28 63 64 oop (car tal)(cd 2d60: 72 20 74 61 6c 29 28 69 66 20 6e 65 77 20 28 61 r tal)(if new (a 2d70: 70 70 65 6e 64 20 72 65 73 20 28 6c 69 73 74 20 ppend res (list 2d80: 6e 65 77 29 29 20 72 65 73 29 28 2b 20 6c 6e 75 new)) res)(+ lnu 2d90: 6d 20 31 29 29 29 0a 09 20 20 3b 3b 20 64 72 6f m 1))).. ;; dro 2da0: 70 20 74 6f 20 68 65 72 65 20 77 68 65 6e 20 64 p to here when d 2db0: 6f 6e 65 20 70 72 6f 63 65 73 73 69 6e 67 2c 20 one processing, 2dc0: 72 65 73 20 63 6f 6e 74 61 69 6e 73 20 6d 6f 64 res contains mod 2dd0: 69 66 69 65 64 20 6c 69 73 74 20 6f 66 20 6c 69 ified list of li 2de0: 6e 65 73 0a 09 20 20 28 73 65 74 21 20 66 64 61 nes.. (set! fda 2df0: 74 20 72 65 73 29 29 29 0a 0a 20 20 20 20 3b 3b t res))).. ;; 2e00: 20 73 74 65 70 20 34 3a 20 41 70 70 65 6e 64 20 step 4: Append 2e10: 6e 65 77 20 76 61 6c 75 65 73 20 74 6f 20 74 68 new values to th 2e20: 65 20 73 65 63 74 69 6f 6e 0a 20 20 20 20 28 66 e section. (f 2e30: 6f 72 2d 65 61 63 68 20 0a 20 20 20 20 20 28 6c or-each . (l 2e40: 61 6d 62 64 61 20 28 73 65 63 74 69 6f 6e 29 0a ambda (section). 2e50: 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 73 64 (let ((sd 2e60: 61 74 20 20 20 27 28 29 29 20 3b 3b 20 61 70 70 at '()) ;; app 2e70: 65 6e 64 20 6e 65 65 64 65 64 20 62 69 74 73 20 end needed bits 2e80: 68 65 72 65 0a 09 20 20 20 20 20 28 73 76 61 72 here.. (svar 2e90: 73 20 20 28 63 6f 6e 66 69 67 66 3a 73 65 63 74 s (configf:sect 2ea0: 69 6f 6e 2d 76 61 72 73 20 69 6e 64 61 74 20 73 ion-vars indat s 2eb0: 65 63 74 69 6f 6e 29 29 29 0a 09 20 28 66 6f 72 ection))).. (for 2ec0: 2d 65 61 63 68 20 0a 09 20 20 28 6c 61 6d 62 64 -each .. (lambd 2ed0: 61 20 28 76 61 72 29 0a 09 20 20 20 20 28 6c 65 a (var).. (le 2ee0: 74 20 28 28 76 61 6c 20 28 63 6f 6e 66 69 67 2d t ((val (config- 2ef0: 6c 6f 6f 6b 75 70 20 72 65 66 64 61 74 20 73 65 lookup refdat se 2f00: 63 74 69 6f 6e 20 76 61 72 29 29 29 0a 09 20 20 ction var))).. 2f10: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 76 61 6c (if (not val 2f20: 29 20 3b 3b 20 74 68 69 73 20 6f 6e 65 20 69 73 ) ;; this one is 2f30: 20 6e 65 77 0a 09 09 20 20 28 62 65 67 69 6e 0a new... (begin. 2f40: 09 09 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f .. (if (null? 2f50: 20 73 64 61 74 29 28 73 65 74 21 20 73 64 61 74 sdat)(set! sdat 2f60: 20 28 6c 69 73 74 20 28 63 6f 6e 63 20 22 5b 22 (list (conc "[" 2f70: 20 73 65 63 74 69 6f 6e 20 22 5d 22 29 29 29 29 section "]")))) 2f80: 0a 09 09 20 20 20 20 28 73 65 74 21 20 73 64 61 ... (set! sda 2f90: 74 20 28 61 70 70 65 6e 64 20 73 64 61 74 20 28 t (append sdat ( 2fa0: 6c 69 73 74 20 28 63 6f 6e 63 20 76 61 72 20 22 list (conc var " 2fb0: 20 22 20 76 61 6c 29 29 29 29 29 29 29 29 0a 09 " val)))))))).. 2fc0: 20 20 73 76 61 72 73 29 0a 09 20 28 73 65 74 21 svars).. (set! 2fd0: 20 66 64 61 74 20 28 61 70 70 65 6e 64 20 66 64 fdat (append fd 2fe0: 61 74 20 73 64 61 74 29 29 29 29 0a 20 20 20 20 at sdat)))). 2ff0: 20 28 64 65 6c 65 74 65 2d 64 75 70 6c 69 63 61 (delete-duplica 3000: 74 65 73 20 28 61 70 70 65 6e 64 20 72 65 71 75 tes (append requ 3010: 69 72 65 2d 73 65 63 74 69 6f 6e 73 20 28 68 61 ire-sections (ha 3020: 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 69 6e sh-table-keys in 3030: 64 61 74 29 29 29 29 0a 0a 20 20 20 20 3b 3b 20 dat)))).. ;; 3040: 73 74 65 70 20 35 3a 20 57 72 69 74 65 20 6f 75 step 5: Write ou 3050: 74 20 6e 65 77 20 66 69 6c 65 0a 20 20 20 20 28 t new file. ( 3060: 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 with-output-to-f 3070: 69 6c 65 20 66 6e 61 6d 65 20 0a 20 20 20 20 20 ile fname . 3080: 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 28 66 6f (lambda ()..(fo 3090: 72 2d 65 61 63 68 20 0a 09 20 28 6c 61 6d 62 64 r-each .. (lambd 30a0: 61 20 28 6c 69 6e 65 29 0a 09 20 20 20 28 70 72 a (line).. (pr 30b0: 69 6e 74 20 6c 69 6e 65 29 29 0a 09 20 28 63 6f int line)).. (co 30c0: 6e 66 69 67 66 3a 65 78 70 61 6e 64 2d 6d 75 6c nfigf:expand-mul 30d0: 74 69 2d 6c 69 6e 65 73 20 66 64 61 74 29 29 29 ti-lines fdat))) 30e0: 29 29 29 0a 0a )))..