File
configf.scm
— part of check-in
[0438d75d6c]
at
2012-06-26 14:06:20
on branch v1.44
— Fixed bug with finding wrong megatest.config and megatest.db due to usage of symlinks
(user:
mrwellan
size: 16397)
[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 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 20 23 21 6b 65 79 20 28 74 6f 70 70 61 74 me #!key (toppat
0360: 68 20 23 66 29 29 0a 20 20 28 69 66 20 74 6f 70 h #f)). (if top
0370: 70 61 74 68 0a 20 20 20 20 20 20 28 6c 65 74 20 path. (let
0380: 28 28 63 66 6e 61 6d 65 20 28 63 6f 6e 63 20 74 ((cfname (conc t
0390: 6f 70 70 61 74 68 20 22 2f 22 20 63 6f 6e 66 69 oppath "/" confi
03a0: 67 6e 61 6d 65 29 29 29 0a 09 28 69 66 20 28 66 gname)))..(if (f
03b0: 69 6c 65 2d 65 78 69 73 74 73 3f 20 63 66 6e 61 ile-exists? cfna
03c0: 6d 65 29 0a 09 20 20 20 20 28 6c 69 73 74 20 74 me).. (list t
03d0: 6f 70 70 61 74 68 20 63 66 6e 61 6d 65 20 63 6f oppath cfname co
03e0: 6e 66 69 67 6e 61 6d 65 29 0a 09 20 20 20 20 28 nfigname).. (
03f0: 6c 69 73 74 20 23 66 20 20 20 20 20 20 23 66 20 list #f #f
0400: 20 20 20 20 23 66 29 29 29 0a 20 20 20 20 20 20 #f))).
0410: 28 6c 65 74 2a 20 28 28 63 77 64 20 28 73 74 72 (let* ((cwd (str
0420: 69 6e 67 2d 73 70 6c 69 74 20 28 63 75 72 72 65 ing-split (curre
0430: 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 20 22 2f nt-directory) "/
0440: 22 29 29 29 0a 09 28 6c 65 74 20 6c 6f 6f 70 20 ")))..(let loop
0450: 28 28 64 69 72 20 63 77 64 29 29 0a 09 20 20 28 ((dir cwd)).. (
0460: 6c 65 74 2a 20 28 28 70 61 74 68 20 20 20 20 20 let* ((path
0470: 28 63 6f 6e 63 20 22 2f 22 20 28 73 74 72 69 6e (conc "/" (strin
0480: 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 64 69 g-intersperse di
0490: 72 20 22 2f 22 29 29 29 0a 09 09 20 28 66 75 6c r "/")))... (ful
04a0: 6c 70 61 74 68 20 28 63 6f 6e 63 20 70 61 74 68 lpath (conc path
04b0: 20 22 2f 22 20 63 6f 6e 66 69 67 6e 61 6d 65 29 "/" configname)
04c0: 29 29 0a 09 20 20 20 20 28 69 66 20 28 66 69 6c )).. (if (fil
04d0: 65 2d 65 78 69 73 74 73 3f 20 66 75 6c 6c 70 61 e-exists? fullpa
04e0: 74 68 29 0a 09 09 28 6c 69 73 74 20 70 61 74 68 th)...(list path
04f0: 20 66 75 6c 6c 70 61 74 68 20 63 6f 6e 66 69 67 fullpath config
0500: 6e 61 6d 65 29 0a 09 09 28 6c 65 74 20 28 28 72 name)...(let ((r
0510: 65 6d 63 77 64 20 28 74 61 6b 65 20 64 69 72 20 emcwd (take dir
0520: 28 2d 20 28 6c 65 6e 67 74 68 20 64 69 72 29 20 (- (length dir)
0530: 31 29 29 29 29 0a 09 09 20 20 28 69 66 20 28 6e 1))))... (if (n
0540: 75 6c 6c 3f 20 72 65 6d 63 77 64 29 0a 09 09 20 ull? remcwd)...
0550: 20 20 20 20 20 28 6c 69 73 74 20 23 66 20 23 66 (list #f #f
0560: 20 23 66 29 20 3b 3b 20 20 23 66 20 23 66 29 20 #f) ;; #f #f)
0570: 0a 09 09 20 20 28 6c 6f 6f 70 20 72 65 6d 63 77 ... (loop remcw
0580: 64 29 29 29 29 29 29 29 29 29 0a 0a 28 64 65 66 d)))))))))..(def
0590: 69 6e 65 20 28 63 6f 6e 66 69 67 3a 61 73 73 6f ine (config:asso
05a0: 63 2d 73 61 66 65 2d 61 64 64 20 61 6c 69 73 74 c-safe-add alist
05b0: 20 6b 65 79 20 76 61 6c 29 0a 20 20 28 6c 65 74 key val). (let
05c0: 20 28 28 6e 65 77 61 6c 69 73 74 20 28 66 69 6c ((newalist (fil
05d0: 74 65 72 20 28 6c 61 6d 62 64 61 20 28 78 29 28 ter (lambda (x)(
05e0: 6e 6f 74 20 28 65 71 75 61 6c 3f 20 6b 65 79 20 not (equal? key
05f0: 28 63 61 72 20 78 29 29 29 29 20 61 6c 69 73 74 (car x)))) alist
0600: 29 29 29 0a 20 20 20 20 28 61 70 70 65 6e 64 20 ))). (append
0610: 6e 65 77 61 6c 69 73 74 20 28 6c 69 73 74 20 28 newalist (list (
0620: 6c 69 73 74 20 6b 65 79 20 76 61 6c 29 29 29 29 list key val))))
0630: 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 )..(define (conf
0640: 69 67 3a 65 76 61 6c 2d 73 74 72 69 6e 67 2d 69 ig:eval-string-i
0650: 6e 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 73 74 n-environment st
0660: 72 29 0a 20 20 28 6c 65 74 20 28 28 63 6d 64 72 r). (let ((cmdr
0670: 65 73 20 28 63 6d 64 2d 72 75 6e 2d 3e 6c 69 73 es (cmd-run->lis
0680: 74 20 28 63 6f 6e 63 20 22 65 63 68 6f 20 22 20 t (conc "echo "
0690: 73 74 72 29 29 29 29 0a 20 20 20 20 28 69 66 20 str)))). (if
06a0: 28 6e 75 6c 6c 3f 20 63 6d 64 72 65 73 29 20 22 (null? cmdres) "
06b0: 22 0a 09 28 63 61 61 72 20 63 6d 64 72 65 73 29 "..(caar cmdres)
06c0: 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
06d0: 3d 3d 3d 3d 3d 3d 3d 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 0a 3b 3b =============.;;
0710: 20 4d 61 6b 65 20 74 68 65 20 72 65 67 65 78 70 Make the regexp
0720: 27 73 20 6e 65 65 64 65 64 20 67 6c 6f 62 61 6c 's needed global
0730: 6c 79 20 61 76 61 69 6c 61 62 6c 65 0a 3b 3b 3d ly available.;;=
0740: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 0a 28 64 65 66 69 6e 65 20 63 =====..(define c
0790: 6f 6e 66 69 67 66 3a 69 6e 63 6c 75 64 65 2d 72 onfigf:include-r
07a0: 78 20 28 72 65 67 65 78 70 20 22 5e 5c 5c 5b 69 x (regexp "^\\[i
07b0: 6e 63 6c 75 64 65 5c 5c 73 2b 28 2e 2a 29 5c 5c nclude\\s+(.*)\\
07c0: 5d 5c 5c 73 2a 24 22 29 29 0a 28 64 65 66 69 6e ]\\s*$")).(defin
07d0: 65 20 63 6f 6e 66 69 67 66 3a 73 65 63 74 69 6f e configf:sectio
07e0: 6e 2d 72 78 20 28 72 65 67 65 78 70 20 22 5e 5c n-rx (regexp "^\
07f0: 5c 5b 28 2e 2a 29 5c 5c 5d 5c 5c 73 2a 24 22 29 \[(.*)\\]\\s*$")
0800: 29 0a 28 64 65 66 69 6e 65 20 63 6f 6e 66 69 67 ).(define config
0810: 66 3a 62 6c 61 6e 6b 2d 6c 2d 72 78 20 28 72 65 f:blank-l-rx (re
0820: 67 65 78 70 20 22 5e 5c 5c 73 2a 24 22 29 29 0a gexp "^\\s*$")).
0830: 28 64 65 66 69 6e 65 20 63 6f 6e 66 69 67 66 3a (define configf:
0840: 6b 65 79 2d 73 79 73 2d 70 72 20 28 72 65 67 65 key-sys-pr (rege
0850: 78 70 20 22 5e 28 5c 5c 53 2b 29 5c 5c 73 2b 5c xp "^(\\S+)\\s+\
0860: 5c 5b 73 79 73 74 65 6d 5c 5c 73 2b 28 5c 5c 53 \[system\\s+(\\S
0870: 2b 2e 2a 29 5c 5c 5d 5c 5c 73 2a 24 22 29 29 0a +.*)\\]\\s*$")).
0880: 28 64 65 66 69 6e 65 20 63 6f 6e 66 69 67 66 3a (define configf:
0890: 6b 65 79 2d 76 61 6c 2d 70 72 20 28 72 65 67 65 key-val-pr (rege
08a0: 78 70 20 22 5e 28 5c 5c 53 2b 29 5c 5c 73 2b 28 xp "^(\\S+)\\s+(
08b0: 2e 2a 29 24 22 29 29 0a 28 64 65 66 69 6e 65 20 .*)$")).(define
08c0: 63 6f 6e 66 69 67 66 3a 63 6f 6d 6d 65 6e 74 2d configf:comment-
08d0: 72 78 20 28 72 65 67 65 78 70 20 22 5e 5c 5c 73 rx (regexp "^\\s
08e0: 2a 23 2e 2a 22 29 29 0a 28 64 65 66 69 6e 65 20 *#.*")).(define
08f0: 63 6f 6e 66 69 67 66 3a 63 6f 6e 74 2d 6c 6e 2d configf:cont-ln-
0900: 72 78 20 28 72 65 67 65 78 70 20 22 5e 28 5c 5c rx (regexp "^(\\
0910: 73 2b 29 28 5c 5c 53 2b 2e 2a 29 24 22 29 29 0a s+)(\\S+.*)$")).
0920: 0a 3b 3b 20 72 65 61 64 20 61 20 6c 69 6e 65 20 .;; read a line
0930: 61 6e 64 20 70 72 6f 63 65 73 73 20 61 6e 79 20 and process any
0940: 23 7b 20 2e 2e 2e 20 7d 20 63 6f 6e 73 74 72 75 #{ ... } constru
0950: 63 74 73 0a 0a 28 64 65 66 69 6e 65 20 63 6f 6e cts..(define con
0960: 66 69 67 66 3a 76 61 72 2d 65 78 70 61 6e 64 2d figf:var-expand-
0970: 72 65 67 65 78 20 28 72 65 67 65 78 70 20 22 5e regex (regexp "^
0980: 28 2e 2a 29 23 5c 5c 7b 28 73 63 68 65 6d 65 7c (.*)#\\{(scheme|
0990: 73 79 73 74 65 6d 7c 73 68 65 6c 6c 7c 67 65 74 system|shell|get
09a0: 65 6e 76 7c 67 65 74 7c 72 75 6e 63 6f 6e 66 69 env|get|runconfi
09b0: 67 73 2d 67 65 74 29 5c 5c 73 2b 28 5b 5e 5c 5c gs-get)\\s+([^\\
09c0: 7d 5c 5c 7b 5d 2a 29 5c 5c 7d 28 2e 2a 29 22 29 }\\{]*)\\}(.*)")
09d0: 29 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 ).(define (confi
09e0: 67 66 3a 70 72 6f 63 65 73 73 2d 6c 69 6e 65 20 gf:process-line
09f0: 6c 20 68 74 29 0a 20 20 28 6c 65 74 20 6c 6f 6f l ht). (let loo
0a00: 70 20 28 28 72 65 73 20 6c 29 29 0a 20 20 20 20 p ((res l)).
0a10: 28 69 66 20 28 73 74 72 69 6e 67 3f 20 72 65 73 (if (string? res
0a20: 29 0a 09 28 6c 65 74 20 28 28 6d 61 74 63 68 64 )..(let ((matchd
0a30: 61 74 20 28 73 74 72 69 6e 67 2d 73 65 61 72 63 at (string-searc
0a40: 68 20 63 6f 6e 66 69 67 66 3a 76 61 72 2d 65 78 h configf:var-ex
0a50: 70 61 6e 64 2d 72 65 67 65 78 20 72 65 73 29 29 pand-regex res))
0a60: 29 0a 09 20 20 28 69 66 20 6d 61 74 63 68 64 61 ).. (if matchda
0a70: 74 0a 09 20 20 20 20 20 20 28 6c 65 74 2a 20 28 t.. (let* (
0a80: 28 70 72 65 73 74 72 20 20 28 6c 69 73 74 2d 72 (prestr (list-r
0a90: 65 66 20 6d 61 74 63 68 64 61 74 20 31 29 29 0a ef matchdat 1)).
0aa0: 09 09 20 20 20 20 20 28 63 6d 64 74 79 70 65 20 .. (cmdtype
0ab0: 28 6c 69 73 74 2d 72 65 66 20 6d 61 74 63 68 64 (list-ref matchd
0ac0: 61 74 20 32 29 29 20 3b 3b 20 65 76 61 6c 2c 20 at 2)) ;; eval,
0ad0: 73 79 73 74 65 6d 2c 20 73 68 65 6c 6c 2c 20 67 system, shell, g
0ae0: 65 74 65 6e 76 0a 09 09 20 20 20 20 20 28 63 6d etenv... (cm
0af0: 64 20 20 20 20 20 28 6c 69 73 74 2d 72 65 66 20 d (list-ref
0b00: 6d 61 74 63 68 64 61 74 20 33 29 29 0a 09 09 20 matchdat 3))...
0b10: 20 20 20 20 28 70 6f 73 74 73 74 72 20 28 6c 69 (poststr (li
0b20: 73 74 2d 72 65 66 20 6d 61 74 63 68 64 61 74 20 st-ref matchdat
0b30: 34 29 29 0a 09 09 20 20 20 20 20 28 72 65 73 75 4))... (resu
0b40: 6c 74 20 20 23 66 29 0a 09 09 20 20 20 20 20 28 lt #f)... (
0b50: 66 75 6c 6c 63 6d 64 20 28 63 61 73 65 20 28 73 fullcmd (case (s
0b60: 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 63 6d tring->symbol cm
0b70: 64 74 79 70 65 29 0a 09 09 09 09 28 28 73 63 68 dtype).....((sch
0b80: 65 6d 65 29 28 63 6f 6e 63 20 22 28 6c 61 6d 62 eme)(conc "(lamb
0b90: 64 61 20 28 68 74 29 22 20 63 6d 64 20 22 29 22 da (ht)" cmd ")"
0ba0: 29 29 0a 09 09 09 09 28 28 73 79 73 74 65 6d 29 )).....((system)
0bb0: 28 63 6f 6e 63 20 22 28 6c 61 6d 62 64 61 20 28 (conc "(lambda (
0bc0: 68 74 29 28 73 79 73 74 65 6d 20 5c 22 22 20 63 ht)(system \"" c
0bd0: 6d 64 20 22 5c 22 29 29 22 29 29 0a 09 09 09 09 md "\"))")).....
0be0: 28 28 73 68 65 6c 6c 29 20 28 63 6f 6e 63 20 22 ((shell) (conc "
0bf0: 28 6c 61 6d 62 64 61 20 28 68 74 29 28 73 68 65 (lambda (ht)(she
0c00: 6c 6c 20 5c 22 22 20 20 63 6d 64 20 22 5c 22 29 ll \"" cmd "\")
0c10: 29 22 29 29 0a 09 09 09 09 28 28 67 65 74 65 6e )")).....((geten
0c20: 76 29 28 63 6f 6e 63 20 22 28 6c 61 6d 62 64 61 v)(conc "(lambda
0c30: 20 28 68 74 29 28 67 65 74 2d 65 6e 76 69 72 6f (ht)(get-enviro
0c40: 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 5c nment-variable \
0c50: 22 22 20 63 6d 64 20 22 5c 22 29 29 22 29 29 0a "" cmd "\"))")).
0c60: 09 09 09 09 28 28 67 65 74 29 20 20 20 0a 09 09 ....((get) ...
0c70: 09 09 20 28 6c 65 74 2a 20 28 28 70 61 72 74 73 .. (let* ((parts
0c80: 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 63 (string-split c
0c90: 6d 64 29 29 0a 09 09 09 09 09 28 73 65 63 74 20 md))......(sect
0ca0: 20 28 63 61 72 20 70 61 72 74 73 29 29 0a 09 09 (car parts))...
0cb0: 09 09 09 28 76 61 72 20 20 20 28 63 61 64 72 20 ...(var (cadr
0cc0: 70 61 72 74 73 29 29 29 0a 09 09 09 09 20 20 20 parts))).....
0cd0: 28 63 6f 6e 63 20 22 28 6c 61 6d 62 64 61 20 28 (conc "(lambda (
0ce0: 68 74 29 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 ht)(config-looku
0cf0: 70 20 68 74 20 5c 22 22 20 73 65 63 74 20 22 5c p ht \"" sect "\
0d00: 22 20 5c 22 22 20 76 61 72 20 22 5c 22 29 29 22 " \"" var "\"))"
0d10: 29 29 29 0a 09 09 09 09 28 28 72 75 6e 63 6f 6e ))).....((runcon
0d20: 66 69 67 73 2d 67 65 74 29 20 28 63 6f 6e 63 20 figs-get) (conc
0d30: 22 28 6c 61 6d 62 64 61 20 28 68 74 29 28 72 75 "(lambda (ht)(ru
0d40: 6e 63 6f 6e 66 69 67 73 2d 67 65 74 20 68 74 20 nconfigs-get ht
0d50: 5c 22 22 20 63 6d 64 20 22 5c 22 29 29 22 29 29 \"" cmd "\"))"))
0d60: 0a 09 09 09 09 28 65 6c 73 65 20 22 28 6c 61 6d .....(else "(lam
0d70: 62 64 61 20 28 68 74 29 28 70 72 69 6e 74 20 5c bda (ht)(print \
0d80: 22 45 52 52 4f 52 5c 22 29 20 5c 22 45 52 52 4f "ERROR\") \"ERRO
0d90: 52 5c 22 29 22 29 29 29 29 0a 09 09 3b 3b 20 28 R\")"))))...;; (
0da0: 70 72 69 6e 74 20 22 66 75 6c 6c 63 6d 64 3d 22 print "fullcmd="
0db0: 20 66 75 6c 6c 63 6d 64 29 0a 09 09 28 77 69 74 fullcmd)...(wit
0dc0: 68 2d 69 6e 70 75 74 2d 66 72 6f 6d 2d 73 74 72 h-input-from-str
0dd0: 69 6e 67 20 66 75 6c 6c 63 6d 64 0a 09 09 20 20 ing fullcmd...
0de0: 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 20 20 20 (lambda ()...
0df0: 20 28 73 65 74 21 20 72 65 73 75 6c 74 20 28 28 (set! result ((
0e00: 65 76 61 6c 20 28 72 65 61 64 29 29 20 68 74 29 eval (read)) ht)
0e10: 29 29 29 0a 09 09 28 6c 6f 6f 70 20 28 63 6f 6e )))...(loop (con
0e20: 63 20 70 72 65 73 74 72 20 72 65 73 75 6c 74 20 c prestr result
0e30: 70 6f 73 74 73 74 72 29 29 29 0a 09 20 20 20 20 poststr)))..
0e40: 20 20 72 65 73 29 29 0a 09 72 65 73 29 29 29 0a res))..res))).
0e50: 0a 3b 3b 20 52 75 6e 20 61 20 73 68 65 6c 6c 20 .;; Run a shell
0e60: 63 6f 6d 6d 61 6e 64 20 61 6e 64 20 72 65 74 75 command and retu
0e70: 72 6e 20 74 68 65 20 6f 75 74 70 75 74 20 61 73 rn the output as
0e80: 20 61 20 73 74 72 69 6e 67 0a 28 64 65 66 69 6e a string.(defin
0e90: 65 20 28 73 68 65 6c 6c 20 63 6d 64 29 0a 20 20 e (shell cmd).
0ea0: 28 6c 65 74 2a 20 28 28 6f 75 74 70 75 74 20 28 (let* ((output (
0eb0: 63 6d 64 2d 72 75 6e 2d 3e 6c 69 73 74 20 63 6d cmd-run->list cm
0ec0: 64 29 29 0a 09 20 28 72 65 73 20 20 20 20 28 63 d)).. (res (c
0ed0: 61 72 20 6f 75 74 70 75 74 29 29 0a 09 20 28 73 ar output)).. (s
0ee0: 74 61 74 75 73 20 28 63 61 64 72 20 6f 75 74 70 tatus (cadr outp
0ef0: 75 74 29 29 29 0a 20 20 20 20 28 69 66 20 28 65 ut))). (if (e
0f00: 71 75 61 6c 3f 20 73 74 61 74 75 73 20 30 29 0a qual? status 0).
0f10: 09 28 6c 65 74 20 28 28 6f 75 74 72 65 73 20 28 .(let ((outres (
0f20: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
0f30: 73 65 20 0a 09 09 20 20 20 20 20 20 20 72 65 73 se ... res
0f40: 0a 09 09 20 20 20 20 20 20 20 22 5c 6e 22 29 29 ... "\n"))
0f50: 29 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e ).. (debug:prin
0f60: 74 20 34 20 22 49 4e 46 4f 3a 20 73 68 65 6c 6c t 4 "INFO: shell
0f70: 20 72 65 73 75 6c 74 3a 5c 6e 22 20 6f 75 74 72 result:\n" outr
0f80: 65 73 29 0a 09 20 20 6f 75 74 72 65 73 29 0a 09 es).. outres)..
0f90: 28 62 65 67 69 6e 0a 09 20 20 28 77 69 74 68 2d (begin.. (with-
0fa0: 6f 75 74 70 75 74 2d 74 6f 2d 70 6f 72 74 20 28 output-to-port (
0fb0: 63 75 72 72 65 6e 74 2d 65 72 72 6f 72 2d 70 6f current-error-po
0fc0: 72 74 29 0a 09 20 20 20 20 28 70 72 69 6e 74 20 rt).. (print
0fd0: 22 45 52 52 4f 52 3a 20 22 20 63 6d 64 20 22 20 "ERROR: " cmd "
0fe0: 72 65 74 75 72 6e 65 64 20 62 61 64 20 65 78 69 returned bad exi
0ff0: 74 20 63 6f 64 65 20 22 20 73 74 61 74 75 73 29 t code " status)
1000: 29 0a 09 20 20 22 22 29 29 29 29 0a 0a 3b 3b 20 ).. ""))))..;;
1010: 4c 6f 6f 6b 75 70 20 61 20 76 61 6c 75 65 20 69 Lookup a value i
1020: 6e 20 72 75 6e 63 6f 6e 66 69 67 73 20 62 61 73 n runconfigs bas
1030: 65 64 20 6f 6e 20 2d 72 65 71 74 61 72 67 20 6f ed on -reqtarg o
1040: 72 20 2d 74 61 72 67 65 74 0a 28 64 65 66 69 6e r -target.(defin
1050: 65 20 28 72 75 6e 63 6f 6e 66 69 67 73 2d 67 65 e (runconfigs-ge
1060: 74 20 63 6f 6e 66 69 67 20 76 61 72 29 0a 20 20 t config var).
1070: 28 6c 65 74 20 28 28 74 61 72 67 20 28 6f 72 20 (let ((targ (or
1080: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
1090: 72 65 71 74 61 72 67 22 29 28 61 72 67 73 3a 67 reqtarg")(args:g
10a0: 65 74 2d 61 72 67 20 22 2d 74 61 72 67 65 74 22 et-arg "-target"
10b0: 29 29 29 29 0a 20 20 20 20 28 69 66 20 74 61 72 )))). (if tar
10c0: 67 0a 09 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 g..(config-looku
10d0: 70 20 63 6f 6e 66 69 67 20 74 61 72 67 20 76 61 p config targ va
10e0: 72 29 0a 09 23 66 29 29 29 0a 0a 28 64 65 66 69 r)..#f)))..(defi
10f0: 6e 65 2d 69 6e 6c 69 6e 65 20 28 63 6f 6e 66 69 ne-inline (confi
1100: 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 70 20 68 gf:read-line p h
1110: 74 29 0a 20 20 28 63 6f 6e 66 69 67 66 3a 70 72 t). (configf:pr
1120: 6f 63 65 73 73 2d 6c 69 6e 65 20 28 72 65 61 64 ocess-line (read
1130: 2d 6c 69 6e 65 20 70 29 20 68 74 29 29 0a 0a 3b -line p) ht))..;
1140: 3b 20 72 65 61 64 20 61 20 63 6f 6e 66 69 67 20 ; read a config
1150: 66 69 6c 65 2c 20 72 65 74 75 72 6e 73 20 68 61 file, returns ha
1160: 73 68 20 74 61 62 6c 65 20 6f 66 20 61 6c 69 73 sh table of alis
1170: 74 73 0a 0a 3b 3b 20 72 65 61 64 20 61 20 63 6f ts..;; read a co
1180: 6e 66 69 67 20 66 69 6c 65 2c 20 72 65 74 75 72 nfig file, retur
1190: 6e 73 20 68 61 73 68 20 74 61 62 6c 65 20 6f 66 ns hash table of
11a0: 20 61 6c 69 73 74 73 0a 3b 3b 20 61 64 64 73 20 alists.;; adds
11b0: 74 6f 20 68 74 20 69 66 20 67 69 76 65 6e 20 28 to ht if given (
11c0: 6d 75 73 74 20 62 65 20 23 66 20 6f 74 68 65 72 must be #f other
11d0: 77 69 73 65 29 0a 3b 3b 20 65 6e 76 69 6f 6e 2d wise).;; envion-
11e0: 70 61 74 74 20 69 73 20 61 20 72 65 67 65 78 20 patt is a regex
11f0: 73 70 65 63 20 74 68 61 74 20 69 64 65 6e 74 69 spec that identi
1200: 66 69 65 73 20 73 65 63 74 69 6f 6e 73 20 74 68 fies sections th
1210: 61 74 20 77 69 6c 6c 20 62 65 20 65 76 61 6c 27 at will be eval'
1220: 64 0a 3b 3b 20 69 6e 20 74 68 65 20 65 6e 76 69 d.;; in the envi
1230: 72 6f 6e 6d 65 6e 74 20 6f 6e 20 74 68 65 20 66 ronment on the f
1240: 6c 79 0a 3b 3b 20 73 65 63 74 69 6f 6e 73 3a 20 ly.;; sections:
1250: 23 66 20 3d 3e 20 67 65 74 20 61 6c 6c 2c 20 65 #f => get all, e
1260: 6c 73 65 20 6c 69 73 74 20 6f 66 20 73 65 63 74 lse list of sect
1270: 69 6f 6e 73 20 74 6f 20 67 61 74 68 65 72 0a 28 ions to gather.(
1280: 64 65 66 69 6e 65 20 28 72 65 61 64 2d 63 6f 6e define (read-con
1290: 66 69 67 20 70 61 74 68 20 68 74 20 61 6c 6c 6f fig path ht allo
12a0: 77 2d 73 79 73 74 65 6d 20 23 21 6b 65 79 20 28 w-system #!key (
12b0: 65 6e 76 69 72 6f 6e 2d 70 61 74 74 20 23 66 29 environ-patt #f)
12c0: 28 63 75 72 72 2d 73 65 63 74 69 6f 6e 20 23 66 (curr-section #f
12d0: 29 28 73 65 63 74 69 6f 6e 73 20 23 66 29 29 0a )(sections #f)).
12e0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 (debug:print 4
12f0: 20 22 49 4e 46 4f 3a 20 72 65 61 64 2d 63 6f 6e "INFO: read-con
1300: 66 69 67 20 22 20 70 61 74 68 20 22 20 61 6c 6c fig " path " all
1310: 6f 77 2d 73 79 73 74 65 6d 20 22 20 61 6c 6c 6f ow-system " allo
1320: 77 2d 73 79 73 74 65 6d 20 22 20 65 6e 76 69 72 w-system " envir
1330: 6f 6e 2d 70 61 74 74 20 22 20 65 6e 76 69 72 6f on-patt " enviro
1340: 6e 2d 70 61 74 74 20 22 20 63 75 72 72 2d 73 65 n-patt " curr-se
1350: 63 74 69 6f 6e 3a 20 22 20 63 75 72 72 2d 73 65 ction: " curr-se
1360: 63 74 69 6f 6e 20 22 20 73 65 63 74 69 6f 6e 73 ction " sections
1370: 3a 20 22 20 73 65 63 74 69 6f 6e 73 29 0a 20 20 : " sections).
1380: 28 69 66 20 28 6e 6f 74 20 28 66 69 6c 65 2d 65 (if (not (file-e
1390: 78 69 73 74 73 3f 20 70 61 74 68 29 29 0a 20 20 xists? path)).
13a0: 20 20 20 20 28 62 65 67 69 6e 20 0a 09 28 64 65 (begin ..(de
13b0: 62 75 67 3a 70 72 69 6e 74 20 34 20 22 49 4e 46 bug:print 4 "INF
13c0: 4f 3a 20 72 65 61 64 2d 63 6f 6e 66 69 67 20 2d O: read-config -
13d0: 20 66 69 6c 65 20 6e 6f 74 20 66 6f 75 6e 64 20 file not found
13e0: 22 20 70 61 74 68 20 22 20 63 75 72 72 65 6e 74 " path " current
13f0: 20 70 61 74 68 3a 20 22 20 28 63 75 72 72 65 6e path: " (curren
1400: 74 2d 64 69 72 65 63 74 6f 72 79 29 29 0a 09 28 t-directory))..(
1410: 69 66 20 28 6e 6f 74 20 68 74 29 28 6d 61 6b 65 if (not ht)(make
1420: 2d 68 61 73 68 2d 74 61 62 6c 65 29 20 68 74 29 -hash-table) ht)
1430: 29 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 69 ). (let ((i
1440: 6e 70 20 20 20 20 20 20 20 20 28 6f 70 65 6e 2d np (open-
1450: 69 6e 70 75 74 2d 66 69 6c 65 20 70 61 74 68 29 input-file path)
1460: 29 0a 09 20 20 20 20 28 72 65 73 20 20 20 20 20 ).. (res
1470: 20 20 20 28 69 66 20 28 6e 6f 74 20 68 74 29 28 (if (not ht)(
1480: 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 make-hash-table)
1490: 20 68 74 29 29 29 0a 09 28 6c 65 74 20 6c 6f 6f ht)))..(let loo
14a0: 70 20 28 28 69 6e 6c 20 20 20 20 20 20 20 20 20 p ((inl
14b0: 20 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 72 (configf:r
14c0: 65 61 64 2d 6c 69 6e 65 20 69 6e 70 20 72 65 73 ead-line inp res
14d0: 29 29 20 3b 3b 20 28 72 65 61 64 2d 6c 69 6e 65 )) ;; (read-line
14e0: 20 69 6e 70 29 29 0a 09 09 20 20 20 28 63 75 72 inp))... (cur
14f0: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 28 r-section-name (
1500: 69 66 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 20 if curr-section
1510: 63 75 72 72 2d 73 65 63 74 69 6f 6e 20 22 64 65 curr-section "de
1520: 66 61 75 6c 74 22 29 29 0a 09 09 20 20 20 28 76 fault"))... (v
1530: 61 72 2d 66 6c 61 67 20 23 66 29 3b 3b 20 74 75 ar-flag #f);; tu
1540: 72 6e 20 6f 6e 20 66 6f 72 20 6b 65 79 2d 76 61 rn on for key-va
1550: 72 2d 70 72 20 61 6e 64 20 63 6f 6e 74 2d 6c 6e r-pr and cont-ln
1560: 2d 72 78 2c 20 74 75 72 6e 20 6f 66 66 20 65 6c -rx, turn off el
1570: 73 65 77 68 65 72 65 0a 09 09 20 20 20 28 6c 65 sewhere... (le
1580: 61 64 20 20 20 20 20 23 66 29 29 0a 09 20 20 28 ad #f)).. (
1590: 64 65 62 75 67 3a 70 72 69 6e 74 20 38 20 22 49 debug:print 8 "I
15a0: 4e 46 4f 3a 20 63 75 72 72 2d 73 65 63 74 69 6f NFO: curr-sectio
15b0: 6e 2d 6e 61 6d 65 3a 20 22 20 63 75 72 72 2d 73 n-name: " curr-s
15c0: 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 22 20 76 61 ection-name " va
15d0: 72 2d 66 6c 61 67 3a 20 22 20 76 61 72 2d 66 6c r-flag: " var-fl
15e0: 61 67 20 22 5c 6e 20 20 20 69 6e 6c 3a 20 5c 22 ag "\n inl: \"
15f0: 22 20 69 6e 6c 20 22 5c 22 22 29 0a 09 20 20 28 " inl "\"").. (
1600: 69 66 20 28 65 6f 66 2d 6f 62 6a 65 63 74 3f 20 if (eof-object?
1610: 69 6e 6c 29 20 0a 09 20 20 20 20 20 20 28 62 65 inl) .. (be
1620: 67 69 6e 0a 09 09 28 63 6c 6f 73 65 2d 69 6e 70 gin...(close-inp
1630: 75 74 2d 70 6f 72 74 20 69 6e 70 29 0a 09 09 28 ut-port inp)...(
1640: 68 61 73 68 2d 74 61 62 6c 65 2d 64 65 6c 65 74 hash-table-delet
1650: 65 21 20 72 65 73 20 22 22 29 20 3b 3b 20 77 65 e! res "") ;; we
1660: 20 61 72 65 20 75 73 69 6e 67 20 22 22 20 61 73 are using "" as
1670: 20 61 20 64 75 6d 70 69 6e 67 20 67 72 6f 75 6e a dumping groun
1680: 64 20 61 6e 64 20 6d 75 73 74 20 72 65 6d 6f 76 d and must remov
1690: 65 20 69 74 20 62 65 66 6f 72 65 20 72 65 74 75 e it before retu
16a0: 72 6e 69 6e 67 20 74 68 65 20 68 74 0a 09 09 72 rning the ht...r
16b0: 65 73 29 0a 09 20 20 20 20 20 20 28 72 65 67 65 es).. (rege
16c0: 78 2d 63 61 73 65 20 0a 09 20 20 20 20 20 20 20 x-case ..
16d0: 69 6e 6c 20 0a 09 20 20 20 20 20 20 20 28 63 6f inl .. (co
16e0: 6e 66 69 67 66 3a 63 6f 6d 6d 65 6e 74 2d 72 78 nfigf:comment-rx
16f0: 20 5f 20 20 20 20 20 20 20 20 20 20 20 20 20 20 _
1700: 20 20 20 20 28 6c 6f 6f 70 20 28 63 6f 6e 66 69 (loop (confi
1710: 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 gf:read-line inp
1720: 20 72 65 73 29 20 63 75 72 72 2d 73 65 63 74 69 res) curr-secti
1730: 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 66 29 29 0a on-name #f #f)).
1740: 09 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 66 . (configf
1750: 3a 62 6c 61 6e 6b 2d 6c 2d 72 78 20 5f 20 20 20 :blank-l-rx _
1760: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
1770: 6c 6f 6f 70 20 28 63 6f 6e 66 69 67 66 3a 72 65 loop (configf:re
1780: 61 64 2d 6c 69 6e 65 20 69 6e 70 20 72 65 73 29 ad-line inp res)
1790: 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 curr-section-na
17a0: 6d 65 20 23 66 20 23 66 29 29 0a 09 20 20 20 20 me #f #f))..
17b0: 20 20 20 28 63 6f 6e 66 69 67 66 3a 69 6e 63 6c (configf:incl
17c0: 75 64 65 2d 72 78 20 28 20 78 20 69 6e 63 6c 75 ude-rx ( x inclu
17d0: 64 65 2d 66 69 6c 65 20 29 20 28 6c 65 74 20 28 de-file ) (let (
17e0: 28 63 75 72 72 2d 64 69 72 20 28 63 75 72 72 65 (curr-dir (curre
17f0: 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 29 0a 09 nt-directory))..
1800: 09 09 09 09 09 09 20 20 20 20 28 63 6f 6e 66 2d ...... (conf-
1810: 64 69 72 20 20 28 70 61 74 68 6e 61 6d 65 2d 64 dir (pathname-d
1820: 69 72 65 63 74 6f 72 79 20 70 61 74 68 29 29 29 irectory path)))
1830: 0a 09 09 09 09 09 09 09 28 69 66 20 63 6f 6e 66 ........(if conf
1840: 2d 64 69 72 20 28 63 68 61 6e 67 65 2d 64 69 72 -dir (change-dir
1850: 65 63 74 6f 72 79 20 63 6f 6e 66 2d 64 69 72 29 ectory conf-dir)
1860: 29 0a 09 09 09 09 09 09 09 28 72 65 61 64 2d 63 )........(read-c
1870: 6f 6e 66 69 67 20 69 6e 63 6c 75 64 65 2d 66 69 onfig include-fi
1880: 6c 65 20 72 65 73 20 61 6c 6c 6f 77 2d 73 79 73 le res allow-sys
1890: 74 65 6d 20 65 6e 76 69 72 6f 6e 2d 70 61 74 74 tem environ-patt
18a0: 3a 20 65 6e 76 69 72 6f 6e 2d 70 61 74 74 20 63 : environ-patt c
18b0: 75 72 72 2d 73 65 63 74 69 6f 6e 3a 20 63 75 72 urr-section: cur
18c0: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 73 r-section-name s
18d0: 65 63 74 69 6f 6e 73 3a 20 73 65 63 74 69 6f 6e ections: section
18e0: 73 29 0a 09 09 09 09 09 09 09 28 63 68 61 6e 67 s)........(chang
18f0: 65 2d 64 69 72 65 63 74 6f 72 79 20 63 75 72 72 e-directory curr
1900: 2d 64 69 72 29 0a 09 09 09 09 09 09 09 28 6c 6f -dir)........(lo
1910: 6f 70 20 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 op (configf:read
1920: 2d 6c 69 6e 65 20 69 6e 70 20 72 65 73 29 20 63 -line inp res) c
1930: 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 urr-section-name
1940: 20 23 66 20 23 66 29 29 29 0a 09 20 20 20 20 20 #f #f)))..
1950: 20 20 28 63 6f 6e 66 69 67 66 3a 73 65 63 74 69 (configf:secti
1960: 6f 6e 2d 72 78 20 28 20 78 20 73 65 63 74 69 6f on-rx ( x sectio
1970: 6e 2d 6e 61 6d 65 20 29 20 28 6c 6f 6f 70 20 28 n-name ) (loop (
1980: 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d 6c 69 6e configf:read-lin
1990: 65 20 69 6e 70 20 72 65 73 29 0a 09 09 09 09 09 e inp res)......
19a0: 09 09 20 20 20 20 3b 3b 20 69 66 20 77 65 20 68 .. ;; if we h
19b0: 61 76 65 20 74 68 65 20 73 65 63 74 69 6f 6e 73 ave the sections
19c0: 20 6c 69 73 74 20 74 68 65 6e 20 66 6f 72 63 65 list then force
19d0: 20 61 6c 6c 20 73 65 74 74 69 6e 67 73 20 69 6e all settings in
19e0: 74 6f 20 22 22 20 61 6e 64 20 64 65 6c 65 74 65 to "" and delete
19f0: 20 69 74 20 6c 61 74 65 72 3f 0a 09 09 09 09 09 it later?......
1a00: 09 09 20 20 20 20 28 69 66 20 28 6f 72 20 28 6e .. (if (or (n
1a10: 6f 74 20 73 65 63 74 69 6f 6e 73 29 20 0a 09 09 ot sections) ...
1a20: 09 09 09 09 09 09 20 20 20 20 28 6d 65 6d 62 65 ...... (membe
1a30: 72 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 73 r section-name s
1a40: 65 63 74 69 6f 6e 73 29 29 0a 09 09 09 09 09 09 ections)).......
1a50: 09 09 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 22 ..section-name "
1a60: 22 29 20 3b 3b 20 73 74 69 63 6b 20 65 76 65 72 ") ;; stick ever
1a70: 79 74 68 69 6e 67 20 69 6e 74 6f 20 22 22 0a 09 ything into ""..
1a80: 09 09 09 09 09 09 20 20 20 20 23 66 20 23 66 29 ...... #f #f)
1a90: 29 0a 09 20 20 20 20 20 20 20 28 63 6f 6e 66 69 ).. (confi
1aa0: 67 66 3a 6b 65 79 2d 73 79 73 2d 70 72 20 28 20 gf:key-sys-pr (
1ab0: 78 20 6b 65 79 20 63 6d 64 20 20 20 20 20 20 29 x key cmd )
1ac0: 20 28 69 66 20 61 6c 6c 6f 77 2d 73 79 73 74 65 (if allow-syste
1ad0: 6d 0a 09 09 09 09 09 09 09 20 20 28 6c 65 74 20 m........ (let
1ae0: 28 28 61 6c 69 73 74 20 28 68 61 73 68 2d 74 61 ((alist (hash-ta
1af0: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default
1b00: 72 65 73 20 63 75 72 72 2d 73 65 63 74 69 6f 6e res curr-section
1b10: 2d 6e 61 6d 65 20 27 28 29 29 29 0a 09 09 09 09 -name '())).....
1b20: 09 09 09 09 28 76 61 6c 2d 70 72 6f 63 20 28 6c ....(val-proc (l
1b30: 61 6d 62 64 61 20 28 29 0a 09 09 09 09 09 09 09 ambda ()........
1b40: 09 09 20 20 20 20 28 6c 65 74 2a 20 28 28 63 6d .. (let* ((cm
1b50: 64 72 65 73 20 20 28 63 6d 64 2d 72 75 6e 2d 3e dres (cmd-run->
1b60: 6c 69 73 74 20 63 6d 64 29 29 0a 09 09 09 09 09 list cmd))......
1b70: 09 09 09 09 09 20 20 20 28 73 74 61 74 75 73 20 ..... (status
1b80: 20 28 63 61 64 72 20 63 6d 64 72 65 73 29 29 0a (cadr cmdres)).
1b90: 09 09 09 09 09 09 09 09 09 09 20 20 20 28 72 65 .......... (re
1ba0: 73 20 20 20 20 20 28 63 61 72 20 20 63 6d 64 72 s (car cmdr
1bb0: 65 73 29 29 29 0a 09 09 09 09 09 09 09 09 09 20 es)))..........
1bc0: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
1bd0: 74 20 34 20 22 49 4e 46 4f 3a 20 22 20 69 6e 6c t 4 "INFO: " inl
1be0: 20 22 5c 6e 20 3d 3e 20 22 20 28 73 74 72 69 6e "\n => " (strin
1bf0: 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 72 65 g-intersperse re
1c00: 73 20 22 5c 6e 22 29 29 0a 09 09 09 09 09 09 09 s "\n"))........
1c10: 09 09 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 .. (if (not
1c20: 20 28 65 71 3f 20 73 74 61 74 75 73 20 30 29 29 (eq? status 0))
1c30: 0a 09 09 09 09 09 09 09 09 09 09 20 20 28 62 65 ........... (be
1c40: 67 69 6e 0a 09 09 09 09 09 09 09 09 09 09 20 20 gin...........
1c50: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
1c60: 20 22 45 52 52 4f 52 3a 20 70 72 6f 62 6c 65 6d "ERROR: problem
1c70: 20 77 69 74 68 20 22 20 69 6e 6c 20 22 2c 20 72 with " inl ", r
1c80: 65 74 75 72 6e 20 63 6f 64 65 20 22 20 73 74 61 eturn code " sta
1c90: 74 75 73 0a 09 09 09 09 09 09 09 09 09 09 09 09 tus.............
1ca0: 20 22 20 6f 75 74 70 75 74 3a 20 22 20 63 6d 64 " output: " cmd
1cb0: 72 65 73 29 0a 09 09 09 09 09 09 09 09 09 09 20 res)...........
1cc0: 20 20 20 28 65 78 69 74 20 31 29 29 29 0a 09 09 (exit 1)))...
1cd0: 09 09 09 09 09 09 09 20 20 20 20 20 20 28 69 66 ....... (if
1ce0: 20 28 6e 75 6c 6c 3f 20 72 65 73 29 0a 09 09 09 (null? res)....
1cf0: 09 09 09 09 09 09 09 20 20 22 22 0a 09 09 09 09 ....... "".....
1d00: 09 09 09 09 09 09 20 20 28 73 74 72 69 6e 67 2d ...... (string-
1d10: 69 6e 74 65 72 73 70 65 72 73 65 20 72 65 73 20 intersperse res
1d20: 22 20 22 29 29 29 29 29 29 0a 09 09 09 09 09 09 " ")))))).......
1d30: 09 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 . (hash-table
1d40: 2d 73 65 74 21 20 72 65 73 20 63 75 72 72 2d 73 -set! res curr-s
1d50: 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 0a 09 09 09 ection-name ....
1d60: 09 09 09 09 09 09 20 20 20 20 20 28 63 6f 6e 66 ...... (conf
1d70: 69 67 3a 61 73 73 6f 63 2d 73 61 66 65 2d 61 64 ig:assoc-safe-ad
1d80: 64 20 61 6c 69 73 74 0a 09 09 09 09 09 09 09 09 d alist.........
1d90: 09 09 09 09 20 20 20 20 6b 65 79 20 0a 09 09 09 .... key ....
1da0: 09 09 09 09 09 09 09 09 09 20 20 20 20 28 63 61 ......... (ca
1db0: 73 65 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 0a se allow-system.
1dc0: 09 09 09 09 09 09 09 09 09 09 09 09 20 20 20 20 ............
1dd0: 20 20 28 28 72 65 74 75 72 6e 2d 70 72 6f 63 73 ((return-procs
1de0: 29 20 76 61 6c 2d 70 72 6f 63 29 0a 09 09 09 09 ) val-proc).....
1df0: 09 09 09 09 09 09 09 09 20 20 20 20 20 20 28 28 ........ ((
1e00: 72 65 74 75 72 6e 2d 73 74 72 69 6e 67 29 20 63 return-string) c
1e10: 6d 64 29 0a 09 09 09 09 09 09 09 09 09 09 09 09 md).............
1e20: 20 20 20 20 20 20 28 65 6c 73 65 20 28 76 61 6c (else (val
1e30: 2d 70 72 6f 63 29 29 29 29 29 0a 09 09 09 09 09 -proc)))))......
1e40: 09 09 20 20 20 20 28 6c 6f 6f 70 20 28 63 6f 6e .. (loop (con
1e50: 66 69 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 figf:read-line i
1e60: 6e 70 20 72 65 73 29 20 63 75 72 72 2d 73 65 63 np res) curr-sec
1e70: 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 66 29 tion-name #f #f)
1e80: 29 0a 09 09 09 09 09 09 09 20 20 28 6c 6f 6f 70 )........ (loop
1e90: 20 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d 6c (configf:read-l
1ea0: 69 6e 65 20 69 6e 70 20 72 65 73 29 20 63 75 72 ine inp res) cur
1eb0: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 r-section-name #
1ec0: 66 20 23 66 29 29 29 0a 09 20 20 20 20 20 20 20 f #f)))..
1ed0: 28 63 6f 6e 66 69 67 66 3a 6b 65 79 2d 76 61 6c (configf:key-val
1ee0: 2d 70 72 20 28 20 78 20 6b 65 79 20 76 61 6c 20 -pr ( x key val
1ef0: 20 20 20 20 20 29 20 28 6c 65 74 2a 20 28 28 61 ) (let* ((a
1f00: 6c 69 73 74 20 20 20 28 68 61 73 68 2d 74 61 62 list (hash-tab
1f10: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 72 le-ref/default r
1f20: 65 73 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d es curr-section-
1f30: 6e 61 6d 65 20 27 28 29 29 29 0a 09 09 09 09 09 name '()))......
1f40: 09 09 20 20 20 20 20 28 65 6e 76 61 72 20 20 20 .. (envar
1f50: 28 61 6e 64 20 65 6e 76 69 72 6f 6e 2d 70 61 74 (and environ-pat
1f60: 74 20 28 73 74 72 69 6e 67 2d 73 65 61 72 63 68 t (string-search
1f70: 20 28 72 65 67 65 78 70 20 65 6e 76 69 72 6f 6e (regexp environ
1f80: 2d 70 61 74 74 29 20 63 75 72 72 2d 73 65 63 74 -patt) curr-sect
1f90: 69 6f 6e 2d 6e 61 6d 65 29 29 29 0a 09 09 09 09 ion-name))).....
1fa0: 09 09 09 20 20 20 20 20 28 72 65 61 6c 76 61 6c ... (realval
1fb0: 20 28 69 66 20 65 6e 76 61 72 0a 09 09 09 09 09 (if envar......
1fc0: 09 09 09 09 20 20 28 63 6f 6e 66 69 67 3a 65 76 .... (config:ev
1fd0: 61 6c 2d 73 74 72 69 6e 67 2d 69 6e 2d 65 6e 76 al-string-in-env
1fe0: 69 72 6f 6e 6d 65 6e 74 20 76 61 6c 29 0a 09 09 ironment val)...
1ff0: 09 09 09 09 09 09 09 20 20 76 61 6c 29 29 29 0a ....... val))).
2000: 09 09 09 09 09 09 09 28 64 65 62 75 67 3a 70 72 .......(debug:pr
2010: 69 6e 74 20 36 20 22 49 4e 46 4f 3a 20 72 65 61 int 6 "INFO: rea
2020: 64 2d 63 6f 6e 66 69 67 20 65 6e 76 20 73 65 74 d-config env set
2030: 74 69 6e 67 2c 20 65 6e 76 61 72 3a 20 22 20 65 ting, envar: " e
2040: 6e 76 61 72 20 22 20 72 65 61 6c 76 61 6c 3a 20 nvar " realval:
2050: 22 20 72 65 61 6c 76 61 6c 20 22 20 76 61 6c 3a " realval " val:
2060: 20 22 20 76 61 6c 20 22 20 6b 65 79 3a 20 22 20 " val " key: "
2070: 6b 65 79 20 22 20 63 75 72 72 2d 73 65 63 74 69 key " curr-secti
2080: 6f 6e 2d 6e 61 6d 65 3a 20 22 20 63 75 72 72 2d on-name: " curr-
2090: 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 29 0a 09 09 section-name)...
20a0: 09 09 09 09 09 28 69 66 20 65 6e 76 61 72 0a 09 .....(if envar..
20b0: 09 09 09 09 09 09 20 20 20 20 28 62 65 67 69 6e ...... (begin
20c0: 0a 09 09 09 09 09 09 09 20 20 20 20 20 20 3b 3b ........ ;;
20d0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 (debug:print 4
20e0: 22 49 4e 46 4f 3a 20 72 65 61 64 2d 63 6f 6e 66 "INFO: read-conf
20f0: 69 67 20 6b 65 79 3d 22 20 6b 65 79 20 22 2c 20 ig key=" key ",
2100: 76 61 6c 3d 22 20 76 61 6c 20 22 2c 20 72 65 61 val=" val ", rea
2110: 6c 76 61 6c 3d 22 20 72 65 61 6c 76 61 6c 29 0a lval=" realval).
2120: 09 09 09 09 09 09 09 20 20 20 20 20 20 28 73 65 ....... (se
2130: 74 65 6e 76 20 6b 65 79 20 72 65 61 6c 76 61 6c tenv key realval
2140: 29 29 29 0a 09 09 09 09 09 09 09 28 68 61 73 68 )))........(hash
2150: 2d 74 61 62 6c 65 2d 73 65 74 21 20 72 65 73 20 -table-set! res
2160: 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d curr-section-nam
2170: 65 20 0a 09 09 09 09 09 09 09 09 09 20 28 63 6f e .......... (co
2180: 6e 66 69 67 3a 61 73 73 6f 63 2d 73 61 66 65 2d nfig:assoc-safe-
2190: 61 64 64 20 61 6c 69 73 74 20 6b 65 79 20 72 65 add alist key re
21a0: 61 6c 76 61 6c 29 29 0a 09 09 09 09 09 09 09 28 alval))........(
21b0: 6c 6f 6f 70 20 28 63 6f 6e 66 69 67 66 3a 72 65 loop (configf:re
21c0: 61 64 2d 6c 69 6e 65 20 69 6e 70 20 72 65 73 29 ad-line inp res)
21d0: 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 curr-section-na
21e0: 6d 65 20 6b 65 79 20 23 66 29 29 29 0a 09 20 20 me key #f)))..
21f0: 20 20 20 20 20 3b 3b 20 69 66 20 61 20 63 6f 6e ;; if a con
2200: 74 69 6e 75 65 64 20 6c 69 6e 65 0a 09 20 20 20 tinued line..
2210: 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 63 6f 6e (configf:con
2220: 74 2d 6c 6e 2d 72 78 20 28 20 78 20 77 68 73 70 t-ln-rx ( x whsp
2230: 20 76 61 6c 20 20 20 20 20 29 20 28 6c 65 74 20 val ) (let
2240: 28 28 61 6c 69 73 74 20 28 68 61 73 68 2d 74 61 ((alist (hash-ta
2250: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default
2260: 72 65 73 20 63 75 72 72 2d 73 65 63 74 69 6f 6e res curr-section
2270: 2d 6e 61 6d 65 20 27 28 29 29 29 29 0a 09 09 09 -name '())))....
2280: 09 09 09 28 69 66 20 76 61 72 2d 66 6c 61 67 20 ...(if var-flag
2290: 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 69 ;; i
22a0: 66 20 73 65 74 20 74 6f 20 61 20 73 74 72 69 6e f set to a strin
22b0: 67 20 74 68 65 6e 20 77 65 20 68 61 76 65 20 61 g then we have a
22c0: 20 63 6f 6e 74 69 6e 75 65 64 20 76 61 72 0a 09 continued var..
22d0: 09 09 09 09 09 20 20 20 20 28 6c 65 74 20 28 28 ..... (let ((
22e0: 6e 65 77 76 61 6c 20 28 63 6f 6e 63 20 0a 09 09 newval (conc ...
22f0: 09 09 09 09 09 09 20 20 20 28 63 6f 6e 66 69 67 ...... (config
2300: 2d 6c 6f 6f 6b 75 70 20 72 65 73 20 63 75 72 72 -lookup res curr
2310: 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 76 61 -section-name va
2320: 72 2d 66 6c 61 67 29 20 22 5c 6e 22 0a 09 09 09 r-flag) "\n"....
2330: 09 09 09 09 09 20 20 20 3b 3b 20 74 72 69 6d 20 ..... ;; trim
2340: 6c 65 61 64 20 66 72 6f 6d 20 74 68 65 20 69 6e lead from the in
2350: 63 6f 6d 69 6e 67 20 77 68 73 70 20 74 6f 20 73 coming whsp to s
2360: 75 70 70 6f 72 74 20 73 6f 6d 65 20 69 6e 64 65 upport some inde
2370: 6e 74 69 6e 67 2e 0a 09 09 09 09 09 09 09 09 20 nting..........
2380: 20 20 28 69 66 20 6c 65 61 64 0a 09 09 09 09 09 (if lead......
2390: 09 09 09 20 20 20 20 20 20 20 28 73 74 72 69 6e ... (strin
23a0: 67 2d 73 75 62 73 74 69 74 75 74 65 20 28 72 65 g-substitute (re
23b0: 67 65 78 70 20 6c 65 61 64 29 20 22 22 20 77 68 gexp lead) "" wh
23c0: 73 70 29 0a 09 09 09 09 09 09 09 09 20 20 20 20 sp).........
23d0: 20 20 20 22 22 29 0a 09 09 09 09 09 09 09 09 20 "").........
23e0: 20 20 76 61 6c 29 29 29 0a 09 09 09 09 09 09 20 val))).......
23f0: 20 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 ;; (print "
2400: 76 61 6c 3a 20 22 20 76 61 6c 20 22 5c 6e 6e 65 val: " val "\nne
2410: 77 76 61 6c 3a 20 5c 22 22 20 6e 65 77 76 61 6c wval: \"" newval
2420: 20 22 5c 22 5c 6e 76 61 72 66 6c 61 67 3a 20 22 "\"\nvarflag: "
2430: 20 76 61 72 2d 66 6c 61 67 29 0a 09 09 09 09 09 var-flag)......
2440: 09 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 . (hash-tab
2450: 6c 65 2d 73 65 74 21 20 72 65 73 20 63 75 72 72 le-set! res curr
2460: 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 0a 09 -section-name ..
2470: 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 63 ....... (c
2480: 6f 6e 66 69 67 3a 61 73 73 6f 63 2d 73 61 66 65 onfig:assoc-safe
2490: 2d 61 64 64 20 61 6c 69 73 74 20 76 61 72 2d 66 -add alist var-f
24a0: 6c 61 67 20 6e 65 77 76 61 6c 29 29 0a 09 09 09 lag newval))....
24b0: 09 09 09 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 ... (loop (
24c0: 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d 6c 69 6e configf:read-lin
24d0: 65 20 69 6e 70 20 72 65 73 29 20 63 75 72 72 2d e inp res) curr-
24e0: 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 76 61 72 section-name var
24f0: 2d 66 6c 61 67 20 28 69 66 20 6c 65 61 64 20 6c -flag (if lead l
2500: 65 61 64 20 77 68 73 70 29 29 29 0a 09 09 09 09 ead whsp))).....
2510: 09 09 20 20 20 20 28 6c 6f 6f 70 20 28 63 6f 6e .. (loop (con
2520: 66 69 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 figf:read-line i
2530: 6e 70 20 72 65 73 29 20 63 75 72 72 2d 73 65 63 np res) curr-sec
2540: 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 66 29 tion-name #f #f)
2550: 29 29 29 0a 09 20 20 20 20 20 20 20 28 65 6c 73 ))).. (els
2560: 65 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 e (debug:print 0
2570: 20 22 45 52 52 4f 52 3a 20 70 72 6f 62 6c 65 6d "ERROR: problem
2580: 20 70 61 72 73 69 6e 67 20 22 20 70 61 74 68 20 parsing " path
2590: 22 2c 5c 6e 20 20 20 5c 22 22 20 69 6e 6c 20 22 ",\n \"" inl "
25a0: 5c 22 22 29 0a 09 09 20 20 20 20 20 28 73 65 74 \"")... (set
25b0: 21 20 76 61 72 2d 66 6c 61 67 20 23 66 29 0a 09 ! var-flag #f)..
25c0: 09 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 6f 6e . (loop (con
25d0: 66 69 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 figf:read-line i
25e0: 6e 70 20 72 65 73 29 20 63 75 72 72 2d 73 65 63 np res) curr-sec
25f0: 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 66 29 tion-name #f #f)
2600: 29 29 29 29 29 29 29 0a 20 20 0a 28 64 65 66 69 ))))))). .(defi
2610: 6e 65 20 28 66 69 6e 64 2d 61 6e 64 2d 72 65 61 ne (find-and-rea
2620: 64 2d 63 6f 6e 66 69 67 20 66 6e 61 6d 65 20 23 d-config fname #
2630: 21 6b 65 79 20 28 65 6e 76 69 72 6f 6e 2d 70 61 !key (environ-pa
2640: 74 74 20 23 66 29 28 67 69 76 65 6e 2d 74 6f 70 tt #f)(given-top
2650: 70 61 74 68 20 23 66 29 29 0a 20 20 28 6c 65 74 path #f)). (let
2660: 2a 20 28 28 63 75 72 72 2d 64 69 72 20 20 20 28 * ((curr-dir (
2670: 63 75 72 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 current-director
2680: 79 29 29 0a 20 20 20 20 20 20 20 20 20 28 63 6f y)). (co
2690: 6e 66 69 67 69 6e 66 6f 20 28 66 69 6e 64 2d 63 nfiginfo (find-c
26a0: 6f 6e 66 69 67 20 66 6e 61 6d 65 20 74 6f 70 70 onfig fname topp
26b0: 61 74 68 3a 20 67 69 76 65 6e 2d 74 6f 70 70 61 ath: given-toppa
26c0: 74 68 29 29 0a 09 20 28 74 6f 70 70 61 74 68 20 th)).. (toppath
26d0: 20 20 20 28 63 61 72 20 63 6f 6e 66 69 67 69 6e (car configin
26e0: 66 6f 29 29 0a 09 20 28 63 6f 6e 66 69 67 66 69 fo)).. (configfi
26f0: 6c 65 20 28 63 61 64 72 20 63 6f 6e 66 69 67 69 le (cadr configi
2700: 6e 66 6f 29 29 29 0a 20 20 20 20 28 69 66 20 74 nfo))). (if t
2710: 6f 70 70 61 74 68 20 28 63 68 61 6e 67 65 2d 64 oppath (change-d
2720: 69 72 65 63 74 6f 72 79 20 74 6f 70 70 61 74 68 irectory toppath
2730: 29 29 20 0a 20 20 20 20 28 6c 65 74 20 28 28 63 )) . (let ((c
2740: 6f 6e 66 69 67 64 61 74 20 20 28 69 66 20 63 6f onfigdat (if co
2750: 6e 66 69 67 66 69 6c 65 20 28 72 65 61 64 2d 63 nfigfile (read-c
2760: 6f 6e 66 69 67 20 63 6f 6e 66 69 67 66 69 6c 65 onfig configfile
2770: 20 23 66 20 23 74 20 65 6e 76 69 72 6f 6e 2d 70 #f #t environ-p
2780: 61 74 74 3a 20 65 6e 76 69 72 6f 6e 2d 70 61 74 att: environ-pat
2790: 74 29 20 23 66 29 29 29 20 3b 3b 20 28 6d 61 6b t) #f))) ;; (mak
27a0: 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 29 29 e-hash-table))))
27b0: 0a 20 20 20 20 20 20 28 69 66 20 74 6f 70 70 61 . (if toppa
27c0: 74 68 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 th (change-direc
27d0: 74 6f 72 79 20 63 75 72 72 2d 64 69 72 29 29 0a tory curr-dir)).
27e0: 20 20 20 20 20 20 28 6c 69 73 74 20 63 6f 6e 66 (list conf
27f0: 69 67 64 61 74 20 74 6f 70 70 61 74 68 20 63 6f igdat toppath co
2800: 6e 66 69 67 66 69 6c 65 20 66 6e 61 6d 65 29 29 nfigfile fname))
2810: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e ))..(define (con
2820: 66 69 67 2d 6c 6f 6f 6b 75 70 20 63 66 67 64 61 fig-lookup cfgda
2830: 74 20 73 65 63 74 69 6f 6e 20 76 61 72 29 0a 20 t section var).
2840: 20 28 69 66 20 28 68 61 73 68 2d 74 61 62 6c 65 (if (hash-table
2850: 3f 20 63 66 67 64 61 74 29 0a 20 20 20 20 20 20 ? cfgdat).
2860: 28 6c 65 74 20 28 28 73 65 63 74 64 61 74 20 28 (let ((sectdat (
2870: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d
2880: 65 66 61 75 6c 74 20 63 66 67 64 61 74 20 73 65 efault cfgdat se
2890: 63 74 69 6f 6e 20 27 28 29 29 29 29 0a 09 28 69 ction '())))..(i
28a0: 66 20 28 6e 75 6c 6c 3f 20 73 65 63 74 64 61 74 f (null? sectdat
28b0: 29 0a 09 20 20 20 20 23 66 0a 09 20 20 20 20 28 ).. #f.. (
28c0: 6c 65 74 20 28 28 6d 61 74 63 68 20 28 61 73 73 let ((match (ass
28d0: 6f 63 20 76 61 72 20 73 65 63 74 64 61 74 29 29 oc var sectdat))
28e0: 29 0a 09 20 20 20 20 20 20 28 69 66 20 6d 61 74 ).. (if mat
28f0: 63 68 20 3b 3b 20 28 61 6e 64 20 6d 61 74 63 68 ch ;; (and match
2900: 20 28 6c 69 73 74 3f 20 6d 61 74 63 68 29 28 3e (list? match)(>
2910: 20 28 6c 65 6e 67 74 68 20 6d 61 74 63 68 29 20 (length match)
2920: 31 29 29 0a 09 09 20 20 28 63 61 64 72 20 6d 61 1))... (cadr ma
2930: 74 63 68 29 0a 09 09 20 20 23 66 29 29 0a 09 20 tch)... #f))..
2940: 20 20 20 29 29 0a 20 20 20 20 20 20 23 66 29 29 )). #f))
2950: 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 ..(define (confi
2960: 67 66 3a 73 65 63 74 69 6f 6e 2d 76 61 72 73 20 gf:section-vars
2970: 63 66 67 64 61 74 20 73 65 63 74 69 6f 6e 29 0a cfgdat section).
2980: 20 20 28 6c 65 74 20 28 28 73 65 63 74 64 61 74 (let ((sectdat
2990: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
29a0: 2f 64 65 66 61 75 6c 74 20 63 66 67 64 61 74 20 /default cfgdat
29b0: 73 65 63 74 69 6f 6e 20 27 28 29 29 29 29 0a 20 section '()))).
29c0: 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 73 65 (if (null? se
29d0: 63 74 64 61 74 29 0a 09 27 28 29 0a 09 28 6d 61 ctdat)..'()..(ma
29e0: 70 20 63 61 72 20 73 65 63 74 64 61 74 29 29 29 p car sectdat)))
29f0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 )..(define (conf
2a00: 69 67 66 3a 67 65 74 2d 73 65 63 74 69 6f 6e 20 igf:get-section
2a10: 63 66 64 61 74 20 73 65 63 74 69 6f 6e 29 0a 20 cfdat section).
2a20: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
2a30: 2f 64 65 66 61 75 6c 74 20 63 66 67 64 61 74 20 /default cfgdat
2a40: 73 65 63 74 69 6f 6e 20 27 28 29 29 29 0a 0a 28 section '()))..(
2a50: 64 65 66 69 6e 65 20 28 73 65 74 75 70 29 0a 20 define (setup).
2a60: 20 28 6c 65 74 2a 20 28 28 63 6f 6e 66 69 67 66 (let* ((configf
2a70: 20 28 66 69 6e 64 2d 63 6f 6e 66 69 67 29 29 0a (find-config)).
2a80: 09 20 28 63 6f 6e 66 69 67 20 20 28 69 66 20 63 . (config (if c
2a90: 6f 6e 66 69 67 66 20 28 72 65 61 64 2d 63 6f 6e onfigf (read-con
2aa0: 66 69 67 20 63 6f 6e 66 69 67 66 20 23 66 20 23 fig configf #f #
2ab0: 74 29 20 23 66 29 29 29 0a 20 20 20 20 28 69 66 t) #f))). (if
2ac0: 20 63 6f 6e 66 69 67 0a 09 28 73 65 74 65 6e 76 config..(setenv
2ad0: 20 22 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 22 "RUN_AREA_HOME"
2ae0: 20 28 70 61 74 68 6e 61 6d 65 2d 64 69 72 65 63 (pathname-direc
2af0: 74 6f 72 79 20 63 6f 6e 66 69 67 66 29 29 29 0a tory configf))).
2b00: 20 20 20 20 63 6f 6e 66 69 67 29 29 0a 0a 3b 3b config))..;;
2b10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2b20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2b30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2b40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2b50: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4e 6f 6e 20 64 65 ======.;; Non de
2b60: 73 74 72 75 63 74 69 76 65 20 77 72 69 74 69 6e structive writin
2b70: 67 20 6f 66 20 63 6f 6e 66 69 67 20 66 69 6c 65 g of config file
2b80: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
2b90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2ba0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2bb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2bc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 =========..(defi
2bd0: 6e 65 20 28 63 6f 6e 66 69 67 66 3a 63 6f 6d 70 ne (configf:comp
2be0: 72 65 73 73 2d 6d 75 6c 74 69 2d 6c 69 6e 65 73 ress-multi-lines
2bf0: 20 66 64 61 74 29 0a 20 20 3b 3b 20 73 74 65 70 fdat). ;; step
2c00: 20 31 2e 35 20 2d 20 63 6f 6d 70 72 65 73 73 20 1.5 - compress
2c10: 61 6e 79 20 63 6f 6e 74 69 6e 75 65 64 20 6c 69 any continued li
2c20: 6e 65 73 0a 20 20 28 69 66 20 28 6e 75 6c 6c 3f nes. (if (null?
2c30: 20 66 64 61 74 29 20 66 64 61 74 0a 09 28 6c 65 fdat) fdat..(le
2c40: 74 20 6c 6f 6f 70 20 28 28 68 65 64 20 28 63 61 t loop ((hed (ca
2c50: 72 20 66 64 61 74 29 29 0a 09 09 20 20 20 28 74 r fdat))... (t
2c60: 61 6c 20 28 63 64 72 20 66 64 61 74 29 29 0a 09 al (cdr fdat))..
2c70: 09 20 20 20 28 63 75 72 20 22 22 29 0a 09 09 20 . (cur "")...
2c80: 20 20 28 6c 65 64 20 23 66 29 0a 09 09 20 20 20 (led #f)...
2c90: 28 72 65 73 20 27 28 29 29 29 0a 09 20 20 3b 3b (res '())).. ;;
2ca0: 20 41 4c 4c 20 57 48 49 54 45 53 50 41 43 45 20 ALL WHITESPACE
2cb0: 4c 45 41 44 49 4e 47 20 4c 49 4e 45 53 20 41 52 LEADING LINES AR
2cc0: 45 20 54 41 43 4b 45 44 20 4f 4e 21 21 0a 09 20 E TACKED ON!!..
2cd0: 20 3b 3b 20 20 31 2e 20 72 65 6d 6f 76 65 20 6c ;; 1. remove l
2ce0: 65 64 20 77 68 69 74 65 73 70 61 63 65 0a 09 20 ed whitespace..
2cf0: 20 3b 3b 20 20 32 2e 20 74 61 63 6b 20 6f 6e 20 ;; 2. tack on
2d00: 74 6f 20 68 65 64 20 77 69 74 68 20 22 5c 6e 22 to hed with "\n"
2d10: 0a 09 20 20 28 6c 65 74 20 28 28 6d 61 74 63 68 .. (let ((match
2d20: 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 63 (string-match c
2d30: 6f 6e 66 69 67 66 3a 63 6f 6e 74 2d 6c 6e 2d 72 onfigf:cont-ln-r
2d40: 78 20 68 65 64 29 29 29 0a 09 20 20 20 20 28 69 x hed))).. (i
2d50: 66 20 6d 61 74 63 68 20 3b 3b 20 62 6c 61 73 74 f match ;; blast
2d60: 21 20 68 61 76 65 20 74 6f 20 64 65 61 6c 20 77 ! have to deal w
2d70: 69 74 68 20 61 20 6d 75 6c 74 69 6c 69 6e 65 0a ith a multiline.
2d80: 09 09 28 6c 65 74 2a 20 28 28 6c 65 61 64 20 28 ..(let* ((lead (
2d90: 63 61 64 72 20 6d 61 74 63 68 29 29 0a 09 09 20 cadr match))...
2da0: 20 20 20 20 20 20 28 6c 76 61 6c 20 28 63 61 64 (lval (cad
2db0: 64 72 20 6d 61 74 63 68 29 29 0a 09 09 20 20 20 dr match))...
2dc0: 20 20 20 20 28 6e 65 77 6c 20 28 63 6f 6e 63 20 (newl (conc
2dd0: 63 75 72 20 22 5c 6e 22 20 6c 76 61 6c 29 29 29 cur "\n" lval)))
2de0: 0a 09 09 20 20 28 69 66 20 28 6e 6f 74 20 6c 65 ... (if (not le
2df0: 64 29 28 73 65 74 21 20 6c 65 64 20 6c 65 61 64 d)(set! led lead
2e00: 29 29 0a 09 09 20 20 28 69 66 20 28 6e 75 6c 6c ))... (if (null
2e10: 3f 20 74 61 6c 29 20 0a 09 09 20 20 20 20 20 20 ? tal) ...
2e20: 28 73 65 74 21 20 66 64 61 74 20 28 61 70 70 65 (set! fdat (appe
2e30: 6e 64 20 66 64 61 74 20 28 6c 69 73 74 20 6e 65 nd fdat (list ne
2e40: 77 6c 29 29 29 0a 09 09 20 20 20 20 20 20 28 6c wl)))... (l
2e50: 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 28 63 64 oop (car tal)(cd
2e60: 72 20 74 61 6c 29 20 6e 65 77 6c 20 6c 65 64 20 r tal) newl led
2e70: 72 65 73 29 29 29 20 3b 3b 20 4e 42 2f 2f 20 6e res))) ;; NB// n
2e80: 6f 74 20 74 61 63 6b 69 6e 67 20 6e 65 77 6c 20 ot tacking newl
2e90: 6f 6e 74 6f 20 72 65 73 0a 09 09 28 6c 65 74 20 onto res...(let
2ea0: 28 28 6e 65 77 72 65 73 20 28 69 66 20 6c 65 64 ((newres (if led
2eb0: 20 0a 09 09 09 09 20 20 28 61 70 70 65 6e 64 20 ..... (append
2ec0: 72 65 73 20 28 6c 69 73 74 20 63 75 72 20 68 65 res (list cur he
2ed0: 64 29 29 0a 09 09 09 09 20 20 28 61 70 70 65 6e d))..... (appen
2ee0: 64 20 72 65 73 20 28 6c 69 73 74 20 68 65 64 29 d res (list hed)
2ef0: 29 29 29 29 0a 09 09 20 20 3b 3b 20 70 72 65 76 ))))... ;; prev
2f00: 20 77 61 73 20 61 20 6d 75 6c 74 69 6c 69 6e 65 was a multiline
2f10: 0a 09 09 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 ... (if (null?
2f20: 74 61 6c 29 0a 09 09 20 20 20 20 20 20 6e 65 77 tal)... new
2f30: 72 65 73 0a 09 09 20 20 20 20 20 20 28 6c 6f 6f res... (loo
2f40: 70 20 28 63 61 72 20 74 61 6c 29 28 63 64 72 20 p (car tal)(cdr
2f50: 74 61 6c 29 20 22 22 20 23 66 20 6e 65 77 72 65 tal) "" #f newre
2f60: 73 29 29 29 29 29 29 29 29 0a 0a 3b 3b 20 6e 6f s))))))))..;; no
2f70: 74 65 3a 20 49 27 6d 20 63 68 65 61 74 69 6e 67 te: I'm cheating
2f80: 20 61 20 6c 69 74 74 6c 65 20 68 65 72 65 2e 20 a little here.
2f90: 49 20 6d 65 72 65 6c 79 20 72 65 70 6c 61 63 65 I merely replace
2fa0: 20 22 5c 6e 22 20 77 69 74 68 20 22 5c 6e 20 20 "\n" with "\n
2fb0: 20 20 20 20 20 20 20 22 0a 28 64 65 66 69 6e 65 ".(define
2fc0: 20 28 63 6f 6e 66 69 67 66 3a 65 78 70 61 6e 64 (configf:expand
2fd0: 2d 6d 75 6c 74 69 2d 6c 69 6e 65 73 20 66 64 61 -multi-lines fda
2fe0: 74 29 0a 20 20 3b 3b 20 73 74 65 70 20 31 2e 35 t). ;; step 1.5
2ff0: 20 2d 20 63 6f 6d 70 72 65 73 73 20 61 6e 79 20 - compress any
3000: 63 6f 6e 74 69 6e 75 65 64 20 6c 69 6e 65 73 0a continued lines.
3010: 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 66 64 61 (if (null? fda
3020: 74 29 20 66 64 61 74 0a 20 20 20 20 20 20 28 6c t) fdat. (l
3030: 65 74 20 6c 6f 6f 70 20 28 28 68 65 64 20 28 63 et loop ((hed (c
3040: 61 72 20 66 64 61 74 29 29 0a 09 09 20 28 74 61 ar fdat))... (ta
3050: 6c 20 28 63 64 72 20 66 64 61 74 29 29 0a 09 09 l (cdr fdat))...
3060: 20 28 72 65 73 20 27 28 29 29 29 0a 09 28 6c 65 (res '()))..(le
3070: 74 20 28 28 6e 65 77 72 65 73 20 28 61 70 70 65 t ((newres (appe
3080: 6e 64 20 72 65 73 20 28 6c 69 73 74 20 28 73 74 nd res (list (st
3090: 72 69 6e 67 2d 73 75 62 73 74 69 74 75 74 65 20 ring-substitute
30a0: 28 72 65 67 65 78 70 20 22 5c 6e 22 29 20 22 5c (regexp "\n") "\
30b0: 6e 20 20 20 20 20 20 20 20 20 22 20 68 65 64 20 n " hed
30c0: 23 74 29 29 29 29 29 0a 09 20 20 28 69 66 20 28 #t))))).. (if (
30d0: 6e 75 6c 6c 3f 20 74 61 6c 29 0a 09 20 20 20 20 null? tal)..
30e0: 20 20 6e 65 77 72 65 73 0a 09 20 20 20 20 20 20 newres..
30f0: 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 28 (loop (car tal)(
3100: 63 64 72 20 74 61 6c 29 20 6e 65 77 72 65 73 29 cdr tal) newres)
3110: 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 )))))..(define (
3120: 63 6f 6e 66 69 67 66 3a 66 69 6c 65 2d 3e 6c 69 configf:file->li
3130: 73 74 20 66 6e 61 6d 65 29 0a 20 20 28 69 66 20 st fname). (if
3140: 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 66 6e (file-exists? fn
3150: 61 6d 65 29 0a 20 20 20 20 20 20 28 6c 65 74 20 ame). (let
3160: 28 28 69 6e 70 20 28 6f 70 65 6e 2d 69 6e 70 75 ((inp (open-inpu
3170: 74 2d 66 69 6c 65 20 66 6e 61 6d 65 29 29 29 0a t-file fname))).
3180: 09 28 6c 65 74 20 6c 6f 6f 70 20 28 28 69 6e 6c .(let loop ((inl
3190: 20 28 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 29 (read-line inp)
31a0: 29 0a 09 09 20 20 20 28 72 65 73 20 27 28 29 29 )... (res '())
31b0: 29 0a 09 20 20 28 69 66 20 28 65 6f 66 2d 6f 62 ).. (if (eof-ob
31c0: 6a 65 63 74 3f 20 69 6e 6c 29 0a 09 20 20 20 20 ject? inl)..
31d0: 20 20 28 62 65 67 69 6e 0a 09 09 28 63 6c 6f 73 (begin...(clos
31e0: 65 2d 69 6e 70 75 74 2d 70 6f 72 74 20 69 6e 70 e-input-port inp
31f0: 29 0a 09 09 28 72 65 76 65 72 73 65 20 72 65 73 )...(reverse res
3200: 29 29 0a 09 20 20 20 20 20 20 28 6c 6f 6f 70 20 )).. (loop
3210: 28 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 29 28 (read-line inp)(
3220: 63 6f 6e 73 20 69 6e 6c 29 29 29 29 29 0a 20 20 cons inl))))).
3230: 20 20 20 20 27 28 29 29 29 0a 0a 3b 3b 3d 3d 3d '()))..;;===
3240: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3250: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3260: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3270: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3280: 3d 3d 3d 0a 3b 3b 20 57 72 69 74 65 20 61 20 63 ===.;; Write a c
3290: 6f 6e 66 69 67 0a 3b 3b 20 20 20 30 2e 20 47 69 onfig.;; 0. Gi
32a0: 76 65 6e 20 61 20 72 65 66 65 72 65 72 65 6e 63 ven a refererenc
32b0: 65 20 64 61 74 61 20 73 74 72 75 63 74 75 72 65 e data structure
32c0: 20 22 69 6e 64 61 74 22 0a 3b 3b 20 20 20 31 2e "indat".;; 1.
32d0: 20 4f 70 65 6e 20 74 68 65 20 6f 75 74 70 75 74 Open the output
32e0: 20 66 69 6c 65 20 61 6e 64 20 72 65 61 64 20 69 file and read i
32f0: 74 20 69 6e 74 6f 20 61 20 6c 69 73 74 0a 3b 3b t into a list.;;
3300: 20 20 20 32 2e 20 46 6c 61 74 74 65 6e 20 61 6e 2. Flatten an
3310: 79 20 6d 75 6c 74 69 6c 69 6e 65 20 65 6e 74 72 y multiline entr
3320: 69 65 73 0a 3b 3b 20 20 20 33 2e 20 4d 6f 64 69 ies.;; 3. Modi
3330: 66 79 20 76 61 6c 75 65 73 20 70 65 72 20 63 6f fy values per co
3340: 6e 74 65 6e 74 73 20 6f 66 20 22 69 6e 64 61 74 ntents of "indat
3350: 22 20 61 6e 64 20 72 65 6d 6f 76 65 20 61 62 73 " and remove abs
3360: 65 6e 74 20 76 61 6c 75 65 73 0a 3b 3b 20 20 20 ent values.;;
3370: 34 2e 20 41 70 70 65 6e 64 20 6e 65 77 20 76 61 4. Append new va
3380: 6c 75 65 73 20 74 6f 20 74 68 65 20 73 65 63 74 lues to the sect
3390: 69 6f 6e 20 28 69 6d 6d 65 64 69 61 74 65 6c 79 ion (immediately
33a0: 20 61 66 74 65 72 20 6c 61 73 74 20 6c 65 67 69 after last legi
33b0: 74 20 65 6e 74 72 79 29 0a 3b 3b 20 20 20 35 2e t entry).;; 5.
33c0: 20 57 72 69 74 65 20 6f 75 74 20 74 68 65 20 6e Write out the n
33d0: 65 77 20 6c 69 73 74 20 0a 3b 3b 3d 3d 3d 3d 3d ew list .;;=====
33e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
33f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3400: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3410: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3420: 3d 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 =..(define (conf
3430: 69 67 66 3a 77 72 69 74 65 2d 63 6f 6e 66 69 67 igf:write-config
3440: 20 69 6e 64 61 74 20 66 6e 61 6d 65 20 23 21 6b indat fname #!k
3450: 65 79 20 28 72 65 71 75 69 72 65 64 2d 73 65 63 ey (required-sec
3460: 74 69 6f 6e 73 20 27 28 29 29 29 0a 20 20 28 6c tions '())). (l
3470: 65 74 2a 20 28 3b 3b 20 73 74 65 70 20 31 3a 20 et* (;; step 1:
3480: 4f 70 65 6e 20 74 68 65 20 6f 75 74 70 75 74 20 Open the output
3490: 66 69 6c 65 20 61 6e 64 20 72 65 61 64 20 69 74 file and read it
34a0: 20 69 6e 74 6f 20 61 20 6c 69 73 74 0a 09 20 28 into a list.. (
34b0: 66 64 61 74 20 20 20 20 20 20 20 28 63 6f 6e 66 fdat (conf
34c0: 69 67 66 3a 66 69 6c 65 2d 3e 6c 69 73 74 20 66 igf:file->list f
34d0: 6e 61 6d 65 29 29 0a 09 20 28 72 65 66 64 61 74 name)).. (refdat
34e0: 20 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 (make-hash-tab
34f0: 6c 65 29 29 0a 09 20 28 73 65 63 68 61 73 68 20 le)).. (sechash
3500: 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 (make-hash-table
3510: 29 29 20 3b 3b 20 63 75 72 72 65 6e 74 20 73 65 )) ;; current se
3520: 63 74 69 6f 6e 20 68 61 73 68 2c 20 69 6e 69 74 ction hash, init
3530: 20 77 69 74 68 20 68 61 73 68 20 66 6f 72 20 22 with hash for "
3540: 64 65 66 61 75 6c 74 22 20 73 65 63 74 69 6f 6e default" section
3550: 0a 09 20 28 6e 65 77 20 20 20 20 20 23 66 29 20 .. (new #f)
3560: 3b 3b 20 70 75 74 20 74 68 65 20 6c 69 6e 65 20 ;; put the line
3570: 74 6f 20 62 65 20 75 73 65 64 20 69 6e 20 6e 65 to be used in ne
3580: 77 2c 20 69 66 20 69 74 20 69 73 20 74 6f 20 62 w, if it is to b
3590: 65 20 64 65 6c 65 74 65 64 20 74 68 65 20 73 65 e deleted the se
35a0: 74 20 6e 65 77 20 74 6f 20 23 66 0a 09 20 28 73 t new to #f.. (s
35b0: 65 63 6e 61 6d 65 20 23 66 29 29 0a 0a 20 20 20 ecname #f))..
35c0: 20 3b 3b 20 73 74 65 70 20 32 3a 20 46 6c 61 74 ;; step 2: Flat
35d0: 74 65 6e 20 6d 75 6c 74 69 6c 69 6e 65 20 65 6e ten multiline en
35e0: 74 72 69 65 73 0a 20 20 20 20 28 69 66 20 28 6e tries. (if (n
35f0: 6f 74 20 28 6e 75 6c 6c 3f 20 66 64 61 74 29 29 ot (null? fdat))
3600: 28 73 65 74 21 20 66 64 61 74 20 28 63 6f 6e 66 (set! fdat (conf
3610: 69 67 66 3a 63 6f 6d 70 72 65 73 73 2d 6d 75 6c igf:compress-mul
3620: 74 69 2d 6c 69 6e 65 20 66 64 61 74 29 29 29 0a ti-line fdat))).
3630: 0a 20 20 20 20 3b 3b 20 73 74 65 70 20 33 3a 20 . ;; step 3:
3640: 4d 6f 64 69 66 79 20 76 61 6c 75 65 73 20 70 65 Modify values pe
3650: 72 20 63 6f 6e 74 65 6e 74 73 20 6f 66 20 22 69 r contents of "i
3660: 6e 64 61 74 22 20 61 6e 64 20 72 65 6d 6f 76 65 ndat" and remove
3670: 20 61 62 73 65 6e 74 20 76 61 6c 75 65 73 0a 20 absent values.
3680: 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c (if (not (nul
3690: 6c 3f 20 66 64 61 74 29 29 0a 09 28 6c 65 74 20 l? fdat))..(let
36a0: 6c 6f 6f 70 20 28 28 68 65 64 20 20 28 63 61 72 loop ((hed (car
36b0: 20 66 64 61 74 29 29 0a 09 09 20 20 20 28 74 61 fdat))... (ta
36c0: 6c 20 20 28 63 61 64 72 20 66 64 61 74 29 29 0a l (cadr fdat)).
36d0: 09 09 20 20 20 28 72 65 73 20 20 27 28 29 29 0a .. (res '()).
36e0: 09 09 20 20 20 28 6c 6e 75 6d 20 30 29 29 0a 09 .. (lnum 0))..
36f0: 20 20 28 72 65 67 65 78 2d 63 61 73 65 20 0a 09 (regex-case ..
3700: 20 20 20 68 65 64 0a 09 20 20 20 28 63 6f 6e 66 hed.. (conf
3710: 69 67 66 3a 63 6f 6d 6d 65 6e 74 2d 72 78 20 5f igf:comment-rx _
3720: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3730: 20 20 28 73 65 74 21 20 72 65 73 20 28 61 70 70 (set! res (app
3740: 65 6e 64 20 72 65 73 20 28 6c 69 73 74 20 68 65 end res (list he
3750: 64 29 29 29 29 20 3b 3b 20 28 6c 6f 6f 70 20 28 d)))) ;; (loop (
3760: 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 29 20 63 read-line inp) c
3770: 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 urr-section-name
3780: 20 23 66 20 23 66 29 29 0a 09 20 20 20 28 63 6f #f #f)).. (co
3790: 6e 66 69 67 66 3a 62 6c 61 6e 6b 2d 6c 2d 72 78 nfigf:blank-l-rx
37a0: 20 5f 20 20 20 20 20 20 20 20 20 20 20 20 20 20 _
37b0: 20 20 20 20 28 73 65 74 21 20 72 65 73 20 28 61 (set! res (a
37c0: 70 70 65 6e 64 20 72 65 73 20 28 6c 69 73 74 20 ppend res (list
37d0: 68 65 64 29 29 29 29 20 3b 3b 20 28 6c 6f 6f 70 hed)))) ;; (loop
37e0: 20 28 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 29 (read-line inp)
37f0: 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 curr-section-na
3800: 6d 65 20 23 66 20 23 66 29 29 0a 09 20 20 20 28 me #f #f)).. (
3810: 63 6f 6e 66 69 67 66 3a 73 65 63 74 69 6f 6e 2d configf:section-
3820: 72 78 20 28 20 78 20 73 65 63 74 69 6f 6e 2d 6e rx ( x section-n
3830: 61 6d 65 20 29 20 28 6c 65 74 20 28 28 73 65 63 ame ) (let ((sec
3840: 74 69 6f 6e 2d 68 61 73 68 20 28 68 61 73 68 2d tion-hash (hash-
3850: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
3860: 74 20 72 65 66 64 61 74 20 73 65 63 74 69 6f 6e t refdat section
3870: 2d 6e 61 6d 65 20 23 66 29 29 29 0a 09 09 09 09 -name #f))).....
3880: 09 20 20 20 20 28 69 66 20 28 6e 6f 74 20 73 65 . (if (not se
3890: 63 74 69 6f 6e 2d 68 61 73 68 29 0a 09 09 09 09 ction-hash).....
38a0: 09 09 28 6c 65 74 20 28 28 6e 65 77 68 61 73 68 ..(let ((newhash
38b0: 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c (make-hash-tabl
38c0: 65 29 29 29 0a 09 09 09 09 09 09 20 20 28 68 61 e)))....... (ha
38d0: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 72 65 sh-table-set! re
38e0: 66 68 61 73 68 20 73 65 63 74 69 6f 6e 2d 6e 61 fhash section-na
38f0: 6d 65 20 6e 65 77 68 61 73 68 29 0a 09 09 09 09 me newhash).....
3900: 09 09 20 20 28 73 65 74 21 20 73 65 63 68 61 73 .. (set! sechas
3910: 68 20 6e 65 77 68 61 73 68 29 29 0a 09 09 09 09 h newhash)).....
3920: 09 09 28 73 65 74 21 20 73 65 63 68 61 73 68 20 ..(set! sechash
3930: 73 65 63 74 69 6f 6e 2d 68 61 73 68 29 29 0a 09 section-hash))..
3940: 09 09 09 09 20 20 20 20 28 73 65 74 21 20 6e 65 .... (set! ne
3950: 77 20 68 65 64 29 20 3b 3b 20 77 69 6c 6c 20 61 w hed) ;; will a
3960: 70 70 65 6e 64 20 74 68 69 73 20 61 74 20 74 68 ppend this at th
3970: 65 20 62 6f 74 74 6f 6d 20 6f 66 20 74 68 65 20 e bottom of the
3980: 6c 6f 6f 70 0a 09 09 09 09 09 20 20 20 20 28 73 loop...... (s
3990: 65 74 21 20 73 65 63 6e 61 6d 65 20 73 65 63 74 et! secname sect
39a0: 69 6f 6e 2d 6e 61 6d 65 29 0a 09 09 09 09 09 20 ion-name)......
39b0: 20 20 20 29 29 0a 09 20 20 20 3b 3b 20 4e 6f 20 )).. ;; No
39c0: 6e 65 65 64 20 74 6f 20 70 72 6f 63 65 73 73 20 need to process
39d0: 6b 65 79 20 63 6d 64 2c 20 6c 65 74 20 69 74 20 key cmd, let it
39e0: 66 61 6c 6c 20 74 68 6f 75 67 68 20 74 6f 20 6b fall though to k
39f0: 65 79 20 76 61 6c 0a 09 20 20 20 28 63 6f 6e 66 ey val.. (conf
3a00: 69 67 66 3a 6b 65 79 2d 76 61 6c 2d 70 72 20 28 igf:key-val-pr (
3a10: 20 78 20 6b 65 79 20 76 61 6c 20 20 20 20 20 20 x key val
3a20: 29 0a 09 09 20 20 20 20 20 20 20 28 6c 65 74 20 )... (let
3a30: 28 28 6e 65 77 76 61 6c 20 28 63 6f 6e 66 69 67 ((newval (config
3a40: 2d 6c 6f 6f 6b 75 70 20 69 6e 64 61 74 20 73 65 -lookup indat se
3a50: 63 20 6b 65 79 29 29 29 0a 09 09 09 20 3b 3b 20 c key))).... ;;
3a60: 63 61 6e 20 68 61 6e 64 6c 65 20 6e 65 77 76 61 can handle newva
3a70: 6c 20 3d 3d 20 23 66 20 68 65 72 65 20 3d 3e 20 l == #f here =>
3a80: 74 68 61 74 20 6d 65 61 6e 73 20 6b 65 79 20 69 that means key i
3a90: 73 20 72 65 6d 6f 76 65 64 0a 09 09 09 20 28 63 s removed.... (c
3aa0: 6f 6e 64 20 0a 09 09 09 20 20 28 28 65 71 75 61 ond .... ((equa
3ab0: 6c 3f 20 6e 65 77 76 61 6c 20 76 61 6c 29 0a 09 l? newval val)..
3ac0: 09 09 20 20 20 28 73 65 74 21 20 72 65 73 20 28 .. (set! res (
3ad0: 61 70 70 65 6e 64 20 72 65 73 20 28 6c 69 73 74 append res (list
3ae0: 20 68 65 64 29 29 29 29 0a 09 09 09 20 20 28 28 hed)))).... ((
3af0: 6e 6f 74 20 6e 65 77 76 61 6c 29 20 3b 3b 20 6b not newval) ;; k
3b00: 65 79 20 68 61 73 20 62 65 65 6e 20 72 65 6d 6f ey has been remo
3b10: 76 65 64 0a 09 09 09 20 20 20 28 73 65 74 21 20 ved.... (set!
3b20: 6e 65 77 20 23 66 29 29 0a 09 09 09 20 20 28 28 new #f)).... ((
3b30: 6e 6f 74 20 28 65 71 75 61 6c 3f 20 6e 65 77 76 not (equal? newv
3b40: 61 6c 20 76 61 6c 29 29 0a 09 09 09 20 20 20 20 al val))....
3b50: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 (hash-table-set
3b60: 21 20 73 65 63 68 61 73 68 20 6b 65 79 20 6e 65 ! sechash key ne
3b70: 77 76 61 6c 29 0a 09 09 09 20 20 20 20 20 28 73 wval).... (s
3b80: 65 74 21 20 6e 65 77 20 28 63 6f 6e 63 20 6b 65 et! new (conc ke
3b90: 79 20 22 20 22 20 6e 65 77 76 61 6c 29 29 29 0a y " " newval))).
3ba0: 09 09 09 20 20 28 65 6c 73 65 0a 09 09 09 20 20 ... (else....
3bb0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
3bc0: 22 45 52 52 4f 52 3a 20 70 72 6f 62 6c 65 6d 20 "ERROR: problem
3bd0: 70 61 72 73 69 6e 67 20 6c 69 6e 65 20 6e 75 6d parsing line num
3be0: 62 65 72 20 22 20 6c 6e 75 6d 20 22 5c 22 22 20 ber " lnum "\""
3bf0: 68 65 64 20 22 5c 22 22 29 29 29 29 29 0a 09 20 hed "\"")))))..
3c00: 20 20 28 65 6c 73 65 0a 09 20 20 20 20 28 64 65 (else.. (de
3c10: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 bug:print 0 "ERR
3c20: 4f 52 3a 20 50 72 6f 62 6c 65 6d 20 70 61 72 73 OR: Problem pars
3c30: 69 6e 67 20 6c 69 6e 65 20 6e 75 6d 20 22 20 6c ing line num " l
3c40: 6e 75 6d 20 22 20 3a 5c 6e 20 20 20 22 20 68 65 num " :\n " he
3c50: 64 20 29 29 29 0a 09 20 20 28 69 66 20 28 6e 6f d ))).. (if (no
3c60: 74 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 29 0a 09 t (null? tal))..
3c70: 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 (loop (car
3c80: 20 74 61 6c 29 28 63 64 72 20 74 61 6c 29 28 69 tal)(cdr tal)(i
3c90: 66 20 6e 65 77 20 28 61 70 70 65 6e 64 20 72 65 f new (append re
3ca0: 73 20 28 6c 69 73 74 20 6e 65 77 29 29 20 72 65 s (list new)) re
3cb0: 73 29 28 2b 20 6c 6e 75 6d 20 31 29 29 29 0a 09 s)(+ lnum 1)))..
3cc0: 20 20 3b 3b 20 64 72 6f 70 20 74 6f 20 68 65 72 ;; drop to her
3cd0: 65 20 77 68 65 6e 20 64 6f 6e 65 20 70 72 6f 63 e when done proc
3ce0: 65 73 73 69 6e 67 2c 20 72 65 73 20 63 6f 6e 74 essing, res cont
3cf0: 61 69 6e 73 20 6d 6f 64 69 66 69 65 64 20 6c 69 ains modified li
3d00: 73 74 20 6f 66 20 6c 69 6e 65 73 0a 09 20 20 28 st of lines.. (
3d10: 73 65 74 21 20 66 64 61 74 20 72 65 73 29 29 29 set! fdat res)))
3d20: 0a 0a 20 20 20 20 3b 3b 20 73 74 65 70 20 34 3a .. ;; step 4:
3d30: 20 41 70 70 65 6e 64 20 6e 65 77 20 76 61 6c 75 Append new valu
3d40: 65 73 20 74 6f 20 74 68 65 20 73 65 63 74 69 6f es to the sectio
3d50: 6e 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 n. (for-each
3d60: 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 73 . (lambda (s
3d70: 65 63 74 69 6f 6e 29 0a 20 20 20 20 20 20 20 28 ection). (
3d80: 6c 65 74 20 28 28 73 64 61 74 20 20 20 27 28 29 let ((sdat '()
3d90: 29 20 3b 3b 20 61 70 70 65 6e 64 20 6e 65 65 64 ) ;; append need
3da0: 65 64 20 62 69 74 73 20 68 65 72 65 0a 09 20 20 ed bits here..
3db0: 20 20 20 28 73 76 61 72 73 20 20 28 63 6f 6e 66 (svars (conf
3dc0: 69 67 66 3a 73 65 63 74 69 6f 6e 2d 76 61 72 73 igf:section-vars
3dd0: 20 69 6e 64 61 74 20 73 65 63 74 69 6f 6e 29 29 indat section))
3de0: 29 0a 09 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 ).. (for-each ..
3df0: 20 20 28 6c 61 6d 62 64 61 20 28 76 61 72 29 0a (lambda (var).
3e00: 09 20 20 20 20 28 6c 65 74 20 28 28 76 61 6c 20 . (let ((val
3e10: 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 72 (config-lookup r
3e20: 65 66 64 61 74 20 73 65 63 74 69 6f 6e 20 76 61 efdat section va
3e30: 72 29 29 29 0a 09 20 20 20 20 20 20 28 69 66 20 r))).. (if
3e40: 28 6e 6f 74 20 76 61 6c 29 20 3b 3b 20 74 68 69 (not val) ;; thi
3e50: 73 20 6f 6e 65 20 69 73 20 6e 65 77 0a 09 09 20 s one is new...
3e60: 20 28 62 65 67 69 6e 0a 09 09 20 20 20 20 28 69 (begin... (i
3e70: 66 20 28 6e 75 6c 6c 3f 20 73 64 61 74 29 28 73 f (null? sdat)(s
3e80: 65 74 21 20 73 64 61 74 20 28 6c 69 73 74 20 28 et! sdat (list (
3e90: 63 6f 6e 63 20 22 5b 22 20 73 65 63 74 69 6f 6e conc "[" section
3ea0: 20 22 5d 22 29 29 29 29 0a 09 09 20 20 20 20 28 "]"))))... (
3eb0: 73 65 74 21 20 73 64 61 74 20 28 61 70 70 65 6e set! sdat (appen
3ec0: 64 20 73 64 61 74 20 28 6c 69 73 74 20 28 63 6f d sdat (list (co
3ed0: 6e 63 20 76 61 72 20 22 20 22 20 76 61 6c 29 29 nc var " " val))
3ee0: 29 29 29 29 29 29 0a 09 20 20 73 76 61 72 73 29 )))))).. svars)
3ef0: 0a 09 20 28 73 65 74 21 20 66 64 61 74 20 28 61 .. (set! fdat (a
3f00: 70 70 65 6e 64 20 66 64 61 74 20 73 64 61 74 29 ppend fdat sdat)
3f10: 29 29 29 0a 20 20 20 20 20 28 64 65 6c 65 74 65 ))). (delete
3f20: 2d 64 75 70 6c 69 63 61 74 65 73 20 28 61 70 70 -duplicates (app
3f30: 65 6e 64 20 72 65 71 75 69 72 65 2d 73 65 63 74 end require-sect
3f40: 69 6f 6e 73 20 28 68 61 73 68 2d 74 61 62 6c 65 ions (hash-table
3f50: 2d 6b 65 79 73 20 69 6e 64 61 74 29 29 29 29 0a -keys indat)))).
3f60: 0a 20 20 20 20 3b 3b 20 73 74 65 70 20 35 3a 20 . ;; step 5:
3f70: 57 72 69 74 65 20 6f 75 74 20 6e 65 77 20 66 69 Write out new fi
3f80: 6c 65 0a 20 20 20 20 28 77 69 74 68 2d 6f 75 74 le. (with-out
3f90: 70 75 74 2d 74 6f 2d 66 69 6c 65 20 66 6e 61 6d put-to-file fnam
3fa0: 65 20 0a 20 20 20 20 20 20 28 6c 61 6d 62 64 61 e . (lambda
3fb0: 20 28 29 0a 09 28 66 6f 72 2d 65 61 63 68 20 0a ()..(for-each .
3fc0: 09 20 28 6c 61 6d 62 64 61 20 28 6c 69 6e 65 29 . (lambda (line)
3fd0: 0a 09 20 20 20 28 70 72 69 6e 74 20 6c 69 6e 65 .. (print line
3fe0: 29 29 0a 09 20 28 63 6f 6e 66 69 67 66 3a 65 78 )).. (configf:ex
3ff0: 70 61 6e 64 2d 6d 75 6c 74 69 2d 6c 69 6e 65 73 pand-multi-lines
4000: 20 66 64 61 74 29 29 29 29 29 29 0a 0a fdat))))))..