Artifact b0a9c60c641a4415e6bec993bc423f61cfa43a71:
- File configf.scm — part of check-in [8f378d4740] at 2011-11-27 16:28:25 on branch trunk — Completed but not tested non-destructive open/modify/write of config files (user: matt size: 12392)
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 20 w-system....... 0dd0: 20 28 6c 65 74 20 28 28 61 6c 69 73 74 20 28 68 (let ((alist (h 0de0: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de 0df0: 66 61 75 6c 74 20 72 65 73 20 63 75 72 72 2d 73 fault res curr-s 0e00: 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 27 28 29 29 ection-name '()) 0e10: 29 0a 09 09 09 09 09 09 09 28 76 61 6c 2d 70 72 )........(val-pr 0e20: 6f 63 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 oc (lambda ()... 0e30: 09 09 09 09 09 09 20 20 20 20 28 6c 65 74 2a 20 ...... (let* 0e40: 28 28 63 6d 64 72 65 73 20 20 28 63 6d 64 2d 72 ((cmdres (cmd-r 0e50: 75 6e 2d 3e 6c 69 73 74 20 63 6d 64 29 29 0a 09 un->list cmd)).. 0e60: 09 09 09 09 09 09 09 09 20 20 20 28 73 74 61 74 ........ (stat 0e70: 75 73 20 20 28 63 61 64 72 20 63 6d 64 72 65 73 us (cadr cmdres 0e80: 29 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 28 )).......... ( 0e90: 72 65 73 20 20 20 20 20 28 63 61 72 20 20 63 6d res (car cm 0ea0: 64 72 65 73 29 29 29 0a 09 09 09 09 09 09 09 09 dres)))......... 0eb0: 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 (if (not ( 0ec0: 65 71 3f 20 73 74 61 74 75 73 20 30 29 29 0a 09 eq? status 0)).. 0ed0: 09 09 09 09 09 09 09 09 20 20 28 62 65 67 69 6e ........ (begin 0ee0: 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 28 64 .......... (d 0ef0: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 ebug:print 0 "ER 0f00: 52 4f 52 3a 20 70 72 6f 62 6c 65 6d 20 77 69 74 ROR: problem wit 0f10: 68 20 22 20 69 6e 6c 20 22 2c 20 72 65 74 75 72 h " inl ", retur 0f20: 6e 20 63 6f 64 65 20 22 20 73 74 61 74 75 73 29 n code " status) 0f30: 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 28 65 .......... (e 0f40: 78 69 74 20 31 29 29 29 0a 09 09 09 09 09 09 09 xit 1)))........ 0f50: 09 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c . (if (null 0f60: 3f 20 72 65 73 29 0a 09 09 09 09 09 09 09 09 09 ? res).......... 0f70: 20 20 22 22 0a 09 09 09 09 09 09 09 09 09 20 20 "".......... 0f80: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe 0f90: 72 73 65 20 72 65 73 20 22 20 22 29 29 29 29 29 rse res " "))))) 0fa0: 29 0a 09 09 09 09 09 09 20 20 20 20 28 68 61 73 )....... (has 0fb0: 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 72 65 73 h-table-set! res 0fc0: 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 curr-section-na 0fd0: 6d 65 20 0a 09 09 09 09 09 09 09 09 20 20 20 20 me ......... 0fe0: 20 28 63 6f 6e 66 69 67 3a 61 73 73 6f 63 2d 73 (config:assoc-s 0ff0: 61 66 65 2d 61 64 64 20 61 6c 69 73 74 0a 09 09 afe-add alist... 1000: 09 09 09 09 09 09 09 09 09 20 20 20 20 6b 65 79 ......... key 1010: 20 0a 09 09 09 09 09 09 09 09 09 09 09 20 20 20 ............ 1020: 20 28 69 66 20 28 65 71 3f 20 61 6c 6c 6f 77 2d (if (eq? allow- 1030: 73 79 73 74 65 6d 20 27 72 65 74 75 72 6e 2d 70 system 'return-p 1040: 72 6f 63 73 29 0a 09 09 09 09 09 09 09 09 09 09 rocs)........... 1050: 09 09 76 61 6c 2d 70 72 6f 63 0a 09 09 09 09 09 ..val-proc...... 1060: 09 09 09 09 09 09 09 28 76 61 6c 2d 70 72 6f 63 .......(val-proc 1070: 29 29 29 29 0a 09 09 09 09 09 09 20 20 20 20 28 ))))....... ( 1080: 6c 6f 6f 70 20 28 72 65 61 64 2d 6c 69 6e 65 20 loop (read-line 1090: 69 6e 70 29 20 63 75 72 72 2d 73 65 63 74 69 6f inp) curr-sectio 10a0: 6e 2d 6e 61 6d 65 20 23 66 20 23 66 29 29 0a 09 n-name #f #f)).. 10b0: 09 09 09 09 09 20 20 28 6c 6f 6f 70 20 28 72 65 ..... (loop (re 10c0: 61 64 2d 6c 69 6e 65 20 69 6e 70 29 20 63 75 72 ad-line inp) cur 10d0: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 r-section-name # 10e0: 66 20 23 66 29 29 29 0a 09 20 20 20 20 20 20 20 f #f))).. 10f0: 28 63 6f 6e 66 69 67 66 3a 6b 65 79 2d 76 61 6c (configf:key-val 1100: 2d 70 72 20 28 20 78 20 6b 65 79 20 76 61 6c 20 -pr ( x key val 1110: 20 20 20 20 20 29 20 28 6c 65 74 2a 20 28 28 61 ) (let* ((a 1120: 6c 69 73 74 20 20 20 28 68 61 73 68 2d 74 61 62 list (hash-tab 1130: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 72 le-ref/default r 1140: 65 73 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d es curr-section- 1150: 6e 61 6d 65 20 27 28 29 29 29 0a 09 09 09 09 09 name '()))...... 1160: 09 20 20 20 20 20 28 65 6e 76 61 72 20 20 20 28 . (envar ( 1170: 61 6e 64 20 65 6e 76 69 72 6f 6e 2d 70 61 74 74 and environ-patt 1180: 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 28 (string-match ( 1190: 72 65 67 65 78 70 20 65 6e 76 69 72 6f 6e 2d 70 regexp environ-p 11a0: 61 74 74 29 20 63 75 72 72 2d 73 65 63 74 69 6f att) curr-sectio 11b0: 6e 2d 6e 61 6d 65 29 29 29 0a 09 09 09 09 09 09 n-name)))....... 11c0: 20 20 20 20 20 28 72 65 61 6c 76 61 6c 20 28 69 (realval (i 11d0: 66 20 65 6e 76 61 72 0a 09 09 09 09 09 09 09 09 f envar......... 11e0: 20 28 63 6f 6e 66 69 67 3a 65 76 61 6c 2d 73 74 (config:eval-st 11f0: 72 69 6e 67 2d 69 6e 2d 65 6e 76 69 72 6f 6e 6d ring-in-environm 1200: 65 6e 74 20 76 61 6c 29 0a 09 09 09 09 09 09 09 ent val)........ 1210: 09 20 76 61 6c 29 29 29 0a 09 09 09 09 09 09 28 . val))).......( 1220: 69 66 20 65 6e 76 61 72 0a 09 09 09 09 09 09 20 if envar....... 1230: 20 20 20 28 62 65 67 69 6e 0a 09 09 09 09 09 09 (begin....... 1240: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri 1250: 6e 74 20 34 20 22 49 4e 46 4f 3a 20 72 65 61 64 nt 4 "INFO: read 1260: 2d 63 6f 6e 66 69 67 20 6b 65 79 3d 22 20 6b 65 -config key=" ke 1270: 79 20 22 2c 20 76 61 6c 3d 22 20 76 61 6c 20 22 y ", val=" val " 1280: 2c 20 72 65 61 6c 76 61 6c 3d 22 20 72 65 61 6c , realval=" real 1290: 76 61 6c 29 0a 09 09 09 09 09 09 20 20 20 20 20 val)....... 12a0: 20 28 73 65 74 65 6e 76 20 6b 65 79 20 72 65 61 (setenv key rea 12b0: 6c 76 61 6c 29 29 29 0a 09 09 09 09 09 09 28 68 lval))).......(h 12c0: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 72 ash-table-set! r 12d0: 65 73 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d es curr-section- 12e0: 6e 61 6d 65 20 0a 09 09 09 09 09 09 09 09 20 28 name ......... ( 12f0: 63 6f 6e 66 69 67 3a 61 73 73 6f 63 2d 73 61 66 config:assoc-saf 1300: 65 2d 61 64 64 20 61 6c 69 73 74 20 6b 65 79 20 e-add alist key 1310: 72 65 61 6c 76 61 6c 29 29 0a 09 09 09 09 09 09 realval))....... 1320: 28 6c 6f 6f 70 20 28 72 65 61 64 2d 6c 69 6e 65 (loop (read-line 1330: 20 69 6e 70 29 20 63 75 72 72 2d 73 65 63 74 69 inp) curr-secti 1340: 6f 6e 2d 6e 61 6d 65 20 6b 65 79 20 23 66 29 29 on-name key #f)) 1350: 29 0a 09 20 20 20 20 20 20 20 3b 3b 20 69 66 20 ).. ;; if 1360: 61 20 63 6f 6e 74 69 6e 75 65 64 20 6c 69 6e 65 a continued line 1370: 0a 09 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 .. (config 1380: 66 3a 63 6f 6e 74 2d 6c 6e 2d 72 78 20 28 20 78 f:cont-ln-rx ( x 1390: 20 77 68 73 70 20 76 61 6c 20 20 20 20 20 29 20 whsp val ) 13a0: 28 6c 65 74 20 28 28 61 6c 69 73 74 20 28 68 61 (let ((alist (ha 13b0: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def 13c0: 61 75 6c 74 20 72 65 73 20 63 75 72 72 2d 73 65 ault res curr-se 13d0: 63 74 69 6f 6e 2d 6e 61 6d 65 20 27 28 29 29 29 ction-name '())) 13e0: 29 0a 09 09 09 09 09 09 28 69 66 20 76 61 72 2d ).......(if var- 13f0: 66 6c 61 67 20 20 20 20 20 20 20 20 20 20 20 20 flag 1400: 20 3b 3b 20 69 66 20 73 65 74 20 74 6f 20 61 20 ;; if set to a 1410: 73 74 72 69 6e 67 20 74 68 65 6e 20 77 65 20 68 string then we h 1420: 61 76 65 20 61 20 63 6f 6e 74 69 6e 75 65 64 20 ave a continued 1430: 76 61 72 0a 09 09 09 09 09 09 20 20 20 20 28 6c var....... (l 1440: 65 74 20 28 28 6e 65 77 76 61 6c 20 28 63 6f 6e et ((newval (con 1450: 63 20 0a 09 09 09 09 09 09 09 09 20 20 20 28 63 c ......... (c 1460: 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 72 65 73 onfig-lookup res 1470: 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 curr-section-na 1480: 6d 65 20 76 61 72 2d 66 6c 61 67 29 20 22 5c 6e me var-flag) "\n 1490: 22 0a 09 09 09 09 09 09 09 09 20 20 20 3b 3b 20 "......... ;; 14a0: 74 72 69 6d 20 6c 65 61 64 20 66 72 6f 6d 20 74 trim lead from t 14b0: 68 65 20 69 6e 63 6f 6d 69 6e 67 20 77 68 73 70 he incoming whsp 14c0: 20 74 6f 20 73 75 70 70 6f 72 74 20 73 6f 6d 65 to support some 14d0: 20 69 6e 64 65 6e 74 69 6e 67 2e 0a 09 09 09 09 indenting...... 14e0: 09 09 09 09 20 20 20 28 69 66 20 6c 65 61 64 0a .... (if lead. 14f0: 09 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 ........ ( 1500: 73 74 72 69 6e 67 2d 73 75 62 73 74 69 74 75 74 string-substitut 1510: 65 20 28 72 65 67 65 78 70 20 6c 65 61 64 29 20 e (regexp lead) 1520: 22 22 20 77 68 73 70 29 0a 09 09 09 09 09 09 09 "" whsp)........ 1530: 09 20 20 20 20 20 20 20 22 22 29 0a 09 09 09 09 . "")..... 1540: 09 09 09 09 20 20 20 76 61 6c 29 29 29 0a 09 09 .... val)))... 1550: 09 09 09 09 20 20 20 20 20 20 3b 3b 20 28 70 72 .... ;; (pr 1560: 69 6e 74 20 22 76 61 6c 3a 20 22 20 76 61 6c 20 int "val: " val 1570: 22 5c 6e 6e 65 77 76 61 6c 3a 20 5c 22 22 20 6e "\nnewval: \"" n 1580: 65 77 76 61 6c 20 22 5c 22 5c 6e 76 61 72 66 6c ewval "\"\nvarfl 1590: 61 67 3a 20 22 20 76 61 72 2d 66 6c 61 67 29 0a ag: " var-flag). 15a0: 09 09 09 09 09 09 20 20 20 20 20 20 28 68 61 73 ...... (has 15b0: 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 72 65 73 h-table-set! res 15c0: 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 curr-section-na 15d0: 6d 65 20 0a 09 09 09 09 09 09 09 09 20 20 20 20 me ......... 15e0: 20 20 20 28 63 6f 6e 66 69 67 3a 61 73 73 6f 63 (config:assoc 15f0: 2d 73 61 66 65 2d 61 64 64 20 61 6c 69 73 74 20 -safe-add alist 1600: 76 61 72 2d 66 6c 61 67 20 6e 65 77 76 61 6c 29 var-flag newval) 1610: 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 28 6c )....... (l 1620: 6f 6f 70 20 28 72 65 61 64 2d 6c 69 6e 65 20 69 oop (read-line i 1630: 6e 70 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e np) curr-section 1640: 2d 6e 61 6d 65 20 76 61 72 2d 66 6c 61 67 20 28 -name var-flag ( 1650: 69 66 20 6c 65 61 64 20 6c 65 61 64 20 77 68 73 if lead lead whs 1660: 70 29 29 29 0a 09 09 09 09 09 09 20 20 20 20 28 p)))....... ( 1670: 6c 6f 6f 70 20 28 72 65 61 64 2d 6c 69 6e 65 20 loop (read-line 1680: 69 6e 70 29 20 63 75 72 72 2d 73 65 63 74 69 6f inp) curr-sectio 1690: 6e 2d 6e 61 6d 65 20 23 66 20 23 66 29 29 29 29 n-name #f #f)))) 16a0: 0a 09 20 20 20 20 20 20 20 28 65 6c 73 65 20 28 .. (else ( 16b0: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 debug:print 0 "E 16c0: 52 52 4f 52 3a 20 70 72 6f 62 6c 65 6d 20 70 61 RROR: problem pa 16d0: 72 73 69 6e 67 20 22 20 70 61 74 68 20 22 2c 5c rsing " path ",\ 16e0: 6e 20 20 20 5c 22 22 20 69 6e 6c 20 22 5c 22 22 n \"" inl "\"" 16f0: 29 0a 09 09 20 20 20 20 20 28 73 65 74 21 20 76 )... (set! v 1700: 61 72 2d 66 6c 61 67 20 23 66 29 0a 09 09 20 20 ar-flag #f)... 1710: 20 20 20 28 6c 6f 6f 70 20 28 72 65 61 64 2d 6c (loop (read-l 1720: 69 6e 65 20 69 6e 70 29 20 63 75 72 72 2d 73 65 ine inp) curr-se 1730: 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 66 ction-name #f #f 1740: 29 29 29 29 29 29 29 29 0a 20 20 0a 28 64 65 66 )))))))). .(def 1750: 69 6e 65 20 28 66 69 6e 64 2d 61 6e 64 2d 72 65 ine (find-and-re 1760: 61 64 2d 63 6f 6e 66 69 67 20 66 6e 61 6d 65 20 ad-config fname 1770: 23 21 6b 65 79 20 28 65 6e 76 69 72 6f 6e 2d 70 #!key (environ-p 1780: 61 74 74 20 23 66 29 29 0a 20 20 28 6c 65 74 2a att #f)). (let* 1790: 20 28 28 63 75 72 72 2d 64 69 72 20 20 20 28 63 ((curr-dir (c 17a0: 75 72 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 urrent-directory 17b0: 29 29 0a 20 20 20 20 20 20 20 20 20 28 63 6f 6e )). (con 17c0: 66 69 67 69 6e 66 6f 20 28 66 69 6e 64 2d 63 6f figinfo (find-co 17d0: 6e 66 69 67 20 66 6e 61 6d 65 29 29 0a 09 20 28 nfig fname)).. ( 17e0: 74 6f 70 70 61 74 68 20 20 20 20 28 63 61 72 20 toppath (car 17f0: 63 6f 6e 66 69 67 69 6e 66 6f 29 29 0a 09 20 28 configinfo)).. ( 1800: 63 6f 6e 66 69 67 66 69 6c 65 20 28 63 61 64 72 configfile (cadr 1810: 20 63 6f 6e 66 69 67 69 6e 66 6f 29 29 29 0a 20 configinfo))). 1820: 20 20 20 28 69 66 20 74 6f 70 70 61 74 68 20 28 (if toppath ( 1830: 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 change-directory 1840: 20 74 6f 70 70 61 74 68 29 29 20 0a 20 20 20 20 toppath)) . 1850: 28 6c 65 74 20 28 28 63 6f 6e 66 69 67 64 61 74 (let ((configdat 1860: 20 20 28 69 66 20 63 6f 6e 66 69 67 66 69 6c 65 (if configfile 1870: 20 28 72 65 61 64 2d 63 6f 6e 66 69 67 20 63 6f (read-config co 1880: 6e 66 69 67 66 69 6c 65 20 23 66 20 23 74 20 65 nfigfile #f #t e 1890: 6e 76 69 72 6f 6e 2d 70 61 74 74 3a 20 65 6e 76 nviron-patt: env 18a0: 69 72 6f 6e 2d 70 61 74 74 29 20 23 66 29 29 29 iron-patt) #f))) 18b0: 20 3b 3b 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 ;; (make-hash-t 18c0: 61 62 6c 65 29 29 29 29 0a 20 20 20 20 20 20 28 able)))). ( 18d0: 69 66 20 74 6f 70 70 61 74 68 20 28 63 68 61 6e if toppath (chan 18e0: 67 65 2d 64 69 72 65 63 74 6f 72 79 20 63 75 72 ge-directory cur 18f0: 72 2d 64 69 72 29 29 0a 20 20 20 20 20 20 28 6c r-dir)). (l 1900: 69 73 74 20 63 6f 6e 66 69 67 64 61 74 20 74 6f ist configdat to 1910: 70 70 61 74 68 20 63 6f 6e 66 69 67 66 69 6c 65 ppath configfile 1920: 20 66 6e 61 6d 65 29 29 29 29 0a 0a 28 64 65 66 fname))))..(def 1930: 69 6e 65 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b ine (config-look 1940: 75 70 20 63 66 67 64 61 74 20 73 65 63 74 69 6f up cfgdat sectio 1950: 6e 20 76 61 72 29 0a 20 20 28 6c 65 74 20 28 28 n var). (let (( 1960: 73 65 63 74 64 61 74 20 28 68 61 73 68 2d 74 61 sectdat (hash-ta 1970: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default 1980: 63 66 67 64 61 74 20 73 65 63 74 69 6f 6e 20 27 cfgdat section ' 1990: 28 29 29 29 29 0a 20 20 20 20 28 69 66 20 28 6e ()))). (if (n 19a0: 75 6c 6c 3f 20 73 65 63 74 64 61 74 29 0a 09 23 ull? sectdat)..# 19b0: 66 0a 09 28 6c 65 74 20 28 28 6d 61 74 63 68 20 f..(let ((match 19c0: 28 61 73 73 6f 63 20 76 61 72 20 73 65 63 74 64 (assoc var sectd 19d0: 61 74 29 29 29 0a 09 20 20 28 69 66 20 6d 61 74 at))).. (if mat 19e0: 63 68 0a 09 20 20 20 20 20 20 28 63 61 64 72 20 ch.. (cadr 19f0: 6d 61 74 63 68 29 0a 09 20 20 20 20 20 20 23 66 match).. #f 1a00: 29 29 0a 09 29 29 29 0a 0a 28 64 65 66 69 6e 65 ))..)))..(define 1a10: 20 28 63 6f 6e 66 69 67 66 3a 73 65 63 74 69 6f (configf:sectio 1a20: 6e 2d 76 61 72 73 20 63 66 67 64 61 74 20 73 65 n-vars cfgdat se 1a30: 63 74 69 6f 6e 29 0a 20 20 28 6c 65 74 20 28 28 ction). (let (( 1a40: 73 65 63 74 64 61 74 20 28 68 61 73 68 2d 74 61 sectdat (hash-ta 1a50: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default 1a60: 63 66 67 64 61 74 20 73 65 63 74 69 6f 6e 20 27 cfgdat section ' 1a70: 28 29 29 29 29 0a 20 20 20 20 28 69 66 20 28 6e ()))). (if (n 1a80: 75 6c 6c 3f 20 73 65 63 74 64 61 74 29 0a 09 27 ull? sectdat)..' 1a90: 28 29 0a 09 28 6d 61 70 20 63 61 72 20 73 65 63 ()..(map car sec 1aa0: 74 64 61 74 29 29 29 29 0a 0a 28 64 65 66 69 6e tdat))))..(defin 1ab0: 65 20 28 73 65 74 75 70 29 0a 20 20 28 6c 65 74 e (setup). (let 1ac0: 2a 20 28 28 63 6f 6e 66 69 67 66 20 28 66 69 6e * ((configf (fin 1ad0: 64 2d 63 6f 6e 66 69 67 29 29 0a 09 20 28 63 6f d-config)).. (co 1ae0: 6e 66 69 67 20 20 28 69 66 20 63 6f 6e 66 69 67 nfig (if config 1af0: 66 20 28 72 65 61 64 2d 63 6f 6e 66 69 67 20 63 f (read-config c 1b00: 6f 6e 66 69 67 66 20 23 66 20 23 74 29 20 23 66 onfigf #f #t) #f 1b10: 29 29 29 0a 20 20 20 20 28 69 66 20 63 6f 6e 66 ))). (if conf 1b20: 69 67 0a 09 28 73 65 74 65 6e 76 20 22 52 55 4e ig..(setenv "RUN 1b30: 5f 41 52 45 41 5f 48 4f 4d 45 22 20 28 70 61 74 _AREA_HOME" (pat 1b40: 68 6e 61 6d 65 2d 64 69 72 65 63 74 6f 72 79 20 hname-directory 1b50: 63 6f 6e 66 69 67 66 29 29 29 0a 20 20 20 20 63 configf))). c 1b60: 6f 6e 66 69 67 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d onfig))..;;===== 1b70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1b80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1b90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1ba0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1bb0: 3d 0a 3b 3b 20 4e 6f 6e 20 64 65 73 74 72 75 63 =.;; Non destruc 1bc0: 74 69 76 65 20 77 72 69 74 69 6e 67 20 6f 66 20 tive writing of 1bd0: 63 6f 6e 66 69 67 20 66 69 6c 65 0a 3b 3b 3d 3d config file.;;== 1be0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 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 0a 0a 28 64 65 66 69 6e 65 20 28 63 ====..(define (c 1c30: 6f 6e 66 69 67 66 3a 63 6f 6d 70 72 65 73 73 2d onfigf:compress- 1c40: 6d 75 6c 74 69 2d 6c 69 6e 65 73 20 66 64 61 74 multi-lines fdat 1c50: 29 0a 20 20 3b 3b 20 73 74 65 70 20 31 2e 35 20 ). ;; step 1.5 1c60: 2d 20 63 6f 6d 70 72 65 73 73 20 61 6e 79 20 63 - compress any c 1c70: 6f 6e 74 69 6e 75 65 64 20 6c 69 6e 65 73 0a 20 ontinued lines. 1c80: 20 28 69 66 20 28 6e 75 6c 6c 3f 20 66 64 61 74 (if (null? fdat 1c90: 29 20 66 64 61 74 0a 09 28 6c 65 74 20 6c 6f 6f ) fdat..(let loo 1ca0: 70 20 28 28 68 65 64 20 28 63 61 72 20 66 64 61 p ((hed (car fda 1cb0: 74 29 29 0a 09 09 20 20 20 28 74 61 6c 20 28 63 t))... (tal (c 1cc0: 64 72 20 66 64 61 74 29 29 0a 09 09 20 20 20 28 dr fdat))... ( 1cd0: 63 75 72 20 22 22 29 0a 09 09 20 20 20 28 6c 65 cur "")... (le 1ce0: 64 20 23 66 29 0a 09 09 20 20 20 28 72 65 73 20 d #f)... (res 1cf0: 27 28 29 29 29 0a 09 20 20 3b 3b 20 41 4c 4c 20 '())).. ;; ALL 1d00: 57 48 49 54 45 53 50 41 43 45 20 4c 45 41 44 49 WHITESPACE LEADI 1d10: 4e 47 20 4c 49 4e 45 53 20 41 52 45 20 54 41 43 NG LINES ARE TAC 1d20: 4b 45 44 20 4f 4e 21 21 0a 09 20 20 3b 3b 20 20 KED ON!!.. ;; 1d30: 31 2e 20 72 65 6d 6f 76 65 20 6c 65 64 20 77 68 1. remove led wh 1d40: 69 74 65 73 70 61 63 65 0a 09 20 20 3b 3b 20 20 itespace.. ;; 1d50: 32 2e 20 74 61 63 6b 20 6f 6e 20 74 6f 20 68 65 2. tack on to he 1d60: 64 20 77 69 74 68 20 22 5c 6e 22 0a 09 20 20 28 d with "\n".. ( 1d70: 6c 65 74 20 28 28 6d 61 74 63 68 20 28 73 74 72 let ((match (str 1d80: 69 6e 67 2d 6d 61 74 63 68 20 63 6f 6e 66 69 67 ing-match config 1d90: 66 3a 63 6f 6e 74 2d 6c 6e 2d 72 78 20 68 65 64 f:cont-ln-rx hed 1da0: 29 29 29 0a 09 20 20 20 20 28 69 66 20 6d 61 74 ))).. (if mat 1db0: 63 68 20 3b 3b 20 62 6c 61 73 74 21 20 68 61 76 ch ;; blast! hav 1dc0: 65 20 74 6f 20 64 65 61 6c 20 77 69 74 68 20 61 e to deal with a 1dd0: 20 6d 75 6c 74 69 6c 69 6e 65 0a 09 09 28 6c 65 multiline...(le 1de0: 74 2a 20 28 28 6c 65 61 64 20 28 63 61 64 72 20 t* ((lead (cadr 1df0: 6d 61 74 63 68 29 29 0a 09 09 20 20 20 20 20 20 match))... 1e00: 20 28 6c 76 61 6c 20 28 63 61 64 64 72 20 6d 61 (lval (caddr ma 1e10: 74 63 68 29 29 0a 09 09 20 20 20 20 20 20 20 28 tch))... ( 1e20: 6e 65 77 6c 20 28 63 6f 6e 63 20 63 75 72 20 22 newl (conc cur " 1e30: 5c 6e 22 20 6c 76 61 6c 29 29 29 0a 09 09 20 20 \n" lval)))... 1e40: 28 69 66 20 28 6e 6f 74 20 6c 65 64 29 28 73 65 (if (not led)(se 1e50: 74 21 20 6c 65 64 20 6c 65 61 64 29 29 0a 09 09 t! led lead))... 1e60: 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 61 6c (if (null? tal 1e70: 29 20 0a 09 09 20 20 20 20 20 20 28 73 65 74 21 ) ... (set! 1e80: 20 66 64 61 74 20 28 61 70 70 65 6e 64 20 66 64 fdat (append fd 1e90: 61 74 20 28 6c 69 73 74 20 6e 65 77 6c 29 29 29 at (list newl))) 1ea0: 0a 09 09 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 ... (loop ( 1eb0: 63 61 72 20 74 61 6c 29 28 63 64 72 20 74 61 6c car tal)(cdr tal 1ec0: 29 20 6e 65 77 6c 20 6c 65 64 20 72 65 73 29 29 ) newl led res)) 1ed0: 29 20 3b 3b 20 4e 42 2f 2f 20 6e 6f 74 20 74 61 ) ;; NB// not ta 1ee0: 63 6b 69 6e 67 20 6e 65 77 6c 20 6f 6e 74 6f 20 cking newl onto 1ef0: 72 65 73 0a 09 09 28 6c 65 74 20 28 28 6e 65 77 res...(let ((new 1f00: 72 65 73 20 28 69 66 20 6c 65 64 20 0a 09 09 09 res (if led .... 1f10: 09 20 20 28 61 70 70 65 6e 64 20 72 65 73 20 28 . (append res ( 1f20: 6c 69 73 74 20 63 75 72 20 68 65 64 29 29 0a 09 list cur hed)).. 1f30: 09 09 09 20 20 28 61 70 70 65 6e 64 20 72 65 73 ... (append res 1f40: 20 28 6c 69 73 74 20 68 65 64 29 29 29 29 29 0a (list hed))))). 1f50: 09 09 20 20 3b 3b 20 70 72 65 76 20 77 61 73 20 .. ;; prev was 1f60: 61 20 6d 75 6c 74 69 6c 69 6e 65 0a 09 09 20 20 a multiline... 1f70: 28 69 66 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 0a (if (null? tal). 1f80: 09 09 20 20 20 20 20 20 6e 65 77 72 65 73 0a 09 .. newres.. 1f90: 09 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 . (loop (ca 1fa0: 72 20 74 61 6c 29 28 63 64 72 20 74 61 6c 29 20 r tal)(cdr tal) 1fb0: 22 22 20 23 66 20 6e 65 77 72 65 73 29 29 29 29 "" #f newres)))) 1fc0: 29 29 29 29 0a 0a 3b 3b 20 6e 6f 74 65 3a 20 49 ))))..;; note: I 1fd0: 27 6d 20 63 68 65 61 74 69 6e 67 20 61 20 6c 69 'm cheating a li 1fe0: 74 74 6c 65 20 68 65 72 65 2e 20 49 20 6d 65 72 ttle here. I mer 1ff0: 65 6c 79 20 72 65 70 6c 61 63 65 20 22 5c 6e 22 ely replace "\n" 2000: 20 77 69 74 68 20 22 5c 6e 20 20 20 20 20 20 20 with "\n 2010: 20 20 22 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e ".(define (con 2020: 66 69 67 66 3a 65 78 70 61 6e 64 2d 6d 75 6c 74 figf:expand-mult 2030: 69 2d 6c 69 6e 65 73 20 66 64 61 74 29 0a 20 20 i-lines fdat). 2040: 3b 3b 20 73 74 65 70 20 31 2e 35 20 2d 20 63 6f ;; step 1.5 - co 2050: 6d 70 72 65 73 73 20 61 6e 79 20 63 6f 6e 74 69 mpress any conti 2060: 6e 75 65 64 20 6c 69 6e 65 73 0a 20 20 28 69 66 nued lines. (if 2070: 20 28 6e 75 6c 6c 3f 20 66 64 61 74 29 20 66 64 (null? fdat) fd 2080: 61 74 0a 20 20 20 20 20 20 28 6c 65 74 20 6c 6f at. (let lo 2090: 6f 70 20 28 28 68 65 64 20 28 63 61 72 20 66 64 op ((hed (car fd 20a0: 61 74 29 29 0a 09 09 20 28 74 61 6c 20 28 63 64 at))... (tal (cd 20b0: 72 20 66 64 61 74 29 29 0a 09 09 20 28 72 65 73 r fdat))... (res 20c0: 20 27 28 29 29 29 0a 09 28 6c 65 74 20 28 28 6e '()))..(let ((n 20d0: 65 77 72 65 73 20 28 61 70 70 65 6e 64 20 72 65 ewres (append re 20e0: 73 20 28 6c 69 73 74 20 28 73 74 72 69 6e 67 2d s (list (string- 20f0: 73 75 62 73 74 69 74 75 74 65 20 28 72 65 67 65 substitute (rege 2100: 78 70 20 22 5c 6e 22 29 20 22 5c 6e 20 20 20 20 xp "\n") "\n 2110: 20 20 20 20 20 22 20 68 65 64 20 23 74 29 29 29 " hed #t))) 2120: 29 29 0a 09 20 20 28 69 66 20 28 6e 75 6c 6c 3f )).. (if (null? 2130: 20 74 61 6c 29 0a 09 20 20 20 20 20 20 6e 65 77 tal).. new 2140: 72 65 73 0a 09 20 20 20 20 20 20 28 6c 6f 6f 70 res.. (loop 2150: 20 28 63 61 72 20 74 61 6c 29 28 63 64 72 20 74 (car tal)(cdr t 2160: 61 6c 29 20 6e 65 77 72 65 73 29 29 29 29 29 29 al) newres)))))) 2170: 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 ..(define (confi 2180: 67 66 3a 66 69 6c 65 2d 3e 6c 69 73 74 20 66 6e gf:file->list fn 2190: 61 6d 65 29 0a 20 20 28 69 66 20 28 66 69 6c 65 ame). (if (file 21a0: 2d 65 78 69 73 74 73 3f 20 66 6e 61 6d 65 29 0a -exists? fname). 21b0: 20 20 20 20 20 20 28 6c 65 74 20 28 28 69 6e 70 (let ((inp 21c0: 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 66 69 6c (open-input-fil 21d0: 65 20 66 6e 61 6d 65 29 29 29 0a 09 28 6c 65 74 e fname)))..(let 21e0: 20 6c 6f 6f 70 20 28 28 69 6e 6c 20 28 72 65 61 loop ((inl (rea 21f0: 64 2d 6c 69 6e 65 20 69 6e 70 29 29 0a 09 09 20 d-line inp))... 2200: 20 20 28 72 65 73 20 27 28 29 29 29 0a 09 20 20 (res '())).. 2210: 28 69 66 20 28 65 6f 66 2d 6f 62 6a 65 63 74 3f (if (eof-object? 2220: 20 69 6e 6c 29 0a 09 20 20 20 20 20 20 28 62 65 inl).. (be 2230: 67 69 6e 0a 09 09 28 63 6c 6f 73 65 2d 69 6e 70 gin...(close-inp 2240: 75 74 2d 70 6f 72 74 20 69 6e 70 29 0a 09 09 28 ut-port inp)...( 2250: 72 65 76 65 72 73 65 20 72 65 73 29 29 0a 09 20 reverse res)).. 2260: 20 20 20 20 20 28 6c 6f 6f 70 20 28 72 65 61 64 (loop (read 2270: 2d 6c 69 6e 65 20 69 6e 70 29 28 63 6f 6e 73 20 -line inp)(cons 2280: 69 6e 6c 29 29 29 29 29 0a 20 20 20 20 20 20 27 inl))))). ' 2290: 28 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d ()))..;;======== 22a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 22b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 22c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 22d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.; 22e0: 3b 20 57 72 69 74 65 20 61 20 63 6f 6e 66 69 67 ; Write a config 22f0: 0a 3b 3b 20 20 20 30 2e 20 47 69 76 65 6e 20 61 .;; 0. Given a 2300: 20 72 65 66 65 72 65 72 65 6e 63 65 20 64 61 74 refererence dat 2310: 61 20 73 74 72 75 63 74 75 72 65 20 22 69 6e 64 a structure "ind 2320: 61 74 22 0a 3b 3b 20 20 20 31 2e 20 4f 70 65 6e at".;; 1. Open 2330: 20 74 68 65 20 6f 75 74 70 75 74 20 66 69 6c 65 the output file 2340: 20 61 6e 64 20 72 65 61 64 20 69 74 20 69 6e 74 and read it int 2350: 6f 20 61 20 6c 69 73 74 0a 3b 3b 20 20 20 32 2e o a list.;; 2. 2360: 20 46 6c 61 74 74 65 6e 20 61 6e 79 20 6d 75 6c Flatten any mul 2370: 74 69 6c 69 6e 65 20 65 6e 74 72 69 65 73 0a 3b tiline entries.; 2380: 3b 20 20 20 33 2e 20 4d 6f 64 69 66 79 20 76 61 ; 3. Modify va 2390: 6c 75 65 73 20 70 65 72 20 63 6f 6e 74 65 6e 74 lues per content 23a0: 73 20 6f 66 20 22 69 6e 64 61 74 22 20 61 6e 64 s of "indat" and 23b0: 20 72 65 6d 6f 76 65 20 61 62 73 65 6e 74 20 76 remove absent v 23c0: 61 6c 75 65 73 0a 3b 3b 20 20 20 34 2e 20 41 70 alues.;; 4. Ap 23d0: 70 65 6e 64 20 6e 65 77 20 76 61 6c 75 65 73 20 pend new values 23e0: 74 6f 20 74 68 65 20 73 65 63 74 69 6f 6e 20 28 to the section ( 23f0: 69 6d 6d 65 64 69 61 74 65 6c 79 20 61 66 74 65 immediately afte 2400: 72 20 6c 61 73 74 20 6c 65 67 69 74 20 65 6e 74 r last legit ent 2410: 72 79 29 0a 3b 3b 20 20 20 35 2e 20 57 72 69 74 ry).;; 5. Writ 2420: 65 20 6f 75 74 20 74 68 65 20 6e 65 77 20 6c 69 e out the new li 2430: 73 74 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d st .;;========== 2440: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 2450: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 2460: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 2470: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 ============..(d 2480: 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a 77 efine (configf:w 2490: 72 69 74 65 2d 63 6f 6e 66 69 67 20 69 6e 64 61 rite-config inda 24a0: 74 20 66 6e 61 6d 65 20 23 21 6b 65 79 20 28 72 t fname #!key (r 24b0: 65 71 75 69 72 65 64 2d 73 65 63 74 69 6f 6e 73 equired-sections 24c0: 20 27 28 29 29 29 0a 20 20 28 6c 65 74 2a 20 28 '())). (let* ( 24d0: 3b 3b 20 73 74 65 70 20 31 3a 20 4f 70 65 6e 20 ;; step 1: Open 24e0: 74 68 65 20 6f 75 74 70 75 74 20 66 69 6c 65 20 the output file 24f0: 61 6e 64 20 72 65 61 64 20 69 74 20 69 6e 74 6f and read it into 2500: 20 61 20 6c 69 73 74 0a 09 20 28 66 64 61 74 20 a list.. (fdat 2510: 20 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 66 (configf:f 2520: 69 6c 65 2d 3e 6c 69 73 74 20 66 6e 61 6d 65 29 ile->list fname) 2530: 29 0a 09 20 28 72 65 66 64 61 74 20 20 28 6d 61 ).. (refdat (ma 2540: 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a ke-hash-table)). 2550: 09 20 28 73 65 63 68 61 73 68 20 28 6d 61 6b 65 . (sechash (make 2560: 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 20 3b 3b -hash-table)) ;; 2570: 20 63 75 72 72 65 6e 74 20 73 65 63 74 69 6f 6e current section 2580: 20 68 61 73 68 2c 20 69 6e 69 74 20 77 69 74 68 hash, init with 2590: 20 68 61 73 68 20 66 6f 72 20 22 64 65 66 61 75 hash for "defau 25a0: 6c 74 22 20 73 65 63 74 69 6f 6e 0a 09 20 28 6e lt" section.. (n 25b0: 65 77 20 20 20 20 20 23 66 29 20 3b 3b 20 70 75 ew #f) ;; pu 25c0: 74 20 74 68 65 20 6c 69 6e 65 20 74 6f 20 62 65 t the line to be 25d0: 20 75 73 65 64 20 69 6e 20 6e 65 77 2c 20 69 66 used in new, if 25e0: 20 69 74 20 69 73 20 74 6f 20 62 65 20 64 65 6c it is to be del 25f0: 65 74 65 64 20 74 68 65 20 73 65 74 20 6e 65 77 eted the set new 2600: 20 74 6f 20 23 66 0a 09 20 28 73 65 63 6e 61 6d to #f.. (secnam 2610: 65 20 23 66 29 29 0a 0a 20 20 20 20 3b 3b 20 73 e #f)).. ;; s 2620: 74 65 70 20 32 3a 20 46 6c 61 74 74 65 6e 20 6d tep 2: Flatten m 2630: 75 6c 74 69 6c 69 6e 65 20 65 6e 74 72 69 65 73 ultiline entries 2640: 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6e . (if (not (n 2650: 75 6c 6c 3f 20 66 64 61 74 29 29 28 73 65 74 21 ull? fdat))(set! 2660: 20 66 64 61 74 20 28 63 6f 6e 66 69 67 66 3a 63 fdat (configf:c 2670: 6f 6d 70 72 65 73 73 2d 6d 75 6c 74 69 2d 6c 69 ompress-multi-li 2680: 6e 65 20 66 64 61 74 29 29 29 0a 0a 20 20 20 20 ne fdat))).. 2690: 3b 3b 20 73 74 65 70 20 33 3a 20 4d 6f 64 69 66 ;; step 3: Modif 26a0: 79 20 76 61 6c 75 65 73 20 70 65 72 20 63 6f 6e y values per con 26b0: 74 65 6e 74 73 20 6f 66 20 22 69 6e 64 61 74 22 tents of "indat" 26c0: 20 61 6e 64 20 72 65 6d 6f 76 65 20 61 62 73 65 and remove abse 26d0: 6e 74 20 76 61 6c 75 65 73 0a 20 20 20 20 28 69 nt values. (i 26e0: 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 66 64 f (not (null? fd 26f0: 61 74 29 29 0a 09 28 6c 65 74 20 6c 6f 6f 70 20 at))..(let loop 2700: 28 28 68 65 64 20 20 28 63 61 72 20 66 64 61 74 ((hed (car fdat 2710: 29 29 0a 09 09 20 20 20 28 74 61 6c 20 20 28 63 ))... (tal (c 2720: 61 64 72 20 66 64 61 74 29 29 0a 09 09 20 20 20 adr fdat))... 2730: 28 72 65 73 20 20 27 28 29 29 0a 09 09 20 20 20 (res '())... 2740: 28 6c 6e 75 6d 20 30 29 29 0a 09 20 20 28 72 65 (lnum 0)).. (re 2750: 67 65 78 2d 63 61 73 65 20 0a 09 20 20 20 68 65 gex-case .. he 2760: 64 0a 09 20 20 20 28 63 6f 6e 66 69 67 66 3a 63 d.. (configf:c 2770: 6f 6d 6d 65 6e 74 2d 72 78 20 5f 20 20 20 20 20 omment-rx _ 2780: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 65 (se 2790: 74 21 20 72 65 73 20 28 61 70 70 65 6e 64 20 72 t! res (append r 27a0: 65 73 20 28 6c 69 73 74 20 68 65 64 29 29 29 29 es (list hed)))) 27b0: 20 3b 3b 20 28 6c 6f 6f 70 20 28 72 65 61 64 2d ;; (loop (read- 27c0: 6c 69 6e 65 20 69 6e 70 29 20 63 75 72 72 2d 73 line inp) curr-s 27d0: 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 ection-name #f # 27e0: 66 29 29 0a 09 20 20 20 28 63 6f 6e 66 69 67 66 f)).. (configf 27f0: 3a 62 6c 61 6e 6b 2d 6c 2d 72 78 20 5f 20 20 20 :blank-l-rx _ 2800: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ( 2810: 73 65 74 21 20 72 65 73 20 28 61 70 70 65 6e 64 set! res (append 2820: 20 72 65 73 20 28 6c 69 73 74 20 68 65 64 29 29 res (list hed)) 2830: 29 29 20 3b 3b 20 28 6c 6f 6f 70 20 28 72 65 61 )) ;; (loop (rea 2840: 64 2d 6c 69 6e 65 20 69 6e 70 29 20 63 75 72 72 d-line inp) curr 2850: 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 -section-name #f 2860: 20 23 66 29 29 0a 09 20 20 20 28 63 6f 6e 66 69 #f)).. (confi 2870: 67 66 3a 73 65 63 74 69 6f 6e 2d 72 78 20 28 20 gf:section-rx ( 2880: 78 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 29 x section-name ) 2890: 20 28 6c 65 74 20 28 28 73 65 63 74 69 6f 6e 2d (let ((section- 28a0: 68 61 73 68 20 28 68 61 73 68 2d 74 61 62 6c 65 hash (hash-table 28b0: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 72 65 66 -ref/default ref 28c0: 64 61 74 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 dat section-name 28d0: 20 23 66 29 29 29 0a 09 09 09 09 09 20 20 20 20 #f)))...... 28e0: 28 69 66 20 28 6e 6f 74 20 73 65 63 74 69 6f 6e (if (not section 28f0: 2d 68 61 73 68 29 0a 09 09 09 09 09 09 28 6c 65 -hash).......(le 2900: 74 20 28 28 6e 65 77 68 61 73 68 20 28 6d 61 6b t ((newhash (mak 2910: 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 29 0a e-hash-table))). 2920: 09 09 09 09 09 09 20 20 28 68 61 73 68 2d 74 61 ...... (hash-ta 2930: 62 6c 65 2d 73 65 74 21 20 72 65 66 68 61 73 68 ble-set! refhash 2940: 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 6e 65 section-name ne 2950: 77 68 61 73 68 29 0a 09 09 09 09 09 09 20 20 28 whash)....... ( 2960: 73 65 74 21 20 73 65 63 68 61 73 68 20 6e 65 77 set! sechash new 2970: 68 61 73 68 29 29 0a 09 09 09 09 09 09 28 73 65 hash)).......(se 2980: 74 21 20 73 65 63 68 61 73 68 20 73 65 63 74 69 t! sechash secti 2990: 6f 6e 2d 68 61 73 68 29 29 0a 09 09 09 09 09 20 on-hash))...... 29a0: 20 20 20 28 73 65 74 21 20 6e 65 77 20 68 65 64 (set! new hed 29b0: 29 20 3b 3b 20 77 69 6c 6c 20 61 70 70 65 6e 64 ) ;; will append 29c0: 20 74 68 69 73 20 61 74 20 74 68 65 20 62 6f 74 this at the bot 29d0: 74 6f 6d 20 6f 66 20 74 68 65 20 6c 6f 6f 70 0a tom of the loop. 29e0: 09 09 09 09 09 20 20 20 20 28 73 65 74 21 20 73 ..... (set! s 29f0: 65 63 6e 61 6d 65 20 73 65 63 74 69 6f 6e 2d 6e ecname section-n 2a00: 61 6d 65 29 0a 09 09 09 09 09 20 20 20 20 29 29 ame)...... )) 2a10: 0a 09 20 20 20 3b 3b 20 4e 6f 20 6e 65 65 64 20 .. ;; No need 2a20: 74 6f 20 70 72 6f 63 65 73 73 20 6b 65 79 20 63 to process key c 2a30: 6d 64 2c 20 6c 65 74 20 69 74 20 66 61 6c 6c 20 md, let it fall 2a40: 74 68 6f 75 67 68 20 74 6f 20 6b 65 79 20 76 61 though to key va 2a50: 6c 0a 09 20 20 20 28 63 6f 6e 66 69 67 66 3a 6b l.. (configf:k 2a60: 65 79 2d 76 61 6c 2d 70 72 20 28 20 78 20 6b 65 ey-val-pr ( x ke 2a70: 79 20 76 61 6c 20 20 20 20 20 20 29 0a 09 09 20 y val )... 2a80: 20 20 20 20 20 20 28 6c 65 74 20 28 28 6e 65 77 (let ((new 2a90: 76 61 6c 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b val (config-look 2aa0: 75 70 20 69 6e 64 61 74 20 73 65 63 20 6b 65 79 up indat sec key 2ab0: 29 29 29 0a 09 09 09 20 3b 3b 20 63 61 6e 20 68 ))).... ;; can h 2ac0: 61 6e 64 6c 65 20 6e 65 77 76 61 6c 20 3d 3d 20 andle newval == 2ad0: 23 66 20 68 65 72 65 20 3d 3e 20 74 68 61 74 20 #f here => that 2ae0: 6d 65 61 6e 73 20 6b 65 79 20 69 73 20 72 65 6d means key is rem 2af0: 6f 76 65 64 0a 09 09 09 20 28 63 6f 6e 64 20 0a oved.... (cond . 2b00: 09 09 09 20 20 28 28 65 71 75 61 6c 3f 20 6e 65 ... ((equal? ne 2b10: 77 76 61 6c 20 76 61 6c 29 0a 09 09 09 20 20 20 wval val).... 2b20: 28 73 65 74 21 20 72 65 73 20 28 61 70 70 65 6e (set! res (appen 2b30: 64 20 72 65 73 20 28 6c 69 73 74 20 68 65 64 29 d res (list hed) 2b40: 29 29 29 0a 09 09 09 20 20 28 28 6e 6f 74 20 6e ))).... ((not n 2b50: 65 77 76 61 6c 29 20 3b 3b 20 6b 65 79 20 68 61 ewval) ;; key ha 2b60: 73 20 62 65 65 6e 20 72 65 6d 6f 76 65 64 0a 09 s been removed.. 2b70: 09 09 20 20 20 28 73 65 74 21 20 6e 65 77 20 23 .. (set! new # 2b80: 66 29 29 0a 09 09 09 20 20 28 28 6e 6f 74 20 28 f)).... ((not ( 2b90: 65 71 75 61 6c 3f 20 6e 65 77 76 61 6c 20 76 61 equal? newval va 2ba0: 6c 29 29 0a 09 09 09 20 20 20 20 20 28 68 61 73 l)).... (has 2bb0: 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 73 65 63 h-table-set! sec 2bc0: 68 61 73 68 20 6b 65 79 20 6e 65 77 76 61 6c 29 hash key newval) 2bd0: 0a 09 09 09 20 20 20 20 20 28 73 65 74 21 20 6e .... (set! n 2be0: 65 77 20 28 63 6f 6e 63 20 6b 65 79 20 22 20 22 ew (conc key " " 2bf0: 20 6e 65 77 76 61 6c 29 29 29 0a 09 09 09 20 20 newval))).... 2c00: 28 65 6c 73 65 0a 09 09 09 20 20 20 28 64 65 62 (else.... (deb 2c10: 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f ug:print 0 "ERRO 2c20: 52 3a 20 70 72 6f 62 6c 65 6d 20 70 61 72 73 69 R: problem parsi 2c30: 6e 67 20 6c 69 6e 65 20 6e 75 6d 62 65 72 20 22 ng line number " 2c40: 20 6c 6e 75 6d 20 22 5c 22 22 20 68 65 64 20 22 lnum "\"" hed " 2c50: 5c 22 22 29 29 29 29 29 0a 09 20 20 20 28 65 6c \""))))).. (el 2c60: 73 65 0a 09 20 20 20 20 28 64 65 62 75 67 3a 70 se.. (debug:p 2c70: 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 50 rint 0 "ERROR: P 2c80: 72 6f 62 6c 65 6d 20 70 61 72 73 69 6e 67 20 6c roblem parsing l 2c90: 69 6e 65 20 6e 75 6d 20 22 20 6c 6e 75 6d 20 22 ine num " lnum " 2ca0: 20 3a 5c 6e 20 20 20 22 20 68 65 64 20 29 29 29 :\n " hed ))) 2cb0: 0a 09 20 20 28 69 66 20 28 6e 6f 74 20 28 6e 75 .. (if (not (nu 2cc0: 6c 6c 3f 20 74 61 6c 29 29 0a 09 20 20 20 20 20 ll? tal)).. 2cd0: 20 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 (loop (car tal) 2ce0: 28 63 64 72 20 74 61 6c 29 28 69 66 20 6e 65 77 (cdr tal)(if new 2cf0: 20 28 61 70 70 65 6e 64 20 72 65 73 20 28 6c 69 (append res (li 2d00: 73 74 20 6e 65 77 29 29 20 72 65 73 29 28 2b 20 st new)) res)(+ 2d10: 6c 6e 75 6d 20 31 29 29 29 0a 09 20 20 3b 3b 20 lnum 1))).. ;; 2d20: 64 72 6f 70 20 74 6f 20 68 65 72 65 20 77 68 65 drop to here whe 2d30: 6e 20 64 6f 6e 65 20 70 72 6f 63 65 73 73 69 6e n done processin 2d40: 67 2c 20 72 65 73 20 63 6f 6e 74 61 69 6e 73 20 g, res contains 2d50: 6d 6f 64 69 66 69 65 64 20 6c 69 73 74 20 6f 66 modified list of 2d60: 20 6c 69 6e 65 73 0a 09 20 20 28 73 65 74 21 20 lines.. (set! 2d70: 66 64 61 74 20 72 65 73 29 29 29 0a 0a 20 20 20 fdat res))).. 2d80: 20 3b 3b 20 73 74 65 70 20 34 3a 20 41 70 70 65 ;; step 4: Appe 2d90: 6e 64 20 6e 65 77 20 76 61 6c 75 65 73 20 74 6f nd new values to 2da0: 20 74 68 65 20 73 65 63 74 69 6f 6e 0a 20 20 20 the section. 2db0: 20 28 66 6f 72 2d 65 61 63 68 20 0a 20 20 20 20 (for-each . 2dc0: 20 28 6c 61 6d 62 64 61 20 28 73 65 63 74 69 6f (lambda (sectio 2dd0: 6e 29 0a 20 20 20 20 20 20 20 28 6c 65 74 20 28 n). (let ( 2de0: 28 73 64 61 74 20 20 20 27 28 29 29 20 3b 3b 20 (sdat '()) ;; 2df0: 61 70 70 65 6e 64 20 6e 65 65 64 65 64 20 62 69 append needed bi 2e00: 74 73 20 68 65 72 65 0a 09 20 20 20 20 20 28 73 ts here.. (s 2e10: 76 61 72 73 20 20 28 63 6f 6e 66 69 67 66 3a 73 vars (configf:s 2e20: 65 63 74 69 6f 6e 2d 76 61 72 73 20 69 6e 64 61 ection-vars inda 2e30: 74 20 73 65 63 74 69 6f 6e 29 29 29 0a 09 20 28 t section))).. ( 2e40: 66 6f 72 2d 65 61 63 68 20 0a 09 20 20 28 6c 61 for-each .. (la 2e50: 6d 62 64 61 20 28 76 61 72 29 0a 09 20 20 20 20 mbda (var).. 2e60: 28 6c 65 74 20 28 28 76 61 6c 20 28 63 6f 6e 66 (let ((val (conf 2e70: 69 67 2d 6c 6f 6f 6b 75 70 20 72 65 66 64 61 74 ig-lookup refdat 2e80: 20 73 65 63 74 69 6f 6e 20 76 61 72 29 29 29 0a section var))). 2e90: 09 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 . (if (not 2ea0: 76 61 6c 29 20 3b 3b 20 74 68 69 73 20 6f 6e 65 val) ;; this one 2eb0: 20 69 73 20 6e 65 77 0a 09 09 20 20 28 62 65 67 is new... (beg 2ec0: 69 6e 0a 09 09 20 20 20 20 28 69 66 20 28 6e 75 in... (if (nu 2ed0: 6c 6c 3f 20 73 64 61 74 29 28 73 65 74 21 20 73 ll? sdat)(set! s 2ee0: 64 61 74 20 28 6c 69 73 74 20 28 63 6f 6e 63 20 dat (list (conc 2ef0: 22 5b 22 20 73 65 63 74 69 6f 6e 20 22 5d 22 29 "[" section "]") 2f00: 29 29 29 0a 09 09 20 20 20 20 28 73 65 74 21 20 )))... (set! 2f10: 73 64 61 74 20 28 61 70 70 65 6e 64 20 73 64 61 sdat (append sda 2f20: 74 20 28 6c 69 73 74 20 28 63 6f 6e 63 20 76 61 t (list (conc va 2f30: 72 20 22 20 22 20 76 61 6c 29 29 29 29 29 29 29 r " " val))))))) 2f40: 29 0a 09 20 20 73 76 61 72 73 29 0a 09 20 28 73 ).. svars).. (s 2f50: 65 74 21 20 66 64 61 74 20 28 61 70 70 65 6e 64 et! fdat (append 2f60: 20 66 64 61 74 20 73 64 61 74 29 29 29 29 0a 20 fdat sdat)))). 2f70: 20 20 20 20 28 64 65 6c 65 74 65 2d 64 75 70 6c (delete-dupl 2f80: 69 63 61 74 65 73 20 28 61 70 70 65 6e 64 20 72 icates (append r 2f90: 65 71 75 69 72 65 2d 73 65 63 74 69 6f 6e 73 20 equire-sections 2fa0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 (hash-table-keys 2fb0: 20 69 6e 64 61 74 29 29 29 29 0a 0a 20 20 20 20 indat)))).. 2fc0: 3b 3b 20 73 74 65 70 20 35 3a 20 57 72 69 74 65 ;; step 5: Write 2fd0: 20 6f 75 74 20 6e 65 77 20 66 69 6c 65 0a 20 20 out new file. 2fe0: 20 20 28 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 (with-output-t 2ff0: 6f 2d 66 69 6c 65 20 66 6e 61 6d 65 20 0a 20 20 o-file fname . 3000: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 (lambda ().. 3010: 28 66 6f 72 2d 65 61 63 68 20 0a 09 20 28 6c 61 (for-each .. (la 3020: 6d 62 64 61 20 28 6c 69 6e 65 29 0a 09 20 20 20 mbda (line).. 3030: 28 70 72 69 6e 74 20 6c 69 6e 65 29 29 0a 09 20 (print line)).. 3040: 28 63 6f 6e 66 69 67 66 3a 65 78 70 61 6e 64 2d (configf:expand- 3050: 6d 75 6c 74 69 2d 6c 69 6e 65 73 20 66 64 61 74 multi-lines fdat 3060: 29 29 29 29 29 29 0a 0a ))))))..