Artifact e94bf5cc897fc504d35d4d4a94136def80f80a10:
- File configf.scm — part of check-in [e21b04bc41] at 2011-11-27 15:36:16 on branch trunk — Partially complete non-destructive open/modify/write of config files (user: matt size: 12846)
0000: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;============== 0010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0040: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 43 6f 70 79 ========.;; Copy 0050: 72 69 67 68 74 20 32 30 30 36 2d 32 30 31 31 2c right 2006-2011, 0060: 20 4d 61 74 74 68 65 77 20 57 65 6c 6c 61 6e 64 Matthew Welland 0070: 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68 69 73 20 70 ..;; .;; This p 0080: 72 6f 67 72 61 6d 20 69 73 20 6d 61 64 65 20 61 rogram is made a 0090: 76 61 69 6c 61 62 6c 65 20 75 6e 64 65 72 20 74 vailable under t 00a0: 68 65 20 47 4e 55 20 47 50 4c 20 76 65 72 73 69 he GNU GPL versi 00b0: 6f 6e 20 32 2e 30 20 6f 72 0a 3b 3b 20 20 67 72 on 2.0 or.;; gr 00c0: 65 61 74 65 72 2e 20 53 65 65 20 74 68 65 20 61 eater. See the a 00d0: 63 63 6f 6d 70 61 6e 79 69 6e 67 20 66 69 6c 65 ccompanying file 00e0: 20 43 4f 50 59 49 4e 47 20 66 6f 72 20 64 65 74 COPYING for det 00f0: 61 69 6c 73 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68 ails..;; .;; Th 0100: 69 73 20 70 72 6f 67 72 61 6d 20 69 73 20 64 69 is program is di 0110: 73 74 72 69 62 75 74 65 64 20 57 49 54 48 4f 55 stributed WITHOU 0120: 54 20 41 4e 59 20 57 41 52 52 41 4e 54 59 3b 20 T ANY WARRANTY; 0130: 77 69 74 68 6f 75 74 20 65 76 65 6e 20 74 68 65 without even the 0140: 0a 3b 3b 20 20 69 6d 70 6c 69 65 64 20 77 61 72 .;; implied war 0150: 72 61 6e 74 79 20 6f 66 20 4d 45 52 43 48 41 4e ranty of MERCHAN 0160: 54 41 42 49 4c 49 54 59 20 6f 72 20 46 49 54 4e TABILITY or FITN 0170: 45 53 53 20 46 4f 52 20 41 20 50 41 52 54 49 43 ESS FOR A PARTIC 0180: 55 4c 41 52 0a 3b 3b 20 20 50 55 52 50 4f 53 45 ULAR.;; PURPOSE 0190: 2e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============ 01a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 01b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 01c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 01d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 3d 3d ==========..;;== 01e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 01f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0200: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0210: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0220: 3d 3d 3d 3d 0a 3b 3b 20 43 6f 6e 66 69 67 20 66 ====.;; Config f 0230: 69 6c 65 20 68 61 6e 64 6c 69 6e 67 0a 3b 3b 3d ile handling.;;= 0240: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0250: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0260: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0270: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0280: 3d 3d 3d 3d 3d 0a 0a 28 75 73 65 20 72 65 67 65 =====..(use rege 0290: 78 20 72 65 67 65 78 2d 63 61 73 65 29 0a 28 64 x regex-case).(d 02a0: 65 63 6c 61 72 65 20 28 75 6e 69 74 20 63 6f 6e eclare (unit con 02b0: 66 69 67 66 29 29 0a 28 64 65 63 6c 61 72 65 20 figf)).(declare 02c0: 28 75 73 65 73 20 63 6f 6d 6d 6f 6e 29 29 0a 28 (uses common)).( 02d0: 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 70 72 declare (uses pr 02e0: 6f 63 65 73 73 29 29 0a 0a 28 69 6e 63 6c 75 64 ocess))..(includ 02f0: 65 20 22 63 6f 6d 6d 6f 6e 5f 72 65 63 6f 72 64 e "common_record 0300: 73 2e 73 63 6d 22 29 0a 0a 3b 3b 20 72 65 74 75 s.scm")..;; retu 0310: 72 6e 20 6c 69 73 74 20 28 70 61 74 68 20 66 75 rn list (path fu 0320: 6c 6c 70 61 74 68 20 63 6f 6e 66 69 67 6e 61 6d llpath confignam 0330: 65 29 0a 28 64 65 66 69 6e 65 20 28 66 69 6e 64 e).(define (find 0340: 2d 63 6f 6e 66 69 67 20 63 6f 6e 66 69 67 6e 61 -config configna 0350: 6d 65 29 0a 20 20 28 6c 65 74 2a 20 28 28 63 77 me). (let* ((cw 0360: 64 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 d (string-split 0370: 28 63 75 72 72 65 6e 74 2d 64 69 72 65 63 74 6f (current-directo 0380: 72 79 29 20 22 2f 22 29 29 29 0a 20 20 20 20 28 ry) "/"))). ( 0390: 6c 65 74 20 6c 6f 6f 70 20 28 28 64 69 72 20 63 let loop ((dir c 03a0: 77 64 29 29 0a 20 20 20 20 20 20 28 6c 65 74 2a wd)). (let* 03b0: 20 28 28 70 61 74 68 20 20 20 20 20 28 63 6f 6e ((path (con 03c0: 63 20 22 2f 22 20 28 73 74 72 69 6e 67 2d 69 6e c "/" (string-in 03d0: 74 65 72 73 70 65 72 73 65 20 64 69 72 20 22 2f tersperse dir "/ 03e0: 22 29 29 29 0a 09 20 20 20 20 20 28 66 75 6c 6c "))).. (full 03f0: 70 61 74 68 20 28 63 6f 6e 63 20 70 61 74 68 20 path (conc path 0400: 22 2f 22 20 63 6f 6e 66 69 67 6e 61 6d 65 29 29 "/" configname)) 0410: 29 0a 09 28 69 66 20 28 66 69 6c 65 2d 65 78 69 )..(if (file-exi 0420: 73 74 73 3f 20 66 75 6c 6c 70 61 74 68 29 0a 09 sts? fullpath).. 0430: 20 20 20 20 28 6c 69 73 74 20 70 61 74 68 20 66 (list path f 0440: 75 6c 6c 70 61 74 68 20 63 6f 6e 66 69 67 6e 61 ullpath configna 0450: 6d 65 29 0a 09 20 20 20 20 28 6c 65 74 20 28 28 me).. (let (( 0460: 72 65 6d 63 77 64 20 28 74 61 6b 65 20 64 69 72 remcwd (take dir 0470: 20 28 2d 20 28 6c 65 6e 67 74 68 20 64 69 72 29 (- (length dir) 0480: 20 31 29 29 29 29 0a 09 20 20 20 20 20 20 28 69 1)))).. (i 0490: 66 20 28 6e 75 6c 6c 3f 20 72 65 6d 63 77 64 29 f (null? remcwd) 04a0: 0a 09 09 20 20 28 6c 69 73 74 20 23 66 20 23 66 ... (list #f #f 04b0: 20 23 66 29 20 3b 3b 20 20 23 66 20 23 66 29 20 #f) ;; #f #f) 04c0: 0a 09 09 20 20 28 6c 6f 6f 70 20 72 65 6d 63 77 ... (loop remcw 04d0: 64 29 29 29 29 29 29 29 29 0a 0a 28 64 65 66 69 d))))))))..(defi 04e0: 6e 65 20 28 63 6f 6e 66 69 67 3a 61 73 73 6f 63 ne (config:assoc 04f0: 2d 73 61 66 65 2d 61 64 64 20 61 6c 69 73 74 20 -safe-add alist 0500: 6b 65 79 20 76 61 6c 29 0a 20 20 28 6c 65 74 20 key val). (let 0510: 28 28 6e 65 77 61 6c 69 73 74 20 28 66 69 6c 74 ((newalist (filt 0520: 65 72 20 28 6c 61 6d 62 64 61 20 28 78 29 28 6e er (lambda (x)(n 0530: 6f 74 20 28 65 71 75 61 6c 3f 20 6b 65 79 20 28 ot (equal? key ( 0540: 63 61 72 20 78 29 29 29 29 20 61 6c 69 73 74 29 car x)))) alist) 0550: 29 29 0a 20 20 20 20 28 61 70 70 65 6e 64 20 6e )). (append n 0560: 65 77 61 6c 69 73 74 20 28 6c 69 73 74 20 28 6c ewalist (list (l 0570: 69 73 74 20 6b 65 79 20 76 61 6c 29 29 29 29 29 ist key val))))) 0580: 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 ..(define (confi 0590: 67 3a 65 76 61 6c 2d 73 74 72 69 6e 67 2d 69 6e g:eval-string-in 05a0: 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 73 74 72 -environment str 05b0: 29 0a 20 20 28 6c 65 74 20 28 28 63 6d 64 72 65 ). (let ((cmdre 05c0: 73 20 28 63 6d 64 2d 72 75 6e 2d 3e 6c 69 73 74 s (cmd-run->list 05d0: 20 28 63 6f 6e 63 20 22 65 63 68 6f 20 22 20 73 (conc "echo " s 05e0: 74 72 29 29 29 29 0a 20 20 20 20 28 69 66 20 28 tr)))). (if ( 05f0: 6e 75 6c 6c 3f 20 63 6d 64 72 65 73 29 20 22 22 null? cmdres) "" 0600: 0a 09 28 63 61 61 72 20 63 6d 64 72 65 73 29 29 ..(caar cmdres)) 0610: 29 29 0a 0a 3b 3b 20 72 65 61 64 20 61 20 63 6f ))..;; read a co 0620: 6e 66 69 67 20 66 69 6c 65 2c 20 72 65 74 75 72 nfig file, retur 0630: 6e 73 20 68 61 73 68 20 74 61 62 6c 65 20 6f 66 ns hash table of 0640: 20 61 6c 69 73 74 73 0a 3b 3b 20 61 64 64 73 20 alists.;; adds 0650: 74 6f 20 68 74 20 69 66 20 67 69 76 65 6e 20 28 to ht if given ( 0660: 6d 75 73 74 20 62 65 20 23 66 20 6f 74 68 65 72 must be #f other 0670: 77 69 73 65 29 0a 3b 3b 20 65 6e 76 69 6f 6e 2d wise).;; envion- 0680: 70 61 74 74 20 69 73 20 61 20 72 65 67 65 78 20 patt is a regex 0690: 73 70 65 63 20 74 68 61 74 20 69 64 65 6e 74 69 spec that identi 06a0: 66 69 65 73 20 73 65 63 74 69 6f 6e 73 20 74 68 fies sections th 06b0: 61 74 20 77 69 6c 6c 20 62 65 20 65 76 61 6c 27 at will be eval' 06c0: 64 0a 3b 3b 20 69 6e 20 74 68 65 20 65 6e 76 69 d.;; in the envi 06d0: 72 6f 6e 6d 65 6e 74 20 6f 6e 20 74 68 65 20 66 ronment on the f 06e0: 6c 79 0a 0a 28 64 65 66 69 6e 65 20 28 72 65 61 ly..(define (rea 06f0: 64 2d 63 6f 6e 66 69 67 20 70 61 74 68 20 68 74 d-config path ht 0700: 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 23 21 allow-system #! 0710: 6b 65 79 20 28 65 6e 76 69 72 6f 6e 2d 70 61 74 key (environ-pat 0720: 74 20 23 66 29 29 0a 20 20 28 64 65 62 75 67 3a t #f)). (debug: 0730: 70 72 69 6e 74 20 34 20 22 49 4e 46 4f 3a 20 72 print 4 "INFO: r 0740: 65 61 64 2d 63 6f 6e 66 69 67 20 22 20 70 61 74 ead-config " pat 0750: 68 20 22 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d h " allow-system 0760: 20 22 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 " allow-system 0770: 22 20 65 6e 76 69 72 6f 6e 2d 70 61 74 74 20 22 " environ-patt " 0780: 20 65 6e 76 69 72 6f 6e 2d 70 61 74 74 29 0a 20 environ-patt). 0790: 20 28 69 66 20 28 6e 6f 74 20 28 66 69 6c 65 2d (if (not (file- 07a0: 65 78 69 73 74 73 3f 20 70 61 74 68 29 29 0a 20 exists? path)). 07b0: 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 68 74 (if (not ht 07c0: 29 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c )(make-hash-tabl 07d0: 65 29 20 68 74 29 0a 20 20 20 20 20 20 28 6c 65 e) ht). (le 07e0: 74 20 28 28 69 6e 70 20 20 20 20 20 20 20 20 28 t ((inp ( 07f0: 6f 70 65 6e 2d 69 6e 70 75 74 2d 66 69 6c 65 20 open-input-file 0800: 70 61 74 68 29 29 0a 09 20 20 20 20 28 72 65 73 path)).. (res 0810: 20 20 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 (if (not 0820: 20 68 74 29 28 6d 61 6b 65 2d 68 61 73 68 2d 74 ht)(make-hash-t 0830: 61 62 6c 65 29 20 68 74 29 29 0a 09 20 20 20 20 able) ht)).. 0840: 28 69 6e 63 6c 75 64 65 2d 72 78 20 28 72 65 67 (include-rx (reg 0850: 65 78 70 20 22 5e 5c 5c 5b 69 6e 63 6c 75 64 65 exp "^\\[include 0860: 5c 5c 73 2b 28 2e 2a 29 5c 5c 5d 5c 5c 73 2a 24 \\s+(.*)\\]\\s*$ 0870: 22 29 29 0a 09 20 20 20 20 28 73 65 63 74 69 6f ")).. (sectio 0880: 6e 2d 72 78 20 28 72 65 67 65 78 70 20 22 5e 5c n-rx (regexp "^\ 0890: 5c 5b 28 2e 2a 29 5c 5c 5d 5c 5c 73 2a 24 22 29 \[(.*)\\]\\s*$") 08a0: 29 0a 09 20 20 20 20 28 62 6c 61 6e 6b 2d 6c 2d ).. (blank-l- 08b0: 72 78 20 28 72 65 67 65 78 70 20 22 5e 5c 5c 73 rx (regexp "^\\s 08c0: 2a 24 22 29 29 0a 09 20 20 20 20 28 6b 65 79 2d *$")).. (key- 08d0: 73 79 73 2d 70 72 20 28 72 65 67 65 78 70 20 22 sys-pr (regexp " 08e0: 5e 28 5c 5c 53 2b 29 5c 5c 73 2b 5c 5c 5b 73 79 ^(\\S+)\\s+\\[sy 08f0: 73 74 65 6d 5c 5c 73 2b 28 5c 5c 53 2b 2e 2a 29 stem\\s+(\\S+.*) 0900: 5c 5c 5d 5c 5c 73 2a 24 22 29 29 0a 09 20 20 20 \\]\\s*$")).. 0910: 20 28 6b 65 79 2d 76 61 6c 2d 70 72 20 28 72 65 (key-val-pr (re 0920: 67 65 78 70 20 22 5e 28 5c 5c 53 2b 29 5c 5c 73 gexp "^(\\S+)\\s 0930: 2b 28 2e 2a 29 24 22 29 29 0a 09 20 20 20 20 28 +(.*)$")).. ( 0940: 63 6f 6d 6d 65 6e 74 2d 72 78 20 28 72 65 67 65 comment-rx (rege 0950: 78 70 20 22 5e 5c 5c 73 2a 23 2e 2a 22 29 29 0a xp "^\\s*#.*")). 0960: 09 20 20 20 20 28 63 6f 6e 74 2d 6c 6e 2d 72 78 . (cont-ln-rx 0970: 20 28 72 65 67 65 78 70 20 22 5e 28 5c 5c 73 2b (regexp "^(\\s+ 0980: 29 28 5c 5c 53 2b 2e 2a 29 24 22 29 29 29 0a 09 )(\\S+.*)$"))).. 0990: 28 6c 65 74 20 6c 6f 6f 70 20 28 28 69 6e 6c 20 (let loop ((inl 09a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 72 (r 09b0: 65 61 64 2d 6c 69 6e 65 20 69 6e 70 29 29 0a 09 ead-line inp)).. 09c0: 09 20 20 20 28 63 75 72 72 2d 73 65 63 74 69 6f . (curr-sectio 09d0: 6e 2d 6e 61 6d 65 20 22 64 65 66 61 75 6c 74 22 n-name "default" 09e0: 29 0a 09 09 20 20 20 28 76 61 72 2d 66 6c 61 67 )... (var-flag 09f0: 20 23 66 29 3b 3b 20 74 75 72 6e 20 6f 6e 20 66 #f);; turn on f 0a00: 6f 72 20 6b 65 79 2d 76 61 72 2d 70 72 20 61 6e or key-var-pr an 0a10: 64 20 63 6f 6e 74 2d 6c 6e 2d 72 78 2c 20 74 75 d cont-ln-rx, tu 0a20: 72 6e 20 6f 66 66 20 65 6c 73 65 77 68 65 72 65 rn off elsewhere 0a30: 0a 09 09 20 20 20 28 6c 65 61 64 20 20 20 20 20 ... (lead 0a40: 23 66 29 29 0a 09 20 20 28 69 66 20 28 65 6f 66 #f)).. (if (eof 0a50: 2d 6f 62 6a 65 63 74 3f 20 69 6e 6c 29 20 0a 09 -object? inl) .. 0a60: 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 28 (begin...( 0a70: 63 6c 6f 73 65 2d 69 6e 70 75 74 2d 70 6f 72 74 close-input-port 0a80: 20 69 6e 70 29 0a 09 09 72 65 73 29 0a 09 20 20 inp)...res).. 0a90: 20 20 20 20 28 72 65 67 65 78 2d 63 61 73 65 20 (regex-case 0aa0: 0a 09 20 20 20 20 20 20 20 69 6e 6c 20 0a 09 20 .. inl .. 0ab0: 20 20 20 20 20 20 28 63 6f 6d 6d 65 6e 74 2d 72 (comment-r 0ac0: 78 20 5f 20 20 20 20 20 20 20 20 20 20 20 20 20 x _ 0ad0: 20 20 20 20 20 28 6c 6f 6f 70 20 28 72 65 61 64 (loop (read 0ae0: 2d 6c 69 6e 65 20 69 6e 70 29 20 63 75 72 72 2d -line inp) curr- 0af0: 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 section-name #f 0b00: 23 66 29 29 0a 09 20 20 20 20 20 20 20 28 62 6c #f)).. (bl 0b10: 61 6e 6b 2d 6c 2d 72 78 20 5f 20 20 20 20 20 20 ank-l-rx _ 0b20: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f (loo 0b30: 70 20 28 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 p (read-line inp 0b40: 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e ) curr-section-n 0b50: 61 6d 65 20 23 66 20 23 66 29 29 0a 09 20 20 20 ame #f #f)).. 0b60: 20 20 20 20 28 69 6e 63 6c 75 64 65 2d 72 78 20 (include-rx 0b70: 28 20 78 20 69 6e 63 6c 75 64 65 2d 66 69 6c 65 ( x include-file 0b80: 20 29 20 28 62 65 67 69 6e 0a 09 09 09 09 09 09 ) (begin....... 0b90: 28 72 65 61 64 2d 63 6f 6e 66 69 67 20 69 6e 63 (read-config inc 0ba0: 6c 75 64 65 2d 66 69 6c 65 20 72 65 73 20 61 6c lude-file res al 0bb0: 6c 6f 77 2d 73 79 73 74 65 6d 20 65 6e 76 69 72 low-system envir 0bc0: 6f 6e 2d 70 61 74 74 3a 20 65 6e 76 69 72 6f 6e on-patt: environ 0bd0: 2d 70 61 74 74 29 0a 09 09 09 09 09 09 28 6c 6f -patt).......(lo 0be0: 6f 70 20 28 72 65 61 64 2d 6c 69 6e 65 20 69 6e op (read-line in 0bf0: 70 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d p) curr-section- 0c00: 6e 61 6d 65 20 23 66 20 23 66 29 29 29 0a 09 20 name #f #f))).. 0c10: 20 20 20 20 20 20 28 73 65 63 74 69 6f 6e 2d 72 (section-r 0c20: 78 20 28 20 78 20 73 65 63 74 69 6f 6e 2d 6e 61 x ( x section-na 0c30: 6d 65 20 29 20 28 6c 6f 6f 70 20 28 72 65 61 64 me ) (loop (read 0c40: 2d 6c 69 6e 65 20 69 6e 70 29 20 73 65 63 74 69 -line inp) secti 0c50: 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 66 29 29 0a on-name #f #f)). 0c60: 09 20 20 20 20 20 20 20 28 6b 65 79 2d 73 79 73 . (key-sys 0c70: 2d 70 72 20 28 20 78 20 6b 65 79 20 63 6d 64 20 -pr ( x key cmd 0c80: 20 20 20 20 20 29 20 28 69 66 20 61 6c 6c 6f 77 ) (if allow 0c90: 2d 73 79 73 74 65 6d 0a 09 09 09 09 09 09 20 20 -system....... 0ca0: 28 6c 65 74 20 28 28 61 6c 69 73 74 20 28 68 61 (let ((alist (ha 0cb0: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def 0cc0: 61 75 6c 74 20 72 65 73 20 63 75 72 72 2d 73 65 ault res curr-se 0cd0: 63 74 69 6f 6e 2d 6e 61 6d 65 20 27 28 29 29 29 ction-name '())) 0ce0: 0a 09 09 09 09 09 09 09 28 76 61 6c 2d 70 72 6f ........(val-pro 0cf0: 63 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 c (lambda ().... 0d00: 09 09 09 09 09 20 20 20 20 28 6c 65 74 2a 20 28 ..... (let* ( 0d10: 28 63 6d 64 72 65 73 20 20 28 63 6d 64 2d 72 75 (cmdres (cmd-ru 0d20: 6e 2d 3e 6c 69 73 74 20 63 6d 64 29 29 0a 09 09 n->list cmd))... 0d30: 09 09 09 09 09 09 09 20 20 20 28 73 74 61 74 75 ....... (statu 0d40: 73 20 20 28 63 61 64 72 20 63 6d 64 72 65 73 29 s (cadr cmdres) 0d50: 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 28 72 ).......... (r 0d60: 65 73 20 20 20 20 20 28 63 61 72 20 20 63 6d 64 es (car cmd 0d70: 72 65 73 29 29 29 0a 09 09 09 09 09 09 09 09 20 res)))......... 0d80: 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 65 (if (not (e 0d90: 71 3f 20 73 74 61 74 75 73 20 30 29 29 0a 09 09 q? status 0))... 0da0: 09 09 09 09 09 09 09 20 20 28 62 65 67 69 6e 0a ....... (begin. 0db0: 09 09 09 09 09 09 09 09 09 20 20 20 20 28 64 65 ......... (de 0dc0: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 bug:print 0 "ERR 0dd0: 4f 52 3a 20 70 72 6f 62 6c 65 6d 20 77 69 74 68 OR: problem with 0de0: 20 22 20 69 6e 6c 20 22 2c 20 72 65 74 75 72 6e " inl ", return 0df0: 20 63 6f 64 65 20 22 20 73 74 61 74 75 73 29 0a code " status). 0e00: 09 09 09 09 09 09 09 09 09 20 20 20 20 28 65 78 ......... (ex 0e10: 69 74 20 31 29 29 29 0a 09 09 09 09 09 09 09 09 it 1)))......... 0e20: 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f (if (null? 0e30: 20 72 65 73 29 0a 09 09 09 09 09 09 09 09 09 20 res).......... 0e40: 20 22 22 0a 09 09 09 09 09 09 09 09 09 20 20 28 "".......... ( 0e50: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper 0e60: 73 65 20 72 65 73 20 22 20 22 29 29 29 29 29 29 se res " ")))))) 0e70: 0a 09 09 09 09 09 09 20 20 20 20 28 68 61 73 68 ....... (hash 0e80: 2d 74 61 62 6c 65 2d 73 65 74 21 20 72 65 73 20 -table-set! res 0e90: 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d curr-section-nam 0ea0: 65 20 0a 09 09 09 09 09 09 09 09 20 20 20 20 20 e ......... 0eb0: 28 63 6f 6e 66 69 67 3a 61 73 73 6f 63 2d 73 61 (config:assoc-sa 0ec0: 66 65 2d 61 64 64 20 61 6c 69 73 74 0a 09 09 09 fe-add alist.... 0ed0: 09 09 09 09 09 09 09 09 20 20 20 20 6b 65 79 20 ........ key 0ee0: 0a 09 09 09 09 09 09 09 09 09 09 09 20 20 20 20 ............ 0ef0: 28 69 66 20 28 65 71 3f 20 61 6c 6c 6f 77 2d 73 (if (eq? allow-s 0f00: 79 73 74 65 6d 20 27 72 65 74 75 72 6e 2d 70 72 ystem 'return-pr 0f10: 6f 63 73 29 0a 09 09 09 09 09 09 09 09 09 09 09 ocs)............ 0f20: 09 76 61 6c 2d 70 72 6f 63 0a 09 09 09 09 09 09 .val-proc....... 0f30: 09 09 09 09 09 09 28 76 61 6c 2d 70 72 6f 63 29 ......(val-proc) 0f40: 29 29 29 0a 09 09 09 09 09 09 20 20 20 20 28 6c )))....... (l 0f50: 6f 6f 70 20 28 72 65 61 64 2d 6c 69 6e 65 20 69 oop (read-line i 0f60: 6e 70 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e np) curr-section 0f70: 2d 6e 61 6d 65 20 23 66 20 23 66 29 29 0a 09 09 -name #f #f))... 0f80: 09 09 09 09 20 20 28 6c 6f 6f 70 20 28 72 65 61 .... (loop (rea 0f90: 64 2d 6c 69 6e 65 20 69 6e 70 29 20 63 75 72 72 d-line inp) curr 0fa0: 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 -section-name #f 0fb0: 20 23 66 29 29 29 0a 09 20 20 20 20 20 20 20 28 #f))).. ( 0fc0: 6b 65 79 2d 76 61 6c 2d 70 72 20 28 20 78 20 6b key-val-pr ( x k 0fd0: 65 79 20 76 61 6c 20 20 20 20 20 20 29 20 28 6c ey val ) (l 0fe0: 65 74 2a 20 28 28 61 6c 69 73 74 20 20 20 28 68 et* ((alist (h 0ff0: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de 1000: 66 61 75 6c 74 20 72 65 73 20 63 75 72 72 2d 73 fault res curr-s 1010: 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 27 28 29 29 ection-name '()) 1020: 29 0a 09 09 09 09 09 09 20 20 20 20 20 28 65 6e )....... (en 1030: 76 61 72 20 20 20 28 61 6e 64 20 65 6e 76 69 72 var (and envir 1040: 6f 6e 2d 70 61 74 74 20 28 73 74 72 69 6e 67 2d on-patt (string- 1050: 6d 61 74 63 68 20 28 72 65 67 65 78 70 20 65 6e match (regexp en 1060: 76 69 72 6f 6e 2d 70 61 74 74 29 20 63 75 72 72 viron-patt) curr 1070: 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 29 29 29 -section-name))) 1080: 0a 09 09 09 09 09 09 20 20 20 20 20 28 72 65 61 ....... (rea 1090: 6c 76 61 6c 20 28 69 66 20 65 6e 76 61 72 0a 09 lval (if envar.. 10a0: 09 09 09 09 09 09 09 20 28 63 6f 6e 66 69 67 3a ....... (config: 10b0: 65 76 61 6c 2d 73 74 72 69 6e 67 2d 69 6e 2d 65 eval-string-in-e 10c0: 6e 76 69 72 6f 6e 6d 65 6e 74 20 76 61 6c 29 0a nvironment val). 10d0: 09 09 09 09 09 09 09 09 20 76 61 6c 29 29 29 0a ........ val))). 10e0: 09 09 09 09 09 09 28 69 66 20 65 6e 76 61 72 0a ......(if envar. 10f0: 09 09 09 09 09 09 20 20 20 20 28 62 65 67 69 6e ...... (begin 1100: 0a 09 09 09 09 09 09 20 20 20 20 20 20 28 64 65 ....... (de 1110: 62 75 67 3a 70 72 69 6e 74 20 34 20 22 49 4e 46 bug:print 4 "INF 1120: 4f 3a 20 72 65 61 64 2d 63 6f 6e 66 69 67 20 6b O: read-config k 1130: 65 79 3d 22 20 6b 65 79 20 22 2c 20 76 61 6c 3d ey=" key ", val= 1140: 22 20 76 61 6c 20 22 2c 20 72 65 61 6c 76 61 6c " val ", realval 1150: 3d 22 20 72 65 61 6c 76 61 6c 29 0a 09 09 09 09 =" realval)..... 1160: 09 09 20 20 20 20 20 20 28 73 65 74 65 6e 76 20 .. (setenv 1170: 6b 65 79 20 72 65 61 6c 76 61 6c 29 29 29 0a 09 key realval))).. 1180: 09 09 09 09 09 28 68 61 73 68 2d 74 61 62 6c 65 .....(hash-table 1190: 2d 73 65 74 21 20 72 65 73 20 63 75 72 72 2d 73 -set! res curr-s 11a0: 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 0a 09 09 09 ection-name .... 11b0: 09 09 09 09 09 20 28 63 6f 6e 66 69 67 3a 61 73 ..... (config:as 11c0: 73 6f 63 2d 73 61 66 65 2d 61 64 64 20 61 6c 69 soc-safe-add ali 11d0: 73 74 20 6b 65 79 20 72 65 61 6c 76 61 6c 29 29 st key realval)) 11e0: 0a 09 09 09 09 09 09 28 6c 6f 6f 70 20 28 72 65 .......(loop (re 11f0: 61 64 2d 6c 69 6e 65 20 69 6e 70 29 20 63 75 72 ad-line inp) cur 1200: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 6b r-section-name k 1210: 65 79 20 23 66 29 29 29 0a 09 20 20 20 20 20 20 ey #f))).. 1220: 20 3b 3b 20 69 66 20 61 20 63 6f 6e 74 69 6e 75 ;; if a continu 1230: 65 64 20 6c 69 6e 65 0a 09 20 20 20 20 20 20 20 ed line.. 1240: 28 63 6f 6e 74 2d 6c 6e 2d 72 78 20 28 20 78 20 (cont-ln-rx ( x 1250: 77 68 73 70 20 76 61 6c 20 20 20 20 20 29 20 28 whsp val ) ( 1260: 6c 65 74 20 28 28 61 6c 69 73 74 20 28 68 61 73 let ((alist (has 1270: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa 1280: 75 6c 74 20 72 65 73 20 63 75 72 72 2d 73 65 63 ult res curr-sec 1290: 74 69 6f 6e 2d 6e 61 6d 65 20 27 28 29 29 29 29 tion-name '()))) 12a0: 0a 09 09 09 09 09 09 28 69 66 20 76 61 72 2d 66 .......(if var-f 12b0: 6c 61 67 20 20 20 20 20 20 20 20 20 20 20 20 20 lag 12c0: 3b 3b 20 69 66 20 73 65 74 20 74 6f 20 61 20 73 ;; if set to a s 12d0: 74 72 69 6e 67 20 74 68 65 6e 20 77 65 20 68 61 tring then we ha 12e0: 76 65 20 61 20 63 6f 6e 74 69 6e 75 65 64 20 76 ve a continued v 12f0: 61 72 0a 09 09 09 09 09 09 20 20 20 20 28 6c 65 ar....... (le 1300: 74 20 28 28 6e 65 77 76 61 6c 20 28 63 6f 6e 63 t ((newval (conc 1310: 20 0a 09 09 09 09 09 09 09 09 20 20 20 28 63 6f ......... (co 1320: 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 72 65 73 20 nfig-lookup res 1330: 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d curr-section-nam 1340: 65 20 76 61 72 2d 66 6c 61 67 29 20 22 5c 6e 22 e var-flag) "\n" 1350: 0a 09 09 09 09 09 09 09 09 20 20 20 3b 3b 20 74 ......... ;; t 1360: 72 69 6d 20 6c 65 61 64 20 66 72 6f 6d 20 74 68 rim lead from th 1370: 65 20 69 6e 63 6f 6d 69 6e 67 20 77 68 73 70 20 e incoming whsp 1380: 74 6f 20 73 75 70 70 6f 72 74 20 73 6f 6d 65 20 to support some 1390: 69 6e 64 65 6e 74 69 6e 67 2e 0a 09 09 09 09 09 indenting....... 13a0: 09 09 09 20 20 20 28 69 66 20 6c 65 61 64 0a 09 ... (if lead.. 13b0: 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 73 ....... (s 13c0: 74 72 69 6e 67 2d 73 75 62 73 74 69 74 75 74 65 tring-substitute 13d0: 20 28 72 65 67 65 78 70 20 6c 65 61 64 29 20 22 (regexp lead) " 13e0: 22 20 77 68 73 70 29 0a 09 09 09 09 09 09 09 09 " whsp)......... 13f0: 20 20 20 20 20 20 20 22 22 29 0a 09 09 09 09 09 "")...... 1400: 09 09 09 20 20 20 76 61 6c 29 29 29 0a 09 09 09 ... val))).... 1410: 09 09 09 20 20 20 20 20 20 3b 3b 20 28 70 72 69 ... ;; (pri 1420: 6e 74 20 22 76 61 6c 3a 20 22 20 76 61 6c 20 22 nt "val: " val " 1430: 5c 6e 6e 65 77 76 61 6c 3a 20 5c 22 22 20 6e 65 \nnewval: \"" ne 1440: 77 76 61 6c 20 22 5c 22 5c 6e 76 61 72 66 6c 61 wval "\"\nvarfla 1450: 67 3a 20 22 20 76 61 72 2d 66 6c 61 67 29 0a 09 g: " var-flag).. 1460: 09 09 09 09 09 20 20 20 20 20 20 28 68 61 73 68 ..... (hash 1470: 2d 74 61 62 6c 65 2d 73 65 74 21 20 72 65 73 20 -table-set! res 1480: 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d curr-section-nam 1490: 65 20 0a 09 09 09 09 09 09 09 09 20 20 20 20 20 e ......... 14a0: 20 20 28 63 6f 6e 66 69 67 3a 61 73 73 6f 63 2d (config:assoc- 14b0: 73 61 66 65 2d 61 64 64 20 61 6c 69 73 74 20 76 safe-add alist v 14c0: 61 72 2d 66 6c 61 67 20 6e 65 77 76 61 6c 29 29 ar-flag newval)) 14d0: 0a 09 09 09 09 09 09 20 20 20 20 20 20 28 6c 6f ....... (lo 14e0: 6f 70 20 28 72 65 61 64 2d 6c 69 6e 65 20 69 6e op (read-line in 14f0: 70 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d p) curr-section- 1500: 6e 61 6d 65 20 76 61 72 2d 66 6c 61 67 20 28 69 name var-flag (i 1510: 66 20 6c 65 61 64 20 6c 65 61 64 20 77 68 73 70 f lead lead whsp 1520: 29 29 29 0a 09 09 09 09 09 09 20 20 20 20 28 6c )))....... (l 1530: 6f 6f 70 20 28 72 65 61 64 2d 6c 69 6e 65 20 69 oop (read-line i 1540: 6e 70 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e np) curr-section 1550: 2d 6e 61 6d 65 20 23 66 20 23 66 29 29 29 29 0a -name #f #f)))). 1560: 09 20 20 20 20 20 20 20 28 65 6c 73 65 20 28 64 . (else (d 1570: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 ebug:print 0 "ER 1580: 52 4f 52 3a 20 70 72 6f 62 6c 65 6d 20 70 61 72 ROR: problem par 1590: 73 69 6e 67 20 22 20 70 61 74 68 20 22 2c 5c 6e sing " path ",\n 15a0: 20 20 20 5c 22 22 20 69 6e 6c 20 22 5c 22 22 29 \"" inl "\"") 15b0: 0a 09 09 20 20 20 20 20 28 73 65 74 21 20 76 61 ... (set! va 15c0: 72 2d 66 6c 61 67 20 23 66 29 0a 09 09 20 20 20 r-flag #f)... 15d0: 20 20 28 6c 6f 6f 70 20 28 72 65 61 64 2d 6c 69 (loop (read-li 15e0: 6e 65 20 69 6e 70 29 20 63 75 72 72 2d 73 65 63 ne inp) curr-sec 15f0: 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 66 29 tion-name #f #f) 1600: 29 29 29 29 29 29 29 0a 20 20 0a 28 64 65 66 69 ))))))). .(defi 1610: 6e 65 20 28 66 69 6e 64 2d 61 6e 64 2d 72 65 61 ne (find-and-rea 1620: 64 2d 63 6f 6e 66 69 67 20 66 6e 61 6d 65 20 23 d-config fname # 1630: 21 6b 65 79 20 28 65 6e 76 69 72 6f 6e 2d 70 61 !key (environ-pa 1640: 74 74 20 23 66 29 29 0a 20 20 28 6c 65 74 2a 20 tt #f)). (let* 1650: 28 28 63 75 72 72 2d 64 69 72 20 20 20 28 63 75 ((curr-dir (cu 1660: 72 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 rrent-directory) 1670: 29 0a 20 20 20 20 20 20 20 20 20 28 63 6f 6e 66 ). (conf 1680: 69 67 69 6e 66 6f 20 28 66 69 6e 64 2d 63 6f 6e iginfo (find-con 1690: 66 69 67 20 66 6e 61 6d 65 29 29 0a 09 20 28 74 fig fname)).. (t 16a0: 6f 70 70 61 74 68 20 20 20 20 28 63 61 72 20 63 oppath (car c 16b0: 6f 6e 66 69 67 69 6e 66 6f 29 29 0a 09 20 28 63 onfiginfo)).. (c 16c0: 6f 6e 66 69 67 66 69 6c 65 20 28 63 61 64 72 20 onfigfile (cadr 16d0: 63 6f 6e 66 69 67 69 6e 66 6f 29 29 29 0a 20 20 configinfo))). 16e0: 20 20 28 69 66 20 74 6f 70 70 61 74 68 20 28 63 (if toppath (c 16f0: 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 hange-directory 1700: 74 6f 70 70 61 74 68 29 29 20 0a 20 20 20 20 28 toppath)) . ( 1710: 6c 65 74 20 28 28 63 6f 6e 66 69 67 64 61 74 20 let ((configdat 1720: 20 28 69 66 20 63 6f 6e 66 69 67 66 69 6c 65 20 (if configfile 1730: 28 72 65 61 64 2d 63 6f 6e 66 69 67 20 63 6f 6e (read-config con 1740: 66 69 67 66 69 6c 65 20 23 66 20 23 74 20 65 6e figfile #f #t en 1750: 76 69 72 6f 6e 2d 70 61 74 74 3a 20 65 6e 76 69 viron-patt: envi 1760: 72 6f 6e 2d 70 61 74 74 29 20 23 66 29 29 29 20 ron-patt) #f))) 1770: 3b 3b 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 ;; (make-hash-ta 1780: 62 6c 65 29 29 29 29 0a 20 20 20 20 20 20 28 69 ble)))). (i 1790: 66 20 74 6f 70 70 61 74 68 20 28 63 68 61 6e 67 f toppath (chang 17a0: 65 2d 64 69 72 65 63 74 6f 72 79 20 63 75 72 72 e-directory curr 17b0: 2d 64 69 72 29 29 0a 20 20 20 20 20 20 28 6c 69 -dir)). (li 17c0: 73 74 20 63 6f 6e 66 69 67 64 61 74 20 74 6f 70 st configdat top 17d0: 70 61 74 68 20 63 6f 6e 66 69 67 66 69 6c 65 20 path configfile 17e0: 66 6e 61 6d 65 29 29 29 29 0a 0a 28 64 65 66 69 fname))))..(defi 17f0: 6e 65 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 ne (config-looku 1800: 70 20 63 66 67 64 61 74 20 73 65 63 74 69 6f 6e p cfgdat section 1810: 20 76 61 72 29 0a 20 20 28 6c 65 74 20 28 28 73 var). (let ((s 1820: 65 63 74 64 61 74 20 28 68 61 73 68 2d 74 61 62 ectdat (hash-tab 1830: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 63 le-ref/default c 1840: 66 67 64 61 74 20 73 65 63 74 69 6f 6e 20 27 28 fgdat section '( 1850: 29 29 29 29 0a 20 20 20 20 28 69 66 20 28 6e 75 )))). (if (nu 1860: 6c 6c 3f 20 73 65 63 74 64 61 74 29 0a 09 23 66 ll? sectdat)..#f 1870: 0a 09 28 6c 65 74 20 28 28 6d 61 74 63 68 20 28 ..(let ((match ( 1880: 61 73 73 6f 63 20 76 61 72 20 73 65 63 74 64 61 assoc var sectda 1890: 74 29 29 29 0a 09 20 20 28 69 66 20 6d 61 74 63 t))).. (if matc 18a0: 68 0a 09 20 20 20 20 20 20 28 63 61 64 72 20 6d h.. (cadr m 18b0: 61 74 63 68 29 0a 09 20 20 20 20 20 20 23 66 29 atch).. #f) 18c0: 29 0a 09 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 )..)))..(define 18d0: 28 63 6f 6e 66 69 67 66 3a 73 65 63 74 69 6f 6e (configf:section 18e0: 2d 76 61 72 73 20 63 66 67 64 61 74 20 73 65 63 -vars cfgdat sec 18f0: 74 69 6f 6e 29 0a 20 20 28 6c 65 74 20 28 28 73 tion). (let ((s 1900: 65 63 74 64 61 74 20 28 68 61 73 68 2d 74 61 62 ectdat (hash-tab 1910: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 63 le-ref/default c 1920: 66 67 64 61 74 20 73 65 63 74 69 6f 6e 20 27 28 fgdat section '( 1930: 29 29 29 29 0a 20 20 20 20 28 69 66 20 28 6e 75 )))). (if (nu 1940: 6c 6c 3f 20 73 65 63 74 64 61 74 29 0a 09 27 28 ll? sectdat)..'( 1950: 29 0a 09 28 6d 61 70 20 63 61 72 20 73 65 63 74 )..(map car sect 1960: 64 61 74 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 dat))))..(define 1970: 20 28 73 65 74 75 70 29 0a 20 20 28 6c 65 74 2a (setup). (let* 1980: 20 28 28 63 6f 6e 66 69 67 66 20 28 66 69 6e 64 ((configf (find 1990: 2d 63 6f 6e 66 69 67 29 29 0a 09 20 28 63 6f 6e -config)).. (con 19a0: 66 69 67 20 20 28 69 66 20 63 6f 6e 66 69 67 66 fig (if configf 19b0: 20 28 72 65 61 64 2d 63 6f 6e 66 69 67 20 63 6f (read-config co 19c0: 6e 66 69 67 66 20 23 66 20 23 74 29 20 23 66 29 nfigf #f #t) #f) 19d0: 29 29 0a 20 20 20 20 28 69 66 20 63 6f 6e 66 69 )). (if confi 19e0: 67 0a 09 28 73 65 74 65 6e 76 20 22 52 55 4e 5f g..(setenv "RUN_ 19f0: 41 52 45 41 5f 48 4f 4d 45 22 20 28 70 61 74 68 AREA_HOME" (path 1a00: 6e 61 6d 65 2d 64 69 72 65 63 74 6f 72 79 20 63 name-directory c 1a10: 6f 6e 66 69 67 66 29 29 29 0a 20 20 20 20 63 6f onfigf))). co 1a20: 6e 66 69 67 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d nfig))..;;====== 1a30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1a40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1a50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1a60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1a70: 0a 3b 3b 20 4e 6f 6e 20 64 65 73 74 72 75 63 74 .;; Non destruct 1a80: 69 76 65 20 77 72 69 74 69 6e 67 20 6f 66 20 63 ive writing of c 1a90: 6f 6e 66 69 67 20 66 69 6c 65 0a 3b 3b 3d 3d 3d onfig file.;;=== 1aa0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1ab0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1ac0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1ad0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1ae0: 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f ===..(define (co 1af0: 6e 66 69 67 66 3a 63 6f 6d 70 72 65 73 73 2d 6d nfigf:compress-m 1b00: 75 6c 74 69 2d 6c 69 6e 65 73 20 66 64 61 74 29 ulti-lines fdat) 1b10: 0a 20 20 3b 3b 20 73 74 65 70 20 31 2e 35 20 2d . ;; step 1.5 - 1b20: 20 63 6f 6d 70 72 65 73 73 20 61 6e 79 20 63 6f compress any co 1b30: 6e 74 69 6e 75 65 64 20 6c 69 6e 65 73 0a 20 20 ntinued lines. 1b40: 28 69 66 20 28 6e 75 6c 6c 3f 20 66 64 61 74 29 (if (null? fdat) 1b50: 20 66 64 61 74 0a 09 28 6c 65 74 20 6c 6f 6f 70 fdat..(let loop 1b60: 20 28 28 68 65 64 20 28 63 61 72 20 66 64 61 74 ((hed (car fdat 1b70: 29 29 0a 09 09 20 20 20 28 74 61 6c 20 28 63 64 ))... (tal (cd 1b80: 72 20 66 64 61 74 29 29 0a 09 09 20 20 20 28 63 r fdat))... (c 1b90: 75 72 20 22 22 29 0a 09 09 20 20 20 28 6c 65 64 ur "")... (led 1ba0: 20 23 66 29 0a 09 09 20 20 20 28 72 65 73 20 27 #f)... (res ' 1bb0: 28 29 29 29 0a 09 20 20 3b 3b 20 41 4c 4c 20 57 ())).. ;; ALL W 1bc0: 48 49 54 45 53 50 41 43 45 20 4c 45 41 44 49 4e HITESPACE LEADIN 1bd0: 47 20 4c 49 4e 45 53 20 41 52 45 20 54 41 43 4b G LINES ARE TACK 1be0: 45 44 20 4f 4e 21 21 0a 09 20 20 3b 3b 20 20 31 ED ON!!.. ;; 1 1bf0: 2e 20 72 65 6d 6f 76 65 20 6c 65 64 20 77 68 69 . remove led whi 1c00: 74 65 73 70 61 63 65 0a 09 20 20 3b 3b 20 20 32 tespace.. ;; 2 1c10: 2e 20 74 61 63 6b 20 6f 6e 20 74 6f 20 68 65 64 . tack on to hed 1c20: 20 77 69 74 68 20 22 5c 6e 22 0a 09 20 20 28 6c with "\n".. (l 1c30: 65 74 20 28 28 6d 61 74 63 68 20 28 73 74 72 69 et ((match (stri 1c40: 6e 67 2d 6d 61 74 63 68 20 63 6f 6e 74 2d 6c 6e ng-match cont-ln 1c50: 2d 72 78 20 68 65 64 29 29 29 0a 09 20 20 20 20 -rx hed))).. 1c60: 28 69 66 20 6d 61 74 63 68 20 3b 3b 20 62 6c 61 (if match ;; bla 1c70: 73 74 21 20 68 61 76 65 20 74 6f 20 64 65 61 6c st! have to deal 1c80: 20 77 69 74 68 20 61 20 6d 75 6c 74 69 6c 69 6e with a multilin 1c90: 65 0a 09 09 28 6c 65 74 2a 20 28 28 6c 65 61 64 e...(let* ((lead 1ca0: 20 28 63 61 64 72 20 6d 61 74 63 68 29 29 0a 09 (cadr match)).. 1cb0: 09 20 20 20 20 20 20 20 28 6c 76 61 6c 20 28 63 . (lval (c 1cc0: 61 64 64 72 20 6d 61 74 63 68 29 29 0a 09 09 20 addr match))... 1cd0: 20 20 20 20 20 20 28 6e 65 77 6c 20 28 63 6f 6e (newl (con 1ce0: 63 20 63 75 72 20 22 5c 6e 22 20 6c 76 61 6c 29 c cur "\n" lval) 1cf0: 29 29 0a 09 09 20 20 28 69 66 20 28 6e 6f 74 20 ))... (if (not 1d00: 6c 65 64 29 28 73 65 74 21 20 6c 65 64 20 6c 65 led)(set! led le 1d10: 61 64 29 29 0a 09 09 20 20 28 69 66 20 28 6e 75 ad))... (if (nu 1d20: 6c 6c 3f 20 74 61 6c 29 20 0a 09 09 20 20 20 20 ll? tal) ... 1d30: 20 20 28 73 65 74 21 20 66 64 61 74 20 28 61 70 (set! fdat (ap 1d40: 70 65 6e 64 20 66 64 61 74 20 28 6c 69 73 74 20 pend fdat (list 1d50: 6e 65 77 6c 29 29 29 0a 09 09 20 20 20 20 20 20 newl)))... 1d60: 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 28 (loop (car tal)( 1d70: 63 64 72 20 74 61 6c 29 20 6e 65 77 6c 20 6c 65 cdr tal) newl le 1d80: 64 20 72 65 73 29 29 29 20 3b 3b 20 4e 42 2f 2f d res))) ;; NB// 1d90: 20 6e 6f 74 20 74 61 63 6b 69 6e 67 20 6e 65 77 not tacking new 1da0: 6c 20 6f 6e 74 6f 20 72 65 73 0a 09 09 28 6c 65 l onto res...(le 1db0: 74 20 28 28 6e 65 77 72 65 73 20 28 69 66 20 6c t ((newres (if l 1dc0: 65 64 20 0a 09 09 09 09 20 20 28 61 70 70 65 6e ed ..... (appen 1dd0: 64 20 72 65 73 20 28 6c 69 73 74 20 63 75 72 20 d res (list cur 1de0: 68 65 64 29 29 0a 09 09 09 09 20 20 28 61 70 70 hed))..... (app 1df0: 65 6e 64 20 72 65 73 20 28 6c 69 73 74 20 68 65 end res (list he 1e00: 64 29 29 29 29 29 0a 09 09 20 20 3b 3b 20 70 72 d)))))... ;; pr 1e10: 65 76 20 77 61 73 20 61 20 6d 75 6c 74 69 6c 69 ev was a multili 1e20: 6e 65 0a 09 09 20 20 28 69 66 20 28 6e 75 6c 6c ne... (if (null 1e30: 3f 20 74 61 6c 29 0a 09 09 20 20 20 20 20 20 6e ? tal)... n 1e40: 65 77 72 65 73 0a 09 09 20 20 20 20 20 20 28 6c ewres... (l 1e50: 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 28 63 64 oop (car tal)(cd 1e60: 72 20 74 61 6c 29 20 22 22 20 23 66 20 6e 65 77 r tal) "" #f new 1e70: 72 65 73 29 29 29 29 29 29 29 29 0a 0a 28 64 65 res))))))))..(de 1e80: 66 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a 65 78 fine (configf:ex 1e90: 70 61 6e 64 2d 6d 75 6c 74 69 2d 6c 69 6e 65 73 pand-multi-lines 1ea0: 20 66 64 61 74 29 0a 20 20 3b 3b 20 73 74 65 70 fdat). ;; step 1eb0: 20 31 2e 35 20 2d 20 63 6f 6d 70 72 65 73 73 20 1.5 - compress 1ec0: 61 6e 79 20 63 6f 6e 74 69 6e 75 65 64 20 6c 69 any continued li 1ed0: 6e 65 73 0a 20 20 28 69 66 20 28 6e 75 6c 6c 3f nes. (if (null? 1ee0: 20 66 64 61 74 29 20 66 64 61 74 0a 09 28 6c 65 fdat) fdat..(le 1ef0: 74 20 6c 6f 6f 70 20 28 28 68 65 64 20 28 63 61 t loop ((hed (ca 1f00: 72 20 66 64 61 74 29 29 0a 09 09 20 20 20 28 74 r fdat))... (t 1f10: 61 6c 20 28 63 64 72 20 66 64 61 74 29 29 0a 09 al (cdr fdat)).. 1f20: 09 20 20 20 28 63 75 72 20 22 22 29 0a 09 09 20 . (cur "")... 1f30: 20 20 28 6c 65 64 20 23 66 29 0a 09 09 20 20 20 (led #f)... 1f40: 28 72 65 73 20 27 28 29 29 29 0a 09 20 20 3b 3b (res '())).. ;; 1f50: 20 41 4c 4c 20 57 48 49 54 45 53 50 41 43 45 20 ALL WHITESPACE 1f60: 4c 45 41 44 49 4e 47 20 4c 49 4e 45 53 20 41 52 LEADING LINES AR 1f70: 45 20 54 41 43 4b 45 44 20 4f 4e 21 21 0a 09 20 E TACKED ON!!.. 1f80: 20 3b 3b 20 20 31 2e 20 72 65 6d 6f 76 65 20 6c ;; 1. remove l 1f90: 65 64 20 77 68 69 74 65 73 70 61 63 65 0a 09 20 ed whitespace.. 1fa0: 20 3b 3b 20 20 32 2e 20 74 61 63 6b 20 6f 6e 20 ;; 2. tack on 1fb0: 74 6f 20 68 65 64 20 77 69 74 68 20 22 5c 6e 22 to hed with "\n" 1fc0: 0a 09 20 20 28 6c 65 74 20 28 28 6d 61 74 63 68 .. (let ((match 1fd0: 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 63 (string-match c 1fe0: 6f 6e 74 2d 6c 6e 2d 72 78 20 68 65 64 29 29 29 ont-ln-rx hed))) 1ff0: 0a 09 20 20 20 20 28 69 66 20 6d 61 74 63 68 20 .. (if match 2000: 3b 3b 20 62 6c 61 73 74 21 20 68 61 76 65 20 74 ;; blast! have t 2010: 6f 20 64 65 61 6c 20 77 69 74 68 20 61 20 6d 75 o deal with a mu 2020: 6c 74 69 6c 69 6e 65 0a 09 09 28 6c 65 74 2a 20 ltiline...(let* 2030: 28 28 6c 65 61 64 20 28 63 61 64 72 20 6d 61 74 ((lead (cadr mat 2040: 63 68 29 29 0a 09 09 20 20 20 20 20 20 20 28 6c ch))... (l 2050: 76 61 6c 20 28 63 61 64 64 72 20 6d 61 74 63 68 val (caddr match 2060: 29 29 0a 09 09 20 20 20 20 20 20 20 28 6e 65 77 ))... (new 2070: 6c 20 28 63 6f 6e 63 20 63 75 72 20 22 5c 6e 22 l (conc cur "\n" 2080: 20 6c 76 61 6c 29 29 29 0a 09 09 20 20 28 69 66 lval)))... (if 2090: 20 28 6e 6f 74 20 6c 65 64 29 28 73 65 74 21 20 (not led)(set! 20a0: 6c 65 64 20 6c 65 61 64 29 29 0a 09 09 20 20 28 led lead))... ( 20b0: 69 66 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 20 0a if (null? tal) . 20c0: 09 09 20 20 20 20 20 20 28 73 65 74 21 20 66 64 .. (set! fd 20d0: 61 74 20 28 61 70 70 65 6e 64 20 66 64 61 74 20 at (append fdat 20e0: 28 6c 69 73 74 20 6e 65 77 6c 29 29 29 0a 09 09 (list newl)))... 20f0: 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 (loop (car 2100: 20 74 61 6c 29 28 63 64 72 20 74 61 6c 29 20 6e tal)(cdr tal) n 2110: 65 77 6c 20 6c 65 64 20 72 65 73 29 29 29 20 3b ewl led res))) ; 2120: 3b 20 4e 42 2f 2f 20 6e 6f 74 20 74 61 63 6b 69 ; NB// not tacki 2130: 6e 67 20 6e 65 77 6c 20 6f 6e 74 6f 20 72 65 73 ng newl onto res 2140: 0a 09 09 28 6c 65 74 20 28 28 6e 65 77 72 65 73 ...(let ((newres 2150: 20 28 69 66 20 6c 65 64 20 0a 09 09 09 09 20 20 (if led ..... 2160: 28 61 70 70 65 6e 64 20 72 65 73 20 28 6c 69 73 (append res (lis 2170: 74 20 63 75 72 20 68 65 64 29 29 0a 09 09 09 09 t cur hed))..... 2180: 20 20 28 61 70 70 65 6e 64 20 72 65 73 20 28 6c (append res (l 2190: 69 73 74 20 68 65 64 29 29 29 29 29 0a 09 09 20 ist hed)))))... 21a0: 20 3b 3b 20 70 72 65 76 20 77 61 73 20 61 20 6d ;; prev was a m 21b0: 75 6c 74 69 6c 69 6e 65 0a 09 09 20 20 28 69 66 ultiline... (if 21c0: 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 0a 09 09 20 (null? tal)... 21d0: 20 20 20 20 20 6e 65 77 72 65 73 0a 09 09 20 20 newres... 21e0: 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 74 (loop (car t 21f0: 61 6c 29 28 63 64 72 20 74 61 6c 29 20 22 22 20 al)(cdr tal) "" 2200: 23 66 20 6e 65 77 72 65 73 29 29 29 29 29 29 29 #f newres))))))) 2210: 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 )..(define (conf 2220: 69 67 66 3a 66 69 6c 65 2d 3e 6c 69 73 74 20 66 igf:file->list f 2230: 6e 61 6d 65 29 0a 20 20 28 69 66 20 28 66 69 6c name). (if (fil 2240: 65 2d 65 78 69 73 74 73 3f 20 66 6e 61 6d 65 29 e-exists? fname) 2250: 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 69 6e . (let ((in 2260: 70 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 66 69 p (open-input-fi 2270: 6c 65 20 66 6e 61 6d 65 29 29 29 0a 09 28 6c 65 le fname)))..(le 2280: 74 20 6c 6f 6f 70 20 28 28 69 6e 6c 20 28 72 65 t loop ((inl (re 2290: 61 64 2d 6c 69 6e 65 20 69 6e 70 29 29 0a 09 09 ad-line inp))... 22a0: 20 20 20 28 72 65 73 20 27 28 29 29 29 0a 09 20 (res '())).. 22b0: 20 28 69 66 20 28 65 6f 66 2d 6f 62 6a 65 63 74 (if (eof-object 22c0: 3f 20 69 6e 6c 29 0a 09 20 20 20 20 20 20 28 62 ? inl).. (b 22d0: 65 67 69 6e 0a 09 09 28 63 6c 6f 73 65 2d 69 6e egin...(close-in 22e0: 70 75 74 2d 70 6f 72 74 20 69 6e 70 29 0a 09 09 put-port inp)... 22f0: 28 72 65 76 65 72 73 65 20 72 65 73 29 29 0a 09 (reverse res)).. 2300: 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 72 65 61 (loop (rea 2310: 64 2d 6c 69 6e 65 20 69 6e 70 29 28 63 6f 6e 73 d-line inp)(cons 2320: 20 69 6e 6c 29 29 29 29 29 0a 20 20 20 20 20 20 inl))))). 2330: 27 28 29 29 29 0a 0a 3b 3b 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 3d 3d 3d 3d 3d ================ 2360: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 2370: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============. 2380: 3b 3b 20 57 72 69 74 65 20 61 20 63 6f 6e 66 69 ;; Write a confi 2390: 67 0a 3b 3b 20 20 20 30 2e 20 47 69 76 65 6e 20 g.;; 0. Given 23a0: 61 20 72 65 66 65 72 65 72 65 6e 63 65 20 64 61 a refererence da 23b0: 74 61 20 73 74 72 75 63 74 75 72 65 20 22 69 6e ta structure "in 23c0: 64 61 74 22 0a 3b 3b 20 20 20 31 2e 20 4f 70 65 dat".;; 1. Ope 23d0: 6e 20 74 68 65 20 6f 75 74 70 75 74 20 66 69 6c n the output fil 23e0: 65 20 61 6e 64 20 72 65 61 64 20 69 74 20 69 6e e and read it in 23f0: 74 6f 20 61 20 6c 69 73 74 0a 3b 3b 20 20 20 32 to a list.;; 2 2400: 2e 20 46 6c 61 74 74 65 6e 20 61 6e 79 20 6d 75 . Flatten any mu 2410: 6c 74 69 6c 69 6e 65 20 65 6e 74 72 69 65 73 0a ltiline entries. 2420: 3b 3b 20 20 20 33 2e 20 4d 6f 64 69 66 79 20 76 ;; 3. Modify v 2430: 61 6c 75 65 73 20 70 65 72 20 63 6f 6e 74 65 6e alues per conten 2440: 74 73 20 6f 66 20 22 69 6e 64 61 74 22 20 61 6e ts of "indat" an 2450: 64 20 72 65 6d 6f 76 65 20 61 62 73 65 6e 74 20 d remove absent 2460: 76 61 6c 75 65 73 0a 3b 3b 20 20 20 34 2e 20 41 values.;; 4. A 2470: 70 70 65 6e 64 20 6e 65 77 20 76 61 6c 75 65 73 ppend new values 2480: 20 74 6f 20 74 68 65 20 73 65 63 74 69 6f 6e 20 to the section 2490: 28 69 6d 6d 65 64 69 61 74 65 6c 79 20 61 66 74 (immediately aft 24a0: 65 72 20 6c 61 73 74 20 6c 65 67 69 74 20 65 6e er last legit en 24b0: 74 72 79 29 0a 3b 3b 20 20 20 35 2e 20 57 72 69 try).;; 5. Wri 24c0: 74 65 20 6f 75 74 20 74 68 65 20 6e 65 77 20 6c te out the new l 24d0: 69 73 74 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d ist .;;========= 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 3d 3d 3d 3d 3d 3d 3d ================ 2500: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 2510: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 =============..( 2520: 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a define (configf: 2530: 77 72 69 74 65 2d 63 6f 6e 66 69 67 20 69 6e 64 write-config ind 2540: 61 74 20 66 6e 61 6d 65 20 23 21 6b 65 79 20 28 at fname #!key ( 2550: 72 65 71 75 69 72 65 64 2d 73 65 63 74 69 6f 6e required-section 2560: 73 20 27 28 29 29 29 0a 20 20 28 6c 65 74 2a 20 s '())). (let* 2570: 28 28 69 6e 63 6c 75 64 65 2d 72 78 20 28 72 65 ((include-rx (re 2580: 67 65 78 70 20 22 5e 5c 5c 5b 69 6e 63 6c 75 64 gexp "^\\[includ 2590: 65 5c 5c 73 2b 28 2e 2a 29 5c 5c 5d 5c 5c 73 2a e\\s+(.*)\\]\\s* 25a0: 24 22 29 29 0a 09 20 28 73 65 63 74 69 6f 6e 2d $")).. (section- 25b0: 72 78 20 28 72 65 67 65 78 70 20 22 5e 5c 5c 5b rx (regexp "^\\[ 25c0: 28 2e 2a 29 5c 5c 5d 5c 5c 73 2a 24 22 29 29 0a (.*)\\]\\s*$")). 25d0: 09 20 28 62 6c 61 6e 6b 2d 6c 2d 72 78 20 28 72 . (blank-l-rx (r 25e0: 65 67 65 78 70 20 22 5e 5c 5c 73 2a 24 22 29 29 egexp "^\\s*$")) 25f0: 0a 09 20 28 6b 65 79 2d 73 79 73 2d 70 72 20 28 .. (key-sys-pr ( 2600: 72 65 67 65 78 70 20 22 5e 28 5c 5c 53 2b 29 5c regexp "^(\\S+)\ 2610: 5c 73 2b 5c 5c 5b 73 79 73 74 65 6d 5c 5c 73 2b \s+\\[system\\s+ 2620: 28 5c 5c 53 2b 2e 2a 29 5c 5c 5d 5c 5c 73 2a 24 (\\S+.*)\\]\\s*$ 2630: 22 29 29 0a 09 20 28 6b 65 79 2d 76 61 6c 2d 70 ")).. (key-val-p 2640: 72 20 28 72 65 67 65 78 70 20 22 5e 28 5c 5c 53 r (regexp "^(\\S 2650: 2b 29 5c 5c 73 2b 28 2e 2a 29 24 22 29 29 0a 09 +)\\s+(.*)$")).. 2660: 20 28 63 6f 6d 6d 65 6e 74 2d 72 78 20 28 72 65 (comment-rx (re 2670: 67 65 78 70 20 22 5e 5c 5c 73 2a 23 2e 2a 22 29 gexp "^\\s*#.*") 2680: 29 0a 09 20 28 63 6f 6e 74 2d 6c 6e 2d 72 78 20 ).. (cont-ln-rx 2690: 28 72 65 67 65 78 70 20 22 5e 28 5c 5c 73 2b 29 (regexp "^(\\s+) 26a0: 28 5c 5c 53 2b 2e 2a 29 24 22 29 29 0a 09 20 3b (\\S+.*)$")).. ; 26b0: 3b 20 73 74 65 70 20 31 3a 20 4f 70 65 6e 20 74 ; step 1: Open t 26c0: 68 65 20 6f 75 74 70 75 74 20 66 69 6c 65 20 61 he output file a 26d0: 6e 64 20 72 65 61 64 20 69 74 20 69 6e 74 6f 20 nd read it into 26e0: 61 20 6c 69 73 74 0a 09 20 28 66 64 61 74 20 20 a list.. (fdat 26f0: 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 66 69 (configf:fi 2700: 6c 65 2d 3e 6c 69 73 74 20 66 6e 61 6d 65 29 29 le->list fname)) 2710: 0a 09 20 28 72 65 66 64 61 74 20 20 28 6d 61 6b .. (refdat (mak 2720: 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a 09 e-hash-table)).. 2730: 20 28 73 65 63 68 61 73 68 20 28 6d 61 6b 65 2d (sechash (make- 2740: 68 61 73 68 2d 74 61 62 6c 65 29 29 20 3b 3b 20 hash-table)) ;; 2750: 63 75 72 72 65 6e 74 20 73 65 63 74 69 6f 6e 20 current section 2760: 68 61 73 68 2c 20 69 6e 69 74 20 77 69 74 68 20 hash, init with 2770: 68 61 73 68 20 66 6f 72 20 22 64 65 66 61 75 6c hash for "defaul 2780: 74 22 20 73 65 63 74 69 6f 6e 0a 09 20 28 6e 65 t" section.. (ne 2790: 77 20 20 20 20 20 23 66 29 29 20 3b 3b 20 70 75 w #f)) ;; pu 27a0: 74 20 74 68 65 20 6c 69 6e 65 20 74 6f 20 62 65 t the line to be 27b0: 20 75 73 65 64 20 69 6e 20 6e 65 77 2c 20 69 66 used in new, if 27c0: 20 69 74 20 69 73 20 74 6f 20 62 65 20 64 65 6c it is to be del 27d0: 65 74 65 64 20 74 68 65 20 73 65 74 20 6e 65 77 eted the set new 27e0: 20 74 6f 20 23 66 0a 0a 20 20 20 20 3b 3b 20 73 to #f.. ;; s 27f0: 74 65 70 20 32 3a 20 46 6c 61 74 74 65 6e 20 6d tep 2: Flatten m 2800: 75 6c 74 69 6c 69 6e 65 20 65 6e 74 72 69 65 73 ultiline entries 2810: 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6e . (if (not (n 2820: 75 6c 6c 3f 20 66 64 61 74 29 29 28 73 65 74 21 ull? fdat))(set! 2830: 20 66 64 61 74 20 28 63 6f 6e 66 69 67 66 3a 63 fdat (configf:c 2840: 6f 6d 70 72 65 73 73 2d 6d 75 6c 74 69 2d 6c 69 ompress-multi-li 2850: 6e 65 20 66 64 61 74 29 29 29 0a 0a 20 20 20 20 ne fdat))).. 2860: 3b 3b 20 73 74 65 70 20 33 3a 20 4d 6f 64 69 66 ;; step 3: Modif 2870: 79 20 76 61 6c 75 65 73 20 70 65 72 20 63 6f 6e y values per con 2880: 74 65 6e 74 73 20 6f 66 20 22 69 6e 64 61 74 22 tents of "indat" 2890: 20 61 6e 64 20 72 65 6d 6f 76 65 20 61 62 73 65 and remove abse 28a0: 6e 74 20 76 61 6c 75 65 73 0a 20 20 20 20 28 69 nt values. (i 28b0: 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 66 64 f (not (null? fd 28c0: 61 74 29 29 0a 09 28 6c 65 74 20 6c 6f 6f 70 20 at))..(let loop 28d0: 28 28 68 65 64 20 20 28 63 61 72 20 66 64 61 74 ((hed (car fdat 28e0: 29 29 0a 09 09 20 20 20 28 74 61 6c 20 20 28 63 ))... (tal (c 28f0: 61 64 72 20 66 64 61 74 29 29 0a 09 09 20 20 20 adr fdat))... 2900: 28 72 65 73 20 20 27 28 29 29 0a 09 09 20 20 20 (res '())... 2910: 28 73 65 63 20 20 23 66 29 20 3b 3b 20 73 65 63 (sec #f) ;; sec 2920: 74 69 6f 6e 0a 09 09 20 20 20 28 6c 6e 75 6d 20 tion... (lnum 2930: 30 29 29 0a 09 20 20 28 72 65 67 65 78 2d 63 61 0)).. (regex-ca 2940: 73 65 20 0a 09 20 20 20 68 65 64 0a 09 20 20 20 se .. hed.. 2950: 28 63 6f 6d 6d 65 6e 74 2d 72 78 20 5f 20 20 20 (comment-rx _ 2960: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ( 2970: 73 65 74 21 20 72 65 73 20 28 61 70 70 65 6e 64 set! res (append 2980: 20 72 65 73 20 28 6c 69 73 74 20 68 65 64 29 29 res (list hed)) 2990: 29 29 20 3b 3b 20 28 6c 6f 6f 70 20 28 72 65 61 )) ;; (loop (rea 29a0: 64 2d 6c 69 6e 65 20 69 6e 70 29 20 63 75 72 72 d-line inp) curr 29b0: 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 -section-name #f 29c0: 20 23 66 29 29 0a 09 20 20 20 28 62 6c 61 6e 6b #f)).. (blank 29d0: 2d 6c 2d 72 78 20 5f 20 20 20 20 20 20 20 20 20 -l-rx _ 29e0: 20 20 20 20 20 20 20 20 20 28 73 65 74 21 20 72 (set! r 29f0: 65 73 20 28 61 70 70 65 6e 64 20 72 65 73 20 28 es (append res ( 2a00: 6c 69 73 74 20 68 65 64 29 29 29 29 20 3b 3b 20 list hed)))) ;; 2a10: 28 6c 6f 6f 70 20 28 72 65 61 64 2d 6c 69 6e 65 (loop (read-line 2a20: 20 69 6e 70 29 20 63 75 72 72 2d 73 65 63 74 69 inp) curr-secti 2a30: 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 66 29 29 0a on-name #f #f)). 2a40: 09 20 20 20 28 73 65 63 74 69 6f 6e 2d 72 78 20 . (section-rx 2a50: 28 20 78 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 ( x section-name 2a60: 20 29 20 28 6c 65 74 20 28 28 73 65 63 74 69 6f ) (let ((sectio 2a70: 6e 2d 68 61 73 68 20 28 68 61 73 68 2d 74 61 62 n-hash (hash-tab 2a80: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 72 le-ref/default r 2a90: 65 66 64 61 74 20 73 65 63 74 69 6f 6e 2d 6e 61 efdat section-na 2aa0: 6d 65 20 23 66 29 29 29 0a 09 09 09 09 09 20 20 me #f)))...... 2ab0: 20 20 28 69 66 20 28 6e 6f 74 20 73 65 63 74 69 (if (not secti 2ac0: 6f 6e 2d 68 61 73 68 29 0a 09 09 09 09 09 09 28 on-hash).......( 2ad0: 6c 65 74 20 28 28 6e 65 77 68 61 73 68 20 28 6d let ((newhash (m 2ae0: 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 ake-hash-table)) 2af0: 29 0a 09 09 09 09 09 09 20 20 28 68 61 73 68 2d )....... (hash- 2b00: 74 61 62 6c 65 2d 73 65 74 21 20 72 65 66 68 61 table-set! refha 2b10: 73 68 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 sh section-name 2b20: 6e 65 77 68 61 73 68 29 0a 09 09 09 09 09 09 20 newhash)....... 2b30: 20 28 73 65 74 21 20 73 65 63 68 61 73 68 20 6e (set! sechash n 2b40: 65 77 68 61 73 68 29 29 0a 09 09 09 09 09 09 28 ewhash)).......( 2b50: 73 65 74 21 20 73 65 63 68 61 73 68 20 73 65 63 set! sechash sec 2b60: 74 69 6f 6e 2d 68 61 73 68 29 29 0a 09 09 09 09 tion-hash))..... 2b70: 09 20 20 20 20 28 73 65 74 21 20 6e 65 77 20 68 . (set! new h 2b80: 65 64 29 20 3b 3b 20 77 69 6c 6c 20 61 70 70 65 ed) ;; will appe 2b90: 6e 64 20 74 68 69 73 20 61 74 20 74 68 65 20 62 nd this at the b 2ba0: 6f 74 74 6f 6d 20 6f 66 20 74 68 65 20 6c 6f 6f ottom of the loo 2bb0: 70 0a 09 09 09 09 09 20 20 20 20 28 73 65 74 21 p...... (set! 2bc0: 20 73 65 63 20 73 65 63 74 69 6f 6e 2d 6e 61 6d sec section-nam 2bd0: 65 29 0a 09 09 09 09 09 20 20 20 20 29 29 0a 09 e)...... )).. 2be0: 20 20 20 3b 3b 20 4e 6f 20 6e 65 65 64 20 74 6f ;; No need to 2bf0: 20 70 72 6f 63 65 73 73 20 6b 65 79 20 63 6d 64 process key cmd 2c00: 2c 20 6c 65 74 20 69 74 20 66 61 6c 6c 20 74 68 , let it fall th 2c10: 6f 75 67 68 20 74 6f 20 6b 65 79 20 76 61 6c 0a ough to key val. 2c20: 09 20 20 20 28 6b 65 79 2d 76 61 6c 2d 70 72 20 . (key-val-pr 2c30: 28 20 78 20 6b 65 79 20 76 61 6c 20 20 20 20 20 ( x key val 2c40: 20 29 0a 09 09 20 20 20 20 20 20 20 28 6c 65 74 )... (let 2c50: 20 28 28 6e 65 77 76 61 6c 20 28 63 6f 6e 66 69 ((newval (confi 2c60: 67 2d 6c 6f 6f 6b 75 70 20 69 6e 64 61 74 20 73 g-lookup indat s 2c70: 65 63 20 6b 65 79 29 29 29 0a 09 09 09 20 3b 3b ec key))).... ;; 2c80: 20 63 61 6e 20 68 61 6e 64 6c 65 20 6e 65 77 76 can handle newv 2c90: 61 6c 20 3d 3d 20 23 66 20 68 65 72 65 20 3d 3e al == #f here => 2ca0: 20 74 68 61 74 20 6d 65 61 6e 73 20 6b 65 79 20 that means key 2cb0: 69 73 20 72 65 6d 6f 76 65 64 0a 09 09 09 20 28 is removed.... ( 2cc0: 63 6f 6e 64 20 0a 09 09 09 20 20 28 28 65 71 75 cond .... ((equ 2cd0: 61 6c 3f 20 6e 65 77 76 61 6c 20 76 61 6c 29 0a al? newval val). 2ce0: 09 09 09 20 20 20 28 73 65 74 21 20 72 65 73 20 ... (set! res 2cf0: 28 61 70 70 65 6e 64 20 72 65 73 20 28 6c 69 73 (append res (lis 2d00: 74 20 68 65 64 29 29 29 29 0a 09 09 09 20 20 28 t hed)))).... ( 2d10: 28 6e 6f 74 20 6e 65 77 76 61 6c 29 20 3b 3b 20 (not newval) ;; 2d20: 6b 65 79 20 68 61 73 20 62 65 65 6e 20 72 65 6d key has been rem 2d30: 6f 76 65 64 0a 09 09 09 20 20 20 28 73 65 74 21 oved.... (set! 2d40: 20 6e 65 77 20 23 66 29 29 0a 09 09 09 20 20 28 new #f)).... ( 2d50: 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 6e 65 77 (not (equal? new 2d60: 76 61 6c 20 76 61 6c 29 29 0a 09 09 09 20 20 20 val val)).... 2d70: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 (hash-table-se 2d80: 74 21 20 73 65 63 68 61 73 68 20 6b 65 79 20 6e t! sechash key n 2d90: 65 77 76 61 6c 29 0a 09 09 09 20 20 20 20 20 28 ewval).... ( 2da0: 73 65 74 21 20 6e 65 77 20 28 63 6f 6e 63 20 6b set! new (conc k 2db0: 65 79 20 22 20 22 20 6e 65 77 76 61 6c 29 29 29 ey " " newval))) 2dc0: 0a 09 09 09 20 20 28 65 6c 73 65 0a 09 09 09 20 .... (else.... 2dd0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0 2de0: 20 22 45 52 52 4f 52 3a 20 70 72 6f 62 6c 65 6d "ERROR: problem 2df0: 20 70 61 72 73 69 6e 67 20 6c 69 6e 65 20 6e 75 parsing line nu 2e00: 6d 62 65 72 20 22 20 6c 6e 75 6d 20 22 5c 22 22 mber " lnum "\"" 2e10: 20 68 65 64 20 22 5c 22 22 29 29 29 29 29 0a 09 hed "\""))))).. 2e20: 20 20 20 28 65 6c 73 65 0a 09 20 20 20 20 28 64 (else.. (d 2e30: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 ebug:print 0 "ER 2e40: 52 4f 52 3a 20 50 72 6f 62 6c 65 6d 20 70 61 72 ROR: Problem par 2e50: 73 69 6e 67 20 6c 69 6e 65 20 6e 75 6d 20 22 20 sing line num " 2e60: 6c 6e 75 6d 20 22 20 3a 5c 6e 20 20 20 22 20 68 lnum " :\n " h 2e70: 65 64 20 29 29 29 0a 09 20 20 28 69 66 20 28 6e ed ))).. (if (n 2e80: 6f 74 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 29 0a ot (null? tal)). 2e90: 09 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 . (loop (ca 2ea0: 72 20 74 61 6c 29 28 63 64 72 20 74 61 6c 29 28 r tal)(cdr tal)( 2eb0: 69 66 20 6e 65 77 20 28 61 70 70 65 6e 64 20 72 if new (append r 2ec0: 65 73 20 28 6c 69 73 74 20 6e 65 77 29 29 20 72 es (list new)) r 2ed0: 65 73 29 28 2b 20 6c 6e 75 6d 20 31 29 29 29 0a es)(+ lnum 1))). 2ee0: 09 20 20 3b 3b 20 64 72 6f 70 20 74 6f 20 68 65 . ;; drop to he 2ef0: 72 65 20 77 68 65 6e 20 64 6f 6e 65 20 70 72 6f re when done pro 2f00: 63 65 73 73 69 6e 67 2c 20 72 65 73 20 63 6f 6e cessing, res con 2f10: 74 61 69 6e 73 20 6d 6f 64 69 66 69 65 64 20 6c tains modified l 2f20: 69 73 74 20 6f 66 20 6c 69 6e 65 73 0a 09 20 20 ist of lines.. 2f30: 28 73 65 74 21 20 66 64 61 74 20 72 65 73 29 29 (set! fdat res)) 2f40: 29 0a 0a 20 20 20 20 3b 3b 20 73 74 65 70 20 34 ).. ;; step 4 2f50: 3a 20 41 70 70 65 6e 64 20 6e 65 77 20 76 61 6c : Append new val 2f60: 75 65 73 20 74 6f 20 74 68 65 20 73 65 63 74 69 ues to the secti 2f70: 6f 6e 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 68 on. (for-each 2f80: 20 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 . (lambda ( 2f90: 73 65 63 74 69 6f 6e 29 0a 20 20 20 20 20 20 20 section). 2fa0: 28 6c 65 74 20 28 28 73 64 61 74 20 20 20 27 28 (let ((sdat '( 2fb0: 29 29 20 3b 3b 20 61 70 70 65 6e 64 20 6e 65 65 )) ;; append nee 2fc0: 64 65 64 20 62 69 74 73 20 68 65 72 65 0a 09 20 ded bits here.. 2fd0: 20 20 20 20 28 73 76 61 72 73 20 20 28 63 6f 6e (svars (con 2fe0: 66 69 67 66 3a 73 65 63 74 69 6f 6e 2d 76 61 72 figf:section-var 2ff0: 73 20 69 6e 64 61 74 20 73 65 63 74 69 6f 6e 29 s indat section) 3000: 29 29 0a 09 20 28 66 6f 72 2d 65 61 63 68 20 0a )).. (for-each . 3010: 09 20 20 28 6c 61 6d 62 64 61 20 28 76 61 72 29 . (lambda (var) 3020: 0a 09 20 20 20 20 28 6c 65 74 20 28 28 76 61 6c .. (let ((val 3030: 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 (config-lookup 3040: 72 65 66 64 61 74 20 73 65 63 74 69 6f 6e 20 76 refdat section v 3050: 61 72 29 29 29 0a 09 20 20 20 20 20 20 28 69 66 ar))).. (if 3060: 20 28 6e 6f 74 20 76 61 6c 29 20 3b 3b 20 74 68 (not val) ;; th 3070: 69 73 20 6f 6e 65 20 69 73 20 6e 65 77 0a 09 09 is one is new... 3080: 20 20 28 62 65 67 69 6e 0a 09 09 20 20 20 20 28 (begin... ( 3090: 69 66 20 28 6e 75 6c 6c 3f 20 73 64 61 74 29 28 if (null? sdat)( 30a0: 73 65 74 21 20 73 64 61 74 20 28 6c 69 73 74 20 set! sdat (list 30b0: 28 63 6f 6e 63 20 22 5b 22 20 73 65 63 74 69 6f (conc "[" sectio 30c0: 6e 20 22 5d 22 29 29 29 29 0a 09 09 20 20 20 20 n "]"))))... 30d0: 28 73 65 74 21 20 73 64 61 74 20 28 61 70 70 65 (set! sdat (appe 30e0: 6e 64 20 73 64 61 74 20 28 6c 69 73 74 20 28 63 nd sdat (list (c 30f0: 6f 6e 63 20 76 61 72 20 22 20 22 20 76 61 6c 29 onc var " " val) 3100: 29 29 29 29 29 29 29 0a 09 20 20 73 76 61 72 73 ))))))).. svars 3110: 29 0a 09 20 28 73 65 74 21 20 66 64 61 74 20 28 ).. (set! fdat ( 3120: 61 70 70 65 6e 64 20 66 64 61 74 20 73 64 61 74 append fdat sdat 3130: 29 29 29 29 0a 20 20 20 20 20 28 64 65 6c 65 74 )))). (delet 3140: 65 2d 64 75 70 6c 69 63 61 74 65 73 20 28 61 70 e-duplicates (ap 3150: 70 65 6e 64 20 72 65 71 75 69 72 65 2d 73 65 63 pend require-sec 3160: 74 69 6f 6e 73 20 28 68 61 73 68 2d 74 61 62 6c tions (hash-tabl 3170: 65 2d 6b 65 79 73 20 69 6e 64 61 74 29 29 29 29 e-keys indat)))) 3180: 0a 0a 20 20 20 20 3b 3b 20 73 74 65 70 20 35 3a .. ;; step 5: 3190: 20 57 72 69 74 65 20 6f 75 74 20 6e 65 77 20 66 Write out new f 31a0: 69 6c 65 0a 20 20 20 20 28 77 69 74 68 2d 6f 75 ile. (with-ou 31b0: 74 70 75 74 2d 74 6f 2d 66 69 6c 65 20 66 6e 61 tput-to-file fna 31c0: 6d 65 20 0a 20 20 20 20 20 20 28 6c 61 6d 62 64 me . (lambd 31d0: 61 20 28 29 0a 09 28 66 6f 72 2d 65 61 63 68 20 a ()..(for-each 31e0: 0a 09 20 28 6c 61 6d 62 64 61 20 28 6c 69 6e 65 .. (lambda (line 31f0: 29 0a 09 20 20 20 28 70 72 69 6e 74 20 6c 69 6e ).. (print lin 3200: 65 29 29 0a 09 20 28 63 6f 6e 66 69 67 66 3a 65 e)).. (configf:e 3210: 78 70 61 6e 64 2d 6d 75 6c 74 69 2d 6c 69 6e 65 xpand-multi-line 3220: 73 20 66 64 61 74 29 29 29 29 29 29 0a 0a s fdat))))))..