File
configf.scm
— part of check-in
[bd5a474d0e]
at
2012-04-11 14:19:54
on branch trunk
— Fixed issue where config is called with filename only and no path
(user:
mrwellan
size: 15269)
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 32 2c right 2006-2012,
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 6c 69 6e 65 20 61 ;; read a line a
0880: 6e 64 20 70 72 6f 63 65 73 73 20 61 6e 79 20 23 nd process any #
0890: 7b 20 2e 2e 2e 20 7d 20 63 6f 6e 73 74 72 75 63 { ... } construc
08a0: 74 73 0a 0a 28 64 65 66 69 6e 65 20 63 6f 6e 66 ts..(define conf
08b0: 69 67 66 3a 76 61 72 2d 65 78 70 61 6e 64 2d 72 igf:var-expand-r
08c0: 65 67 65 78 20 28 72 65 67 65 78 70 20 22 5e 28 egex (regexp "^(
08d0: 2e 2a 29 23 5c 5c 7b 28 73 63 68 65 6d 65 7c 73 .*)#\\{(scheme|s
08e0: 79 73 74 65 6d 7c 73 68 65 6c 6c 7c 67 65 74 65 ystem|shell|gete
08f0: 6e 76 7c 67 65 74 7c 72 75 6e 63 6f 6e 66 69 67 nv|get|runconfig
0900: 73 2d 67 65 74 29 5c 5c 73 2b 28 5b 5e 5c 5c 7d s-get)\\s+([^\\}
0910: 5c 5c 7b 5d 2a 29 5c 5c 7d 28 2e 2a 29 22 29 29 \\{]*)\\}(.*)"))
0920: 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 .(define (config
0930: 66 3a 70 72 6f 63 65 73 73 2d 6c 69 6e 65 20 6c f:process-line l
0940: 20 68 74 29 0a 20 20 28 6c 65 74 20 6c 6f 6f 70 ht). (let loop
0950: 20 28 28 72 65 73 20 6c 29 29 0a 20 20 20 20 28 ((res l)). (
0960: 69 66 20 28 73 74 72 69 6e 67 3f 20 72 65 73 29 if (string? res)
0970: 0a 09 28 6c 65 74 20 28 28 6d 61 74 63 68 64 61 ..(let ((matchda
0980: 74 20 28 73 74 72 69 6e 67 2d 73 65 61 72 63 68 t (string-search
0990: 20 63 6f 6e 66 69 67 66 3a 76 61 72 2d 65 78 70 configf:var-exp
09a0: 61 6e 64 2d 72 65 67 65 78 20 72 65 73 29 29 29 and-regex res)))
09b0: 0a 09 20 20 28 69 66 20 6d 61 74 63 68 64 61 74 .. (if matchdat
09c0: 0a 09 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 .. (let* ((
09d0: 70 72 65 73 74 72 20 20 28 6c 69 73 74 2d 72 65 prestr (list-re
09e0: 66 20 6d 61 74 63 68 64 61 74 20 31 29 29 0a 09 f matchdat 1))..
09f0: 09 20 20 20 20 20 28 63 6d 64 74 79 70 65 20 28 . (cmdtype (
0a00: 6c 69 73 74 2d 72 65 66 20 6d 61 74 63 68 64 61 list-ref matchda
0a10: 74 20 32 29 29 20 3b 3b 20 65 76 61 6c 2c 20 73 t 2)) ;; eval, s
0a20: 79 73 74 65 6d 2c 20 73 68 65 6c 6c 2c 20 67 65 ystem, shell, ge
0a30: 74 65 6e 76 0a 09 09 20 20 20 20 20 28 63 6d 64 tenv... (cmd
0a40: 20 20 20 20 20 28 6c 69 73 74 2d 72 65 66 20 6d (list-ref m
0a50: 61 74 63 68 64 61 74 20 33 29 29 0a 09 09 20 20 atchdat 3))...
0a60: 20 20 20 28 70 6f 73 74 73 74 72 20 28 6c 69 73 (poststr (lis
0a70: 74 2d 72 65 66 20 6d 61 74 63 68 64 61 74 20 34 t-ref matchdat 4
0a80: 29 29 0a 09 09 20 20 20 20 20 28 72 65 73 75 6c ))... (resul
0a90: 74 20 20 23 66 29 0a 09 09 20 20 20 20 20 28 66 t #f)... (f
0aa0: 75 6c 6c 63 6d 64 20 28 63 61 73 65 20 28 73 74 ullcmd (case (st
0ab0: 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 63 6d 64 ring->symbol cmd
0ac0: 74 79 70 65 29 0a 09 09 09 09 28 28 73 63 68 65 type).....((sche
0ad0: 6d 65 29 28 63 6f 6e 63 20 22 28 6c 61 6d 62 64 me)(conc "(lambd
0ae0: 61 20 28 68 74 29 22 20 63 6d 64 20 22 29 22 29 a (ht)" cmd ")")
0af0: 29 0a 09 09 09 09 28 28 73 79 73 74 65 6d 29 28 ).....((system)(
0b00: 63 6f 6e 63 20 22 28 6c 61 6d 62 64 61 20 28 68 conc "(lambda (h
0b10: 74 29 28 73 79 73 74 65 6d 20 5c 22 22 20 63 6d t)(system \"" cm
0b20: 64 20 22 5c 22 29 29 22 29 29 0a 09 09 09 09 28 d "\"))")).....(
0b30: 28 73 68 65 6c 6c 29 20 28 63 6f 6e 63 20 22 28 (shell) (conc "(
0b40: 6c 61 6d 62 64 61 20 28 68 74 29 28 73 68 65 6c lambda (ht)(shel
0b50: 6c 20 5c 22 22 20 20 63 6d 64 20 22 5c 22 29 29 l \"" cmd "\"))
0b60: 22 29 29 0a 09 09 09 09 28 28 67 65 74 65 6e 76 ")).....((getenv
0b70: 29 28 63 6f 6e 63 20 22 28 6c 61 6d 62 64 61 20 )(conc "(lambda
0b80: 28 68 74 29 28 67 65 74 2d 65 6e 76 69 72 6f 6e (ht)(get-environ
0b90: 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 5c 22 ment-variable \"
0ba0: 22 20 63 6d 64 20 22 5c 22 29 29 22 29 29 0a 09 " cmd "\"))"))..
0bb0: 09 09 09 28 28 67 65 74 29 20 20 20 0a 09 09 09 ...((get) ....
0bc0: 09 20 28 6c 65 74 2a 20 28 28 70 61 72 74 73 20 . (let* ((parts
0bd0: 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 63 6d (string-split cm
0be0: 64 29 29 0a 09 09 09 09 09 28 73 65 63 74 20 20 d))......(sect
0bf0: 28 63 61 72 20 70 61 72 74 73 29 29 0a 09 09 09 (car parts))....
0c00: 09 09 28 76 61 72 20 20 20 28 63 61 64 72 20 70 ..(var (cadr p
0c10: 61 72 74 73 29 29 29 0a 09 09 09 09 20 20 20 28 arts)))..... (
0c20: 63 6f 6e 63 20 22 28 6c 61 6d 62 64 61 20 28 68 conc "(lambda (h
0c30: 74 29 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 t)(config-lookup
0c40: 20 68 74 20 5c 22 22 20 73 65 63 74 20 22 5c 22 ht \"" sect "\"
0c50: 20 5c 22 22 20 76 61 72 20 22 5c 22 29 29 22 29 \"" var "\"))")
0c60: 29 29 0a 09 09 09 09 28 28 72 75 6e 63 6f 6e 66 )).....((runconf
0c70: 69 67 73 2d 67 65 74 29 20 28 63 6f 6e 63 20 22 igs-get) (conc "
0c80: 28 6c 61 6d 62 64 61 20 28 68 74 29 28 72 75 6e (lambda (ht)(run
0c90: 63 6f 6e 66 69 67 73 2d 67 65 74 20 68 74 20 5c configs-get ht \
0ca0: 22 22 20 63 6d 64 20 22 5c 22 29 29 22 29 29 0a "" cmd "\"))")).
0cb0: 09 09 09 09 28 65 6c 73 65 20 22 28 6c 61 6d 62 ....(else "(lamb
0cc0: 64 61 20 28 68 74 29 28 70 72 69 6e 74 20 5c 22 da (ht)(print \"
0cd0: 45 52 52 4f 52 5c 22 29 20 5c 22 45 52 52 4f 52 ERROR\") \"ERROR
0ce0: 5c 22 29 22 29 29 29 29 0a 09 09 3b 3b 20 28 70 \")"))))...;; (p
0cf0: 72 69 6e 74 20 22 66 75 6c 6c 63 6d 64 3d 22 20 rint "fullcmd="
0d00: 66 75 6c 6c 63 6d 64 29 0a 09 09 28 77 69 74 68 fullcmd)...(with
0d10: 2d 69 6e 70 75 74 2d 66 72 6f 6d 2d 73 74 72 69 -input-from-stri
0d20: 6e 67 20 66 75 6c 6c 63 6d 64 0a 09 09 20 20 28 ng fullcmd... (
0d30: 6c 61 6d 62 64 61 20 28 29 0a 09 09 20 20 20 20 lambda ()...
0d40: 28 73 65 74 21 20 72 65 73 75 6c 74 20 28 28 65 (set! result ((e
0d50: 76 61 6c 20 28 72 65 61 64 29 29 20 68 74 29 29 val (read)) ht))
0d60: 29 29 0a 09 09 28 6c 6f 6f 70 20 28 63 6f 6e 63 ))...(loop (conc
0d70: 20 70 72 65 73 74 72 20 72 65 73 75 6c 74 20 70 prestr result p
0d80: 6f 73 74 73 74 72 29 29 29 0a 09 20 20 20 20 20 oststr)))..
0d90: 20 72 65 73 29 29 0a 09 72 65 73 29 29 29 0a 0a res))..res)))..
0da0: 3b 3b 20 52 75 6e 20 61 20 73 68 65 6c 6c 20 63 ;; Run a shell c
0db0: 6f 6d 6d 61 6e 64 20 61 6e 64 20 72 65 74 75 72 ommand and retur
0dc0: 6e 20 74 68 65 20 6f 75 74 70 75 74 20 61 73 20 n the output as
0dd0: 61 20 73 74 72 69 6e 67 0a 28 64 65 66 69 6e 65 a string.(define
0de0: 20 28 73 68 65 6c 6c 20 63 6d 64 29 0a 20 20 28 (shell cmd). (
0df0: 6c 65 74 2a 20 28 28 6f 75 74 70 75 74 20 28 63 let* ((output (c
0e00: 6d 64 2d 72 75 6e 2d 3e 6c 69 73 74 20 63 6d 64 md-run->list cmd
0e10: 29 29 0a 09 20 28 72 65 73 20 20 20 20 28 63 61 )).. (res (ca
0e20: 72 20 6f 75 74 70 75 74 29 29 0a 09 20 28 73 74 r output)).. (st
0e30: 61 74 75 73 20 28 63 61 64 72 20 6f 75 74 70 75 atus (cadr outpu
0e40: 74 29 29 29 0a 20 20 20 20 28 69 66 20 28 65 71 t))). (if (eq
0e50: 75 61 6c 3f 20 73 74 61 74 75 73 20 30 29 0a 09 ual? status 0)..
0e60: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
0e70: 72 73 65 20 0a 09 20 72 65 73 0a 09 20 22 5c 6e rse .. res.. "\n
0e80: 22 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 77 ")..(begin.. (w
0e90: 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 70 6f ith-output-to-po
0ea0: 72 74 20 28 63 75 72 72 65 6e 74 2d 65 72 72 6f rt (current-erro
0eb0: 72 2d 70 6f 72 74 29 0a 09 20 20 20 20 28 70 72 r-port).. (pr
0ec0: 69 6e 74 20 22 45 52 52 4f 52 3a 20 22 20 63 6d int "ERROR: " cm
0ed0: 64 20 22 20 72 65 74 75 72 6e 65 64 20 62 61 64 d " returned bad
0ee0: 20 65 78 69 74 20 63 6f 64 65 20 22 20 73 74 61 exit code " sta
0ef0: 74 75 73 29 29 0a 09 20 20 22 22 29 29 29 29 0a tus)).. "")))).
0f00: 0a 3b 3b 20 4c 6f 6f 6b 75 70 20 61 20 76 61 6c .;; Lookup a val
0f10: 75 65 20 69 6e 20 72 75 6e 63 6f 6e 66 69 67 73 ue in runconfigs
0f20: 20 62 61 73 65 64 20 6f 6e 20 2d 72 65 71 74 61 based on -reqta
0f30: 72 67 20 6f 72 20 2d 74 61 72 67 65 74 0a 28 64 rg or -target.(d
0f40: 65 66 69 6e 65 20 28 72 75 6e 63 6f 6e 66 69 67 efine (runconfig
0f50: 73 2d 67 65 74 20 63 6f 6e 66 69 67 20 76 61 72 s-get config var
0f60: 29 0a 20 20 28 6c 65 74 20 28 28 74 61 72 67 20 ). (let ((targ
0f70: 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
0f80: 67 20 22 2d 72 65 71 74 61 72 67 22 29 28 61 72 g "-reqtarg")(ar
0f90: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 61 72 gs:get-arg "-tar
0fa0: 67 65 74 22 29 29 29 29 0a 20 20 20 20 28 69 66 get")))). (if
0fb0: 20 74 61 72 67 0a 09 28 63 6f 6e 66 69 67 2d 6c targ..(config-l
0fc0: 6f 6f 6b 75 70 20 63 6f 6e 66 69 67 20 74 61 72 ookup config tar
0fd0: 67 20 76 61 72 29 0a 09 23 66 29 29 29 0a 0a 28 g var)..#f)))..(
0fe0: 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 63 define-inline (c
0ff0: 6f 6e 66 69 67 66 3a 72 65 61 64 2d 6c 69 6e 65 onfigf:read-line
1000: 20 70 20 68 74 29 0a 20 20 28 63 6f 6e 66 69 67 p ht). (config
1010: 66 3a 70 72 6f 63 65 73 73 2d 6c 69 6e 65 20 28 f:process-line (
1020: 72 65 61 64 2d 6c 69 6e 65 20 70 29 20 68 74 29 read-line p) ht)
1030: 29 0a 0a 3b 3b 20 72 65 61 64 20 61 20 63 6f 6e )..;; read a con
1040: 66 69 67 20 66 69 6c 65 2c 20 72 65 74 75 72 6e fig file, return
1050: 73 20 68 61 73 68 20 74 61 62 6c 65 20 6f 66 20 s hash table of
1060: 61 6c 69 73 74 73 0a 0a 3b 3b 20 72 65 61 64 20 alists..;; read
1070: 61 20 63 6f 6e 66 69 67 20 66 69 6c 65 2c 20 72 a config file, r
1080: 65 74 75 72 6e 73 20 68 61 73 68 20 74 61 62 6c eturns hash tabl
1090: 65 20 6f 66 20 61 6c 69 73 74 73 0a 3b 3b 20 61 e of alists.;; a
10a0: 64 64 73 20 74 6f 20 68 74 20 69 66 20 67 69 76 dds to ht if giv
10b0: 65 6e 20 28 6d 75 73 74 20 62 65 20 23 66 20 6f en (must be #f o
10c0: 74 68 65 72 77 69 73 65 29 0a 3b 3b 20 65 6e 76 therwise).;; env
10d0: 69 6f 6e 2d 70 61 74 74 20 69 73 20 61 20 72 65 ion-patt is a re
10e0: 67 65 78 20 73 70 65 63 20 74 68 61 74 20 69 64 gex spec that id
10f0: 65 6e 74 69 66 69 65 73 20 73 65 63 74 69 6f 6e entifies section
1100: 73 20 74 68 61 74 20 77 69 6c 6c 20 62 65 20 65 s that will be e
1110: 76 61 6c 27 64 0a 3b 3b 20 69 6e 20 74 68 65 20 val'd.;; in the
1120: 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 6f 6e 20 74 environment on t
1130: 68 65 20 66 6c 79 0a 0a 28 64 65 66 69 6e 65 20 he fly..(define
1140: 28 72 65 61 64 2d 63 6f 6e 66 69 67 20 70 61 74 (read-config pat
1150: 68 20 68 74 20 61 6c 6c 6f 77 2d 73 79 73 74 65 h ht allow-syste
1160: 6d 20 23 21 6b 65 79 20 28 65 6e 76 69 72 6f 6e m #!key (environ
1170: 2d 70 61 74 74 20 23 66 29 28 63 75 72 72 2d 73 -patt #f)(curr-s
1180: 65 63 74 69 6f 6e 20 23 66 29 29 0a 20 20 28 64 ection #f)). (d
1190: 65 62 75 67 3a 70 72 69 6e 74 20 34 20 22 49 4e ebug:print 4 "IN
11a0: 46 4f 3a 20 72 65 61 64 2d 63 6f 6e 66 69 67 20 FO: read-config
11b0: 22 20 70 61 74 68 20 22 20 61 6c 6c 6f 77 2d 73 " path " allow-s
11c0: 79 73 74 65 6d 20 22 20 61 6c 6c 6f 77 2d 73 79 ystem " allow-sy
11d0: 73 74 65 6d 20 22 20 65 6e 76 69 72 6f 6e 2d 70 stem " environ-p
11e0: 61 74 74 20 22 20 65 6e 76 69 72 6f 6e 2d 70 61 att " environ-pa
11f0: 74 74 20 22 20 63 75 72 72 2d 73 65 63 74 69 6f tt " curr-sectio
1200: 6e 3a 20 22 20 63 75 72 72 2d 73 65 63 74 69 6f n: " curr-sectio
1210: 6e 29 0a 20 20 28 69 66 20 28 6e 6f 74 20 28 66 n). (if (not (f
1220: 69 6c 65 2d 65 78 69 73 74 73 3f 20 70 61 74 68 ile-exists? path
1230: 29 29 0a 20 20 20 20 20 20 28 62 65 67 69 6e 20 )). (begin
1240: 0a 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 ..(debug:print 4
1250: 20 22 49 4e 46 4f 3a 20 72 65 61 64 2d 63 6f 6e "INFO: read-con
1260: 66 69 67 20 2d 20 66 69 6c 65 20 6e 6f 74 20 66 fig - file not f
1270: 6f 75 6e 64 20 22 20 70 61 74 68 20 22 20 63 75 ound " path " cu
1280: 72 72 65 6e 74 20 70 61 74 68 3a 20 22 20 28 63 rrent path: " (c
1290: 75 72 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 urrent-directory
12a0: 29 29 0a 09 28 69 66 20 28 6e 6f 74 20 68 74 29 ))..(if (not ht)
12b0: 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 (make-hash-table
12c0: 29 20 68 74 29 29 0a 20 20 20 20 20 20 28 6c 65 ) ht)). (le
12d0: 74 20 28 28 69 6e 70 20 20 20 20 20 20 20 20 28 t ((inp (
12e0: 6f 70 65 6e 2d 69 6e 70 75 74 2d 66 69 6c 65 20 open-input-file
12f0: 70 61 74 68 29 29 0a 09 20 20 20 20 28 72 65 73 path)).. (res
1300: 20 20 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 (if (not
1310: 20 68 74 29 28 6d 61 6b 65 2d 68 61 73 68 2d 74 ht)(make-hash-t
1320: 61 62 6c 65 29 20 68 74 29 29 29 0a 09 28 6c 65 able) ht)))..(le
1330: 74 20 6c 6f 6f 70 20 28 28 69 6e 6c 20 20 20 20 t loop ((inl
1340: 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 66 (conf
1350: 69 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e igf:read-line in
1360: 70 20 72 65 73 29 29 20 3b 3b 20 28 72 65 61 64 p res)) ;; (read
1370: 2d 6c 69 6e 65 20 69 6e 70 29 29 0a 09 09 20 20 -line inp))...
1380: 20 28 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e (curr-section-n
1390: 61 6d 65 20 28 69 66 20 63 75 72 72 2d 73 65 63 ame (if curr-sec
13a0: 74 69 6f 6e 20 63 75 72 72 2d 73 65 63 74 69 6f tion curr-sectio
13b0: 6e 20 22 64 65 66 61 75 6c 74 22 29 29 0a 09 09 n "default"))...
13c0: 20 20 20 28 76 61 72 2d 66 6c 61 67 20 23 66 29 (var-flag #f)
13d0: 3b 3b 20 74 75 72 6e 20 6f 6e 20 66 6f 72 20 6b ;; turn on for k
13e0: 65 79 2d 76 61 72 2d 70 72 20 61 6e 64 20 63 6f ey-var-pr and co
13f0: 6e 74 2d 6c 6e 2d 72 78 2c 20 74 75 72 6e 20 6f nt-ln-rx, turn o
1400: 66 66 20 65 6c 73 65 77 68 65 72 65 0a 09 09 20 ff elsewhere...
1410: 20 20 28 6c 65 61 64 20 20 20 20 20 23 66 29 29 (lead #f))
1420: 0a 09 20 20 28 69 66 20 28 65 6f 66 2d 6f 62 6a .. (if (eof-obj
1430: 65 63 74 3f 20 69 6e 6c 29 20 0a 09 20 20 20 20 ect? inl) ..
1440: 20 20 28 62 65 67 69 6e 0a 09 09 28 63 6c 6f 73 (begin...(clos
1450: 65 2d 69 6e 70 75 74 2d 70 6f 72 74 20 69 6e 70 e-input-port inp
1460: 29 0a 09 09 72 65 73 29 0a 09 20 20 20 20 20 20 )...res)..
1470: 28 72 65 67 65 78 2d 63 61 73 65 20 0a 09 20 20 (regex-case ..
1480: 20 20 20 20 20 69 6e 6c 20 0a 09 20 20 20 20 20 inl ..
1490: 20 20 28 63 6f 6e 66 69 67 66 3a 63 6f 6d 6d 65 (configf:comme
14a0: 6e 74 2d 72 78 20 5f 20 20 20 20 20 20 20 20 20 nt-rx _
14b0: 20 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 (loop (
14c0: 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d 6c 69 6e configf:read-lin
14d0: 65 20 69 6e 70 20 72 65 73 29 20 63 75 72 72 2d e inp res) curr-
14e0: 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 section-name #f
14f0: 23 66 29 29 0a 09 20 20 20 20 20 20 20 28 63 6f #f)).. (co
1500: 6e 66 69 67 66 3a 62 6c 61 6e 6b 2d 6c 2d 72 78 nfigf:blank-l-rx
1510: 20 5f 20 20 20 20 20 20 20 20 20 20 20 20 20 20 _
1520: 20 20 20 20 28 6c 6f 6f 70 20 28 63 6f 6e 66 69 (loop (confi
1530: 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 gf:read-line inp
1540: 20 72 65 73 29 20 63 75 72 72 2d 73 65 63 74 69 res) curr-secti
1550: 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 66 29 29 0a on-name #f #f)).
1560: 09 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 66 . (configf
1570: 3a 69 6e 63 6c 75 64 65 2d 72 78 20 28 20 78 20 :include-rx ( x
1580: 69 6e 63 6c 75 64 65 2d 66 69 6c 65 20 29 20 28 include-file ) (
1590: 6c 65 74 20 28 28 63 75 72 72 2d 64 69 72 20 28 let ((curr-dir (
15a0: 63 75 72 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 current-director
15b0: 79 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 28 y))........ (
15c0: 63 6f 6e 66 2d 64 69 72 20 20 28 70 61 74 68 6e conf-dir (pathn
15d0: 61 6d 65 2d 64 69 72 65 63 74 6f 72 79 20 70 61 ame-directory pa
15e0: 74 68 29 29 29 0a 09 09 09 09 09 09 09 28 69 66 th)))........(if
15f0: 20 63 6f 6e 66 2d 64 69 72 20 28 63 68 61 6e 67 conf-dir (chang
1600: 65 2d 64 69 72 65 63 74 6f 72 79 20 63 6f 6e 66 e-directory conf
1610: 2d 64 69 72 29 29 0a 09 09 09 09 09 09 09 28 72 -dir))........(r
1620: 65 61 64 2d 63 6f 6e 66 69 67 20 69 6e 63 6c 75 ead-config inclu
1630: 64 65 2d 66 69 6c 65 20 72 65 73 20 61 6c 6c 6f de-file res allo
1640: 77 2d 73 79 73 74 65 6d 20 65 6e 76 69 72 6f 6e w-system environ
1650: 2d 70 61 74 74 3a 20 65 6e 76 69 72 6f 6e 2d 70 -patt: environ-p
1660: 61 74 74 20 63 75 72 72 2d 73 65 63 74 69 6f 6e att curr-section
1670: 3a 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e : curr-section-n
1680: 61 6d 65 29 0a 09 09 09 09 09 09 09 28 63 68 61 ame)........(cha
1690: 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 63 75 nge-directory cu
16a0: 72 72 2d 64 69 72 29 0a 09 09 09 09 09 09 09 28 rr-dir)........(
16b0: 6c 6f 6f 70 20 28 63 6f 6e 66 69 67 66 3a 72 65 loop (configf:re
16c0: 61 64 2d 6c 69 6e 65 20 69 6e 70 20 72 65 73 29 ad-line inp res)
16d0: 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 curr-section-na
16e0: 6d 65 20 23 66 20 23 66 29 29 29 0a 09 20 20 20 me #f #f)))..
16f0: 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 73 65 63 (configf:sec
1700: 74 69 6f 6e 2d 72 78 20 28 20 78 20 73 65 63 74 tion-rx ( x sect
1710: 69 6f 6e 2d 6e 61 6d 65 20 29 20 28 6c 6f 6f 70 ion-name ) (loop
1720: 20 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d 6c (configf:read-l
1730: 69 6e 65 20 69 6e 70 20 72 65 73 29 20 73 65 63 ine inp res) sec
1740: 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 66 29 tion-name #f #f)
1750: 29 0a 09 20 20 20 20 20 20 20 28 63 6f 6e 66 69 ).. (confi
1760: 67 66 3a 6b 65 79 2d 73 79 73 2d 70 72 20 28 20 gf:key-sys-pr (
1770: 78 20 6b 65 79 20 63 6d 64 20 20 20 20 20 20 29 x key cmd )
1780: 20 28 69 66 20 61 6c 6c 6f 77 2d 73 79 73 74 65 (if allow-syste
1790: 6d 0a 09 09 09 09 09 09 09 20 20 28 6c 65 74 20 m........ (let
17a0: 28 28 61 6c 69 73 74 20 28 68 61 73 68 2d 74 61 ((alist (hash-ta
17b0: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default
17c0: 72 65 73 20 63 75 72 72 2d 73 65 63 74 69 6f 6e res curr-section
17d0: 2d 6e 61 6d 65 20 27 28 29 29 29 0a 09 09 09 09 -name '())).....
17e0: 09 09 09 09 28 76 61 6c 2d 70 72 6f 63 20 28 6c ....(val-proc (l
17f0: 61 6d 62 64 61 20 28 29 0a 09 09 09 09 09 09 09 ambda ()........
1800: 09 09 20 20 20 20 28 6c 65 74 2a 20 28 28 63 6d .. (let* ((cm
1810: 64 72 65 73 20 20 28 63 6d 64 2d 72 75 6e 2d 3e dres (cmd-run->
1820: 6c 69 73 74 20 63 6d 64 29 29 0a 09 09 09 09 09 list cmd))......
1830: 09 09 09 09 09 20 20 20 28 73 74 61 74 75 73 20 ..... (status
1840: 20 28 63 61 64 72 20 63 6d 64 72 65 73 29 29 0a (cadr cmdres)).
1850: 09 09 09 09 09 09 09 09 09 09 20 20 20 28 72 65 .......... (re
1860: 73 20 20 20 20 20 28 63 61 72 20 20 63 6d 64 72 s (car cmdr
1870: 65 73 29 29 29 0a 09 09 09 09 09 09 09 09 09 20 es)))..........
1880: 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 65 (if (not (e
1890: 71 3f 20 73 74 61 74 75 73 20 30 29 29 0a 09 09 q? status 0))...
18a0: 09 09 09 09 09 09 09 09 20 20 28 62 65 67 69 6e ........ (begin
18b0: 0a 09 09 09 09 09 09 09 09 09 09 20 20 20 20 28 ........... (
18c0: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 debug:print 0 "E
18d0: 52 52 4f 52 3a 20 70 72 6f 62 6c 65 6d 20 77 69 RROR: problem wi
18e0: 74 68 20 22 20 69 6e 6c 20 22 2c 20 72 65 74 75 th " inl ", retu
18f0: 72 6e 20 63 6f 64 65 20 22 20 73 74 61 74 75 73 rn code " status
1900: 29 0a 09 09 09 09 09 09 09 09 09 09 20 20 20 20 )...........
1910: 28 65 78 69 74 20 31 29 29 29 0a 09 09 09 09 09 (exit 1)))......
1920: 09 09 09 09 20 20 20 20 20 20 28 69 66 20 28 6e .... (if (n
1930: 75 6c 6c 3f 20 72 65 73 29 0a 09 09 09 09 09 09 ull? res).......
1940: 09 09 09 09 20 20 22 22 0a 09 09 09 09 09 09 09 .... ""........
1950: 09 09 09 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 ... (string-int
1960: 65 72 73 70 65 72 73 65 20 72 65 73 20 22 20 22 ersperse res " "
1970: 29 29 29 29 29 29 0a 09 09 09 09 09 09 09 20 20 ))))))........
1980: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 (hash-table-se
1990: 74 21 20 72 65 73 20 63 75 72 72 2d 73 65 63 74 t! res curr-sect
19a0: 69 6f 6e 2d 6e 61 6d 65 20 0a 09 09 09 09 09 09 ion-name .......
19b0: 09 09 09 20 20 20 20 20 28 63 6f 6e 66 69 67 3a ... (config:
19c0: 61 73 73 6f 63 2d 73 61 66 65 2d 61 64 64 20 61 assoc-safe-add a
19d0: 6c 69 73 74 0a 09 09 09 09 09 09 09 09 09 09 09 list............
19e0: 09 20 20 20 20 6b 65 79 20 0a 09 09 09 09 09 09 . key .......
19f0: 09 09 09 09 09 09 20 20 20 20 28 63 61 73 65 20 ...... (case
1a00: 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 0a 09 09 09 allow-system....
1a10: 09 09 09 09 09 09 09 09 09 20 20 20 20 20 20 28 ......... (
1a20: 28 72 65 74 75 72 6e 2d 70 72 6f 63 73 29 20 76 (return-procs) v
1a30: 61 6c 2d 70 72 6f 63 29 0a 09 09 09 09 09 09 09 al-proc)........
1a40: 09 09 09 09 09 20 20 20 20 20 20 28 28 72 65 74 ..... ((ret
1a50: 75 72 6e 2d 73 74 72 69 6e 67 29 20 63 6d 64 29 urn-string) cmd)
1a60: 0a 09 09 09 09 09 09 09 09 09 09 09 09 20 20 20 .............
1a70: 20 20 20 28 65 6c 73 65 20 28 76 61 6c 2d 70 72 (else (val-pr
1a80: 6f 63 29 29 29 29 29 0a 09 09 09 09 09 09 09 20 oc)))))........
1a90: 20 20 20 28 6c 6f 6f 70 20 28 63 6f 6e 66 69 67 (loop (config
1aa0: 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 20 f:read-line inp
1ab0: 72 65 73 29 20 63 75 72 72 2d 73 65 63 74 69 6f res) curr-sectio
1ac0: 6e 2d 6e 61 6d 65 20 23 66 20 23 66 29 29 0a 09 n-name #f #f))..
1ad0: 09 09 09 09 09 09 20 20 28 6c 6f 6f 70 20 28 63 ...... (loop (c
1ae0: 6f 6e 66 69 67 66 3a 72 65 61 64 2d 6c 69 6e 65 onfigf:read-line
1af0: 20 69 6e 70 20 72 65 73 29 20 63 75 72 72 2d 73 inp res) curr-s
1b00: 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 ection-name #f #
1b10: 66 29 29 29 0a 09 20 20 20 20 20 20 20 28 63 6f f))).. (co
1b20: 6e 66 69 67 66 3a 6b 65 79 2d 76 61 6c 2d 70 72 nfigf:key-val-pr
1b30: 20 28 20 78 20 6b 65 79 20 76 61 6c 20 20 20 20 ( x key val
1b40: 20 20 29 20 28 6c 65 74 2a 20 28 28 61 6c 69 73 ) (let* ((alis
1b50: 74 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d t (hash-table-
1b60: 72 65 66 2f 64 65 66 61 75 6c 74 20 72 65 73 20 ref/default res
1b70: 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d curr-section-nam
1b80: 65 20 27 28 29 29 29 0a 09 09 09 09 09 09 09 20 e '()))........
1b90: 20 20 20 20 28 65 6e 76 61 72 20 20 20 28 61 6e (envar (an
1ba0: 64 20 65 6e 76 69 72 6f 6e 2d 70 61 74 74 20 28 d environ-patt (
1bb0: 73 74 72 69 6e 67 2d 73 65 61 72 63 68 20 28 72 string-search (r
1bc0: 65 67 65 78 70 20 65 6e 76 69 72 6f 6e 2d 70 61 egexp environ-pa
1bd0: 74 74 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e tt) curr-section
1be0: 2d 6e 61 6d 65 29 29 29 0a 09 09 09 09 09 09 09 -name)))........
1bf0: 20 20 20 20 20 28 72 65 61 6c 76 61 6c 20 28 69 (realval (i
1c00: 66 20 65 6e 76 61 72 0a 09 09 09 09 09 09 09 09 f envar.........
1c10: 09 20 20 28 63 6f 6e 66 69 67 3a 65 76 61 6c 2d . (config:eval-
1c20: 73 74 72 69 6e 67 2d 69 6e 2d 65 6e 76 69 72 6f string-in-enviro
1c30: 6e 6d 65 6e 74 20 76 61 6c 29 0a 09 09 09 09 09 nment val)......
1c40: 09 09 09 09 20 20 76 61 6c 29 29 29 0a 09 09 09 .... val)))....
1c50: 09 09 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 ....(debug:print
1c60: 20 36 20 22 49 4e 46 4f 3a 20 72 65 61 64 2d 63 6 "INFO: read-c
1c70: 6f 6e 66 69 67 20 65 6e 76 20 73 65 74 74 69 6e onfig env settin
1c80: 67 2c 20 65 6e 76 61 72 3a 20 22 20 65 6e 76 61 g, envar: " enva
1c90: 72 20 22 20 72 65 61 6c 76 61 6c 3a 20 22 20 72 r " realval: " r
1ca0: 65 61 6c 76 61 6c 20 22 20 76 61 6c 3a 20 22 20 ealval " val: "
1cb0: 76 61 6c 20 22 20 6b 65 79 3a 20 22 20 6b 65 79 val " key: " key
1cc0: 20 22 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d " curr-section-
1cd0: 6e 61 6d 65 3a 20 22 20 63 75 72 72 2d 73 65 63 name: " curr-sec
1ce0: 74 69 6f 6e 2d 6e 61 6d 65 29 0a 09 09 09 09 09 tion-name)......
1cf0: 09 09 28 69 66 20 65 6e 76 61 72 0a 09 09 09 09 ..(if envar.....
1d00: 09 09 09 20 20 20 20 28 62 65 67 69 6e 0a 09 09 ... (begin...
1d10: 09 09 09 09 09 20 20 20 20 20 20 3b 3b 20 28 64 ..... ;; (d
1d20: 65 62 75 67 3a 70 72 69 6e 74 20 34 20 22 49 4e ebug:print 4 "IN
1d30: 46 4f 3a 20 72 65 61 64 2d 63 6f 6e 66 69 67 20 FO: read-config
1d40: 6b 65 79 3d 22 20 6b 65 79 20 22 2c 20 76 61 6c key=" key ", val
1d50: 3d 22 20 76 61 6c 20 22 2c 20 72 65 61 6c 76 61 =" val ", realva
1d60: 6c 3d 22 20 72 65 61 6c 76 61 6c 29 0a 09 09 09 l=" realval)....
1d70: 09 09 09 09 20 20 20 20 20 20 28 73 65 74 65 6e .... (seten
1d80: 76 20 6b 65 79 20 72 65 61 6c 76 61 6c 29 29 29 v key realval)))
1d90: 0a 09 09 09 09 09 09 09 28 68 61 73 68 2d 74 61 ........(hash-ta
1da0: 62 6c 65 2d 73 65 74 21 20 72 65 73 20 63 75 72 ble-set! res cur
1db0: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 0a r-section-name .
1dc0: 09 09 09 09 09 09 09 09 09 20 28 63 6f 6e 66 69 ......... (confi
1dd0: 67 3a 61 73 73 6f 63 2d 73 61 66 65 2d 61 64 64 g:assoc-safe-add
1de0: 20 61 6c 69 73 74 20 6b 65 79 20 72 65 61 6c 76 alist key realv
1df0: 61 6c 29 29 0a 09 09 09 09 09 09 09 28 6c 6f 6f al))........(loo
1e00: 70 20 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d p (configf:read-
1e10: 6c 69 6e 65 20 69 6e 70 20 72 65 73 29 20 63 75 line inp res) cu
1e20: 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 rr-section-name
1e30: 6b 65 79 20 23 66 29 29 29 0a 09 20 20 20 20 20 key #f)))..
1e40: 20 20 3b 3b 20 69 66 20 61 20 63 6f 6e 74 69 6e ;; if a contin
1e50: 75 65 64 20 6c 69 6e 65 0a 09 20 20 20 20 20 20 ued line..
1e60: 20 28 63 6f 6e 66 69 67 66 3a 63 6f 6e 74 2d 6c (configf:cont-l
1e70: 6e 2d 72 78 20 28 20 78 20 77 68 73 70 20 76 61 n-rx ( x whsp va
1e80: 6c 20 20 20 20 20 29 20 28 6c 65 74 20 28 28 61 l ) (let ((a
1e90: 6c 69 73 74 20 28 68 61 73 68 2d 74 61 62 6c 65 list (hash-table
1ea0: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 72 65 73 -ref/default res
1eb0: 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 curr-section-na
1ec0: 6d 65 20 27 28 29 29 29 29 0a 09 09 09 09 09 09 me '()))).......
1ed0: 28 69 66 20 76 61 72 2d 66 6c 61 67 20 20 20 20 (if var-flag
1ee0: 20 20 20 20 20 20 20 20 20 3b 3b 20 69 66 20 73 ;; if s
1ef0: 65 74 20 74 6f 20 61 20 73 74 72 69 6e 67 20 74 et to a string t
1f00: 68 65 6e 20 77 65 20 68 61 76 65 20 61 20 63 6f hen we have a co
1f10: 6e 74 69 6e 75 65 64 20 76 61 72 0a 09 09 09 09 ntinued var.....
1f20: 09 09 20 20 20 20 28 6c 65 74 20 28 28 6e 65 77 .. (let ((new
1f30: 76 61 6c 20 28 63 6f 6e 63 20 0a 09 09 09 09 09 val (conc ......
1f40: 09 09 09 20 20 20 28 63 6f 6e 66 69 67 2d 6c 6f ... (config-lo
1f50: 6f 6b 75 70 20 72 65 73 20 63 75 72 72 2d 73 65 okup res curr-se
1f60: 63 74 69 6f 6e 2d 6e 61 6d 65 20 76 61 72 2d 66 ction-name var-f
1f70: 6c 61 67 29 20 22 5c 6e 22 0a 09 09 09 09 09 09 lag) "\n".......
1f80: 09 09 20 20 20 3b 3b 20 74 72 69 6d 20 6c 65 61 .. ;; trim lea
1f90: 64 20 66 72 6f 6d 20 74 68 65 20 69 6e 63 6f 6d d from the incom
1fa0: 69 6e 67 20 77 68 73 70 20 74 6f 20 73 75 70 70 ing whsp to supp
1fb0: 6f 72 74 20 73 6f 6d 65 20 69 6e 64 65 6e 74 69 ort some indenti
1fc0: 6e 67 2e 0a 09 09 09 09 09 09 09 09 20 20 20 28 ng.......... (
1fd0: 69 66 20 6c 65 61 64 0a 09 09 09 09 09 09 09 09 if lead.........
1fe0: 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d 73 (string-s
1ff0: 75 62 73 74 69 74 75 74 65 20 28 72 65 67 65 78 ubstitute (regex
2000: 70 20 6c 65 61 64 29 20 22 22 20 77 68 73 70 29 p lead) "" whsp)
2010: 0a 09 09 09 09 09 09 09 09 20 20 20 20 20 20 20 .........
2020: 22 22 29 0a 09 09 09 09 09 09 09 09 20 20 20 76 "")......... v
2030: 61 6c 29 29 29 0a 09 09 09 09 09 09 20 20 20 20 al))).......
2040: 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 76 61 6c ;; (print "val
2050: 3a 20 22 20 76 61 6c 20 22 5c 6e 6e 65 77 76 61 : " val "\nnewva
2060: 6c 3a 20 5c 22 22 20 6e 65 77 76 61 6c 20 22 5c l: \"" newval "\
2070: 22 5c 6e 76 61 72 66 6c 61 67 3a 20 22 20 76 61 "\nvarflag: " va
2080: 72 2d 66 6c 61 67 29 0a 09 09 09 09 09 09 20 20 r-flag).......
2090: 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (hash-table-
20a0: 73 65 74 21 20 72 65 73 20 63 75 72 72 2d 73 65 set! res curr-se
20b0: 63 74 69 6f 6e 2d 6e 61 6d 65 20 0a 09 09 09 09 ction-name .....
20c0: 09 09 09 09 20 20 20 20 20 20 20 28 63 6f 6e 66 .... (conf
20d0: 69 67 3a 61 73 73 6f 63 2d 73 61 66 65 2d 61 64 ig:assoc-safe-ad
20e0: 64 20 61 6c 69 73 74 20 76 61 72 2d 66 6c 61 67 d alist var-flag
20f0: 20 6e 65 77 76 61 6c 29 29 0a 09 09 09 09 09 09 newval)).......
2100: 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 6f 6e (loop (con
2110: 66 69 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 figf:read-line i
2120: 6e 70 20 72 65 73 29 20 63 75 72 72 2d 73 65 63 np res) curr-sec
2130: 74 69 6f 6e 2d 6e 61 6d 65 20 76 61 72 2d 66 6c tion-name var-fl
2140: 61 67 20 28 69 66 20 6c 65 61 64 20 6c 65 61 64 ag (if lead lead
2150: 20 77 68 73 70 29 29 29 0a 09 09 09 09 09 09 20 whsp))).......
2160: 20 20 20 28 6c 6f 6f 70 20 28 63 6f 6e 66 69 67 (loop (config
2170: 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 20 f:read-line inp
2180: 72 65 73 29 20 63 75 72 72 2d 73 65 63 74 69 6f res) curr-sectio
2190: 6e 2d 6e 61 6d 65 20 23 66 20 23 66 29 29 29 29 n-name #f #f))))
21a0: 0a 09 20 20 20 20 20 20 20 28 65 6c 73 65 20 28 .. (else (
21b0: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 debug:print 0 "E
21c0: 52 52 4f 52 3a 20 70 72 6f 62 6c 65 6d 20 70 61 RROR: problem pa
21d0: 72 73 69 6e 67 20 22 20 70 61 74 68 20 22 2c 5c rsing " path ",\
21e0: 6e 20 20 20 5c 22 22 20 69 6e 6c 20 22 5c 22 22 n \"" inl "\""
21f0: 29 0a 09 09 20 20 20 20 20 28 73 65 74 21 20 76 )... (set! v
2200: 61 72 2d 66 6c 61 67 20 23 66 29 0a 09 09 20 20 ar-flag #f)...
2210: 20 20 20 28 6c 6f 6f 70 20 28 63 6f 6e 66 69 67 (loop (config
2220: 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 20 f:read-line inp
2230: 72 65 73 29 20 63 75 72 72 2d 73 65 63 74 69 6f res) curr-sectio
2240: 6e 2d 6e 61 6d 65 20 23 66 20 23 66 29 29 29 29 n-name #f #f))))
2250: 29 29 29 29 0a 20 20 0a 28 64 65 66 69 6e 65 20 )))). .(define
2260: 28 66 69 6e 64 2d 61 6e 64 2d 72 65 61 64 2d 63 (find-and-read-c
2270: 6f 6e 66 69 67 20 66 6e 61 6d 65 20 23 21 6b 65 onfig fname #!ke
2280: 79 20 28 65 6e 76 69 72 6f 6e 2d 70 61 74 74 20 y (environ-patt
2290: 23 66 29 29 0a 20 20 28 6c 65 74 2a 20 28 28 63 #f)). (let* ((c
22a0: 75 72 72 2d 64 69 72 20 20 20 28 63 75 72 72 65 urr-dir (curre
22b0: 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 29 0a 20 nt-directory)).
22c0: 20 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 69 (configi
22d0: 6e 66 6f 20 28 66 69 6e 64 2d 63 6f 6e 66 69 67 nfo (find-config
22e0: 20 66 6e 61 6d 65 29 29 0a 09 20 28 74 6f 70 70 fname)).. (topp
22f0: 61 74 68 20 20 20 20 28 63 61 72 20 63 6f 6e 66 ath (car conf
2300: 69 67 69 6e 66 6f 29 29 0a 09 20 28 63 6f 6e 66 iginfo)).. (conf
2310: 69 67 66 69 6c 65 20 28 63 61 64 72 20 63 6f 6e igfile (cadr con
2320: 66 69 67 69 6e 66 6f 29 29 29 0a 20 20 20 20 28 figinfo))). (
2330: 69 66 20 74 6f 70 70 61 74 68 20 28 63 68 61 6e if toppath (chan
2340: 67 65 2d 64 69 72 65 63 74 6f 72 79 20 74 6f 70 ge-directory top
2350: 70 61 74 68 29 29 20 0a 20 20 20 20 28 6c 65 74 path)) . (let
2360: 20 28 28 63 6f 6e 66 69 67 64 61 74 20 20 28 69 ((configdat (i
2370: 66 20 63 6f 6e 66 69 67 66 69 6c 65 20 28 72 65 f configfile (re
2380: 61 64 2d 63 6f 6e 66 69 67 20 63 6f 6e 66 69 67 ad-config config
2390: 66 69 6c 65 20 23 66 20 23 74 20 65 6e 76 69 72 file #f #t envir
23a0: 6f 6e 2d 70 61 74 74 3a 20 65 6e 76 69 72 6f 6e on-patt: environ
23b0: 2d 70 61 74 74 29 20 23 66 29 29 29 20 3b 3b 20 -patt) #f))) ;;
23c0: 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 (make-hash-table
23d0: 29 29 29 29 0a 20 20 20 20 20 20 28 69 66 20 74 )))). (if t
23e0: 6f 70 70 61 74 68 20 28 63 68 61 6e 67 65 2d 64 oppath (change-d
23f0: 69 72 65 63 74 6f 72 79 20 63 75 72 72 2d 64 69 irectory curr-di
2400: 72 29 29 0a 20 20 20 20 20 20 28 6c 69 73 74 20 r)). (list
2410: 63 6f 6e 66 69 67 64 61 74 20 74 6f 70 70 61 74 configdat toppat
2420: 68 20 63 6f 6e 66 69 67 66 69 6c 65 20 66 6e 61 h configfile fna
2430: 6d 65 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 me))))..(define
2440: 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 63 (config-lookup c
2450: 66 67 64 61 74 20 73 65 63 74 69 6f 6e 20 76 61 fgdat section va
2460: 72 29 0a 20 20 28 6c 65 74 20 28 28 73 65 63 74 r). (let ((sect
2470: 64 61 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d dat (hash-table-
2480: 72 65 66 2f 64 65 66 61 75 6c 74 20 63 66 67 64 ref/default cfgd
2490: 61 74 20 73 65 63 74 69 6f 6e 20 27 28 29 29 29 at section '()))
24a0: 29 0a 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f ). (if (null?
24b0: 20 73 65 63 74 64 61 74 29 0a 09 23 66 0a 09 28 sectdat)..#f..(
24c0: 6c 65 74 20 28 28 6d 61 74 63 68 20 28 61 73 73 let ((match (ass
24d0: 6f 63 20 76 61 72 20 73 65 63 74 64 61 74 29 29 oc var sectdat))
24e0: 29 0a 09 20 20 28 69 66 20 6d 61 74 63 68 20 3b ).. (if match ;
24f0: 3b 20 28 61 6e 64 20 6d 61 74 63 68 20 28 6c 69 ; (and match (li
2500: 73 74 3f 20 6d 61 74 63 68 29 28 3e 20 28 6c 65 st? match)(> (le
2510: 6e 67 74 68 20 6d 61 74 63 68 29 20 31 29 29 0a ngth match) 1)).
2520: 09 20 20 20 20 20 20 28 63 61 64 72 20 6d 61 74 . (cadr mat
2530: 63 68 29 0a 09 20 20 20 20 20 20 23 66 29 29 0a ch).. #f)).
2540: 09 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 .)))..(define (c
2550: 6f 6e 66 69 67 66 3a 73 65 63 74 69 6f 6e 2d 76 onfigf:section-v
2560: 61 72 73 20 63 66 67 64 61 74 20 73 65 63 74 69 ars cfgdat secti
2570: 6f 6e 29 0a 20 20 28 6c 65 74 20 28 28 73 65 63 on). (let ((sec
2580: 74 64 61 74 20 28 68 61 73 68 2d 74 61 62 6c 65 tdat (hash-table
2590: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 63 66 67 -ref/default cfg
25a0: 64 61 74 20 73 65 63 74 69 6f 6e 20 27 28 29 29 dat section '())
25b0: 29 29 0a 20 20 20 20 28 69 66 20 28 6e 75 6c 6c )). (if (null
25c0: 3f 20 73 65 63 74 64 61 74 29 0a 09 27 28 29 0a ? sectdat)..'().
25d0: 09 28 6d 61 70 20 63 61 72 20 73 65 63 74 64 61 .(map car sectda
25e0: 74 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 t))))..(define (
25f0: 73 65 74 75 70 29 0a 20 20 28 6c 65 74 2a 20 28 setup). (let* (
2600: 28 63 6f 6e 66 69 67 66 20 28 66 69 6e 64 2d 63 (configf (find-c
2610: 6f 6e 66 69 67 29 29 0a 09 20 28 63 6f 6e 66 69 onfig)).. (confi
2620: 67 20 20 28 69 66 20 63 6f 6e 66 69 67 66 20 28 g (if configf (
2630: 72 65 61 64 2d 63 6f 6e 66 69 67 20 63 6f 6e 66 read-config conf
2640: 69 67 66 20 23 66 20 23 74 29 20 23 66 29 29 29 igf #f #t) #f)))
2650: 0a 20 20 20 20 28 69 66 20 63 6f 6e 66 69 67 0a . (if config.
2660: 09 28 73 65 74 65 6e 76 20 22 52 55 4e 5f 41 52 .(setenv "RUN_AR
2670: 45 41 5f 48 4f 4d 45 22 20 28 70 61 74 68 6e 61 EA_HOME" (pathna
2680: 6d 65 2d 64 69 72 65 63 74 6f 72 79 20 63 6f 6e me-directory con
2690: 66 69 67 66 29 29 29 0a 20 20 20 20 63 6f 6e 66 figf))). conf
26a0: 69 67 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d ig))..;;========
26b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
26c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
26d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
26e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
26f0: 3b 20 4e 6f 6e 20 64 65 73 74 72 75 63 74 69 76 ; Non destructiv
2700: 65 20 77 72 69 74 69 6e 67 20 6f 66 20 63 6f 6e e writing of con
2710: 66 69 67 20 66 69 6c 65 0a 3b 3b 3d 3d 3d 3d 3d fig file.;;=====
2720: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2730: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2740: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2750: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2760: 3d 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 =..(define (conf
2770: 69 67 66 3a 63 6f 6d 70 72 65 73 73 2d 6d 75 6c igf:compress-mul
2780: 74 69 2d 6c 69 6e 65 73 20 66 64 61 74 29 0a 20 ti-lines fdat).
2790: 20 3b 3b 20 73 74 65 70 20 31 2e 35 20 2d 20 63 ;; step 1.5 - c
27a0: 6f 6d 70 72 65 73 73 20 61 6e 79 20 63 6f 6e 74 ompress any cont
27b0: 69 6e 75 65 64 20 6c 69 6e 65 73 0a 20 20 28 69 inued lines. (i
27c0: 66 20 28 6e 75 6c 6c 3f 20 66 64 61 74 29 20 66 f (null? fdat) f
27d0: 64 61 74 0a 09 28 6c 65 74 20 6c 6f 6f 70 20 28 dat..(let loop (
27e0: 28 68 65 64 20 28 63 61 72 20 66 64 61 74 29 29 (hed (car fdat))
27f0: 0a 09 09 20 20 20 28 74 61 6c 20 28 63 64 72 20 ... (tal (cdr
2800: 66 64 61 74 29 29 0a 09 09 20 20 20 28 63 75 72 fdat))... (cur
2810: 20 22 22 29 0a 09 09 20 20 20 28 6c 65 64 20 23 "")... (led #
2820: 66 29 0a 09 09 20 20 20 28 72 65 73 20 27 28 29 f)... (res '()
2830: 29 29 0a 09 20 20 3b 3b 20 41 4c 4c 20 57 48 49 )).. ;; ALL WHI
2840: 54 45 53 50 41 43 45 20 4c 45 41 44 49 4e 47 20 TESPACE LEADING
2850: 4c 49 4e 45 53 20 41 52 45 20 54 41 43 4b 45 44 LINES ARE TACKED
2860: 20 4f 4e 21 21 0a 09 20 20 3b 3b 20 20 31 2e 20 ON!!.. ;; 1.
2870: 72 65 6d 6f 76 65 20 6c 65 64 20 77 68 69 74 65 remove led white
2880: 73 70 61 63 65 0a 09 20 20 3b 3b 20 20 32 2e 20 space.. ;; 2.
2890: 74 61 63 6b 20 6f 6e 20 74 6f 20 68 65 64 20 77 tack on to hed w
28a0: 69 74 68 20 22 5c 6e 22 0a 09 20 20 28 6c 65 74 ith "\n".. (let
28b0: 20 28 28 6d 61 74 63 68 20 28 73 74 72 69 6e 67 ((match (string
28c0: 2d 6d 61 74 63 68 20 63 6f 6e 66 69 67 66 3a 63 -match configf:c
28d0: 6f 6e 74 2d 6c 6e 2d 72 78 20 68 65 64 29 29 29 ont-ln-rx hed)))
28e0: 0a 09 20 20 20 20 28 69 66 20 6d 61 74 63 68 20 .. (if match
28f0: 3b 3b 20 62 6c 61 73 74 21 20 68 61 76 65 20 74 ;; blast! have t
2900: 6f 20 64 65 61 6c 20 77 69 74 68 20 61 20 6d 75 o deal with a mu
2910: 6c 74 69 6c 69 6e 65 0a 09 09 28 6c 65 74 2a 20 ltiline...(let*
2920: 28 28 6c 65 61 64 20 28 63 61 64 72 20 6d 61 74 ((lead (cadr mat
2930: 63 68 29 29 0a 09 09 20 20 20 20 20 20 20 28 6c ch))... (l
2940: 76 61 6c 20 28 63 61 64 64 72 20 6d 61 74 63 68 val (caddr match
2950: 29 29 0a 09 09 20 20 20 20 20 20 20 28 6e 65 77 ))... (new
2960: 6c 20 28 63 6f 6e 63 20 63 75 72 20 22 5c 6e 22 l (conc cur "\n"
2970: 20 6c 76 61 6c 29 29 29 0a 09 09 20 20 28 69 66 lval)))... (if
2980: 20 28 6e 6f 74 20 6c 65 64 29 28 73 65 74 21 20 (not led)(set!
2990: 6c 65 64 20 6c 65 61 64 29 29 0a 09 09 20 20 28 led lead))... (
29a0: 69 66 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 20 0a if (null? tal) .
29b0: 09 09 20 20 20 20 20 20 28 73 65 74 21 20 66 64 .. (set! fd
29c0: 61 74 20 28 61 70 70 65 6e 64 20 66 64 61 74 20 at (append fdat
29d0: 28 6c 69 73 74 20 6e 65 77 6c 29 29 29 0a 09 09 (list newl)))...
29e0: 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 (loop (car
29f0: 20 74 61 6c 29 28 63 64 72 20 74 61 6c 29 20 6e tal)(cdr tal) n
2a00: 65 77 6c 20 6c 65 64 20 72 65 73 29 29 29 20 3b ewl led res))) ;
2a10: 3b 20 4e 42 2f 2f 20 6e 6f 74 20 74 61 63 6b 69 ; NB// not tacki
2a20: 6e 67 20 6e 65 77 6c 20 6f 6e 74 6f 20 72 65 73 ng newl onto res
2a30: 0a 09 09 28 6c 65 74 20 28 28 6e 65 77 72 65 73 ...(let ((newres
2a40: 20 28 69 66 20 6c 65 64 20 0a 09 09 09 09 20 20 (if led .....
2a50: 28 61 70 70 65 6e 64 20 72 65 73 20 28 6c 69 73 (append res (lis
2a60: 74 20 63 75 72 20 68 65 64 29 29 0a 09 09 09 09 t cur hed)).....
2a70: 20 20 28 61 70 70 65 6e 64 20 72 65 73 20 28 6c (append res (l
2a80: 69 73 74 20 68 65 64 29 29 29 29 29 0a 09 09 20 ist hed)))))...
2a90: 20 3b 3b 20 70 72 65 76 20 77 61 73 20 61 20 6d ;; prev was a m
2aa0: 75 6c 74 69 6c 69 6e 65 0a 09 09 20 20 28 69 66 ultiline... (if
2ab0: 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 0a 09 09 20 (null? tal)...
2ac0: 20 20 20 20 20 6e 65 77 72 65 73 0a 09 09 20 20 newres...
2ad0: 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 74 (loop (car t
2ae0: 61 6c 29 28 63 64 72 20 74 61 6c 29 20 22 22 20 al)(cdr tal) ""
2af0: 23 66 20 6e 65 77 72 65 73 29 29 29 29 29 29 29 #f newres)))))))
2b00: 29 0a 0a 3b 3b 20 6e 6f 74 65 3a 20 49 27 6d 20 )..;; note: I'm
2b10: 63 68 65 61 74 69 6e 67 20 61 20 6c 69 74 74 6c cheating a littl
2b20: 65 20 68 65 72 65 2e 20 49 20 6d 65 72 65 6c 79 e here. I merely
2b30: 20 72 65 70 6c 61 63 65 20 22 5c 6e 22 20 77 69 replace "\n" wi
2b40: 74 68 20 22 5c 6e 20 20 20 20 20 20 20 20 20 22 th "\n "
2b50: 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 .(define (config
2b60: 66 3a 65 78 70 61 6e 64 2d 6d 75 6c 74 69 2d 6c f:expand-multi-l
2b70: 69 6e 65 73 20 66 64 61 74 29 0a 20 20 3b 3b 20 ines fdat). ;;
2b80: 73 74 65 70 20 31 2e 35 20 2d 20 63 6f 6d 70 72 step 1.5 - compr
2b90: 65 73 73 20 61 6e 79 20 63 6f 6e 74 69 6e 75 65 ess any continue
2ba0: 64 20 6c 69 6e 65 73 0a 20 20 28 69 66 20 28 6e d lines. (if (n
2bb0: 75 6c 6c 3f 20 66 64 61 74 29 20 66 64 61 74 0a ull? fdat) fdat.
2bc0: 20 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 (let loop
2bd0: 28 28 68 65 64 20 28 63 61 72 20 66 64 61 74 29 ((hed (car fdat)
2be0: 29 0a 09 09 20 28 74 61 6c 20 28 63 64 72 20 66 )... (tal (cdr f
2bf0: 64 61 74 29 29 0a 09 09 20 28 72 65 73 20 27 28 dat))... (res '(
2c00: 29 29 29 0a 09 28 6c 65 74 20 28 28 6e 65 77 72 )))..(let ((newr
2c10: 65 73 20 28 61 70 70 65 6e 64 20 72 65 73 20 28 es (append res (
2c20: 6c 69 73 74 20 28 73 74 72 69 6e 67 2d 73 75 62 list (string-sub
2c30: 73 74 69 74 75 74 65 20 28 72 65 67 65 78 70 20 stitute (regexp
2c40: 22 5c 6e 22 29 20 22 5c 6e 20 20 20 20 20 20 20 "\n") "\n
2c50: 20 20 22 20 68 65 64 20 23 74 29 29 29 29 29 0a " hed #t))))).
2c60: 09 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 61 . (if (null? ta
2c70: 6c 29 0a 09 20 20 20 20 20 20 6e 65 77 72 65 73 l).. newres
2c80: 0a 09 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 .. (loop (c
2c90: 61 72 20 74 61 6c 29 28 63 64 72 20 74 61 6c 29 ar tal)(cdr tal)
2ca0: 20 6e 65 77 72 65 73 29 29 29 29 29 29 0a 0a 28 newres))))))..(
2cb0: 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a define (configf:
2cc0: 66 69 6c 65 2d 3e 6c 69 73 74 20 66 6e 61 6d 65 file->list fname
2cd0: 29 0a 20 20 28 69 66 20 28 66 69 6c 65 2d 65 78 ). (if (file-ex
2ce0: 69 73 74 73 3f 20 66 6e 61 6d 65 29 0a 20 20 20 ists? fname).
2cf0: 20 20 20 28 6c 65 74 20 28 28 69 6e 70 20 28 6f (let ((inp (o
2d00: 70 65 6e 2d 69 6e 70 75 74 2d 66 69 6c 65 20 66 pen-input-file f
2d10: 6e 61 6d 65 29 29 29 0a 09 28 6c 65 74 20 6c 6f name)))..(let lo
2d20: 6f 70 20 28 28 69 6e 6c 20 28 72 65 61 64 2d 6c op ((inl (read-l
2d30: 69 6e 65 20 69 6e 70 29 29 0a 09 09 20 20 20 28 ine inp))... (
2d40: 72 65 73 20 27 28 29 29 29 0a 09 20 20 28 69 66 res '())).. (if
2d50: 20 28 65 6f 66 2d 6f 62 6a 65 63 74 3f 20 69 6e (eof-object? in
2d60: 6c 29 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e l).. (begin
2d70: 0a 09 09 28 63 6c 6f 73 65 2d 69 6e 70 75 74 2d ...(close-input-
2d80: 70 6f 72 74 20 69 6e 70 29 0a 09 09 28 72 65 76 port inp)...(rev
2d90: 65 72 73 65 20 72 65 73 29 29 0a 09 20 20 20 20 erse res))..
2da0: 20 20 28 6c 6f 6f 70 20 28 72 65 61 64 2d 6c 69 (loop (read-li
2db0: 6e 65 20 69 6e 70 29 28 63 6f 6e 73 20 69 6e 6c ne inp)(cons inl
2dc0: 29 29 29 29 29 0a 20 20 20 20 20 20 27 28 29 29 ))))). '())
2dd0: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
2de0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2df0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2e00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2e10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 57 ===========.;; W
2e20: 72 69 74 65 20 61 20 63 6f 6e 66 69 67 0a 3b 3b rite a config.;;
2e30: 20 20 20 30 2e 20 47 69 76 65 6e 20 61 20 72 65 0. Given a re
2e40: 66 65 72 65 72 65 6e 63 65 20 64 61 74 61 20 73 fererence data s
2e50: 74 72 75 63 74 75 72 65 20 22 69 6e 64 61 74 22 tructure "indat"
2e60: 0a 3b 3b 20 20 20 31 2e 20 4f 70 65 6e 20 74 68 .;; 1. Open th
2e70: 65 20 6f 75 74 70 75 74 20 66 69 6c 65 20 61 6e e output file an
2e80: 64 20 72 65 61 64 20 69 74 20 69 6e 74 6f 20 61 d read it into a
2e90: 20 6c 69 73 74 0a 3b 3b 20 20 20 32 2e 20 46 6c list.;; 2. Fl
2ea0: 61 74 74 65 6e 20 61 6e 79 20 6d 75 6c 74 69 6c atten any multil
2eb0: 69 6e 65 20 65 6e 74 72 69 65 73 0a 3b 3b 20 20 ine entries.;;
2ec0: 20 33 2e 20 4d 6f 64 69 66 79 20 76 61 6c 75 65 3. Modify value
2ed0: 73 20 70 65 72 20 63 6f 6e 74 65 6e 74 73 20 6f s per contents o
2ee0: 66 20 22 69 6e 64 61 74 22 20 61 6e 64 20 72 65 f "indat" and re
2ef0: 6d 6f 76 65 20 61 62 73 65 6e 74 20 76 61 6c 75 move absent valu
2f00: 65 73 0a 3b 3b 20 20 20 34 2e 20 41 70 70 65 6e es.;; 4. Appen
2f10: 64 20 6e 65 77 20 76 61 6c 75 65 73 20 74 6f 20 d new values to
2f20: 74 68 65 20 73 65 63 74 69 6f 6e 20 28 69 6d 6d the section (imm
2f30: 65 64 69 61 74 65 6c 79 20 61 66 74 65 72 20 6c ediately after l
2f40: 61 73 74 20 6c 65 67 69 74 20 65 6e 74 72 79 29 ast legit entry)
2f50: 0a 3b 3b 20 20 20 35 2e 20 57 72 69 74 65 20 6f .;; 5. Write o
2f60: 75 74 20 74 68 65 20 6e 65 77 20 6c 69 73 74 20 ut the new list
2f70: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
2f80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2f90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2fa0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2fb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 =========..(defi
2fc0: 6e 65 20 28 63 6f 6e 66 69 67 66 3a 77 72 69 74 ne (configf:writ
2fd0: 65 2d 63 6f 6e 66 69 67 20 69 6e 64 61 74 20 66 e-config indat f
2fe0: 6e 61 6d 65 20 23 21 6b 65 79 20 28 72 65 71 75 name #!key (requ
2ff0: 69 72 65 64 2d 73 65 63 74 69 6f 6e 73 20 27 28 ired-sections '(
3000: 29 29 29 0a 20 20 28 6c 65 74 2a 20 28 3b 3b 20 ))). (let* (;;
3010: 73 74 65 70 20 31 3a 20 4f 70 65 6e 20 74 68 65 step 1: Open the
3020: 20 6f 75 74 70 75 74 20 66 69 6c 65 20 61 6e 64 output file and
3030: 20 72 65 61 64 20 69 74 20 69 6e 74 6f 20 61 20 read it into a
3040: 6c 69 73 74 0a 09 20 28 66 64 61 74 20 20 20 20 list.. (fdat
3050: 20 20 20 28 63 6f 6e 66 69 67 66 3a 66 69 6c 65 (configf:file
3060: 2d 3e 6c 69 73 74 20 66 6e 61 6d 65 29 29 0a 09 ->list fname))..
3070: 20 28 72 65 66 64 61 74 20 20 28 6d 61 6b 65 2d (refdat (make-
3080: 68 61 73 68 2d 74 61 62 6c 65 29 29 0a 09 20 28 hash-table)).. (
3090: 73 65 63 68 61 73 68 20 28 6d 61 6b 65 2d 68 61 sechash (make-ha
30a0: 73 68 2d 74 61 62 6c 65 29 29 20 3b 3b 20 63 75 sh-table)) ;; cu
30b0: 72 72 65 6e 74 20 73 65 63 74 69 6f 6e 20 68 61 rrent section ha
30c0: 73 68 2c 20 69 6e 69 74 20 77 69 74 68 20 68 61 sh, init with ha
30d0: 73 68 20 66 6f 72 20 22 64 65 66 61 75 6c 74 22 sh for "default"
30e0: 20 73 65 63 74 69 6f 6e 0a 09 20 28 6e 65 77 20 section.. (new
30f0: 20 20 20 20 23 66 29 20 3b 3b 20 70 75 74 20 74 #f) ;; put t
3100: 68 65 20 6c 69 6e 65 20 74 6f 20 62 65 20 75 73 he line to be us
3110: 65 64 20 69 6e 20 6e 65 77 2c 20 69 66 20 69 74 ed in new, if it
3120: 20 69 73 20 74 6f 20 62 65 20 64 65 6c 65 74 65 is to be delete
3130: 64 20 74 68 65 20 73 65 74 20 6e 65 77 20 74 6f d the set new to
3140: 20 23 66 0a 09 20 28 73 65 63 6e 61 6d 65 20 23 #f.. (secname #
3150: 66 29 29 0a 0a 20 20 20 20 3b 3b 20 73 74 65 70 f)).. ;; step
3160: 20 32 3a 20 46 6c 61 74 74 65 6e 20 6d 75 6c 74 2: Flatten mult
3170: 69 6c 69 6e 65 20 65 6e 74 72 69 65 73 0a 20 20 iline entries.
3180: 20 20 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c (if (not (null
3190: 3f 20 66 64 61 74 29 29 28 73 65 74 21 20 66 64 ? fdat))(set! fd
31a0: 61 74 20 28 63 6f 6e 66 69 67 66 3a 63 6f 6d 70 at (configf:comp
31b0: 72 65 73 73 2d 6d 75 6c 74 69 2d 6c 69 6e 65 20 ress-multi-line
31c0: 66 64 61 74 29 29 29 0a 0a 20 20 20 20 3b 3b 20 fdat))).. ;;
31d0: 73 74 65 70 20 33 3a 20 4d 6f 64 69 66 79 20 76 step 3: Modify v
31e0: 61 6c 75 65 73 20 70 65 72 20 63 6f 6e 74 65 6e alues per conten
31f0: 74 73 20 6f 66 20 22 69 6e 64 61 74 22 20 61 6e ts of "indat" an
3200: 64 20 72 65 6d 6f 76 65 20 61 62 73 65 6e 74 20 d remove absent
3210: 76 61 6c 75 65 73 0a 20 20 20 20 28 69 66 20 28 values. (if (
3220: 6e 6f 74 20 28 6e 75 6c 6c 3f 20 66 64 61 74 29 not (null? fdat)
3230: 29 0a 09 28 6c 65 74 20 6c 6f 6f 70 20 28 28 68 )..(let loop ((h
3240: 65 64 20 20 28 63 61 72 20 66 64 61 74 29 29 0a ed (car fdat)).
3250: 09 09 20 20 20 28 74 61 6c 20 20 28 63 61 64 72 .. (tal (cadr
3260: 20 66 64 61 74 29 29 0a 09 09 20 20 20 28 72 65 fdat))... (re
3270: 73 20 20 27 28 29 29 0a 09 09 20 20 20 28 6c 6e s '())... (ln
3280: 75 6d 20 30 29 29 0a 09 20 20 28 72 65 67 65 78 um 0)).. (regex
3290: 2d 63 61 73 65 20 0a 09 20 20 20 68 65 64 0a 09 -case .. hed..
32a0: 20 20 20 28 63 6f 6e 66 69 67 66 3a 63 6f 6d 6d (configf:comm
32b0: 65 6e 74 2d 72 78 20 5f 20 20 20 20 20 20 20 20 ent-rx _
32c0: 20 20 20 20 20 20 20 20 20 20 28 73 65 74 21 20 (set!
32d0: 72 65 73 20 28 61 70 70 65 6e 64 20 72 65 73 20 res (append res
32e0: 28 6c 69 73 74 20 68 65 64 29 29 29 29 20 3b 3b (list hed)))) ;;
32f0: 20 28 6c 6f 6f 70 20 28 72 65 61 64 2d 6c 69 6e (loop (read-lin
3300: 65 20 69 6e 70 29 20 63 75 72 72 2d 73 65 63 74 e inp) curr-sect
3310: 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 66 29 29 ion-name #f #f))
3320: 0a 09 20 20 20 28 63 6f 6e 66 69 67 66 3a 62 6c .. (configf:bl
3330: 61 6e 6b 2d 6c 2d 72 78 20 5f 20 20 20 20 20 20 ank-l-rx _
3340: 20 20 20 20 20 20 20 20 20 20 20 20 28 73 65 74 (set
3350: 21 20 72 65 73 20 28 61 70 70 65 6e 64 20 72 65 ! res (append re
3360: 73 20 28 6c 69 73 74 20 68 65 64 29 29 29 29 20 s (list hed))))
3370: 3b 3b 20 28 6c 6f 6f 70 20 28 72 65 61 64 2d 6c ;; (loop (read-l
3380: 69 6e 65 20 69 6e 70 29 20 63 75 72 72 2d 73 65 ine inp) curr-se
3390: 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 66 ction-name #f #f
33a0: 29 29 0a 09 20 20 20 28 63 6f 6e 66 69 67 66 3a )).. (configf:
33b0: 73 65 63 74 69 6f 6e 2d 72 78 20 28 20 78 20 73 section-rx ( x s
33c0: 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 29 20 28 6c ection-name ) (l
33d0: 65 74 20 28 28 73 65 63 74 69 6f 6e 2d 68 61 73 et ((section-has
33e0: 68 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 h (hash-table-re
33f0: 66 2f 64 65 66 61 75 6c 74 20 72 65 66 64 61 74 f/default refdat
3400: 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 section-name #f
3410: 29 29 29 0a 09 09 09 09 09 20 20 20 20 28 69 66 )))...... (if
3420: 20 28 6e 6f 74 20 73 65 63 74 69 6f 6e 2d 68 61 (not section-ha
3430: 73 68 29 0a 09 09 09 09 09 09 28 6c 65 74 20 28 sh).......(let (
3440: 28 6e 65 77 68 61 73 68 20 28 6d 61 6b 65 2d 68 (newhash (make-h
3450: 61 73 68 2d 74 61 62 6c 65 29 29 29 0a 09 09 09 ash-table)))....
3460: 09 09 09 20 20 28 68 61 73 68 2d 74 61 62 6c 65 ... (hash-table
3470: 2d 73 65 74 21 20 72 65 66 68 61 73 68 20 73 65 -set! refhash se
3480: 63 74 69 6f 6e 2d 6e 61 6d 65 20 6e 65 77 68 61 ction-name newha
3490: 73 68 29 0a 09 09 09 09 09 09 20 20 28 73 65 74 sh)....... (set
34a0: 21 20 73 65 63 68 61 73 68 20 6e 65 77 68 61 73 ! sechash newhas
34b0: 68 29 29 0a 09 09 09 09 09 09 28 73 65 74 21 20 h)).......(set!
34c0: 73 65 63 68 61 73 68 20 73 65 63 74 69 6f 6e 2d sechash section-
34d0: 68 61 73 68 29 29 0a 09 09 09 09 09 20 20 20 20 hash))......
34e0: 28 73 65 74 21 20 6e 65 77 20 68 65 64 29 20 3b (set! new hed) ;
34f0: 3b 20 77 69 6c 6c 20 61 70 70 65 6e 64 20 74 68 ; will append th
3500: 69 73 20 61 74 20 74 68 65 20 62 6f 74 74 6f 6d is at the bottom
3510: 20 6f 66 20 74 68 65 20 6c 6f 6f 70 0a 09 09 09 of the loop....
3520: 09 09 20 20 20 20 28 73 65 74 21 20 73 65 63 6e .. (set! secn
3530: 61 6d 65 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 ame section-name
3540: 29 0a 09 09 09 09 09 20 20 20 20 29 29 0a 09 20 )...... ))..
3550: 20 20 3b 3b 20 4e 6f 20 6e 65 65 64 20 74 6f 20 ;; No need to
3560: 70 72 6f 63 65 73 73 20 6b 65 79 20 63 6d 64 2c process key cmd,
3570: 20 6c 65 74 20 69 74 20 66 61 6c 6c 20 74 68 6f let it fall tho
3580: 75 67 68 20 74 6f 20 6b 65 79 20 76 61 6c 0a 09 ugh to key val..
3590: 20 20 20 28 63 6f 6e 66 69 67 66 3a 6b 65 79 2d (configf:key-
35a0: 76 61 6c 2d 70 72 20 28 20 78 20 6b 65 79 20 76 val-pr ( x key v
35b0: 61 6c 20 20 20 20 20 20 29 0a 09 09 20 20 20 20 al )...
35c0: 20 20 20 28 6c 65 74 20 28 28 6e 65 77 76 61 6c (let ((newval
35d0: 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 (config-lookup
35e0: 69 6e 64 61 74 20 73 65 63 20 6b 65 79 29 29 29 indat sec key)))
35f0: 0a 09 09 09 20 3b 3b 20 63 61 6e 20 68 61 6e 64 .... ;; can hand
3600: 6c 65 20 6e 65 77 76 61 6c 20 3d 3d 20 23 66 20 le newval == #f
3610: 68 65 72 65 20 3d 3e 20 74 68 61 74 20 6d 65 61 here => that mea
3620: 6e 73 20 6b 65 79 20 69 73 20 72 65 6d 6f 76 65 ns key is remove
3630: 64 0a 09 09 09 20 28 63 6f 6e 64 20 0a 09 09 09 d.... (cond ....
3640: 20 20 28 28 65 71 75 61 6c 3f 20 6e 65 77 76 61 ((equal? newva
3650: 6c 20 76 61 6c 29 0a 09 09 09 20 20 20 28 73 65 l val).... (se
3660: 74 21 20 72 65 73 20 28 61 70 70 65 6e 64 20 72 t! res (append r
3670: 65 73 20 28 6c 69 73 74 20 68 65 64 29 29 29 29 es (list hed))))
3680: 0a 09 09 09 20 20 28 28 6e 6f 74 20 6e 65 77 76 .... ((not newv
3690: 61 6c 29 20 3b 3b 20 6b 65 79 20 68 61 73 20 62 al) ;; key has b
36a0: 65 65 6e 20 72 65 6d 6f 76 65 64 0a 09 09 09 20 een removed....
36b0: 20 20 28 73 65 74 21 20 6e 65 77 20 23 66 29 29 (set! new #f))
36c0: 0a 09 09 09 20 20 28 28 6e 6f 74 20 28 65 71 75 .... ((not (equ
36d0: 61 6c 3f 20 6e 65 77 76 61 6c 20 76 61 6c 29 29 al? newval val))
36e0: 0a 09 09 09 20 20 20 20 20 28 68 61 73 68 2d 74 .... (hash-t
36f0: 61 62 6c 65 2d 73 65 74 21 20 73 65 63 68 61 73 able-set! sechas
3700: 68 20 6b 65 79 20 6e 65 77 76 61 6c 29 0a 09 09 h key newval)...
3710: 09 20 20 20 20 20 28 73 65 74 21 20 6e 65 77 20 . (set! new
3720: 28 63 6f 6e 63 20 6b 65 79 20 22 20 22 20 6e 65 (conc key " " ne
3730: 77 76 61 6c 29 29 29 0a 09 09 09 20 20 28 65 6c wval))).... (el
3740: 73 65 0a 09 09 09 20 20 20 28 64 65 62 75 67 3a se.... (debug:
3750: 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 print 0 "ERROR:
3760: 70 72 6f 62 6c 65 6d 20 70 61 72 73 69 6e 67 20 problem parsing
3770: 6c 69 6e 65 20 6e 75 6d 62 65 72 20 22 20 6c 6e line number " ln
3780: 75 6d 20 22 5c 22 22 20 68 65 64 20 22 5c 22 22 um "\"" hed "\""
3790: 29 29 29 29 29 0a 09 20 20 20 28 65 6c 73 65 0a ))))).. (else.
37a0: 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
37b0: 74 20 30 20 22 45 52 52 4f 52 3a 20 50 72 6f 62 t 0 "ERROR: Prob
37c0: 6c 65 6d 20 70 61 72 73 69 6e 67 20 6c 69 6e 65 lem parsing line
37d0: 20 6e 75 6d 20 22 20 6c 6e 75 6d 20 22 20 3a 5c num " lnum " :\
37e0: 6e 20 20 20 22 20 68 65 64 20 29 29 29 0a 09 20 n " hed )))..
37f0: 20 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f (if (not (null?
3800: 20 74 61 6c 29 29 0a 09 20 20 20 20 20 20 28 6c tal)).. (l
3810: 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 28 63 64 oop (car tal)(cd
3820: 72 20 74 61 6c 29 28 69 66 20 6e 65 77 20 28 61 r tal)(if new (a
3830: 70 70 65 6e 64 20 72 65 73 20 28 6c 69 73 74 20 ppend res (list
3840: 6e 65 77 29 29 20 72 65 73 29 28 2b 20 6c 6e 75 new)) res)(+ lnu
3850: 6d 20 31 29 29 29 0a 09 20 20 3b 3b 20 64 72 6f m 1))).. ;; dro
3860: 70 20 74 6f 20 68 65 72 65 20 77 68 65 6e 20 64 p to here when d
3870: 6f 6e 65 20 70 72 6f 63 65 73 73 69 6e 67 2c 20 one processing,
3880: 72 65 73 20 63 6f 6e 74 61 69 6e 73 20 6d 6f 64 res contains mod
3890: 69 66 69 65 64 20 6c 69 73 74 20 6f 66 20 6c 69 ified list of li
38a0: 6e 65 73 0a 09 20 20 28 73 65 74 21 20 66 64 61 nes.. (set! fda
38b0: 74 20 72 65 73 29 29 29 0a 0a 20 20 20 20 3b 3b t res))).. ;;
38c0: 20 73 74 65 70 20 34 3a 20 41 70 70 65 6e 64 20 step 4: Append
38d0: 6e 65 77 20 76 61 6c 75 65 73 20 74 6f 20 74 68 new values to th
38e0: 65 20 73 65 63 74 69 6f 6e 0a 20 20 20 20 28 66 e section. (f
38f0: 6f 72 2d 65 61 63 68 20 0a 20 20 20 20 20 28 6c or-each . (l
3900: 61 6d 62 64 61 20 28 73 65 63 74 69 6f 6e 29 0a ambda (section).
3910: 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 73 64 (let ((sd
3920: 61 74 20 20 20 27 28 29 29 20 3b 3b 20 61 70 70 at '()) ;; app
3930: 65 6e 64 20 6e 65 65 64 65 64 20 62 69 74 73 20 end needed bits
3940: 68 65 72 65 0a 09 20 20 20 20 20 28 73 76 61 72 here.. (svar
3950: 73 20 20 28 63 6f 6e 66 69 67 66 3a 73 65 63 74 s (configf:sect
3960: 69 6f 6e 2d 76 61 72 73 20 69 6e 64 61 74 20 73 ion-vars indat s
3970: 65 63 74 69 6f 6e 29 29 29 0a 09 20 28 66 6f 72 ection))).. (for
3980: 2d 65 61 63 68 20 0a 09 20 20 28 6c 61 6d 62 64 -each .. (lambd
3990: 61 20 28 76 61 72 29 0a 09 20 20 20 20 28 6c 65 a (var).. (le
39a0: 74 20 28 28 76 61 6c 20 28 63 6f 6e 66 69 67 2d t ((val (config-
39b0: 6c 6f 6f 6b 75 70 20 72 65 66 64 61 74 20 73 65 lookup refdat se
39c0: 63 74 69 6f 6e 20 76 61 72 29 29 29 0a 09 20 20 ction var)))..
39d0: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 76 61 6c (if (not val
39e0: 29 20 3b 3b 20 74 68 69 73 20 6f 6e 65 20 69 73 ) ;; this one is
39f0: 20 6e 65 77 0a 09 09 20 20 28 62 65 67 69 6e 0a new... (begin.
3a00: 09 09 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f .. (if (null?
3a10: 20 73 64 61 74 29 28 73 65 74 21 20 73 64 61 74 sdat)(set! sdat
3a20: 20 28 6c 69 73 74 20 28 63 6f 6e 63 20 22 5b 22 (list (conc "["
3a30: 20 73 65 63 74 69 6f 6e 20 22 5d 22 29 29 29 29 section "]"))))
3a40: 0a 09 09 20 20 20 20 28 73 65 74 21 20 73 64 61 ... (set! sda
3a50: 74 20 28 61 70 70 65 6e 64 20 73 64 61 74 20 28 t (append sdat (
3a60: 6c 69 73 74 20 28 63 6f 6e 63 20 76 61 72 20 22 list (conc var "
3a70: 20 22 20 76 61 6c 29 29 29 29 29 29 29 29 0a 09 " val))))))))..
3a80: 20 20 73 76 61 72 73 29 0a 09 20 28 73 65 74 21 svars).. (set!
3a90: 20 66 64 61 74 20 28 61 70 70 65 6e 64 20 66 64 fdat (append fd
3aa0: 61 74 20 73 64 61 74 29 29 29 29 0a 20 20 20 20 at sdat)))).
3ab0: 20 28 64 65 6c 65 74 65 2d 64 75 70 6c 69 63 61 (delete-duplica
3ac0: 74 65 73 20 28 61 70 70 65 6e 64 20 72 65 71 75 tes (append requ
3ad0: 69 72 65 2d 73 65 63 74 69 6f 6e 73 20 28 68 61 ire-sections (ha
3ae0: 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 69 6e sh-table-keys in
3af0: 64 61 74 29 29 29 29 0a 0a 20 20 20 20 3b 3b 20 dat)))).. ;;
3b00: 73 74 65 70 20 35 3a 20 57 72 69 74 65 20 6f 75 step 5: Write ou
3b10: 74 20 6e 65 77 20 66 69 6c 65 0a 20 20 20 20 28 t new file. (
3b20: 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 with-output-to-f
3b30: 69 6c 65 20 66 6e 61 6d 65 20 0a 20 20 20 20 20 ile fname .
3b40: 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 28 66 6f (lambda ()..(fo
3b50: 72 2d 65 61 63 68 20 0a 09 20 28 6c 61 6d 62 64 r-each .. (lambd
3b60: 61 20 28 6c 69 6e 65 29 0a 09 20 20 20 28 70 72 a (line).. (pr
3b70: 69 6e 74 20 6c 69 6e 65 29 29 0a 09 20 28 63 6f int line)).. (co
3b80: 6e 66 69 67 66 3a 65 78 70 61 6e 64 2d 6d 75 6c nfigf:expand-mul
3b90: 74 69 2d 6c 69 6e 65 73 20 66 64 61 74 29 29 29 ti-lines fdat)))
3ba0: 29 29 29 0a 0a )))..