File
configf.scm
— part of check-in
[ce2999b801]
at
2013-05-02 22:06:41
on branch v1.54
— Added rget alias for runconfigs-get, added backslash line extension, added get of default in rget if not found in target
(user:
matt
size: 17800)
[more...]
0000: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
0010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0040: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 43 6f 70 79 ========.;; Copy
0050: 72 69 67 68 74 20 32 30 30 36 2d 32 30 31 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 20 64 69 72 x regex-case dir
02a0: 65 63 74 6f 72 79 2d 75 74 69 6c 73 29 0a 28 64 ectory-utils).(d
02b0: 65 63 6c 61 72 65 20 28 75 6e 69 74 20 63 6f 6e eclare (unit con
02c0: 66 69 67 66 29 29 0a 28 64 65 63 6c 61 72 65 20 figf)).(declare
02d0: 28 75 73 65 73 20 63 6f 6d 6d 6f 6e 29 29 0a 28 (uses common)).(
02e0: 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 70 72 declare (uses pr
02f0: 6f 63 65 73 73 29 29 0a 0a 28 69 6e 63 6c 75 64 ocess))..(includ
0300: 65 20 22 63 6f 6d 6d 6f 6e 5f 72 65 63 6f 72 64 e "common_record
0310: 73 2e 73 63 6d 22 29 0a 0a 3b 3b 20 72 65 74 75 s.scm")..;; retu
0320: 72 6e 20 6c 69 73 74 20 28 70 61 74 68 20 66 75 rn list (path fu
0330: 6c 6c 70 61 74 68 20 63 6f 6e 66 69 67 6e 61 6d llpath confignam
0340: 65 29 0a 28 64 65 66 69 6e 65 20 28 66 69 6e 64 e).(define (find
0350: 2d 63 6f 6e 66 69 67 20 63 6f 6e 66 69 67 6e 61 -config configna
0360: 6d 65 20 23 21 6b 65 79 20 28 74 6f 70 70 61 74 me #!key (toppat
0370: 68 20 23 66 29 29 0a 20 20 28 69 66 20 74 6f 70 h #f)). (if top
0380: 70 61 74 68 0a 20 20 20 20 20 20 28 6c 65 74 20 path. (let
0390: 28 28 63 66 6e 61 6d 65 20 28 63 6f 6e 63 20 74 ((cfname (conc t
03a0: 6f 70 70 61 74 68 20 22 2f 22 20 63 6f 6e 66 69 oppath "/" confi
03b0: 67 6e 61 6d 65 29 29 29 0a 09 28 69 66 20 28 66 gname)))..(if (f
03c0: 69 6c 65 2d 65 78 69 73 74 73 3f 20 63 66 6e 61 ile-exists? cfna
03d0: 6d 65 29 0a 09 20 20 20 20 28 6c 69 73 74 20 74 me).. (list t
03e0: 6f 70 70 61 74 68 20 63 66 6e 61 6d 65 20 63 6f oppath cfname co
03f0: 6e 66 69 67 6e 61 6d 65 29 0a 09 20 20 20 20 28 nfigname).. (
0400: 6c 69 73 74 20 23 66 20 20 20 20 20 20 23 66 20 list #f #f
0410: 20 20 20 20 23 66 29 29 29 0a 20 20 20 20 20 20 #f))).
0420: 28 6c 65 74 2a 20 28 28 63 77 64 20 28 73 74 72 (let* ((cwd (str
0430: 69 6e 67 2d 73 70 6c 69 74 20 28 63 75 72 72 65 ing-split (curre
0440: 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 20 22 2f nt-directory) "/
0450: 22 29 29 29 0a 09 28 6c 65 74 20 6c 6f 6f 70 20 ")))..(let loop
0460: 28 28 64 69 72 20 63 77 64 29 29 0a 09 20 20 28 ((dir cwd)).. (
0470: 6c 65 74 2a 20 28 28 70 61 74 68 20 20 20 20 20 let* ((path
0480: 28 63 6f 6e 63 20 22 2f 22 20 28 73 74 72 69 6e (conc "/" (strin
0490: 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 64 69 g-intersperse di
04a0: 72 20 22 2f 22 29 29 29 0a 09 09 20 28 66 75 6c r "/")))... (ful
04b0: 6c 70 61 74 68 20 28 63 6f 6e 63 20 70 61 74 68 lpath (conc path
04c0: 20 22 2f 22 20 63 6f 6e 66 69 67 6e 61 6d 65 29 "/" configname)
04d0: 29 29 0a 09 20 20 20 20 28 69 66 20 28 66 69 6c )).. (if (fil
04e0: 65 2d 65 78 69 73 74 73 3f 20 66 75 6c 6c 70 61 e-exists? fullpa
04f0: 74 68 29 0a 09 09 28 6c 69 73 74 20 70 61 74 68 th)...(list path
0500: 20 66 75 6c 6c 70 61 74 68 20 63 6f 6e 66 69 67 fullpath config
0510: 6e 61 6d 65 29 0a 09 09 28 6c 65 74 20 28 28 72 name)...(let ((r
0520: 65 6d 63 77 64 20 28 74 61 6b 65 20 64 69 72 20 emcwd (take dir
0530: 28 2d 20 28 6c 65 6e 67 74 68 20 64 69 72 29 20 (- (length dir)
0540: 31 29 29 29 29 0a 09 09 20 20 28 69 66 20 28 6e 1))))... (if (n
0550: 75 6c 6c 3f 20 72 65 6d 63 77 64 29 0a 09 09 20 ull? remcwd)...
0560: 20 20 20 20 20 28 6c 69 73 74 20 23 66 20 23 66 (list #f #f
0570: 20 23 66 29 20 3b 3b 20 20 23 66 20 23 66 29 20 #f) ;; #f #f)
0580: 0a 09 09 20 20 28 6c 6f 6f 70 20 72 65 6d 63 77 ... (loop remcw
0590: 64 29 29 29 29 29 29 29 29 29 0a 0a 28 64 65 66 d)))))))))..(def
05a0: 69 6e 65 20 28 63 6f 6e 66 69 67 3a 61 73 73 6f ine (config:asso
05b0: 63 2d 73 61 66 65 2d 61 64 64 20 61 6c 69 73 74 c-safe-add alist
05c0: 20 6b 65 79 20 76 61 6c 29 0a 20 20 28 6c 65 74 key val). (let
05d0: 20 28 28 6e 65 77 61 6c 69 73 74 20 28 66 69 6c ((newalist (fil
05e0: 74 65 72 20 28 6c 61 6d 62 64 61 20 28 78 29 28 ter (lambda (x)(
05f0: 6e 6f 74 20 28 65 71 75 61 6c 3f 20 6b 65 79 20 not (equal? key
0600: 28 63 61 72 20 78 29 29 29 29 20 61 6c 69 73 74 (car x)))) alist
0610: 29 29 29 0a 20 20 20 20 28 61 70 70 65 6e 64 20 ))). (append
0620: 6e 65 77 61 6c 69 73 74 20 28 6c 69 73 74 20 28 newalist (list (
0630: 6c 69 73 74 20 6b 65 79 20 76 61 6c 29 29 29 29 list key val))))
0640: 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 )..(define (conf
0650: 69 67 3a 65 76 61 6c 2d 73 74 72 69 6e 67 2d 69 ig:eval-string-i
0660: 6e 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 73 74 n-environment st
0670: 72 29 0a 20 20 28 6c 65 74 20 28 28 63 6d 64 72 r). (let ((cmdr
0680: 65 73 20 28 63 6d 64 2d 72 75 6e 2d 3e 6c 69 73 es (cmd-run->lis
0690: 74 20 28 63 6f 6e 63 20 22 65 63 68 6f 20 22 20 t (conc "echo "
06a0: 73 74 72 29 29 29 29 0a 20 20 20 20 28 69 66 20 str)))). (if
06b0: 28 6e 75 6c 6c 3f 20 63 6d 64 72 65 73 29 20 22 (null? cmdres) "
06c0: 22 0a 09 28 63 61 61 72 20 63 6d 64 72 65 73 29 "..(caar cmdres)
06d0: 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
06e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
06f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0700: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0710: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
0720: 20 4d 61 6b 65 20 74 68 65 20 72 65 67 65 78 70 Make the regexp
0730: 27 73 20 6e 65 65 64 65 64 20 67 6c 6f 62 61 6c 's needed global
0740: 6c 79 20 61 76 61 69 6c 61 62 6c 65 0a 3b 3b 3d ly available.;;=
0750: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0760: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0770: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0780: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0790: 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 63 =====..(define c
07a0: 6f 6e 66 69 67 66 3a 69 6e 63 6c 75 64 65 2d 72 onfigf:include-r
07b0: 78 20 28 72 65 67 65 78 70 20 22 5e 5c 5c 5b 69 x (regexp "^\\[i
07c0: 6e 63 6c 75 64 65 5c 5c 73 2b 28 2e 2a 29 5c 5c nclude\\s+(.*)\\
07d0: 5d 5c 5c 73 2a 24 22 29 29 0a 28 64 65 66 69 6e ]\\s*$")).(defin
07e0: 65 20 63 6f 6e 66 69 67 66 3a 73 65 63 74 69 6f e configf:sectio
07f0: 6e 2d 72 78 20 28 72 65 67 65 78 70 20 22 5e 5c n-rx (regexp "^\
0800: 5c 5b 28 2e 2a 29 5c 5c 5d 5c 5c 73 2a 24 22 29 \[(.*)\\]\\s*$")
0810: 29 0a 28 64 65 66 69 6e 65 20 63 6f 6e 66 69 67 ).(define config
0820: 66 3a 62 6c 61 6e 6b 2d 6c 2d 72 78 20 28 72 65 f:blank-l-rx (re
0830: 67 65 78 70 20 22 5e 5c 5c 73 2a 24 22 29 29 0a gexp "^\\s*$")).
0840: 28 64 65 66 69 6e 65 20 63 6f 6e 66 69 67 66 3a (define configf:
0850: 6b 65 79 2d 73 79 73 2d 70 72 20 28 72 65 67 65 key-sys-pr (rege
0860: 78 70 20 22 5e 28 5c 5c 53 2b 29 5c 5c 73 2b 5c xp "^(\\S+)\\s+\
0870: 5c 5b 73 79 73 74 65 6d 5c 5c 73 2b 28 5c 5c 53 \[system\\s+(\\S
0880: 2b 2e 2a 29 5c 5c 5d 5c 5c 73 2a 24 22 29 29 0a +.*)\\]\\s*$")).
0890: 28 64 65 66 69 6e 65 20 63 6f 6e 66 69 67 66 3a (define configf:
08a0: 6b 65 79 2d 76 61 6c 2d 70 72 20 28 72 65 67 65 key-val-pr (rege
08b0: 78 70 20 22 5e 28 5c 5c 53 2b 29 28 5c 5c 73 2b xp "^(\\S+)(\\s+
08c0: 28 2e 2a 29 7c 28 29 29 24 22 29 29 0a 28 64 65 (.*)|())$")).(de
08d0: 66 69 6e 65 20 63 6f 6e 66 69 67 66 3a 63 6f 6d fine configf:com
08e0: 6d 65 6e 74 2d 72 78 20 28 72 65 67 65 78 70 20 ment-rx (regexp
08f0: 22 5e 5c 5c 73 2a 23 2e 2a 22 29 29 0a 28 64 65 "^\\s*#.*")).(de
0900: 66 69 6e 65 20 63 6f 6e 66 69 67 66 3a 63 6f 6e fine configf:con
0910: 74 2d 6c 6e 2d 72 78 20 28 72 65 67 65 78 70 20 t-ln-rx (regexp
0920: 22 5e 28 5c 5c 73 2b 29 28 5c 5c 53 2b 2e 2a 29 "^(\\s+)(\\S+.*)
0930: 24 22 29 29 0a 0a 3b 3b 20 72 65 61 64 20 61 20 $"))..;; read a
0940: 6c 69 6e 65 20 61 6e 64 20 70 72 6f 63 65 73 73 line and process
0950: 20 61 6e 79 20 23 7b 20 2e 2e 2e 20 7d 20 63 6f any #{ ... } co
0960: 6e 73 74 72 75 63 74 73 0a 0a 28 64 65 66 69 6e nstructs..(defin
0970: 65 20 63 6f 6e 66 69 67 66 3a 76 61 72 2d 65 78 e configf:var-ex
0980: 70 61 6e 64 2d 72 65 67 65 78 20 28 72 65 67 65 pand-regex (rege
0990: 78 70 20 22 5e 28 2e 2a 29 23 5c 5c 7b 28 73 63 xp "^(.*)#\\{(sc
09a0: 68 65 6d 65 7c 73 79 73 74 65 6d 7c 73 68 65 6c heme|system|shel
09b0: 6c 7c 67 65 74 65 6e 76 7c 67 65 74 7c 72 75 6e l|getenv|get|run
09c0: 63 6f 6e 66 69 67 73 2d 67 65 74 7c 72 67 65 74 configs-get|rget
09d0: 29 5c 5c 73 2b 28 5b 5e 5c 5c 7d 5c 5c 7b 5d 2a )\\s+([^\\}\\{]*
09e0: 29 5c 5c 7d 28 2e 2a 29 22 29 29 0a 28 64 65 66 )\\}(.*)")).(def
09f0: 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a 70 72 6f ine (configf:pro
0a00: 63 65 73 73 2d 6c 69 6e 65 20 6c 20 68 74 29 0a cess-line l ht).
0a10: 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 72 65 (let loop ((re
0a20: 73 20 6c 29 29 0a 20 20 20 20 28 69 66 20 28 73 s l)). (if (s
0a30: 74 72 69 6e 67 3f 20 72 65 73 29 0a 09 28 6c 65 tring? res)..(le
0a40: 74 20 28 28 6d 61 74 63 68 64 61 74 20 28 73 74 t ((matchdat (st
0a50: 72 69 6e 67 2d 73 65 61 72 63 68 20 63 6f 6e 66 ring-search conf
0a60: 69 67 66 3a 76 61 72 2d 65 78 70 61 6e 64 2d 72 igf:var-expand-r
0a70: 65 67 65 78 20 72 65 73 29 29 29 0a 09 20 20 28 egex res))).. (
0a80: 69 66 20 6d 61 74 63 68 64 61 74 0a 09 20 20 20 if matchdat..
0a90: 20 20 20 28 6c 65 74 2a 20 28 28 70 72 65 73 74 (let* ((prest
0aa0: 72 20 20 28 6c 69 73 74 2d 72 65 66 20 6d 61 74 r (list-ref mat
0ab0: 63 68 64 61 74 20 31 29 29 0a 09 09 20 20 20 20 chdat 1))...
0ac0: 20 28 63 6d 64 74 79 70 65 20 28 6c 69 73 74 2d (cmdtype (list-
0ad0: 72 65 66 20 6d 61 74 63 68 64 61 74 20 32 29 29 ref matchdat 2))
0ae0: 20 3b 3b 20 65 76 61 6c 2c 20 73 79 73 74 65 6d ;; eval, system
0af0: 2c 20 73 68 65 6c 6c 2c 20 67 65 74 65 6e 76 0a , shell, getenv.
0b00: 09 09 20 20 20 20 20 28 63 6d 64 20 20 20 20 20 .. (cmd
0b10: 28 6c 69 73 74 2d 72 65 66 20 6d 61 74 63 68 64 (list-ref matchd
0b20: 61 74 20 33 29 29 0a 09 09 20 20 20 20 20 28 70 at 3))... (p
0b30: 6f 73 74 73 74 72 20 28 6c 69 73 74 2d 72 65 66 oststr (list-ref
0b40: 20 6d 61 74 63 68 64 61 74 20 34 29 29 0a 09 09 matchdat 4))...
0b50: 20 20 20 20 20 28 72 65 73 75 6c 74 20 20 23 66 (result #f
0b60: 29 0a 09 09 20 20 20 20 20 28 66 75 6c 6c 63 6d )... (fullcm
0b70: 64 20 28 63 61 73 65 20 28 73 74 72 69 6e 67 2d d (case (string-
0b80: 3e 73 79 6d 62 6f 6c 20 63 6d 64 74 79 70 65 29 >symbol cmdtype)
0b90: 0a 09 09 09 09 28 28 73 63 68 65 6d 65 29 28 63 .....((scheme)(c
0ba0: 6f 6e 63 20 22 28 6c 61 6d 62 64 61 20 28 68 74 onc "(lambda (ht
0bb0: 29 22 20 63 6d 64 20 22 29 22 29 29 0a 09 09 09 )" cmd ")"))....
0bc0: 09 28 28 73 79 73 74 65 6d 29 28 63 6f 6e 63 20 .((system)(conc
0bd0: 22 28 6c 61 6d 62 64 61 20 28 68 74 29 28 73 79 "(lambda (ht)(sy
0be0: 73 74 65 6d 20 5c 22 22 20 63 6d 64 20 22 5c 22 stem \"" cmd "\"
0bf0: 29 29 22 29 29 0a 09 09 09 09 28 28 73 68 65 6c ))")).....((shel
0c00: 6c 29 20 28 63 6f 6e 63 20 22 28 6c 61 6d 62 64 l) (conc "(lambd
0c10: 61 20 28 68 74 29 28 73 68 65 6c 6c 20 5c 22 22 a (ht)(shell \""
0c20: 20 20 63 6d 64 20 22 5c 22 29 29 22 29 29 0a 09 cmd "\"))"))..
0c30: 09 09 09 28 28 67 65 74 65 6e 76 29 28 63 6f 6e ...((getenv)(con
0c40: 63 20 22 28 6c 61 6d 62 64 61 20 28 68 74 29 28 c "(lambda (ht)(
0c50: 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d get-environment-
0c60: 76 61 72 69 61 62 6c 65 20 5c 22 22 20 63 6d 64 variable \"" cmd
0c70: 20 22 5c 22 29 29 22 29 29 0a 09 09 09 09 28 28 "\"))")).....((
0c80: 67 65 74 29 20 20 20 0a 09 09 09 09 20 28 6c 65 get) ..... (le
0c90: 74 2a 20 28 28 70 61 72 74 73 20 28 73 74 72 69 t* ((parts (stri
0ca0: 6e 67 2d 73 70 6c 69 74 20 63 6d 64 29 29 0a 09 ng-split cmd))..
0cb0: 09 09 09 09 28 73 65 63 74 20 20 28 63 61 72 20 ....(sect (car
0cc0: 70 61 72 74 73 29 29 0a 09 09 09 09 09 28 76 61 parts))......(va
0cd0: 72 20 20 20 28 63 61 64 72 20 70 61 72 74 73 29 r (cadr parts)
0ce0: 29 29 0a 09 09 09 09 20 20 20 28 63 6f 6e 63 20 ))..... (conc
0cf0: 22 28 6c 61 6d 62 64 61 20 28 68 74 29 28 63 6f "(lambda (ht)(co
0d00: 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 68 74 20 5c nfig-lookup ht \
0d10: 22 22 20 73 65 63 74 20 22 5c 22 20 5c 22 22 20 "" sect "\" \""
0d20: 76 61 72 20 22 5c 22 29 29 22 29 29 29 0a 09 09 var "\"))")))...
0d30: 09 09 28 28 72 75 6e 63 6f 6e 66 69 67 73 2d 67 ..((runconfigs-g
0d40: 65 74 29 20 28 63 6f 6e 63 20 22 28 6c 61 6d 62 et) (conc "(lamb
0d50: 64 61 20 28 68 74 29 28 72 75 6e 63 6f 6e 66 69 da (ht)(runconfi
0d60: 67 73 2d 67 65 74 20 68 74 20 5c 22 22 20 63 6d gs-get ht \"" cm
0d70: 64 20 22 5c 22 29 29 22 29 29 0a 09 09 09 09 28 d "\"))")).....(
0d80: 28 72 67 65 74 29 20 20 20 20 20 20 20 20 20 20 (rget)
0d90: 20 28 63 6f 6e 63 20 22 28 6c 61 6d 62 64 61 20 (conc "(lambda
0da0: 28 68 74 29 28 72 75 6e 63 6f 6e 66 69 67 73 2d (ht)(runconfigs-
0db0: 67 65 74 20 68 74 20 5c 22 22 20 63 6d 64 20 22 get ht \"" cmd "
0dc0: 5c 22 29 29 22 29 29 0a 09 09 09 09 28 65 6c 73 \"))")).....(els
0dd0: 65 20 22 28 6c 61 6d 62 64 61 20 28 68 74 29 28 e "(lambda (ht)(
0de0: 70 72 69 6e 74 20 5c 22 45 52 52 4f 52 5c 22 29 print \"ERROR\")
0df0: 20 5c 22 45 52 52 4f 52 5c 22 29 22 29 29 29 29 \"ERROR\")"))))
0e00: 0a 09 09 3b 3b 20 28 70 72 69 6e 74 20 22 66 75 ...;; (print "fu
0e10: 6c 6c 63 6d 64 3d 22 20 66 75 6c 6c 63 6d 64 29 llcmd=" fullcmd)
0e20: 0a 09 09 28 77 69 74 68 2d 69 6e 70 75 74 2d 66 ...(with-input-f
0e30: 72 6f 6d 2d 73 74 72 69 6e 67 20 66 75 6c 6c 63 rom-string fullc
0e40: 6d 64 0a 09 09 20 20 28 6c 61 6d 62 64 61 20 28 md... (lambda (
0e50: 29 0a 09 09 20 20 20 20 28 73 65 74 21 20 72 65 )... (set! re
0e60: 73 75 6c 74 20 28 28 65 76 61 6c 20 28 72 65 61 sult ((eval (rea
0e70: 64 29 29 20 68 74 29 29 29 29 0a 09 09 28 6c 6f d)) ht))))...(lo
0e80: 6f 70 20 28 63 6f 6e 63 20 70 72 65 73 74 72 20 op (conc prestr
0e90: 72 65 73 75 6c 74 20 70 6f 73 74 73 74 72 29 29 result poststr))
0ea0: 29 0a 09 20 20 20 20 20 20 72 65 73 29 29 0a 09 ).. res))..
0eb0: 72 65 73 29 29 29 0a 0a 3b 3b 20 52 75 6e 20 61 res)))..;; Run a
0ec0: 20 73 68 65 6c 6c 20 63 6f 6d 6d 61 6e 64 20 61 shell command a
0ed0: 6e 64 20 72 65 74 75 72 6e 20 74 68 65 20 6f 75 nd return the ou
0ee0: 74 70 75 74 20 61 73 20 61 20 73 74 72 69 6e 67 tput as a string
0ef0: 0a 28 64 65 66 69 6e 65 20 28 73 68 65 6c 6c 20 .(define (shell
0f00: 63 6d 64 29 0a 20 20 28 6c 65 74 2a 20 28 28 6f cmd). (let* ((o
0f10: 75 74 70 75 74 20 28 63 6d 64 2d 72 75 6e 2d 3e utput (cmd-run->
0f20: 6c 69 73 74 20 63 6d 64 29 29 0a 09 20 28 72 65 list cmd)).. (re
0f30: 73 20 20 20 20 28 63 61 72 20 6f 75 74 70 75 74 s (car output
0f40: 29 29 0a 09 20 28 73 74 61 74 75 73 20 28 63 61 )).. (status (ca
0f50: 64 72 20 6f 75 74 70 75 74 29 29 29 0a 20 20 20 dr output))).
0f60: 20 28 69 66 20 28 65 71 75 61 6c 3f 20 73 74 61 (if (equal? sta
0f70: 74 75 73 20 30 29 0a 09 28 6c 65 74 20 28 28 6f tus 0)..(let ((o
0f80: 75 74 72 65 73 20 28 73 74 72 69 6e 67 2d 69 6e utres (string-in
0f90: 74 65 72 73 70 65 72 73 65 20 0a 09 09 20 20 20 tersperse ...
0fa0: 20 20 20 20 72 65 73 0a 09 09 20 20 20 20 20 20 res...
0fb0: 20 22 5c 6e 22 29 29 29 0a 09 20 20 28 64 65 62 "\n"))).. (deb
0fc0: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 34 20 ug:print-info 4
0fd0: 22 73 68 65 6c 6c 20 72 65 73 75 6c 74 3a 5c 6e "shell result:\n
0fe0: 22 20 6f 75 74 72 65 73 29 0a 09 20 20 6f 75 74 " outres).. out
0ff0: 72 65 73 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 res)..(begin..
1000: 28 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d (with-output-to-
1010: 70 6f 72 74 20 28 63 75 72 72 65 6e 74 2d 65 72 port (current-er
1020: 72 6f 72 2d 70 6f 72 74 29 0a 09 20 20 20 20 28 ror-port).. (
1030: 70 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 22 20 print "ERROR: "
1040: 63 6d 64 20 22 20 72 65 74 75 72 6e 65 64 20 62 cmd " returned b
1050: 61 64 20 65 78 69 74 20 63 6f 64 65 20 22 20 73 ad exit code " s
1060: 74 61 74 75 73 29 29 0a 09 20 20 22 22 29 29 29 tatus)).. "")))
1070: 29 0a 0a 3b 3b 20 4c 6f 6f 6b 75 70 20 61 20 76 )..;; Lookup a v
1080: 61 6c 75 65 20 69 6e 20 72 75 6e 63 6f 6e 66 69 alue in runconfi
1090: 67 73 20 62 61 73 65 64 20 6f 6e 20 2d 72 65 71 gs based on -req
10a0: 74 61 72 67 20 6f 72 20 2d 74 61 72 67 65 74 0a targ or -target.
10b0: 28 64 65 66 69 6e 65 20 28 72 75 6e 63 6f 6e 66 (define (runconf
10c0: 69 67 73 2d 67 65 74 20 63 6f 6e 66 69 67 20 76 igs-get config v
10d0: 61 72 29 0a 20 20 28 6c 65 74 20 28 28 74 61 72 ar). (let ((tar
10e0: 67 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d g (or (args:get-
10f0: 61 72 67 20 22 2d 72 65 71 74 61 72 67 22 29 28 arg "-reqtarg")(
1100: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 args:get-arg "-t
1110: 61 72 67 65 74 22 29 29 29 29 0a 20 20 20 20 28 arget")))). (
1120: 69 66 20 74 61 72 67 0a 09 28 6f 72 20 28 63 6f if targ..(or (co
1130: 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 63 6f 6e nfigf:lookup con
1140: 66 69 67 20 74 61 72 67 20 76 61 72 29 0a 09 20 fig targ var)..
1150: 20 20 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b (configf:look
1160: 75 70 20 63 6f 6e 66 69 67 20 22 64 65 66 61 75 up config "defau
1170: 6c 74 22 20 76 61 72 29 29 0a 09 28 63 6f 6e 66 lt" var))..(conf
1180: 69 67 66 3a 6c 6f 6f 6b 75 70 20 63 6f 6e 66 69 igf:lookup confi
1190: 67 20 22 64 65 66 61 75 6c 74 22 20 76 61 72 29 g "default" var)
11a0: 29 29 29 0a 0a 28 64 65 66 69 6e 65 2d 69 6e 6c )))..(define-inl
11b0: 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a 72 65 61 ine (configf:rea
11c0: 64 2d 6c 69 6e 65 20 70 20 68 74 20 61 6c 6c 6f d-line p ht allo
11d0: 77 2d 70 72 6f 63 65 73 73 69 6e 67 29 0a 20 20 w-processing).
11e0: 28 6c 65 74 20 6c 6f 6f 70 20 28 28 69 6e 6c 20 (let loop ((inl
11f0: 28 72 65 61 64 2d 6c 69 6e 65 20 70 29 29 29 0a (read-line p))).
1200: 20 20 20 20 28 69 66 20 28 61 6e 64 20 28 73 74 (if (and (st
1210: 72 69 6e 67 3f 20 69 6e 6c 29 0a 09 20 20 20 20 ring? inl)..
1220: 20 28 6e 6f 74 20 28 73 74 72 69 6e 67 2d 6e 75 (not (string-nu
1230: 6c 6c 3f 20 69 6e 6c 29 29 0a 09 20 20 20 20 20 ll? inl))..
1240: 28 65 71 75 61 6c 3f 20 22 5c 5c 22 20 28 73 74 (equal? "\\" (st
1250: 72 69 6e 67 2d 74 61 6b 65 2d 72 69 67 68 74 20 ring-take-right
1260: 69 6e 6c 20 31 29 29 29 20 3b 3b 20 6c 61 73 74 inl 1))) ;; last
1270: 20 63 68 61 72 61 63 74 65 72 20 69 73 20 5c 20 character is \
1280: 0a 09 28 6c 65 74 20 28 28 6e 65 78 74 6c 20 28 ..(let ((nextl (
1290: 72 65 61 64 2d 6c 69 6e 65 20 70 29 29 29 0a 09 read-line p)))..
12a0: 20 20 28 69 66 20 28 6e 6f 74 20 28 65 6f 66 2d (if (not (eof-
12b0: 6f 62 6a 65 63 74 3f 20 6e 65 78 74 6c 29 29 0a object? nextl)).
12c0: 09 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 73 74 . (loop (st
12d0: 72 69 6e 67 2d 61 70 70 65 6e 64 20 69 6e 6c 20 ring-append inl
12e0: 6e 65 78 74 6c 29 29 29 29 0a 09 28 69 66 20 28 nextl))))..(if (
12f0: 61 6e 64 20 61 6c 6c 6f 77 2d 70 72 6f 63 65 73 and allow-proces
1300: 73 69 6e 67 20 0a 09 09 20 28 6e 6f 74 20 28 65 sing ... (not (e
1310: 71 3f 20 61 6c 6c 6f 77 2d 70 72 6f 63 65 73 73 q? allow-process
1320: 69 6e 67 20 27 72 65 74 75 72 6e 2d 73 74 72 69 ing 'return-stri
1330: 6e 67 29 29 29 0a 09 20 20 20 20 28 63 6f 6e 66 ng))).. (conf
1340: 69 67 66 3a 70 72 6f 63 65 73 73 2d 6c 69 6e 65 igf:process-line
1350: 20 69 6e 6c 20 68 74 29 0a 09 20 20 20 20 69 6e inl ht).. in
1360: 6c 29 29 29 29 0a 0a 3b 3b 20 72 65 61 64 20 61 l))))..;; read a
1370: 20 63 6f 6e 66 69 67 20 66 69 6c 65 2c 20 72 65 config file, re
1380: 74 75 72 6e 73 20 68 61 73 68 20 74 61 62 6c 65 turns hash table
1390: 20 6f 66 20 61 6c 69 73 74 73 0a 0a 3b 3b 20 72 of alists..;; r
13a0: 65 61 64 20 61 20 63 6f 6e 66 69 67 20 66 69 6c ead a config fil
13b0: 65 2c 20 72 65 74 75 72 6e 73 20 68 61 73 68 20 e, returns hash
13c0: 74 61 62 6c 65 20 6f 66 20 61 6c 69 73 74 73 0a table of alists.
13d0: 3b 3b 20 61 64 64 73 20 74 6f 20 68 74 20 69 66 ;; adds to ht if
13e0: 20 67 69 76 65 6e 20 28 6d 75 73 74 20 62 65 20 given (must be
13f0: 23 66 20 6f 74 68 65 72 77 69 73 65 29 0a 3b 3b #f otherwise).;;
1400: 20 65 6e 76 69 6f 6e 2d 70 61 74 74 20 69 73 20 envion-patt is
1410: 61 20 72 65 67 65 78 20 73 70 65 63 20 74 68 61 a regex spec tha
1420: 74 20 69 64 65 6e 74 69 66 69 65 73 20 73 65 63 t identifies sec
1430: 74 69 6f 6e 73 20 74 68 61 74 20 77 69 6c 6c 20 tions that will
1440: 62 65 20 65 76 61 6c 27 64 0a 3b 3b 20 69 6e 20 be eval'd.;; in
1450: 74 68 65 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 the environment
1460: 6f 6e 20 74 68 65 20 66 6c 79 0a 3b 3b 20 73 65 on the fly.;; se
1470: 63 74 69 6f 6e 73 3a 20 23 66 20 3d 3e 20 67 65 ctions: #f => ge
1480: 74 20 61 6c 6c 2c 20 65 6c 73 65 20 6c 69 73 74 t all, else list
1490: 20 6f 66 20 73 65 63 74 69 6f 6e 73 20 74 6f 20 of sections to
14a0: 67 61 74 68 65 72 0a 28 64 65 66 69 6e 65 20 28 gather.(define (
14b0: 72 65 61 64 2d 63 6f 6e 66 69 67 20 70 61 74 68 read-config path
14c0: 20 68 74 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d ht allow-system
14d0: 20 23 21 6b 65 79 20 28 65 6e 76 69 72 6f 6e 2d #!key (environ-
14e0: 70 61 74 74 20 23 66 29 28 63 75 72 72 2d 73 65 patt #f)(curr-se
14f0: 63 74 69 6f 6e 20 23 66 29 28 73 65 63 74 69 6f ction #f)(sectio
1500: 6e 73 20 23 66 29 29 0a 20 20 28 64 65 62 75 67 ns #f)). (debug
1510: 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 35 20 22 72 :print-info 5 "r
1520: 65 61 64 2d 63 6f 6e 66 69 67 20 22 20 70 61 74 ead-config " pat
1530: 68 20 22 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d h " allow-system
1540: 20 22 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 " allow-system
1550: 22 20 65 6e 76 69 72 6f 6e 2d 70 61 74 74 20 22 " environ-patt "
1560: 20 65 6e 76 69 72 6f 6e 2d 70 61 74 74 20 22 20 environ-patt "
1570: 63 75 72 72 2d 73 65 63 74 69 6f 6e 3a 20 22 20 curr-section: "
1580: 63 75 72 72 2d 73 65 63 74 69 6f 6e 20 22 20 73 curr-section " s
1590: 65 63 74 69 6f 6e 73 3a 20 22 20 73 65 63 74 69 ections: " secti
15a0: 6f 6e 73 20 22 20 70 77 64 3a 20 22 20 28 63 75 ons " pwd: " (cu
15b0: 72 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 rrent-directory)
15c0: 29 0a 20 20 28 69 66 20 28 6e 6f 74 20 28 66 69 ). (if (not (fi
15d0: 6c 65 2d 65 78 69 73 74 73 3f 20 70 61 74 68 29 le-exists? path)
15e0: 29 0a 20 20 20 20 20 20 28 62 65 67 69 6e 20 0a ). (begin .
15f0: 09 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e .(debug:print-in
1600: 66 6f 20 31 20 22 72 65 61 64 2d 63 6f 6e 66 69 fo 1 "read-confi
1610: 67 20 2d 20 66 69 6c 65 20 6e 6f 74 20 66 6f 75 g - file not fou
1620: 6e 64 20 22 20 70 61 74 68 20 22 20 63 75 72 72 nd " path " curr
1630: 65 6e 74 20 70 61 74 68 3a 20 22 20 28 63 75 72 ent path: " (cur
1640: 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 29 rent-directory))
1650: 0a 09 28 69 66 20 28 6e 6f 74 20 68 74 29 28 6d ..(if (not ht)(m
1660: 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 20 ake-hash-table)
1670: 68 74 29 29 0a 20 20 20 20 20 20 28 6c 65 74 20 ht)). (let
1680: 28 28 69 6e 70 20 20 20 20 20 20 20 20 28 6f 70 ((inp (op
1690: 65 6e 2d 69 6e 70 75 74 2d 66 69 6c 65 20 70 61 en-input-file pa
16a0: 74 68 29 29 0a 09 20 20 20 20 28 72 65 73 20 20 th)).. (res
16b0: 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 68 (if (not h
16c0: 74 29 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 t)(make-hash-tab
16d0: 6c 65 29 20 68 74 29 29 29 0a 09 28 6c 65 74 20 le) ht)))..(let
16e0: 6c 6f 6f 70 20 28 28 69 6e 6c 20 20 20 20 20 20 loop ((inl
16f0: 20 20 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 (config
1700: 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 20 f:read-line inp
1710: 72 65 73 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d res allow-system
1720: 29 29 20 3b 3b 20 28 72 65 61 64 2d 6c 69 6e 65 )) ;; (read-line
1730: 20 69 6e 70 29 29 0a 09 09 20 20 20 28 63 75 72 inp))... (cur
1740: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 28 r-section-name (
1750: 69 66 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 20 if curr-section
1760: 63 75 72 72 2d 73 65 63 74 69 6f 6e 20 22 64 65 curr-section "de
1770: 66 61 75 6c 74 22 29 29 0a 09 09 20 20 20 28 76 fault"))... (v
1780: 61 72 2d 66 6c 61 67 20 23 66 29 3b 3b 20 74 75 ar-flag #f);; tu
1790: 72 6e 20 6f 6e 20 66 6f 72 20 6b 65 79 2d 76 61 rn on for key-va
17a0: 72 2d 70 72 20 61 6e 64 20 63 6f 6e 74 2d 6c 6e r-pr and cont-ln
17b0: 2d 72 78 2c 20 74 75 72 6e 20 6f 66 66 20 65 6c -rx, turn off el
17c0: 73 65 77 68 65 72 65 0a 09 09 20 20 20 28 6c 65 sewhere... (le
17d0: 61 64 20 20 20 20 20 23 66 29 29 0a 09 20 20 28 ad #f)).. (
17e0: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
17f0: 20 38 20 22 63 75 72 72 2d 73 65 63 74 69 6f 6e 8 "curr-section
1800: 2d 6e 61 6d 65 3a 20 22 20 63 75 72 72 2d 73 65 -name: " curr-se
1810: 63 74 69 6f 6e 2d 6e 61 6d 65 20 22 20 76 61 72 ction-name " var
1820: 2d 66 6c 61 67 3a 20 22 20 76 61 72 2d 66 6c 61 -flag: " var-fla
1830: 67 20 22 5c 6e 20 20 20 69 6e 6c 3a 20 5c 22 22 g "\n inl: \""
1840: 20 69 6e 6c 20 22 5c 22 22 29 0a 09 20 20 28 69 inl "\"").. (i
1850: 66 20 28 65 6f 66 2d 6f 62 6a 65 63 74 3f 20 69 f (eof-object? i
1860: 6e 6c 29 20 0a 09 20 20 20 20 20 20 28 62 65 67 nl) .. (beg
1870: 69 6e 0a 09 09 28 63 6c 6f 73 65 2d 69 6e 70 75 in...(close-inpu
1880: 74 2d 70 6f 72 74 20 69 6e 70 29 0a 09 09 28 68 t-port inp)...(h
1890: 61 73 68 2d 74 61 62 6c 65 2d 64 65 6c 65 74 65 ash-table-delete
18a0: 21 20 72 65 73 20 22 22 29 20 3b 3b 20 77 65 20 ! res "") ;; we
18b0: 61 72 65 20 75 73 69 6e 67 20 22 22 20 61 73 20 are using "" as
18c0: 61 20 64 75 6d 70 69 6e 67 20 67 72 6f 75 6e 64 a dumping ground
18d0: 20 61 6e 64 20 6d 75 73 74 20 72 65 6d 6f 76 65 and must remove
18e0: 20 69 74 20 62 65 66 6f 72 65 20 72 65 74 75 72 it before retur
18f0: 6e 69 6e 67 20 74 68 65 20 68 74 0a 09 09 72 65 ning the ht...re
1900: 73 29 0a 09 20 20 20 20 20 20 28 72 65 67 65 78 s).. (regex
1910: 2d 63 61 73 65 20 0a 09 20 20 20 20 20 20 20 69 -case .. i
1920: 6e 6c 20 0a 09 20 20 20 20 20 20 20 28 63 6f 6e nl .. (con
1930: 66 69 67 66 3a 63 6f 6d 6d 65 6e 74 2d 72 78 20 figf:comment-rx
1940: 5f 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 _
1950: 20 20 20 28 6c 6f 6f 70 20 28 63 6f 6e 66 69 67 (loop (config
1960: 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 20 f:read-line inp
1970: 72 65 73 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d res allow-system
1980: 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e ) curr-section-n
1990: 61 6d 65 20 23 66 20 23 66 29 29 0a 09 20 20 20 ame #f #f))..
19a0: 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 62 6c 61 (configf:bla
19b0: 6e 6b 2d 6c 2d 72 78 20 5f 20 20 20 20 20 20 20 nk-l-rx _
19c0: 20 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 (loop
19d0: 20 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d 6c (configf:read-l
19e0: 69 6e 65 20 69 6e 70 20 72 65 73 20 61 6c 6c 6f ine inp res allo
19f0: 77 2d 73 79 73 74 65 6d 29 20 63 75 72 72 2d 73 w-system) curr-s
1a00: 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 ection-name #f #
1a10: 66 29 29 0a 09 20 20 20 20 20 20 20 28 63 6f 6e f)).. (con
1a20: 66 69 67 66 3a 69 6e 63 6c 75 64 65 2d 72 78 20 figf:include-rx
1a30: 28 20 78 20 69 6e 63 6c 75 64 65 2d 66 69 6c 65 ( x include-file
1a40: 20 29 20 28 6c 65 74 2a 20 28 28 63 75 72 72 2d ) (let* ((curr-
1a50: 63 6f 6e 66 2d 64 69 72 20 28 70 61 74 68 6e 61 conf-dir (pathna
1a60: 6d 65 2d 64 69 72 65 63 74 6f 72 79 20 70 61 74 me-directory pat
1a70: 68 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 h))........
1a80: 28 66 75 6c 6c 2d 63 6f 6e 66 20 20 20 20 20 28 (full-conf (
1a90: 69 66 20 28 61 62 73 6f 6c 75 74 65 2d 70 61 74 if (absolute-pat
1aa0: 68 6e 61 6d 65 3f 20 69 6e 63 6c 75 64 65 2d 66 hname? include-f
1ab0: 69 6c 65 29 0a 09 09 09 09 09 09 09 09 09 09 69 ile)...........i
1ac0: 6e 63 6c 75 64 65 2d 66 69 6c 65 0a 09 09 09 09 nclude-file.....
1ad0: 09 09 09 09 09 09 28 6e 69 63 65 2d 70 61 74 68 ......(nice-path
1ae0: 20 0a 09 09 09 09 09 09 09 09 09 09 20 28 63 6f ........... (co
1af0: 6e 63 20 28 69 66 20 63 75 72 72 2d 63 6f 6e 66 nc (if curr-conf
1b00: 2d 64 69 72 0a 09 09 09 09 09 09 09 09 09 09 09 -dir............
1b10: 20 20 20 63 75 72 72 2d 63 6f 6e 66 2d 64 69 72 curr-conf-dir
1b20: 0a 09 09 09 09 09 09 09 09 09 09 09 20 20 20 22 ............ "
1b30: 2e 22 29 0a 09 09 09 09 09 09 09 09 09 09 20 20 .")...........
1b40: 20 20 20 20 20 22 2f 22 20 69 6e 63 6c 75 64 65 "/" include
1b50: 2d 66 69 6c 65 29 29 29 29 29 0a 09 09 09 09 09 -file)))))......
1b60: 09 09 28 69 66 20 28 66 69 6c 65 2d 65 78 69 73 ..(if (file-exis
1b70: 74 73 3f 20 66 75 6c 6c 2d 63 6f 6e 66 29 0a 09 ts? full-conf)..
1b80: 09 09 09 09 09 09 20 20 20 20 28 62 65 67 69 6e ...... (begin
1b90: 0a 09 09 09 09 09 09 09 20 20 20 20 20 20 3b 3b ........ ;;
1ba0: 20 28 70 75 73 68 2d 64 69 72 65 63 74 6f 72 79 (push-directory
1bb0: 20 63 6f 6e 66 2d 64 69 72 29 0a 09 09 09 09 09 conf-dir)......
1bc0: 09 09 20 20 20 20 20 20 28 72 65 61 64 2d 63 6f .. (read-co
1bd0: 6e 66 69 67 20 66 75 6c 6c 2d 63 6f 6e 66 20 72 nfig full-conf r
1be0: 65 73 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 es allow-system
1bf0: 65 6e 76 69 72 6f 6e 2d 70 61 74 74 3a 20 65 6e environ-patt: en
1c00: 76 69 72 6f 6e 2d 70 61 74 74 20 63 75 72 72 2d viron-patt curr-
1c10: 73 65 63 74 69 6f 6e 3a 20 63 75 72 72 2d 73 65 section: curr-se
1c20: 63 74 69 6f 6e 2d 6e 61 6d 65 20 73 65 63 74 69 ction-name secti
1c30: 6f 6e 73 3a 20 73 65 63 74 69 6f 6e 73 29 0a 09 ons: sections)..
1c40: 09 09 09 09 09 09 20 20 20 20 20 20 3b 3b 20 28 ...... ;; (
1c50: 70 6f 70 2d 64 69 72 65 63 74 6f 72 79 29 0a 09 pop-directory)..
1c60: 09 09 09 09 09 09 20 20 20 20 20 20 28 6c 6f 6f ...... (loo
1c70: 70 20 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d p (configf:read-
1c80: 6c 69 6e 65 20 69 6e 70 20 72 65 73 20 61 6c 6c line inp res all
1c90: 6f 77 2d 73 79 73 74 65 6d 29 20 63 75 72 72 2d ow-system) curr-
1ca0: 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 section-name #f
1cb0: 23 66 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 #f))........
1cc0: 28 62 65 67 69 6e 0a 09 09 09 09 09 09 09 20 20 (begin........
1cd0: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
1ce0: 20 32 20 22 49 4e 46 4f 3a 20 69 6e 63 6c 75 64 2 "INFO: includ
1cf0: 65 20 66 69 6c 65 20 22 20 69 6e 63 6c 75 64 65 e file " include
1d00: 2d 66 69 6c 65 20 22 20 6e 6f 74 20 66 6f 75 6e -file " not foun
1d10: 64 20 28 63 61 6c 6c 65 64 20 66 72 6f 6d 20 22 d (called from "
1d20: 20 70 61 74 68 20 22 29 22 29 0a 09 09 09 09 09 path ")")......
1d30: 09 09 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 .. (debug:p
1d40: 72 69 6e 74 20 32 20 22 20 20 20 20 20 20 20 20 rint 2 "
1d50: 22 20 66 75 6c 6c 2d 63 6f 6e 66 29 0a 09 09 09 " full-conf)....
1d60: 09 09 09 09 20 20 20 20 20 20 28 6c 6f 6f 70 20 .... (loop
1d70: 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d 6c 69 (configf:read-li
1d80: 6e 65 20 69 6e 70 20 72 65 73 20 61 6c 6c 6f 77 ne inp res allow
1d90: 2d 73 79 73 74 65 6d 29 20 63 75 72 72 2d 73 65 -system) curr-se
1da0: 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 66 ction-name #f #f
1db0: 29 29 29 29 29 0a 09 20 20 20 20 20 20 20 28 63 ))))).. (c
1dc0: 6f 6e 66 69 67 66 3a 73 65 63 74 69 6f 6e 2d 72 onfigf:section-r
1dd0: 78 20 28 20 78 20 73 65 63 74 69 6f 6e 2d 6e 61 x ( x section-na
1de0: 6d 65 20 29 20 28 6c 6f 6f 70 20 28 63 6f 6e 66 me ) (loop (conf
1df0: 69 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e igf:read-line in
1e00: 70 20 72 65 73 20 61 6c 6c 6f 77 2d 73 79 73 74 p res allow-syst
1e10: 65 6d 29 0a 09 09 09 09 09 09 09 20 20 20 20 3b em)........ ;
1e20: 3b 20 69 66 20 77 65 20 68 61 76 65 20 74 68 65 ; if we have the
1e30: 20 73 65 63 74 69 6f 6e 73 20 6c 69 73 74 20 74 sections list t
1e40: 68 65 6e 20 66 6f 72 63 65 20 61 6c 6c 20 73 65 hen force all se
1e50: 74 74 69 6e 67 73 20 69 6e 74 6f 20 22 22 20 61 ttings into "" a
1e60: 6e 64 20 64 65 6c 65 74 65 20 69 74 20 6c 61 74 nd delete it lat
1e70: 65 72 3f 0a 09 09 09 09 09 09 09 20 20 20 20 28 er?........ (
1e80: 69 66 20 28 6f 72 20 28 6e 6f 74 20 73 65 63 74 if (or (not sect
1e90: 69 6f 6e 73 29 20 0a 09 09 09 09 09 09 09 09 20 ions) .........
1ea0: 20 20 20 28 6d 65 6d 62 65 72 20 73 65 63 74 69 (member secti
1eb0: 6f 6e 2d 6e 61 6d 65 20 73 65 63 74 69 6f 6e 73 on-name sections
1ec0: 29 29 0a 09 09 09 09 09 09 09 09 73 65 63 74 69 )).........secti
1ed0: 6f 6e 2d 6e 61 6d 65 20 22 22 29 20 3b 3b 20 73 on-name "") ;; s
1ee0: 74 69 63 6b 20 65 76 65 72 79 74 68 69 6e 67 20 tick everything
1ef0: 69 6e 74 6f 20 22 22 0a 09 09 09 09 09 09 09 20 into ""........
1f00: 20 20 20 23 66 20 23 66 29 29 0a 09 20 20 20 20 #f #f))..
1f10: 20 20 20 28 63 6f 6e 66 69 67 66 3a 6b 65 79 2d (configf:key-
1f20: 73 79 73 2d 70 72 20 28 20 78 20 6b 65 79 20 63 sys-pr ( x key c
1f30: 6d 64 20 20 20 20 20 20 29 20 28 69 66 20 61 6c md ) (if al
1f40: 6c 6f 77 2d 73 79 73 74 65 6d 0a 09 09 09 09 09 low-system......
1f50: 09 09 20 20 28 6c 65 74 20 28 28 61 6c 69 73 74 .. (let ((alist
1f60: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
1f70: 2f 64 65 66 61 75 6c 74 20 72 65 73 20 63 75 72 /default res cur
1f80: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 27 r-section-name '
1f90: 28 29 29 29 0a 09 09 09 09 09 09 09 09 28 76 61 ())).........(va
1fa0: 6c 2d 70 72 6f 63 20 28 6c 61 6d 62 64 61 20 28 l-proc (lambda (
1fb0: 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 28 ).......... (
1fc0: 6c 65 74 2a 20 28 28 63 6d 64 72 65 73 20 20 28 let* ((cmdres (
1fd0: 63 6d 64 2d 72 75 6e 2d 3e 6c 69 73 74 20 63 6d cmd-run->list cm
1fe0: 64 29 29 0a 09 09 09 09 09 09 09 09 09 09 20 20 d))...........
1ff0: 20 28 73 74 61 74 75 73 20 20 28 63 61 64 72 20 (status (cadr
2000: 63 6d 64 72 65 73 29 29 0a 09 09 09 09 09 09 09 cmdres))........
2010: 09 09 09 20 20 20 28 72 65 73 20 20 20 20 20 28 ... (res (
2020: 63 61 72 20 20 63 6d 64 72 65 73 29 29 29 0a 09 car cmdres)))..
2030: 09 09 09 09 09 09 09 09 20 20 20 20 20 20 28 64 ........ (d
2040: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
2050: 34 20 22 22 20 69 6e 6c 20 22 5c 6e 20 3d 3e 20 4 "" inl "\n =>
2060: 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 " (string-inters
2070: 70 65 72 73 65 20 72 65 73 20 22 5c 6e 22 29 29 perse res "\n"))
2080: 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 20 20 ..........
2090: 28 69 66 20 28 6e 6f 74 20 28 65 71 3f 20 73 74 (if (not (eq? st
20a0: 61 74 75 73 20 30 29 29 0a 09 09 09 09 09 09 09 atus 0))........
20b0: 09 09 09 20 20 28 62 65 67 69 6e 0a 09 09 09 09 ... (begin.....
20c0: 09 09 09 09 09 09 20 20 20 20 28 64 65 62 75 67 ...... (debug
20d0: 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a :print 0 "ERROR:
20e0: 20 70 72 6f 62 6c 65 6d 20 77 69 74 68 20 22 20 problem with "
20f0: 69 6e 6c 20 22 2c 20 72 65 74 75 72 6e 20 63 6f inl ", return co
2100: 64 65 20 22 20 73 74 61 74 75 73 0a 09 09 09 09 de " status.....
2110: 09 09 09 09 09 09 09 09 20 22 20 6f 75 74 70 75 ........ " outpu
2120: 74 3a 20 22 20 63 6d 64 72 65 73 29 0a 09 09 09 t: " cmdres)....
2130: 09 09 09 09 09 09 09 20 20 20 20 28 65 78 69 74 ....... (exit
2140: 20 31 29 29 29 0a 09 09 09 09 09 09 09 09 09 20 1)))..........
2150: 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 (if (null?
2160: 72 65 73 29 0a 09 09 09 09 09 09 09 09 09 09 20 res)...........
2170: 20 22 22 0a 09 09 09 09 09 09 09 09 09 09 20 20 ""...........
2180: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
2190: 72 73 65 20 72 65 73 20 22 20 22 29 29 29 29 29 rse res " ")))))
21a0: 29 0a 09 09 09 09 09 09 09 20 20 20 20 28 68 61 )........ (ha
21b0: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 72 65 sh-table-set! re
21c0: 73 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e s curr-section-n
21d0: 61 6d 65 20 0a 09 09 09 09 09 09 09 09 09 20 20 ame ..........
21e0: 20 20 20 28 63 6f 6e 66 69 67 3a 61 73 73 6f 63 (config:assoc
21f0: 2d 73 61 66 65 2d 61 64 64 20 61 6c 69 73 74 0a -safe-add alist.
2200: 09 09 09 09 09 09 09 09 09 09 09 09 20 20 20 20 ............
2210: 6b 65 79 20 0a 09 09 09 09 09 09 09 09 09 09 09 key ............
2220: 09 20 20 20 20 28 63 61 73 65 20 61 6c 6c 6f 77 . (case allow
2230: 2d 73 79 73 74 65 6d 0a 09 09 09 09 09 09 09 09 -system.........
2240: 09 09 09 09 20 20 20 20 20 20 28 28 72 65 74 75 .... ((retu
2250: 72 6e 2d 70 72 6f 63 73 29 20 76 61 6c 2d 70 72 rn-procs) val-pr
2260: 6f 63 29 0a 09 09 09 09 09 09 09 09 09 09 09 09 oc).............
2270: 20 20 20 20 20 20 28 28 72 65 74 75 72 6e 2d 73 ((return-s
2280: 74 72 69 6e 67 29 20 63 6d 64 29 0a 09 09 09 09 tring) cmd).....
2290: 09 09 09 09 09 09 09 09 20 20 20 20 20 20 28 65 ........ (e
22a0: 6c 73 65 20 28 76 61 6c 2d 70 72 6f 63 29 29 29 lse (val-proc)))
22b0: 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 28 6c ))........ (l
22c0: 6f 6f 70 20 28 63 6f 6e 66 69 67 66 3a 72 65 61 oop (configf:rea
22d0: 64 2d 6c 69 6e 65 20 69 6e 70 20 72 65 73 20 61 d-line inp res a
22e0: 6c 6c 6f 77 2d 73 79 73 74 65 6d 29 20 63 75 72 llow-system) cur
22f0: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 r-section-name #
2300: 66 20 23 66 29 29 0a 09 09 09 09 09 09 09 20 20 f #f))........
2310: 28 6c 6f 6f 70 20 28 63 6f 6e 66 69 67 66 3a 72 (loop (configf:r
2320: 65 61 64 2d 6c 69 6e 65 20 69 6e 70 20 72 65 73 ead-line inp res
2330: 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 29 20 63 allow-system) c
2340: 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 urr-section-name
2350: 20 23 66 20 23 66 29 29 29 0a 09 20 20 20 20 20 #f #f)))..
2360: 20 20 28 63 6f 6e 66 69 67 66 3a 6b 65 79 2d 76 (configf:key-v
2370: 61 6c 2d 70 72 20 28 20 78 20 6b 65 79 20 75 6e al-pr ( x key un
2380: 6b 31 20 76 61 6c 20 75 6e 6b 32 20 29 20 28 6c k1 val unk2 ) (l
2390: 65 74 2a 20 28 28 61 6c 69 73 74 20 20 20 28 68 et* ((alist (h
23a0: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
23b0: 66 61 75 6c 74 20 72 65 73 20 63 75 72 72 2d 73 fault res curr-s
23c0: 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 27 28 29 29 ection-name '())
23d0: 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 28 65 )........ (e
23e0: 6e 76 61 72 20 20 20 28 61 6e 64 20 65 6e 76 69 nvar (and envi
23f0: 72 6f 6e 2d 70 61 74 74 20 28 73 74 72 69 6e 67 ron-patt (string
2400: 2d 73 65 61 72 63 68 20 28 72 65 67 65 78 70 20 -search (regexp
2410: 65 6e 76 69 72 6f 6e 2d 70 61 74 74 29 20 63 75 environ-patt) cu
2420: 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 29 rr-section-name)
2430: 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 28 ))........ (
2440: 72 65 61 6c 76 61 6c 20 28 69 66 20 65 6e 76 61 realval (if enva
2450: 72 0a 09 09 09 09 09 09 09 09 09 20 20 28 63 6f r.......... (co
2460: 6e 66 69 67 3a 65 76 61 6c 2d 73 74 72 69 6e 67 nfig:eval-string
2470: 2d 69 6e 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 -in-environment
2480: 76 61 6c 29 0a 09 09 09 09 09 09 09 09 09 20 20 val)..........
2490: 76 61 6c 29 29 29 0a 09 09 09 09 09 09 09 28 64 val)))........(d
24a0: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
24b0: 36 20 22 72 65 61 64 2d 63 6f 6e 66 69 67 20 65 6 "read-config e
24c0: 6e 76 20 73 65 74 74 69 6e 67 2c 20 65 6e 76 61 nv setting, enva
24d0: 72 3a 20 22 20 65 6e 76 61 72 20 22 20 72 65 61 r: " envar " rea
24e0: 6c 76 61 6c 3a 20 22 20 72 65 61 6c 76 61 6c 20 lval: " realval
24f0: 22 20 76 61 6c 3a 20 22 20 76 61 6c 20 22 20 6b " val: " val " k
2500: 65 79 3a 20 22 20 6b 65 79 20 22 20 63 75 72 72 ey: " key " curr
2510: 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 3a 20 22 -section-name: "
2520: 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 curr-section-na
2530: 6d 65 29 0a 09 09 09 09 09 09 09 28 69 66 20 65 me)........(if e
2540: 6e 76 61 72 0a 09 09 09 09 09 09 09 20 20 20 20 nvar........
2550: 28 62 65 67 69 6e 0a 09 09 09 09 09 09 09 20 20 (begin........
2560: 20 20 20 20 3b 3b 20 28 64 65 62 75 67 3a 70 72 ;; (debug:pr
2570: 69 6e 74 2d 69 6e 66 6f 20 34 20 22 72 65 61 64 int-info 4 "read
2580: 2d 63 6f 6e 66 69 67 20 6b 65 79 3d 22 20 6b 65 -config key=" ke
2590: 79 20 22 2c 20 76 61 6c 3d 22 20 76 61 6c 20 22 y ", val=" val "
25a0: 2c 20 72 65 61 6c 76 61 6c 3d 22 20 72 65 61 6c , realval=" real
25b0: 76 61 6c 29 0a 09 09 09 09 09 09 09 20 20 20 20 val)........
25c0: 20 20 28 73 65 74 65 6e 76 20 6b 65 79 20 72 65 (setenv key re
25d0: 61 6c 76 61 6c 29 29 29 0a 09 09 09 09 09 09 09 alval)))........
25e0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 (hash-table-set!
25f0: 20 72 65 73 20 63 75 72 72 2d 73 65 63 74 69 6f res curr-sectio
2600: 6e 2d 6e 61 6d 65 20 0a 09 09 09 09 09 09 09 09 n-name .........
2610: 09 20 28 63 6f 6e 66 69 67 3a 61 73 73 6f 63 2d . (config:assoc-
2620: 73 61 66 65 2d 61 64 64 20 61 6c 69 73 74 20 6b safe-add alist k
2630: 65 79 20 72 65 61 6c 76 61 6c 29 29 0a 09 09 09 ey realval))....
2640: 09 09 09 09 28 6c 6f 6f 70 20 28 63 6f 6e 66 69 ....(loop (confi
2650: 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 gf:read-line inp
2660: 20 72 65 73 20 61 6c 6c 6f 77 2d 73 79 73 74 65 res allow-syste
2670: 6d 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d m) curr-section-
2680: 6e 61 6d 65 20 6b 65 79 20 23 66 29 29 29 0a 09 name key #f)))..
2690: 20 20 20 20 20 20 20 3b 3b 20 69 66 20 61 20 63 ;; if a c
26a0: 6f 6e 74 69 6e 75 65 64 20 6c 69 6e 65 0a 09 20 ontinued line..
26b0: 20 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 63 (configf:c
26c0: 6f 6e 74 2d 6c 6e 2d 72 78 20 28 20 78 20 77 68 ont-ln-rx ( x wh
26d0: 73 70 20 76 61 6c 20 20 20 20 20 29 20 28 6c 65 sp val ) (le
26e0: 74 20 28 28 61 6c 69 73 74 20 28 68 61 73 68 2d t ((alist (hash-
26f0: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
2700: 74 20 72 65 73 20 63 75 72 72 2d 73 65 63 74 69 t res curr-secti
2710: 6f 6e 2d 6e 61 6d 65 20 27 28 29 29 29 29 0a 09 on-name '())))..
2720: 09 09 09 09 09 28 69 66 20 76 61 72 2d 66 6c 61 .....(if var-fla
2730: 67 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b g ;;
2740: 20 69 66 20 73 65 74 20 74 6f 20 61 20 73 74 72 if set to a str
2750: 69 6e 67 20 74 68 65 6e 20 77 65 20 68 61 76 65 ing then we have
2760: 20 61 20 63 6f 6e 74 69 6e 75 65 64 20 76 61 72 a continued var
2770: 0a 09 09 09 09 09 09 20 20 20 20 28 6c 65 74 20 ....... (let
2780: 28 28 6e 65 77 76 61 6c 20 28 63 6f 6e 63 20 0a ((newval (conc .
2790: 09 09 09 09 09 09 09 09 20 20 20 28 63 6f 6e 66 ........ (conf
27a0: 69 67 2d 6c 6f 6f 6b 75 70 20 72 65 73 20 63 75 ig-lookup res cu
27b0: 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 rr-section-name
27c0: 76 61 72 2d 66 6c 61 67 29 20 22 5c 6e 22 0a 09 var-flag) "\n"..
27d0: 09 09 09 09 09 09 09 20 20 20 3b 3b 20 74 72 69 ....... ;; tri
27e0: 6d 20 6c 65 61 64 20 66 72 6f 6d 20 74 68 65 20 m lead from the
27f0: 69 6e 63 6f 6d 69 6e 67 20 77 68 73 70 20 74 6f incoming whsp to
2800: 20 73 75 70 70 6f 72 74 20 73 6f 6d 65 20 69 6e support some in
2810: 64 65 6e 74 69 6e 67 2e 0a 09 09 09 09 09 09 09 denting.........
2820: 09 20 20 20 28 69 66 20 6c 65 61 64 0a 09 09 09 . (if lead....
2830: 09 09 09 09 09 20 20 20 20 20 20 20 28 73 74 72 ..... (str
2840: 69 6e 67 2d 73 75 62 73 74 69 74 75 74 65 20 28 ing-substitute (
2850: 72 65 67 65 78 70 20 6c 65 61 64 29 20 22 22 20 regexp lead) ""
2860: 77 68 73 70 29 0a 09 09 09 09 09 09 09 09 20 20 whsp).........
2870: 20 20 20 20 20 22 22 29 0a 09 09 09 09 09 09 09 "")........
2880: 09 20 20 20 76 61 6c 29 29 29 0a 09 09 09 09 09 . val)))......
2890: 09 20 20 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 . ;; (print
28a0: 20 22 76 61 6c 3a 20 22 20 76 61 6c 20 22 5c 6e "val: " val "\n
28b0: 6e 65 77 76 61 6c 3a 20 5c 22 22 20 6e 65 77 76 newval: \"" newv
28c0: 61 6c 20 22 5c 22 5c 6e 76 61 72 66 6c 61 67 3a al "\"\nvarflag:
28d0: 20 22 20 76 61 72 2d 66 6c 61 67 29 0a 09 09 09 " var-flag)....
28e0: 09 09 09 20 20 20 20 20 20 28 68 61 73 68 2d 74 ... (hash-t
28f0: 61 62 6c 65 2d 73 65 74 21 20 72 65 73 20 63 75 able-set! res cu
2900: 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 rr-section-name
2910: 0a 09 09 09 09 09 09 09 09 20 20 20 20 20 20 20 .........
2920: 28 63 6f 6e 66 69 67 3a 61 73 73 6f 63 2d 73 61 (config:assoc-sa
2930: 66 65 2d 61 64 64 20 61 6c 69 73 74 20 76 61 72 fe-add alist var
2940: 2d 66 6c 61 67 20 6e 65 77 76 61 6c 29 29 0a 09 -flag newval))..
2950: 09 09 09 09 09 20 20 20 20 20 20 28 6c 6f 6f 70 ..... (loop
2960: 20 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d 6c (configf:read-l
2970: 69 6e 65 20 69 6e 70 20 72 65 73 20 61 6c 6c 6f ine inp res allo
2980: 77 2d 73 79 73 74 65 6d 29 20 63 75 72 72 2d 73 w-system) curr-s
2990: 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 76 61 72 2d ection-name var-
29a0: 66 6c 61 67 20 28 69 66 20 6c 65 61 64 20 6c 65 flag (if lead le
29b0: 61 64 20 77 68 73 70 29 29 29 0a 09 09 09 09 09 ad whsp)))......
29c0: 09 20 20 20 20 28 6c 6f 6f 70 20 28 63 6f 6e 66 . (loop (conf
29d0: 69 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e igf:read-line in
29e0: 70 20 72 65 73 20 61 6c 6c 6f 77 2d 73 79 73 74 p res allow-syst
29f0: 65 6d 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e em) curr-section
2a00: 2d 6e 61 6d 65 20 23 66 20 23 66 29 29 29 29 0a -name #f #f)))).
2a10: 09 20 20 20 20 20 20 20 28 65 6c 73 65 20 28 64 . (else (d
2a20: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 ebug:print 0 "ER
2a30: 52 4f 52 3a 20 70 72 6f 62 6c 65 6d 20 70 61 72 ROR: problem par
2a40: 73 69 6e 67 20 22 20 70 61 74 68 20 22 2c 5c 6e sing " path ",\n
2a50: 20 20 20 5c 22 22 20 69 6e 6c 20 22 5c 22 22 29 \"" inl "\"")
2a60: 0a 09 09 20 20 20 20 20 28 73 65 74 21 20 76 61 ... (set! va
2a70: 72 2d 66 6c 61 67 20 23 66 29 0a 09 09 20 20 20 r-flag #f)...
2a80: 20 20 28 6c 6f 6f 70 20 28 63 6f 6e 66 69 67 66 (loop (configf
2a90: 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 20 72 :read-line inp r
2aa0: 65 73 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 29 es allow-system)
2ab0: 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 curr-section-na
2ac0: 6d 65 20 23 66 20 23 66 29 29 29 29 29 29 29 29 me #f #f))))))))
2ad0: 0a 20 20 0a 3b 3b 20 70 61 74 68 65 6e 76 76 61 . .;; pathenvva
2ae0: 72 20 77 69 6c 6c 20 73 65 74 20 74 68 65 20 6e r will set the n
2af0: 61 6d 65 64 20 76 61 72 20 74 6f 20 74 68 65 20 amed var to the
2b00: 70 61 74 68 20 6f 66 20 74 68 65 20 63 6f 6e 66 path of the conf
2b10: 69 67 0a 28 64 65 66 69 6e 65 20 28 66 69 6e 64 ig.(define (find
2b20: 2d 61 6e 64 2d 72 65 61 64 2d 63 6f 6e 66 69 67 -and-read-config
2b30: 20 66 6e 61 6d 65 20 23 21 6b 65 79 20 28 65 6e fname #!key (en
2b40: 76 69 72 6f 6e 2d 70 61 74 74 20 23 66 29 28 67 viron-patt #f)(g
2b50: 69 76 65 6e 2d 74 6f 70 70 61 74 68 20 23 66 29 iven-toppath #f)
2b60: 28 70 61 74 68 65 6e 76 76 61 72 20 23 66 29 29 (pathenvvar #f))
2b70: 0a 20 20 28 6c 65 74 2a 20 28 28 63 75 72 72 2d . (let* ((curr-
2b80: 64 69 72 20 20 20 28 63 75 72 72 65 6e 74 2d 64 dir (current-d
2b90: 69 72 65 63 74 6f 72 79 29 29 0a 20 20 20 20 20 irectory)).
2ba0: 20 20 20 20 28 63 6f 6e 66 69 67 69 6e 66 6f 20 (configinfo
2bb0: 28 66 69 6e 64 2d 63 6f 6e 66 69 67 20 66 6e 61 (find-config fna
2bc0: 6d 65 20 74 6f 70 70 61 74 68 3a 20 67 69 76 65 me toppath: give
2bd0: 6e 2d 74 6f 70 70 61 74 68 29 29 0a 09 20 28 74 n-toppath)).. (t
2be0: 6f 70 70 61 74 68 20 20 20 20 28 63 61 72 20 63 oppath (car c
2bf0: 6f 6e 66 69 67 69 6e 66 6f 29 29 0a 09 20 28 63 onfiginfo)).. (c
2c00: 6f 6e 66 69 67 66 69 6c 65 20 28 63 61 64 72 20 onfigfile (cadr
2c10: 63 6f 6e 66 69 67 69 6e 66 6f 29 29 29 0a 20 20 configinfo))).
2c20: 20 20 28 69 66 20 74 6f 70 70 61 74 68 20 28 63 (if toppath (c
2c30: 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 hange-directory
2c40: 74 6f 70 70 61 74 68 29 29 20 0a 20 20 20 20 28 toppath)) . (
2c50: 69 66 20 28 61 6e 64 20 74 6f 70 70 61 74 68 20 if (and toppath
2c60: 70 61 74 68 65 6e 76 76 61 72 29 28 73 65 74 65 pathenvvar)(sete
2c70: 6e 76 20 70 61 74 68 65 6e 76 76 61 72 20 74 6f nv pathenvvar to
2c80: 70 70 61 74 68 29 29 0a 20 20 20 20 28 6c 65 74 ppath)). (let
2c90: 20 28 28 63 6f 6e 66 69 67 64 61 74 20 20 28 69 ((configdat (i
2ca0: 66 20 63 6f 6e 66 69 67 66 69 6c 65 20 28 72 65 f configfile (re
2cb0: 61 64 2d 63 6f 6e 66 69 67 20 63 6f 6e 66 69 67 ad-config config
2cc0: 66 69 6c 65 20 23 66 20 23 74 20 65 6e 76 69 72 file #f #t envir
2cd0: 6f 6e 2d 70 61 74 74 3a 20 65 6e 76 69 72 6f 6e on-patt: environ
2ce0: 2d 70 61 74 74 29 20 23 66 29 29 29 20 3b 3b 20 -patt) #f))) ;;
2cf0: 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 (make-hash-table
2d00: 29 29 29 29 0a 20 20 20 20 20 20 28 69 66 20 74 )))). (if t
2d10: 6f 70 70 61 74 68 20 28 63 68 61 6e 67 65 2d 64 oppath (change-d
2d20: 69 72 65 63 74 6f 72 79 20 63 75 72 72 2d 64 69 irectory curr-di
2d30: 72 29 29 0a 20 20 20 20 20 20 28 6c 69 73 74 20 r)). (list
2d40: 63 6f 6e 66 69 67 64 61 74 20 74 6f 70 70 61 74 configdat toppat
2d50: 68 20 63 6f 6e 66 69 67 66 69 6c 65 20 66 6e 61 h configfile fna
2d60: 6d 65 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 me))))..(define
2d70: 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 63 (config-lookup c
2d80: 66 67 64 61 74 20 73 65 63 74 69 6f 6e 20 76 61 fgdat section va
2d90: 72 29 0a 20 20 28 69 66 20 28 68 61 73 68 2d 74 r). (if (hash-t
2da0: 61 62 6c 65 3f 20 63 66 67 64 61 74 29 0a 20 20 able? cfgdat).
2db0: 20 20 20 20 28 6c 65 74 20 28 28 73 65 63 74 64 (let ((sectd
2dc0: 61 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 at (hash-table-r
2dd0: 65 66 2f 64 65 66 61 75 6c 74 20 63 66 67 64 61 ef/default cfgda
2de0: 74 20 73 65 63 74 69 6f 6e 20 27 28 29 29 29 29 t section '())))
2df0: 0a 09 28 69 66 20 28 6e 75 6c 6c 3f 20 73 65 63 ..(if (null? sec
2e00: 74 64 61 74 29 0a 09 20 20 20 20 23 66 0a 09 20 tdat).. #f..
2e10: 20 20 20 28 6c 65 74 20 28 28 6d 61 74 63 68 20 (let ((match
2e20: 28 61 73 73 6f 63 20 76 61 72 20 73 65 63 74 64 (assoc var sectd
2e30: 61 74 29 29 29 0a 09 20 20 20 20 20 20 28 69 66 at))).. (if
2e40: 20 6d 61 74 63 68 20 3b 3b 20 28 61 6e 64 20 6d match ;; (and m
2e50: 61 74 63 68 20 28 6c 69 73 74 3f 20 6d 61 74 63 atch (list? matc
2e60: 68 29 28 3e 20 28 6c 65 6e 67 74 68 20 6d 61 74 h)(> (length mat
2e70: 63 68 29 20 31 29 29 0a 09 09 20 20 28 63 61 64 ch) 1))... (cad
2e80: 72 20 6d 61 74 63 68 29 0a 09 09 20 20 23 66 29 r match)... #f)
2e90: 29 0a 09 20 20 20 20 29 29 0a 20 20 20 20 20 20 ).. )).
2ea0: 23 66 29 29 0a 0a 28 64 65 66 69 6e 65 20 63 6f #f))..(define co
2eb0: 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 63 6f 6e nfigf:lookup con
2ec0: 66 69 67 2d 6c 6f 6f 6b 75 70 29 0a 0a 28 64 65 fig-lookup)..(de
2ed0: 66 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a 73 65 fine (configf:se
2ee0: 63 74 69 6f 6e 2d 76 61 72 73 20 63 66 67 64 61 ction-vars cfgda
2ef0: 74 20 73 65 63 74 69 6f 6e 29 0a 20 20 28 6c 65 t section). (le
2f00: 74 20 28 28 73 65 63 74 64 61 74 20 28 68 61 73 t ((sectdat (has
2f10: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
2f20: 75 6c 74 20 63 66 67 64 61 74 20 73 65 63 74 69 ult cfgdat secti
2f30: 6f 6e 20 27 28 29 29 29 29 0a 20 20 20 20 28 69 on '()))). (i
2f40: 66 20 28 6e 75 6c 6c 3f 20 73 65 63 74 64 61 74 f (null? sectdat
2f50: 29 0a 09 27 28 29 0a 09 28 6d 61 70 20 63 61 72 )..'()..(map car
2f60: 20 73 65 63 74 64 61 74 29 29 29 29 0a 0a 28 64 sectdat))))..(d
2f70: 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a 67 efine (configf:g
2f80: 65 74 2d 73 65 63 74 69 6f 6e 20 63 66 64 61 74 et-section cfdat
2f90: 20 73 65 63 74 69 6f 6e 29 0a 20 20 28 68 61 73 section). (has
2fa0: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
2fb0: 75 6c 74 20 63 66 67 64 61 74 20 73 65 63 74 69 ult cfgdat secti
2fc0: 6f 6e 20 27 28 29 29 29 0a 0a 28 64 65 66 69 6e on '()))..(defin
2fd0: 65 20 28 73 65 74 75 70 29 0a 20 20 28 6c 65 74 e (setup). (let
2fe0: 2a 20 28 28 63 6f 6e 66 69 67 66 20 28 66 69 6e * ((configf (fin
2ff0: 64 2d 63 6f 6e 66 69 67 29 29 0a 09 20 28 63 6f d-config)).. (co
3000: 6e 66 69 67 20 20 28 69 66 20 63 6f 6e 66 69 67 nfig (if config
3010: 66 20 28 72 65 61 64 2d 63 6f 6e 66 69 67 20 63 f (read-config c
3020: 6f 6e 66 69 67 66 20 23 66 20 23 74 29 20 23 66 onfigf #f #t) #f
3030: 29 29 29 0a 20 20 20 20 28 69 66 20 63 6f 6e 66 ))). (if conf
3040: 69 67 0a 09 28 73 65 74 65 6e 76 20 22 52 55 4e ig..(setenv "RUN
3050: 5f 41 52 45 41 5f 48 4f 4d 45 22 20 28 70 61 74 _AREA_HOME" (pat
3060: 68 6e 61 6d 65 2d 64 69 72 65 63 74 6f 72 79 20 hname-directory
3070: 63 6f 6e 66 69 67 66 29 29 29 0a 20 20 20 20 63 configf))). c
3080: 6f 6e 66 69 67 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d onfig))..;;=====
3090: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
30a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
30b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
30c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
30d0: 3d 0a 3b 3b 20 4e 6f 6e 20 64 65 73 74 72 75 63 =.;; Non destruc
30e0: 74 69 76 65 20 77 72 69 74 69 6e 67 20 6f 66 20 tive writing of
30f0: 63 6f 6e 66 69 67 20 66 69 6c 65 0a 3b 3b 3d 3d config file.;;==
3100: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3110: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3120: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3130: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3140: 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 63 ====..(define (c
3150: 6f 6e 66 69 67 66 3a 63 6f 6d 70 72 65 73 73 2d onfigf:compress-
3160: 6d 75 6c 74 69 2d 6c 69 6e 65 73 20 66 64 61 74 multi-lines fdat
3170: 29 0a 20 20 3b 3b 20 73 74 65 70 20 31 2e 35 20 ). ;; step 1.5
3180: 2d 20 63 6f 6d 70 72 65 73 73 20 61 6e 79 20 63 - compress any c
3190: 6f 6e 74 69 6e 75 65 64 20 6c 69 6e 65 73 0a 20 ontinued lines.
31a0: 20 28 69 66 20 28 6e 75 6c 6c 3f 20 66 64 61 74 (if (null? fdat
31b0: 29 20 66 64 61 74 0a 09 28 6c 65 74 20 6c 6f 6f ) fdat..(let loo
31c0: 70 20 28 28 68 65 64 20 28 63 61 72 20 66 64 61 p ((hed (car fda
31d0: 74 29 29 0a 09 09 20 20 20 28 74 61 6c 20 28 63 t))... (tal (c
31e0: 64 72 20 66 64 61 74 29 29 0a 09 09 20 20 20 28 dr fdat))... (
31f0: 63 75 72 20 22 22 29 0a 09 09 20 20 20 28 6c 65 cur "")... (le
3200: 64 20 23 66 29 0a 09 09 20 20 20 28 72 65 73 20 d #f)... (res
3210: 27 28 29 29 29 0a 09 20 20 3b 3b 20 41 4c 4c 20 '())).. ;; ALL
3220: 57 48 49 54 45 53 50 41 43 45 20 4c 45 41 44 49 WHITESPACE LEADI
3230: 4e 47 20 4c 49 4e 45 53 20 41 52 45 20 54 41 43 NG LINES ARE TAC
3240: 4b 45 44 20 4f 4e 21 21 0a 09 20 20 3b 3b 20 20 KED ON!!.. ;;
3250: 31 2e 20 72 65 6d 6f 76 65 20 6c 65 64 20 77 68 1. remove led wh
3260: 69 74 65 73 70 61 63 65 0a 09 20 20 3b 3b 20 20 itespace.. ;;
3270: 32 2e 20 74 61 63 6b 20 6f 6e 20 74 6f 20 68 65 2. tack on to he
3280: 64 20 77 69 74 68 20 22 5c 6e 22 0a 09 20 20 28 d with "\n".. (
3290: 6c 65 74 20 28 28 6d 61 74 63 68 20 28 73 74 72 let ((match (str
32a0: 69 6e 67 2d 6d 61 74 63 68 20 63 6f 6e 66 69 67 ing-match config
32b0: 66 3a 63 6f 6e 74 2d 6c 6e 2d 72 78 20 68 65 64 f:cont-ln-rx hed
32c0: 29 29 29 0a 09 20 20 20 20 28 69 66 20 6d 61 74 ))).. (if mat
32d0: 63 68 20 3b 3b 20 62 6c 61 73 74 21 20 68 61 76 ch ;; blast! hav
32e0: 65 20 74 6f 20 64 65 61 6c 20 77 69 74 68 20 61 e to deal with a
32f0: 20 6d 75 6c 74 69 6c 69 6e 65 0a 09 09 28 6c 65 multiline...(le
3300: 74 2a 20 28 28 6c 65 61 64 20 28 63 61 64 72 20 t* ((lead (cadr
3310: 6d 61 74 63 68 29 29 0a 09 09 20 20 20 20 20 20 match))...
3320: 20 28 6c 76 61 6c 20 28 63 61 64 64 72 20 6d 61 (lval (caddr ma
3330: 74 63 68 29 29 0a 09 09 20 20 20 20 20 20 20 28 tch))... (
3340: 6e 65 77 6c 20 28 63 6f 6e 63 20 63 75 72 20 22 newl (conc cur "
3350: 5c 6e 22 20 6c 76 61 6c 29 29 29 0a 09 09 20 20 \n" lval)))...
3360: 28 69 66 20 28 6e 6f 74 20 6c 65 64 29 28 73 65 (if (not led)(se
3370: 74 21 20 6c 65 64 20 6c 65 61 64 29 29 0a 09 09 t! led lead))...
3380: 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 61 6c (if (null? tal
3390: 29 20 0a 09 09 20 20 20 20 20 20 28 73 65 74 21 ) ... (set!
33a0: 20 66 64 61 74 20 28 61 70 70 65 6e 64 20 66 64 fdat (append fd
33b0: 61 74 20 28 6c 69 73 74 20 6e 65 77 6c 29 29 29 at (list newl)))
33c0: 0a 09 09 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 ... (loop (
33d0: 63 61 72 20 74 61 6c 29 28 63 64 72 20 74 61 6c car tal)(cdr tal
33e0: 29 20 6e 65 77 6c 20 6c 65 64 20 72 65 73 29 29 ) newl led res))
33f0: 29 20 3b 3b 20 4e 42 2f 2f 20 6e 6f 74 20 74 61 ) ;; NB// not ta
3400: 63 6b 69 6e 67 20 6e 65 77 6c 20 6f 6e 74 6f 20 cking newl onto
3410: 72 65 73 0a 09 09 28 6c 65 74 20 28 28 6e 65 77 res...(let ((new
3420: 72 65 73 20 28 69 66 20 6c 65 64 20 0a 09 09 09 res (if led ....
3430: 09 20 20 28 61 70 70 65 6e 64 20 72 65 73 20 28 . (append res (
3440: 6c 69 73 74 20 63 75 72 20 68 65 64 29 29 0a 09 list cur hed))..
3450: 09 09 09 20 20 28 61 70 70 65 6e 64 20 72 65 73 ... (append res
3460: 20 28 6c 69 73 74 20 68 65 64 29 29 29 29 29 0a (list hed))))).
3470: 09 09 20 20 3b 3b 20 70 72 65 76 20 77 61 73 20 .. ;; prev was
3480: 61 20 6d 75 6c 74 69 6c 69 6e 65 0a 09 09 20 20 a multiline...
3490: 28 69 66 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 0a (if (null? tal).
34a0: 09 09 20 20 20 20 20 20 6e 65 77 72 65 73 0a 09 .. newres..
34b0: 09 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 . (loop (ca
34c0: 72 20 74 61 6c 29 28 63 64 72 20 74 61 6c 29 20 r tal)(cdr tal)
34d0: 22 22 20 23 66 20 6e 65 77 72 65 73 29 29 29 29 "" #f newres))))
34e0: 29 29 29 29 0a 0a 3b 3b 20 6e 6f 74 65 3a 20 49 ))))..;; note: I
34f0: 27 6d 20 63 68 65 61 74 69 6e 67 20 61 20 6c 69 'm cheating a li
3500: 74 74 6c 65 20 68 65 72 65 2e 20 49 20 6d 65 72 ttle here. I mer
3510: 65 6c 79 20 72 65 70 6c 61 63 65 20 22 5c 6e 22 ely replace "\n"
3520: 20 77 69 74 68 20 22 5c 6e 20 20 20 20 20 20 20 with "\n
3530: 20 20 22 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e ".(define (con
3540: 66 69 67 66 3a 65 78 70 61 6e 64 2d 6d 75 6c 74 figf:expand-mult
3550: 69 2d 6c 69 6e 65 73 20 66 64 61 74 29 0a 20 20 i-lines fdat).
3560: 3b 3b 20 73 74 65 70 20 31 2e 35 20 2d 20 63 6f ;; step 1.5 - co
3570: 6d 70 72 65 73 73 20 61 6e 79 20 63 6f 6e 74 69 mpress any conti
3580: 6e 75 65 64 20 6c 69 6e 65 73 0a 20 20 28 69 66 nued lines. (if
3590: 20 28 6e 75 6c 6c 3f 20 66 64 61 74 29 20 66 64 (null? fdat) fd
35a0: 61 74 0a 20 20 20 20 20 20 28 6c 65 74 20 6c 6f at. (let lo
35b0: 6f 70 20 28 28 68 65 64 20 28 63 61 72 20 66 64 op ((hed (car fd
35c0: 61 74 29 29 0a 09 09 20 28 74 61 6c 20 28 63 64 at))... (tal (cd
35d0: 72 20 66 64 61 74 29 29 0a 09 09 20 28 72 65 73 r fdat))... (res
35e0: 20 27 28 29 29 29 0a 09 28 6c 65 74 20 28 28 6e '()))..(let ((n
35f0: 65 77 72 65 73 20 28 61 70 70 65 6e 64 20 72 65 ewres (append re
3600: 73 20 28 6c 69 73 74 20 28 73 74 72 69 6e 67 2d s (list (string-
3610: 73 75 62 73 74 69 74 75 74 65 20 28 72 65 67 65 substitute (rege
3620: 78 70 20 22 5c 6e 22 29 20 22 5c 6e 20 20 20 20 xp "\n") "\n
3630: 20 20 20 20 20 22 20 68 65 64 20 23 74 29 29 29 " hed #t)))
3640: 29 29 0a 09 20 20 28 69 66 20 28 6e 75 6c 6c 3f )).. (if (null?
3650: 20 74 61 6c 29 0a 09 20 20 20 20 20 20 6e 65 77 tal).. new
3660: 72 65 73 0a 09 20 20 20 20 20 20 28 6c 6f 6f 70 res.. (loop
3670: 20 28 63 61 72 20 74 61 6c 29 28 63 64 72 20 74 (car tal)(cdr t
3680: 61 6c 29 20 6e 65 77 72 65 73 29 29 29 29 29 29 al) newres))))))
3690: 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 ..(define (confi
36a0: 67 66 3a 66 69 6c 65 2d 3e 6c 69 73 74 20 66 6e gf:file->list fn
36b0: 61 6d 65 29 0a 20 20 28 69 66 20 28 66 69 6c 65 ame). (if (file
36c0: 2d 65 78 69 73 74 73 3f 20 66 6e 61 6d 65 29 0a -exists? fname).
36d0: 20 20 20 20 20 20 28 6c 65 74 20 28 28 69 6e 70 (let ((inp
36e0: 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 66 69 6c (open-input-fil
36f0: 65 20 66 6e 61 6d 65 29 29 29 0a 09 28 6c 65 74 e fname)))..(let
3700: 20 6c 6f 6f 70 20 28 28 69 6e 6c 20 28 72 65 61 loop ((inl (rea
3710: 64 2d 6c 69 6e 65 20 69 6e 70 29 29 0a 09 09 20 d-line inp))...
3720: 20 20 28 72 65 73 20 27 28 29 29 29 0a 09 20 20 (res '()))..
3730: 28 69 66 20 28 65 6f 66 2d 6f 62 6a 65 63 74 3f (if (eof-object?
3740: 20 69 6e 6c 29 0a 09 20 20 20 20 20 20 28 62 65 inl).. (be
3750: 67 69 6e 0a 09 09 28 63 6c 6f 73 65 2d 69 6e 70 gin...(close-inp
3760: 75 74 2d 70 6f 72 74 20 69 6e 70 29 0a 09 09 28 ut-port inp)...(
3770: 72 65 76 65 72 73 65 20 72 65 73 29 29 0a 09 20 reverse res))..
3780: 20 20 20 20 20 28 6c 6f 6f 70 20 28 72 65 61 64 (loop (read
3790: 2d 6c 69 6e 65 20 69 6e 70 29 28 63 6f 6e 73 20 -line inp)(cons
37a0: 69 6e 6c 29 29 29 29 29 0a 20 20 20 20 20 20 27 inl))))). '
37b0: 28 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d ()))..;;========
37c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
37d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
37e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
37f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
3800: 3b 20 57 72 69 74 65 20 61 20 63 6f 6e 66 69 67 ; Write a config
3810: 0a 3b 3b 20 20 20 30 2e 20 47 69 76 65 6e 20 61 .;; 0. Given a
3820: 20 72 65 66 65 72 65 72 65 6e 63 65 20 64 61 74 refererence dat
3830: 61 20 73 74 72 75 63 74 75 72 65 20 22 69 6e 64 a structure "ind
3840: 61 74 22 0a 3b 3b 20 20 20 31 2e 20 4f 70 65 6e at".;; 1. Open
3850: 20 74 68 65 20 6f 75 74 70 75 74 20 66 69 6c 65 the output file
3860: 20 61 6e 64 20 72 65 61 64 20 69 74 20 69 6e 74 and read it int
3870: 6f 20 61 20 6c 69 73 74 0a 3b 3b 20 20 20 32 2e o a list.;; 2.
3880: 20 46 6c 61 74 74 65 6e 20 61 6e 79 20 6d 75 6c Flatten any mul
3890: 74 69 6c 69 6e 65 20 65 6e 74 72 69 65 73 0a 3b tiline entries.;
38a0: 3b 20 20 20 33 2e 20 4d 6f 64 69 66 79 20 76 61 ; 3. Modify va
38b0: 6c 75 65 73 20 70 65 72 20 63 6f 6e 74 65 6e 74 lues per content
38c0: 73 20 6f 66 20 22 69 6e 64 61 74 22 20 61 6e 64 s of "indat" and
38d0: 20 72 65 6d 6f 76 65 20 61 62 73 65 6e 74 20 76 remove absent v
38e0: 61 6c 75 65 73 0a 3b 3b 20 20 20 34 2e 20 41 70 alues.;; 4. Ap
38f0: 70 65 6e 64 20 6e 65 77 20 76 61 6c 75 65 73 20 pend new values
3900: 74 6f 20 74 68 65 20 73 65 63 74 69 6f 6e 20 28 to the section (
3910: 69 6d 6d 65 64 69 61 74 65 6c 79 20 61 66 74 65 immediately afte
3920: 72 20 6c 61 73 74 20 6c 65 67 69 74 20 65 6e 74 r last legit ent
3930: 72 79 29 0a 3b 3b 20 20 20 35 2e 20 57 72 69 74 ry).;; 5. Writ
3940: 65 20 6f 75 74 20 74 68 65 20 6e 65 77 20 6c 69 e out the new li
3950: 73 74 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d st .;;==========
3960: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3970: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3980: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3990: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 ============..(d
39a0: 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a 77 efine (configf:w
39b0: 72 69 74 65 2d 63 6f 6e 66 69 67 20 69 6e 64 61 rite-config inda
39c0: 74 20 66 6e 61 6d 65 20 23 21 6b 65 79 20 28 72 t fname #!key (r
39d0: 65 71 75 69 72 65 64 2d 73 65 63 74 69 6f 6e 73 equired-sections
39e0: 20 27 28 29 29 29 0a 20 20 28 6c 65 74 2a 20 28 '())). (let* (
39f0: 3b 3b 20 73 74 65 70 20 31 3a 20 4f 70 65 6e 20 ;; step 1: Open
3a00: 74 68 65 20 6f 75 74 70 75 74 20 66 69 6c 65 20 the output file
3a10: 61 6e 64 20 72 65 61 64 20 69 74 20 69 6e 74 6f and read it into
3a20: 20 61 20 6c 69 73 74 0a 09 20 28 66 64 61 74 20 a list.. (fdat
3a30: 20 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 66 (configf:f
3a40: 69 6c 65 2d 3e 6c 69 73 74 20 66 6e 61 6d 65 29 ile->list fname)
3a50: 29 0a 09 20 28 72 65 66 64 61 74 20 20 28 6d 61 ).. (refdat (ma
3a60: 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a ke-hash-table)).
3a70: 09 20 28 73 65 63 68 61 73 68 20 28 6d 61 6b 65 . (sechash (make
3a80: 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 20 3b 3b -hash-table)) ;;
3a90: 20 63 75 72 72 65 6e 74 20 73 65 63 74 69 6f 6e current section
3aa0: 20 68 61 73 68 2c 20 69 6e 69 74 20 77 69 74 68 hash, init with
3ab0: 20 68 61 73 68 20 66 6f 72 20 22 64 65 66 61 75 hash for "defau
3ac0: 6c 74 22 20 73 65 63 74 69 6f 6e 0a 09 20 28 6e lt" section.. (n
3ad0: 65 77 20 20 20 20 20 23 66 29 20 3b 3b 20 70 75 ew #f) ;; pu
3ae0: 74 20 74 68 65 20 6c 69 6e 65 20 74 6f 20 62 65 t the line to be
3af0: 20 75 73 65 64 20 69 6e 20 6e 65 77 2c 20 69 66 used in new, if
3b00: 20 69 74 20 69 73 20 74 6f 20 62 65 20 64 65 6c it is to be del
3b10: 65 74 65 64 20 74 68 65 20 73 65 74 20 6e 65 77 eted the set new
3b20: 20 74 6f 20 23 66 0a 09 20 28 73 65 63 6e 61 6d to #f.. (secnam
3b30: 65 20 23 66 29 29 0a 0a 20 20 20 20 3b 3b 20 73 e #f)).. ;; s
3b40: 74 65 70 20 32 3a 20 46 6c 61 74 74 65 6e 20 6d tep 2: Flatten m
3b50: 75 6c 74 69 6c 69 6e 65 20 65 6e 74 72 69 65 73 ultiline entries
3b60: 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6e . (if (not (n
3b70: 75 6c 6c 3f 20 66 64 61 74 29 29 28 73 65 74 21 ull? fdat))(set!
3b80: 20 66 64 61 74 20 28 63 6f 6e 66 69 67 66 3a 63 fdat (configf:c
3b90: 6f 6d 70 72 65 73 73 2d 6d 75 6c 74 69 2d 6c 69 ompress-multi-li
3ba0: 6e 65 20 66 64 61 74 29 29 29 0a 0a 20 20 20 20 ne fdat)))..
3bb0: 3b 3b 20 73 74 65 70 20 33 3a 20 4d 6f 64 69 66 ;; step 3: Modif
3bc0: 79 20 76 61 6c 75 65 73 20 70 65 72 20 63 6f 6e y values per con
3bd0: 74 65 6e 74 73 20 6f 66 20 22 69 6e 64 61 74 22 tents of "indat"
3be0: 20 61 6e 64 20 72 65 6d 6f 76 65 20 61 62 73 65 and remove abse
3bf0: 6e 74 20 76 61 6c 75 65 73 0a 20 20 20 20 28 69 nt values. (i
3c00: 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 66 64 f (not (null? fd
3c10: 61 74 29 29 0a 09 28 6c 65 74 20 6c 6f 6f 70 20 at))..(let loop
3c20: 28 28 68 65 64 20 20 28 63 61 72 20 66 64 61 74 ((hed (car fdat
3c30: 29 29 0a 09 09 20 20 20 28 74 61 6c 20 20 28 63 ))... (tal (c
3c40: 61 64 72 20 66 64 61 74 29 29 0a 09 09 20 20 20 adr fdat))...
3c50: 28 72 65 73 20 20 27 28 29 29 0a 09 09 20 20 20 (res '())...
3c60: 28 6c 6e 75 6d 20 30 29 29 0a 09 20 20 28 72 65 (lnum 0)).. (re
3c70: 67 65 78 2d 63 61 73 65 20 0a 09 20 20 20 68 65 gex-case .. he
3c80: 64 0a 09 20 20 20 28 63 6f 6e 66 69 67 66 3a 63 d.. (configf:c
3c90: 6f 6d 6d 65 6e 74 2d 72 78 20 5f 20 20 20 20 20 omment-rx _
3ca0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 65 (se
3cb0: 74 21 20 72 65 73 20 28 61 70 70 65 6e 64 20 72 t! res (append r
3cc0: 65 73 20 28 6c 69 73 74 20 68 65 64 29 29 29 29 es (list hed))))
3cd0: 20 3b 3b 20 28 6c 6f 6f 70 20 28 72 65 61 64 2d ;; (loop (read-
3ce0: 6c 69 6e 65 20 69 6e 70 29 20 63 75 72 72 2d 73 line inp) curr-s
3cf0: 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 ection-name #f #
3d00: 66 29 29 0a 09 20 20 20 28 63 6f 6e 66 69 67 66 f)).. (configf
3d10: 3a 62 6c 61 6e 6b 2d 6c 2d 72 78 20 5f 20 20 20 :blank-l-rx _
3d20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
3d30: 73 65 74 21 20 72 65 73 20 28 61 70 70 65 6e 64 set! res (append
3d40: 20 72 65 73 20 28 6c 69 73 74 20 68 65 64 29 29 res (list hed))
3d50: 29 29 20 3b 3b 20 28 6c 6f 6f 70 20 28 72 65 61 )) ;; (loop (rea
3d60: 64 2d 6c 69 6e 65 20 69 6e 70 29 20 63 75 72 72 d-line inp) curr
3d70: 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 -section-name #f
3d80: 20 23 66 29 29 0a 09 20 20 20 28 63 6f 6e 66 69 #f)).. (confi
3d90: 67 66 3a 73 65 63 74 69 6f 6e 2d 72 78 20 28 20 gf:section-rx (
3da0: 78 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 29 x section-name )
3db0: 20 28 6c 65 74 20 28 28 73 65 63 74 69 6f 6e 2d (let ((section-
3dc0: 68 61 73 68 20 28 68 61 73 68 2d 74 61 62 6c 65 hash (hash-table
3dd0: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 72 65 66 -ref/default ref
3de0: 64 61 74 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 dat section-name
3df0: 20 23 66 29 29 29 0a 09 09 09 09 09 20 20 20 20 #f)))......
3e00: 28 69 66 20 28 6e 6f 74 20 73 65 63 74 69 6f 6e (if (not section
3e10: 2d 68 61 73 68 29 0a 09 09 09 09 09 09 28 6c 65 -hash).......(le
3e20: 74 20 28 28 6e 65 77 68 61 73 68 20 28 6d 61 6b t ((newhash (mak
3e30: 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 29 0a e-hash-table))).
3e40: 09 09 09 09 09 09 20 20 28 68 61 73 68 2d 74 61 ...... (hash-ta
3e50: 62 6c 65 2d 73 65 74 21 20 72 65 66 68 61 73 68 ble-set! refhash
3e60: 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 6e 65 section-name ne
3e70: 77 68 61 73 68 29 0a 09 09 09 09 09 09 20 20 28 whash)....... (
3e80: 73 65 74 21 20 73 65 63 68 61 73 68 20 6e 65 77 set! sechash new
3e90: 68 61 73 68 29 29 0a 09 09 09 09 09 09 28 73 65 hash)).......(se
3ea0: 74 21 20 73 65 63 68 61 73 68 20 73 65 63 74 69 t! sechash secti
3eb0: 6f 6e 2d 68 61 73 68 29 29 0a 09 09 09 09 09 20 on-hash))......
3ec0: 20 20 20 28 73 65 74 21 20 6e 65 77 20 68 65 64 (set! new hed
3ed0: 29 20 3b 3b 20 77 69 6c 6c 20 61 70 70 65 6e 64 ) ;; will append
3ee0: 20 74 68 69 73 20 61 74 20 74 68 65 20 62 6f 74 this at the bot
3ef0: 74 6f 6d 20 6f 66 20 74 68 65 20 6c 6f 6f 70 0a tom of the loop.
3f00: 09 09 09 09 09 20 20 20 20 28 73 65 74 21 20 73 ..... (set! s
3f10: 65 63 6e 61 6d 65 20 73 65 63 74 69 6f 6e 2d 6e ecname section-n
3f20: 61 6d 65 29 0a 09 09 09 09 09 20 20 20 20 29 29 ame)...... ))
3f30: 0a 09 20 20 20 3b 3b 20 4e 6f 20 6e 65 65 64 20 .. ;; No need
3f40: 74 6f 20 70 72 6f 63 65 73 73 20 6b 65 79 20 63 to process key c
3f50: 6d 64 2c 20 6c 65 74 20 69 74 20 66 61 6c 6c 20 md, let it fall
3f60: 74 68 6f 75 67 68 20 74 6f 20 6b 65 79 20 76 61 though to key va
3f70: 6c 0a 09 20 20 20 28 63 6f 6e 66 69 67 66 3a 6b l.. (configf:k
3f80: 65 79 2d 76 61 6c 2d 70 72 20 28 20 78 20 6b 65 ey-val-pr ( x ke
3f90: 79 20 76 61 6c 20 20 20 20 20 20 29 0a 09 09 20 y val )...
3fa0: 20 20 20 20 20 20 28 6c 65 74 20 28 28 6e 65 77 (let ((new
3fb0: 76 61 6c 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b val (config-look
3fc0: 75 70 20 69 6e 64 61 74 20 73 65 63 20 6b 65 79 up indat sec key
3fd0: 29 29 29 0a 09 09 09 20 3b 3b 20 63 61 6e 20 68 ))).... ;; can h
3fe0: 61 6e 64 6c 65 20 6e 65 77 76 61 6c 20 3d 3d 20 andle newval ==
3ff0: 23 66 20 68 65 72 65 20 3d 3e 20 74 68 61 74 20 #f here => that
4000: 6d 65 61 6e 73 20 6b 65 79 20 69 73 20 72 65 6d means key is rem
4010: 6f 76 65 64 0a 09 09 09 20 28 63 6f 6e 64 20 0a oved.... (cond .
4020: 09 09 09 20 20 28 28 65 71 75 61 6c 3f 20 6e 65 ... ((equal? ne
4030: 77 76 61 6c 20 76 61 6c 29 0a 09 09 09 20 20 20 wval val)....
4040: 28 73 65 74 21 20 72 65 73 20 28 61 70 70 65 6e (set! res (appen
4050: 64 20 72 65 73 20 28 6c 69 73 74 20 68 65 64 29 d res (list hed)
4060: 29 29 29 0a 09 09 09 20 20 28 28 6e 6f 74 20 6e ))).... ((not n
4070: 65 77 76 61 6c 29 20 3b 3b 20 6b 65 79 20 68 61 ewval) ;; key ha
4080: 73 20 62 65 65 6e 20 72 65 6d 6f 76 65 64 0a 09 s been removed..
4090: 09 09 20 20 20 28 73 65 74 21 20 6e 65 77 20 23 .. (set! new #
40a0: 66 29 29 0a 09 09 09 20 20 28 28 6e 6f 74 20 28 f)).... ((not (
40b0: 65 71 75 61 6c 3f 20 6e 65 77 76 61 6c 20 76 61 equal? newval va
40c0: 6c 29 29 0a 09 09 09 20 20 20 20 20 28 68 61 73 l)).... (has
40d0: 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 73 65 63 h-table-set! sec
40e0: 68 61 73 68 20 6b 65 79 20 6e 65 77 76 61 6c 29 hash key newval)
40f0: 0a 09 09 09 20 20 20 20 20 28 73 65 74 21 20 6e .... (set! n
4100: 65 77 20 28 63 6f 6e 63 20 6b 65 79 20 22 20 22 ew (conc key " "
4110: 20 6e 65 77 76 61 6c 29 29 29 0a 09 09 09 20 20 newval)))....
4120: 28 65 6c 73 65 0a 09 09 09 20 20 20 28 64 65 62 (else.... (deb
4130: 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f ug:print 0 "ERRO
4140: 52 3a 20 70 72 6f 62 6c 65 6d 20 70 61 72 73 69 R: problem parsi
4150: 6e 67 20 6c 69 6e 65 20 6e 75 6d 62 65 72 20 22 ng line number "
4160: 20 6c 6e 75 6d 20 22 5c 22 22 20 68 65 64 20 22 lnum "\"" hed "
4170: 5c 22 22 29 29 29 29 29 0a 09 20 20 20 28 65 6c \""))))).. (el
4180: 73 65 0a 09 20 20 20 20 28 64 65 62 75 67 3a 70 se.. (debug:p
4190: 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 50 rint 0 "ERROR: P
41a0: 72 6f 62 6c 65 6d 20 70 61 72 73 69 6e 67 20 6c roblem parsing l
41b0: 69 6e 65 20 6e 75 6d 20 22 20 6c 6e 75 6d 20 22 ine num " lnum "
41c0: 20 3a 5c 6e 20 20 20 22 20 68 65 64 20 29 29 29 :\n " hed )))
41d0: 0a 09 20 20 28 69 66 20 28 6e 6f 74 20 28 6e 75 .. (if (not (nu
41e0: 6c 6c 3f 20 74 61 6c 29 29 0a 09 20 20 20 20 20 ll? tal))..
41f0: 20 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 (loop (car tal)
4200: 28 63 64 72 20 74 61 6c 29 28 69 66 20 6e 65 77 (cdr tal)(if new
4210: 20 28 61 70 70 65 6e 64 20 72 65 73 20 28 6c 69 (append res (li
4220: 73 74 20 6e 65 77 29 29 20 72 65 73 29 28 2b 20 st new)) res)(+
4230: 6c 6e 75 6d 20 31 29 29 29 0a 09 20 20 3b 3b 20 lnum 1))).. ;;
4240: 64 72 6f 70 20 74 6f 20 68 65 72 65 20 77 68 65 drop to here whe
4250: 6e 20 64 6f 6e 65 20 70 72 6f 63 65 73 73 69 6e n done processin
4260: 67 2c 20 72 65 73 20 63 6f 6e 74 61 69 6e 73 20 g, res contains
4270: 6d 6f 64 69 66 69 65 64 20 6c 69 73 74 20 6f 66 modified list of
4280: 20 6c 69 6e 65 73 0a 09 20 20 28 73 65 74 21 20 lines.. (set!
4290: 66 64 61 74 20 72 65 73 29 29 29 0a 0a 20 20 20 fdat res)))..
42a0: 20 3b 3b 20 73 74 65 70 20 34 3a 20 41 70 70 65 ;; step 4: Appe
42b0: 6e 64 20 6e 65 77 20 76 61 6c 75 65 73 20 74 6f nd new values to
42c0: 20 74 68 65 20 73 65 63 74 69 6f 6e 0a 20 20 20 the section.
42d0: 20 28 66 6f 72 2d 65 61 63 68 20 0a 20 20 20 20 (for-each .
42e0: 20 28 6c 61 6d 62 64 61 20 28 73 65 63 74 69 6f (lambda (sectio
42f0: 6e 29 0a 20 20 20 20 20 20 20 28 6c 65 74 20 28 n). (let (
4300: 28 73 64 61 74 20 20 20 27 28 29 29 20 3b 3b 20 (sdat '()) ;;
4310: 61 70 70 65 6e 64 20 6e 65 65 64 65 64 20 62 69 append needed bi
4320: 74 73 20 68 65 72 65 0a 09 20 20 20 20 20 28 73 ts here.. (s
4330: 76 61 72 73 20 20 28 63 6f 6e 66 69 67 66 3a 73 vars (configf:s
4340: 65 63 74 69 6f 6e 2d 76 61 72 73 20 69 6e 64 61 ection-vars inda
4350: 74 20 73 65 63 74 69 6f 6e 29 29 29 0a 09 20 28 t section))).. (
4360: 66 6f 72 2d 65 61 63 68 20 0a 09 20 20 28 6c 61 for-each .. (la
4370: 6d 62 64 61 20 28 76 61 72 29 0a 09 20 20 20 20 mbda (var)..
4380: 28 6c 65 74 20 28 28 76 61 6c 20 28 63 6f 6e 66 (let ((val (conf
4390: 69 67 2d 6c 6f 6f 6b 75 70 20 72 65 66 64 61 74 ig-lookup refdat
43a0: 20 73 65 63 74 69 6f 6e 20 76 61 72 29 29 29 0a section var))).
43b0: 09 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 . (if (not
43c0: 76 61 6c 29 20 3b 3b 20 74 68 69 73 20 6f 6e 65 val) ;; this one
43d0: 20 69 73 20 6e 65 77 0a 09 09 20 20 28 62 65 67 is new... (beg
43e0: 69 6e 0a 09 09 20 20 20 20 28 69 66 20 28 6e 75 in... (if (nu
43f0: 6c 6c 3f 20 73 64 61 74 29 28 73 65 74 21 20 73 ll? sdat)(set! s
4400: 64 61 74 20 28 6c 69 73 74 20 28 63 6f 6e 63 20 dat (list (conc
4410: 22 5b 22 20 73 65 63 74 69 6f 6e 20 22 5d 22 29 "[" section "]")
4420: 29 29 29 0a 09 09 20 20 20 20 28 73 65 74 21 20 )))... (set!
4430: 73 64 61 74 20 28 61 70 70 65 6e 64 20 73 64 61 sdat (append sda
4440: 74 20 28 6c 69 73 74 20 28 63 6f 6e 63 20 76 61 t (list (conc va
4450: 72 20 22 20 22 20 76 61 6c 29 29 29 29 29 29 29 r " " val)))))))
4460: 29 0a 09 20 20 73 76 61 72 73 29 0a 09 20 28 73 ).. svars).. (s
4470: 65 74 21 20 66 64 61 74 20 28 61 70 70 65 6e 64 et! fdat (append
4480: 20 66 64 61 74 20 73 64 61 74 29 29 29 29 0a 20 fdat sdat)))).
4490: 20 20 20 20 28 64 65 6c 65 74 65 2d 64 75 70 6c (delete-dupl
44a0: 69 63 61 74 65 73 20 28 61 70 70 65 6e 64 20 72 icates (append r
44b0: 65 71 75 69 72 65 2d 73 65 63 74 69 6f 6e 73 20 equire-sections
44c0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 (hash-table-keys
44d0: 20 69 6e 64 61 74 29 29 29 29 0a 0a 20 20 20 20 indat))))..
44e0: 3b 3b 20 73 74 65 70 20 35 3a 20 57 72 69 74 65 ;; step 5: Write
44f0: 20 6f 75 74 20 6e 65 77 20 66 69 6c 65 0a 20 20 out new file.
4500: 20 20 28 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 (with-output-t
4510: 6f 2d 66 69 6c 65 20 66 6e 61 6d 65 20 0a 20 20 o-file fname .
4520: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 (lambda ()..
4530: 28 66 6f 72 2d 65 61 63 68 20 0a 09 20 28 6c 61 (for-each .. (la
4540: 6d 62 64 61 20 28 6c 69 6e 65 29 0a 09 20 20 20 mbda (line)..
4550: 28 70 72 69 6e 74 20 6c 69 6e 65 29 29 0a 09 20 (print line))..
4560: 28 63 6f 6e 66 69 67 66 3a 65 78 70 61 6e 64 2d (configf:expand-
4570: 6d 75 6c 74 69 2d 6c 69 6e 65 73 20 66 64 61 74 multi-lines fdat
4580: 29 29 29 29 29 29 0a 0a ))))))..