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 31 37 2c 20 4d 61 74 74 right 2017, Matt
0060: 68 65 77 20 57 65 6c 6c 61 6e 64 2e 0a 3b 3b 20 hew Welland..;;
0070: 0a 3b 3b 20 54 68 69 73 20 66 69 6c 65 20 69 73 .;; This file is
0080: 20 70 61 72 74 20 6f 66 20 4d 65 67 61 74 65 73 part of Megates
0090: 74 2e 0a 3b 3b 20 0a 3b 3b 20 20 20 20 20 4d 65 t..;; .;; Me
00a0: 67 61 74 65 73 74 20 69 73 20 66 72 65 65 20 73 gatest is free s
00b0: 6f 66 74 77 61 72 65 3a 20 79 6f 75 20 63 61 6e oftware: you can
00c0: 20 72 65 64 69 73 74 72 69 62 75 74 65 20 69 74 redistribute it
00d0: 20 61 6e 64 2f 6f 72 20 6d 6f 64 69 66 79 0a 3b and/or modify.;
00e0: 3b 20 20 20 20 20 69 74 20 75 6e 64 65 72 20 74 ; it under t
00f0: 68 65 20 74 65 72 6d 73 20 6f 66 20 74 68 65 20 he terms of the
0100: 47 4e 55 20 47 65 6e 65 72 61 6c 20 50 75 62 6c GNU General Publ
0110: 69 63 20 4c 69 63 65 6e 73 65 20 61 73 20 70 75 ic License as pu
0120: 62 6c 69 73 68 65 64 20 62 79 0a 3b 3b 20 20 20 blished by.;;
0130: 20 20 74 68 65 20 46 72 65 65 20 53 6f 66 74 77 the Free Softw
0140: 61 72 65 20 46 6f 75 6e 64 61 74 69 6f 6e 2c 20 are Foundation,
0150: 65 69 74 68 65 72 20 76 65 72 73 69 6f 6e 20 33 either version 3
0160: 20 6f 66 20 74 68 65 20 4c 69 63 65 6e 73 65 2c of the License,
0170: 20 6f 72 0a 3b 3b 20 20 20 20 20 28 61 74 20 79 or.;; (at y
0180: 6f 75 72 20 6f 70 74 69 6f 6e 29 20 61 6e 79 20 our option) any
0190: 6c 61 74 65 72 20 76 65 72 73 69 6f 6e 2e 0a 3b later version..;
01a0: 3b 20 0a 3b 3b 20 20 20 20 20 4d 65 67 61 74 65 ; .;; Megate
01b0: 73 74 20 69 73 20 64 69 73 74 72 69 62 75 74 65 st is distribute
01c0: 64 20 69 6e 20 74 68 65 20 68 6f 70 65 20 74 68 d in the hope th
01d0: 61 74 20 69 74 20 77 69 6c 6c 20 62 65 20 75 73 at it will be us
01e0: 65 66 75 6c 2c 0a 3b 3b 20 20 20 20 20 62 75 74 eful,.;; but
01f0: 20 57 49 54 48 4f 55 54 20 41 4e 59 20 57 41 52 WITHOUT ANY WAR
0200: 52 41 4e 54 59 3b 20 77 69 74 68 6f 75 74 20 65 RANTY; without e
0210: 76 65 6e 20 74 68 65 20 69 6d 70 6c 69 65 64 20 ven the implied
0220: 77 61 72 72 61 6e 74 79 20 6f 66 0a 3b 3b 20 20 warranty of.;;
0230: 20 20 20 4d 45 52 43 48 41 4e 54 41 42 49 4c 49 MERCHANTABILI
0240: 54 59 20 6f 72 20 46 49 54 4e 45 53 53 20 46 4f TY or FITNESS FO
0250: 52 20 41 20 50 41 52 54 49 43 55 4c 41 52 20 50 R A PARTICULAR P
0260: 55 52 50 4f 53 45 2e 20 20 53 65 65 20 74 68 65 URPOSE. See the
0270: 0a 3b 3b 20 20 20 20 20 47 4e 55 20 47 65 6e 65 .;; GNU Gene
0280: 72 61 6c 20 50 75 62 6c 69 63 20 4c 69 63 65 6e ral Public Licen
0290: 73 65 20 66 6f 72 20 6d 6f 72 65 20 64 65 74 61 se for more deta
02a0: 69 6c 73 2e 0a 3b 3b 20 0a 3b 3b 20 20 20 20 20 ils..;; .;;
02b0: 59 6f 75 20 73 68 6f 75 6c 64 20 68 61 76 65 20 You should have
02c0: 72 65 63 65 69 76 65 64 20 61 20 63 6f 70 79 20 received a copy
02d0: 6f 66 20 74 68 65 20 47 4e 55 20 47 65 6e 65 72 of the GNU Gener
02e0: 61 6c 20 50 75 62 6c 69 63 20 4c 69 63 65 6e 73 al Public Licens
02f0: 65 0a 3b 3b 20 20 20 20 20 61 6c 6f 6e 67 20 77 e.;; along w
0300: 69 74 68 20 4d 65 67 61 74 65 73 74 2e 20 20 49 ith Megatest. I
0310: 66 20 6e 6f 74 2c 20 73 65 65 20 3c 68 74 74 70 f not, see <http
0320: 3a 2f 2f 77 77 77 2e 67 6e 75 2e 6f 72 67 2f 6c ://www.gnu.org/l
0330: 69 63 65 6e 73 65 73 2f 3e 2e 0a 0a 3b 3b 3d 3d icenses/>...;;==
0340: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0350: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0360: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0370: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0380: 3d 3d 3d 3d 0a 0a 28 64 65 63 6c 61 72 65 20 28 ====..(declare (
0390: 75 6e 69 74 20 63 6f 6e 66 69 67 66 6d 6f 64 29 unit configfmod)
03a0: 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 ).(declare (uses
03b0: 20 6d 74 61 72 67 73 29 29 0a 28 64 65 63 6c 61 mtargs)).(decla
03c0: 72 65 20 28 75 73 65 73 20 64 65 62 75 67 70 72 re (uses debugpr
03d0: 69 6e 74 29 29 0a 28 64 65 63 6c 61 72 65 20 28 int)).(declare (
03e0: 75 73 65 73 20 6b 65 79 73 6d 6f 64 29 29 0a 0a uses keysmod))..
03f0: 28 6d 6f 64 75 6c 65 20 63 6f 6e 66 69 67 66 6d (module configfm
0400: 6f 64 0a 09 28 0a 09 20 63 6f 6d 6d 6f 6e 3a 67 od..(.. common:g
0410: 65 74 2d 66 69 65 6c 64 73 0a 09 20 63 6f 6d 6d et-fields.. comm
0420: 6f 6e 3a 6e 69 63 65 2d 70 61 74 68 0a 09 20 63 on:nice-path.. c
0430: 6f 6d 6d 6f 6e 3a 72 65 61 64 2d 6c 69 6e 6b 2d ommon:read-link-
0440: 66 0a 09 20 63 6f 6d 6d 6f 6e 3a 77 69 74 68 2d f.. common:with-
0450: 65 6e 76 2d 76 61 72 73 0a 09 20 63 6f 6e 66 69 env-vars.. confi
0460: 67 66 3a 63 6f 6e 66 69 67 2d 3e 69 6e 69 0a 09 gf:config->ini..
0470: 20 63 6f 6e 66 69 67 66 3a 61 6c 69 73 74 2d 3e configf:alist->
0480: 63 6f 6e 66 69 67 0a 09 20 63 6f 6e 66 69 67 66 config.. configf
0490: 3a 61 73 73 6f 63 2d 73 61 66 65 2d 61 64 64 0a :assoc-safe-add.
04a0: 09 20 63 6f 6e 66 69 67 66 3a 63 6f 6e 66 69 67 . configf:config
04b0: 2d 3e 61 6c 69 73 74 0a 09 20 63 6f 6e 66 69 67 ->alist.. config
04c0: 66 3a 66 69 6e 64 2d 61 6e 64 2d 72 65 61 64 2d f:find-and-read-
04d0: 63 6f 6e 66 69 67 0a 09 20 63 6f 6e 66 69 67 66 config.. configf
04e0: 3a 67 65 74 2d 73 65 63 74 69 6f 6e 0a 09 20 63 :get-section.. c
04f0: 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 0a 09 20 onfigf:lookup..
0500: 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 2d 6e configf:lookup-n
0510: 75 6d 62 65 72 0a 09 20 63 6f 6e 66 69 67 66 3a umber.. configf:
0520: 6d 61 70 2d 61 6c 6c 2d 68 69 65 72 2d 61 6c 69 map-all-hier-ali
0530: 73 74 0a 09 20 63 6f 6e 66 69 67 66 3a 72 65 61 st.. configf:rea
0540: 64 2d 61 6c 69 73 74 0a 09 20 63 6f 6e 66 69 67 d-alist.. config
0550: 66 3a 72 65 61 64 2d 63 6f 6e 66 69 67 0a 09 20 f:read-config..
0560: 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d 72 65 66 configf:read-ref
0570: 64 62 0a 09 20 63 6f 6e 66 69 67 66 3a 73 65 63 db.. configf:sec
0580: 74 69 6f 6e 2d 76 61 72 2d 73 65 74 21 0a 09 20 tion-var-set!..
0590: 63 6f 6e 66 69 67 66 3a 73 65 63 74 69 6f 6e 2d configf:section-
05a0: 76 61 72 73 0a 09 20 63 6f 6e 66 69 67 66 3a 73 vars.. configf:s
05b0: 65 74 2d 73 65 63 74 69 6f 6e 2d 76 61 72 0a 09 et-section-var..
05c0: 20 63 6f 6e 66 69 67 66 3a 76 61 72 2d 69 73 3f configf:var-is?
05d0: 0a 09 20 63 6f 6e 66 69 67 66 3a 77 72 69 74 65 .. configf:write
05e0: 2d 61 6c 69 73 74 0a 09 20 63 6f 6e 66 69 67 66 -alist.. configf
05f0: 3a 77 72 69 74 65 2d 63 6f 6e 66 69 67 0a 09 20 :write-config..
0600: 66 69 6e 64 2d 63 6f 6e 66 69 67 0a 09 20 67 65 find-config.. ge
0610: 74 65 6e 76 0a 09 20 6d 79 74 61 72 67 65 74 0a tenv.. mytarget.
0620: 09 20 6e 69 63 65 2d 70 61 74 68 0a 09 20 70 72 . nice-path.. pr
0630: 6f 63 65 73 73 3a 63 6d 64 2d 72 75 6e 2d 3e 6c ocess:cmd-run->l
0640: 69 73 74 0a 09 20 72 75 6e 63 6f 6e 66 69 67 3a ist.. runconfig:
0650: 72 65 61 64 0a 09 20 72 75 6e 63 6f 6e 66 69 67 read.. runconfig
0660: 73 2d 67 65 74 0a 09 20 73 61 66 65 2d 73 65 74 s-get.. safe-set
0670: 65 6e 76 0a 09 20 73 65 74 65 6e 76 0a 09 20 63 env.. setenv.. c
0680: 6f 6e 66 69 67 66 3a 65 76 61 6c 2d 73 74 72 69 onfigf:eval-stri
0690: 6e 67 2d 69 6e 2d 65 6e 76 69 72 6f 6e 6d 65 6e ng-in-environmen
06a0: 74 0a 09 29 0a 09 0a 28 69 6d 70 6f 72 74 20 73 t..)...(import s
06b0: 63 68 65 6d 65 0a 0a 09 62 69 67 2d 63 68 69 63 cheme...big-chic
06c0: 6b 65 6e 20 20 20 20 20 20 20 20 3b 3b 20 6d 6f ken ;; mo
06d0: 72 65 20 6f 66 20 61 20 72 65 6d 69 6e 64 65 72 re of a reminder
06e0: 20 74 68 61 6e 20 61 6e 79 74 68 69 6e 67 20 2e than anything .
06f0: 2e 2e 0a 09 63 68 69 63 6b 65 6e 2e 62 61 73 65 ....chicken.base
0700: 0a 09 63 68 69 63 6b 65 6e 2e 63 6f 6e 64 69 74 ..chicken.condit
0710: 69 6f 6e 0a 09 63 68 69 63 6b 65 6e 2e 66 69 6c ion..chicken.fil
0720: 65 0a 09 63 68 69 63 6b 65 6e 2e 69 6f 0a 09 63 e..chicken.io..c
0730: 68 69 63 6b 65 6e 2e 70 61 74 68 6e 61 6d 65 0a hicken.pathname.
0740: 09 63 68 69 63 6b 65 6e 2e 70 6f 72 74 0a 09 63 .chicken.port..c
0750: 68 69 63 6b 65 6e 2e 70 72 65 74 74 79 2d 70 72 hicken.pretty-pr
0760: 69 6e 74 0a 09 63 68 69 63 6b 65 6e 2e 70 72 6f int..chicken.pro
0770: 63 65 73 73 0a 09 63 68 69 63 6b 65 6e 2e 70 72 cess..chicken.pr
0780: 6f 63 65 73 73 2d 63 6f 6e 74 65 78 74 0a 09 63 ocess-context..c
0790: 68 69 63 6b 65 6e 2e 70 72 6f 63 65 73 73 2d 63 hicken.process-c
07a0: 6f 6e 74 65 78 74 2e 70 6f 73 69 78 0a 09 63 68 ontext.posix..ch
07b0: 69 63 6b 65 6e 2e 73 6f 72 74 0a 09 63 68 69 63 icken.sort..chic
07c0: 6b 65 6e 2e 73 74 72 69 6e 67 0a 09 63 68 69 63 ken.string..chic
07d0: 6b 65 6e 2e 74 69 6d 65 0a 09 63 68 69 63 6b 65 ken.time..chicke
07e0: 6e 2e 65 76 61 6c 0a 09 0a 09 64 65 62 75 67 70 n.eval....debugp
07f0: 72 69 6e 74 0a 09 28 70 72 65 66 69 78 20 6d 74 rint..(prefix mt
0800: 61 72 67 73 20 61 72 67 73 3a 29 0a 09 70 6b 74 args args:)..pkt
0810: 73 0a 09 6b 65 79 73 6d 6f 64 0a 0a 09 28 70 72 s..keysmod...(pr
0820: 65 66 69 78 20 62 61 73 65 36 34 20 62 61 73 65 efix base64 base
0830: 36 34 3a 29 0a 09 28 70 72 65 66 69 78 20 64 62 64:)..(prefix db
0840: 69 20 64 62 69 3a 29 0a 09 28 70 72 65 66 69 78 i dbi:)..(prefix
0850: 20 73 71 6c 69 74 65 33 20 73 71 6c 69 74 65 33 sqlite3 sqlite3
0860: 3a 29 0a 09 28 73 72 66 69 20 31 38 29 0a 09 64 :)..(srfi 18)..d
0870: 69 72 65 63 74 6f 72 79 2d 75 74 69 6c 73 0a 09 irectory-utils..
0880: 66 6f 72 6d 61 74 0a 09 6d 61 74 63 68 61 62 6c format..matchabl
0890: 65 0a 09 6d 64 35 0a 09 6d 65 73 73 61 67 65 2d e..md5..message-
08a0: 64 69 67 65 73 74 0a 09 72 65 67 65 78 0a 09 72 digest..regex..r
08b0: 65 67 65 78 2d 63 61 73 65 0a 09 73 70 61 72 73 egex-case..spars
08c0: 65 2d 76 65 63 74 6f 72 73 0a 09 73 72 66 69 2d e-vectors..srfi-
08d0: 31 0a 09 73 72 66 69 2d 31 33 0a 09 73 72 66 69 1..srfi-13..srfi
08e0: 2d 36 39 0a 09 73 74 61 63 6b 0a 09 74 79 70 65 -69..stack..type
08f0: 64 2d 72 65 63 6f 72 64 73 0a 09 7a 33 0a 09 0a d-records..z3...
0900: 09 29 0a 0a 28 64 65 66 69 6e 65 20 67 65 74 65 .)..(define gete
0910: 6e 76 20 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 nv get-environme
0920: 6e 74 2d 76 61 72 69 61 62 6c 65 29 0a 28 64 65 nt-variable).(de
0930: 66 69 6e 65 20 73 65 74 65 6e 76 20 73 65 74 2d fine setenv set-
0940: 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 environment-vari
0950: 61 62 6c 65 21 29 0a 28 64 65 66 69 6e 65 20 75 able!).(define u
0960: 6e 73 65 74 65 6e 76 20 75 6e 73 65 74 2d 65 6e nsetenv unset-en
0970: 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 vironment-variab
0980: 6c 65 21 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d le!)..;;========
0990: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
09a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
09b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
09c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
09d0: 3b 20 70 61 72 61 6d 65 74 65 72 73 0a 3b 3b 3d ; parameters.;;=
09e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
09f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0a00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0a10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0a20: 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 77 68 69 6c 65 20 =====..;; while
0a30: 74 61 72 67 65 74 73 20 61 72 65 20 4d 65 67 61 targets are Mega
0a40: 74 65 73 74 20 73 70 65 63 69 66 69 63 20 74 68 test specific th
0a50: 65 79 20 61 72 65 20 61 20 75 73 65 66 75 6c 20 ey are a useful
0a60: 63 6f 6e 63 65 70 74 0a 28 64 65 66 69 6e 65 20 concept.(define
0a70: 6d 79 74 61 72 67 65 74 20 28 6d 61 6b 65 2d 70 mytarget (make-p
0a80: 61 72 61 6d 65 74 65 72 20 23 66 29 29 0a 0a 3b arameter #f))..;
0a90: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
0aa0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0ab0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0ac0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0ad0: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 6d 6f 76 65 20 =======.;; move
0ae0: 64 65 62 75 67 20 73 74 75 66 66 20 74 6f 20 73 debug stuff to s
0af0: 65 70 61 72 61 74 65 20 6d 6f 64 75 6c 65 20 74 eparate module t
0b00: 68 65 6e 20 70 75 74 20 74 68 65 73 65 20 62 61 hen put these ba
0b10: 63 6b 20 77 68 65 72 65 20 74 68 65 79 20 62 65 ck where they be
0b20: 6c 6f 6e 67 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d long.;;=========
0b30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0b40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0b50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0b60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
0b70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0b80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0b90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0ba0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0bb0: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 6c 6f 6f 6b 75 70 ======.;; lookup
0bc0: 20 72 6f 75 74 69 6e 65 73 20 2d 20 72 65 70 6c routines - repl
0bd0: 69 63 61 74 65 64 20 66 72 6f 6d 20 63 6f 6e 66 icated from conf
0be0: 69 67 66 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d igf.;;==========
0bf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0c00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0c10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0c20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 ============..(d
0c30: 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a 6c efine (configf:l
0c40: 6f 6f 6b 75 70 20 63 66 67 64 61 74 20 73 65 63 ookup cfgdat sec
0c50: 74 69 6f 6e 20 76 61 72 29 0a 20 20 28 69 66 20 tion var). (if
0c60: 28 68 61 73 68 2d 74 61 62 6c 65 3f 20 63 66 67 (hash-table? cfg
0c70: 64 61 74 29 0a 20 20 20 20 20 20 28 6c 65 74 20 dat). (let
0c80: 28 28 73 65 63 74 64 61 74 20 28 68 61 73 68 2d ((sectdat (hash-
0c90: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
0ca0: 74 20 63 66 67 64 61 74 20 73 65 63 74 69 6f 6e t cfgdat section
0cb0: 20 27 28 29 29 29 29 0a 09 28 69 66 20 28 6e 75 '())))..(if (nu
0cc0: 6c 6c 3f 20 73 65 63 74 64 61 74 29 0a 09 20 20 ll? sectdat)..
0cd0: 20 20 23 66 0a 09 20 20 20 20 28 6c 65 74 20 28 #f.. (let (
0ce0: 28 72 65 73 20 28 61 73 73 6f 63 20 76 61 72 20 (res (assoc var
0cf0: 73 65 63 74 64 61 74 29 29 29 0a 09 20 20 20 20 sectdat)))..
0d00: 20 20 28 69 66 20 72 65 73 20 3b 3b 20 28 61 6e (if res ;; (an
0d10: 64 20 6d 61 74 63 68 20 28 6c 69 73 74 3f 20 6d d match (list? m
0d20: 61 74 63 68 29 28 3e 20 28 6c 65 6e 67 74 68 20 atch)(> (length
0d30: 6d 61 74 63 68 29 20 31 29 29 0a 09 09 20 20 28 match) 1))... (
0d40: 63 61 64 72 20 72 65 73 29 0a 09 09 20 20 23 66 cadr res)... #f
0d50: 29 29 0a 09 20 20 20 20 29 29 0a 20 20 20 20 20 )).. )).
0d60: 20 23 66 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 #f))..(define (
0d70: 63 6f 6e 66 69 67 66 3a 61 73 73 6f 63 2d 73 61 configf:assoc-sa
0d80: 66 65 2d 61 64 64 20 61 6c 69 73 74 20 6b 65 79 fe-add alist key
0d90: 20 76 61 6c 20 23 21 6b 65 79 20 28 6d 65 74 61 val #!key (meta
0da0: 64 61 74 61 20 23 66 29 29 0a 20 20 28 6c 65 74 data #f)). (let
0db0: 20 28 28 6e 65 77 61 6c 69 73 74 20 28 66 69 6c ((newalist (fil
0dc0: 74 65 72 20 28 6c 61 6d 62 64 61 20 28 78 29 28 ter (lambda (x)(
0dd0: 6e 6f 74 20 28 65 71 75 61 6c 3f 20 6b 65 79 20 not (equal? key
0de0: 28 63 61 72 20 78 29 29 29 29 20 61 6c 69 73 74 (car x)))) alist
0df0: 29 29 29 0a 20 20 20 20 28 61 70 70 65 6e 64 20 ))). (append
0e00: 6e 65 77 61 6c 69 73 74 20 28 6c 69 73 74 20 28 newalist (list (
0e10: 69 66 20 6d 65 74 61 64 61 74 61 0a 09 09 09 20 if metadata....
0e20: 20 20 20 20 20 20 28 6c 69 73 74 20 6b 65 79 20 (list key
0e30: 76 61 6c 20 6d 65 74 61 64 61 74 61 29 0a 09 09 val metadata)...
0e40: 09 20 20 20 20 20 20 20 28 6c 69 73 74 20 6b 65 . (list ke
0e50: 79 20 76 61 6c 29 29 29 29 29 29 0a 0a 28 64 65 y val))))))..(de
0e60: 66 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a 73 65 fine (configf:se
0e70: 63 74 69 6f 6e 2d 76 61 72 2d 73 65 74 21 20 63 ction-var-set! c
0e80: 66 67 64 61 74 20 73 65 63 74 69 6f 6e 2d 6e 61 fgdat section-na
0e90: 6d 65 20 76 61 72 20 76 61 6c 75 65 20 23 21 6b me var value #!k
0ea0: 65 79 20 28 6d 65 74 61 64 61 74 61 20 23 66 29 ey (metadata #f)
0eb0: 29 0a 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d ). (hash-table-
0ec0: 73 65 74 21 20 63 66 67 64 61 74 20 73 65 63 74 set! cfgdat sect
0ed0: 69 6f 6e 2d 6e 61 6d 65 0a 09 09 20 20 20 28 63 ion-name... (c
0ee0: 6f 6e 66 69 67 66 3a 61 73 73 6f 63 2d 73 61 66 onfigf:assoc-saf
0ef0: 65 2d 61 64 64 0a 09 09 20 20 20 20 28 68 61 73 e-add... (has
0f00: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
0f10: 75 6c 74 20 63 66 67 64 61 74 20 73 65 63 74 69 ult cfgdat secti
0f20: 6f 6e 2d 6e 61 6d 65 20 27 28 29 29 0a 09 09 20 on-name '())...
0f30: 20 20 20 76 61 72 20 76 61 6c 75 65 20 6d 65 74 var value met
0f40: 61 64 61 74 61 3a 20 6d 65 74 61 64 61 74 61 29 adata: metadata)
0f50: 29 29 0a 0a 3b 3b 20 75 73 65 20 74 6f 20 68 61 ))..;; use to ha
0f60: 76 65 20 64 65 66 69 6e 69 74 69 76 65 20 73 65 ve definitive se
0f70: 74 74 69 6e 67 3a 0a 3b 3b 20 20 5b 66 6f 6f 5d tting:.;; [foo]
0f80: 0a 3b 3b 20 20 76 61 72 20 79 65 73 0a 3b 3b 0a .;; var yes.;;.
0f90: 3b 3b 20 20 28 63 6f 6e 66 69 67 66 3a 76 61 72 ;; (configf:var
0fa0: 2d 69 73 3f 20 63 66 67 64 61 74 20 22 66 6f 6f -is? cfgdat "foo
0fb0: 22 20 22 76 61 72 22 20 22 79 65 73 22 29 20 3d " "var" "yes") =
0fc0: 3e 20 23 74 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 > #t.;;.(define
0fd0: 28 63 6f 6e 66 69 67 66 3a 76 61 72 2d 69 73 3f (configf:var-is?
0fe0: 20 63 66 67 64 61 74 20 73 65 63 74 69 6f 6e 20 cfgdat section
0ff0: 76 61 72 20 65 78 70 65 63 74 65 64 2d 76 61 6c var expected-val
1000: 29 0a 20 20 28 65 71 75 61 6c 3f 20 28 63 6f 6e ). (equal? (con
1010: 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 63 66 67 64 figf:lookup cfgd
1020: 61 74 20 73 65 63 74 69 6f 6e 20 76 61 72 29 20 at section var)
1030: 65 78 70 65 63 74 65 64 2d 76 61 6c 29 29 0a 0a expected-val))..
1040: 3b 3b 20 72 65 64 65 66 69 6e 65 73 0a 28 64 65 ;; redefines.(de
1050: 66 69 6e 65 20 63 6f 6e 66 69 67 2d 6c 6f 6f 6b fine config-look
1060: 75 70 20 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 up configf:looku
1070: 70 29 0a 3b 3b 20 28 64 65 66 69 6e 65 20 63 6f p).;; (define co
1080: 6e 66 69 67 66 3a 72 65 61 64 2d 66 69 6c 65 20 nfigf:read-file
1090: 72 65 61 64 2d 63 6f 6e 66 69 67 29 0a 0a 3b 3b read-config)..;;
10a0: 20 73 61 66 65 6c 79 20 6c 6f 6f 6b 20 75 70 20 safely look up
10b0: 61 20 76 61 6c 75 65 20 74 68 61 74 20 69 73 20 a value that is
10c0: 65 78 70 65 63 74 65 64 20 74 6f 20 62 65 20 61 expected to be a
10d0: 20 6e 75 6d 62 65 72 2c 20 72 65 74 75 72 6e 0a number, return.
10e0: 3b 3b 20 61 20 64 65 66 61 75 6c 74 20 28 23 66 ;; a default (#f
10f0: 20 75 6e 6c 65 73 73 20 70 72 6f 76 69 64 65 64 unless provided
1100: 29 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 63 6f ).;;.(define (co
1110: 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 2d 6e 75 6d nfigf:lookup-num
1120: 62 65 72 20 63 66 64 61 74 20 73 65 63 74 69 6f ber cfdat sectio
1130: 6e 20 76 61 72 6e 61 6d 65 20 23 21 6b 65 79 20 n varname #!key
1140: 28 64 65 66 61 75 6c 74 20 23 66 29 29 0a 20 20 (default #f)).
1150: 28 6c 65 74 2a 20 28 28 76 61 6c 20 28 63 6f 6e (let* ((val (con
1160: 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 63 66 64 61 figf:lookup cfda
1170: 74 20 73 65 63 74 69 6f 6e 20 76 61 72 6e 61 6d t section varnam
1180: 65 29 29 0a 20 20 20 20 20 20 20 20 20 28 72 65 e)). (re
1190: 73 20 28 69 66 20 76 61 6c 0a 20 20 20 20 20 20 s (if val.
11a0: 20 20 20 20 20 20 20 20 20 20 20 20 28 73 74 72 (str
11b0: 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 73 74 72 ing->number (str
11c0: 69 6e 67 2d 73 75 62 73 74 69 74 75 74 65 20 22 ing-substitute "
11d0: 5c 5c 73 2b 22 20 22 22 20 76 61 6c 20 23 74 29 \\s+" "" val #t)
11e0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
11f0: 20 20 20 20 23 66 29 29 29 0a 20 20 20 20 28 63 #f))). (c
1200: 6f 6e 64 0a 20 20 20 20 20 28 72 65 73 20 20 72 ond. (res r
1210: 65 73 29 0a 20 20 20 20 20 28 76 61 6c 20 20 28 es). (val (
1220: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
1230: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
1240: 20 22 45 52 52 4f 52 3a 20 6e 6f 20 6e 75 6d 62 "ERROR: no numb
1250: 65 72 20 66 6f 75 6e 64 20 66 6f 72 20 5b 22 20 er found for ["
1260: 73 65 63 74 69 6f 6e 20 22 5d 2c 20 22 20 76 61 section "], " va
1270: 72 6e 61 6d 65 20 22 2c 20 67 6f 74 3a 20 22 20 rname ", got: "
1280: 76 61 6c 29 29 0a 20 20 20 20 20 28 65 6c 73 65 val)). (else
1290: 20 64 65 66 61 75 6c 74 29 29 29 29 0a 0a 28 64 default))))..(d
12a0: 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a 73 efine (configf:s
12b0: 65 63 74 69 6f 6e 2d 76 61 72 73 20 63 66 67 64 ection-vars cfgd
12c0: 61 74 20 73 65 63 74 69 6f 6e 29 0a 20 20 28 6c at section). (l
12d0: 65 74 20 28 28 73 65 63 74 64 61 74 20 28 68 61 et ((sectdat (ha
12e0: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def
12f0: 61 75 6c 74 20 63 66 67 64 61 74 20 73 65 63 74 ault cfgdat sect
1300: 69 6f 6e 20 27 28 29 29 29 29 0a 20 20 20 20 28 ion '()))). (
1310: 69 66 20 28 6e 75 6c 6c 3f 20 73 65 63 74 64 61 if (null? sectda
1320: 74 29 0a 09 27 28 29 0a 09 28 6d 61 70 20 63 61 t)..'()..(map ca
1330: 72 20 73 65 63 74 64 61 74 29 29 29 29 0a 0a 28 r sectdat))))..(
1340: 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a define (configf:
1350: 67 65 74 2d 73 65 63 74 69 6f 6e 20 63 66 67 64 get-section cfgd
1360: 61 74 20 73 65 63 74 69 6f 6e 29 0a 20 20 28 68 at section). (h
1370: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
1380: 66 61 75 6c 74 20 63 66 67 64 61 74 20 73 65 63 fault cfgdat sec
1390: 74 69 6f 6e 20 27 28 29 29 29 0a 0a 28 64 65 66 tion '()))..(def
13a0: 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a 73 65 74 ine (configf:set
13b0: 2d 73 65 63 74 69 6f 6e 2d 76 61 72 20 63 66 67 -section-var cfg
13c0: 64 61 74 20 73 65 63 74 69 6f 6e 20 76 61 72 20 dat section var
13d0: 76 61 6c 29 0a 20 20 28 6c 65 74 20 28 28 73 65 val). (let ((se
13e0: 63 74 64 61 74 20 28 63 6f 6e 66 69 67 66 3a 67 ctdat (configf:g
13f0: 65 74 2d 73 65 63 74 69 6f 6e 20 63 66 67 64 61 et-section cfgda
1400: 74 20 73 65 63 74 69 6f 6e 29 29 29 0a 20 20 20 t section))).
1410: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 (hash-table-set
1420: 21 20 63 66 67 64 61 74 20 73 65 63 74 69 6f 6e ! cfgdat section
1430: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1440: 20 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 61 (configf:a
1450: 73 73 6f 63 2d 73 61 66 65 2d 61 64 64 20 73 65 ssoc-safe-add se
1460: 63 74 64 61 74 20 76 61 72 20 76 61 6c 29 29 29 ctdat var val)))
1470: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
1480: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1490: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 74 68 65 20 65 ===========the e
14c0: 6e 64 0a 0a 3b 3b 20 72 65 74 75 72 6e 20 6c 69 nd..;; return li
14d0: 73 74 20 28 70 61 74 68 20 66 75 6c 6c 70 61 74 st (path fullpat
14e0: 68 20 63 6f 6e 66 69 67 6e 61 6d 65 29 0a 28 64 h configname).(d
14f0: 65 66 69 6e 65 20 28 66 69 6e 64 2d 63 6f 6e 66 efine (find-conf
1500: 69 67 20 63 6f 6e 66 69 67 6e 61 6d 65 20 23 21 ig configname #!
1510: 6b 65 79 20 28 74 6f 70 70 61 74 68 20 23 66 29 key (toppath #f)
1520: 29 0a 20 20 28 69 66 20 74 6f 70 70 61 74 68 0a ). (if toppath.
1530: 20 20 20 20 20 20 28 6c 65 74 20 28 28 63 66 6e (let ((cfn
1540: 61 6d 65 20 28 63 6f 6e 63 20 74 6f 70 70 61 74 ame (conc toppat
1550: 68 20 22 2f 22 20 63 6f 6e 66 69 67 6e 61 6d 65 h "/" configname
1560: 29 29 29 0a 09 28 69 66 20 28 66 69 6c 65 2d 65 )))..(if (file-e
1570: 78 69 73 74 73 3f 20 63 66 6e 61 6d 65 29 0a 09 xists? cfname)..
1580: 20 20 20 20 28 6c 69 73 74 20 74 6f 70 70 61 74 (list toppat
1590: 68 20 63 66 6e 61 6d 65 20 63 6f 6e 66 69 67 6e h cfname confign
15a0: 61 6d 65 29 0a 09 20 20 20 20 28 6c 69 73 74 20 ame).. (list
15b0: 23 66 20 20 20 20 20 20 23 66 20 20 20 20 20 23 #f #f #
15c0: 66 29 29 29 0a 20 20 20 20 20 20 28 6c 65 74 2a f))). (let*
15d0: 20 28 28 63 77 64 20 28 73 74 72 69 6e 67 2d 73 ((cwd (string-s
15e0: 70 6c 69 74 20 28 63 75 72 72 65 6e 74 2d 64 69 plit (current-di
15f0: 72 65 63 74 6f 72 79 29 20 22 2f 22 29 29 29 0a rectory) "/"))).
1600: 09 28 6c 65 74 20 6c 6f 6f 70 20 28 28 64 69 72 .(let loop ((dir
1610: 20 63 77 64 29 29 0a 09 20 20 28 6c 65 74 2a 20 cwd)).. (let*
1620: 28 28 70 61 74 68 20 20 20 20 20 28 63 6f 6e 63 ((path (conc
1630: 20 22 2f 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 "/" (string-int
1640: 65 72 73 70 65 72 73 65 20 64 69 72 20 22 2f 22 ersperse dir "/"
1650: 29 29 29 0a 09 09 20 28 66 75 6c 6c 70 61 74 68 )))... (fullpath
1660: 20 28 63 6f 6e 63 20 70 61 74 68 20 22 2f 22 20 (conc path "/"
1670: 63 6f 6e 66 69 67 6e 61 6d 65 29 29 29 0a 09 20 configname)))..
1680: 20 20 20 28 69 66 20 28 66 69 6c 65 2d 65 78 69 (if (file-exi
1690: 73 74 73 3f 20 66 75 6c 6c 70 61 74 68 29 0a 09 sts? fullpath)..
16a0: 09 28 6c 69 73 74 20 70 61 74 68 20 66 75 6c 6c .(list path full
16b0: 70 61 74 68 20 63 6f 6e 66 69 67 6e 61 6d 65 29 path configname)
16c0: 0a 09 09 28 6c 65 74 20 28 28 72 65 6d 63 77 64 ...(let ((remcwd
16d0: 20 28 74 61 6b 65 20 64 69 72 20 28 2d 20 28 6c (take dir (- (l
16e0: 65 6e 67 74 68 20 64 69 72 29 20 31 29 29 29 29 ength dir) 1))))
16f0: 0a 09 09 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 ... (if (null?
1700: 72 65 6d 63 77 64 29 0a 09 09 20 20 20 20 20 20 remcwd)...
1710: 28 6c 69 73 74 20 23 66 20 23 66 20 23 66 29 20 (list #f #f #f)
1720: 3b 3b 20 20 23 66 20 23 66 29 20 0a 09 09 20 20 ;; #f #f) ...
1730: 28 6c 6f 6f 70 20 72 65 6d 63 77 64 29 29 29 29 (loop remcwd))))
1740: 29 29 29 29 29 0a 0a 3b 3b 20 53 4f 4d 45 54 48 )))))..;; SOMETH
1750: 49 4e 47 20 57 52 4f 4e 47 20 48 45 52 45 20 2d ING WRONG HERE -
1760: 2d 20 42 55 47 21 0a 3b 3b 0a 28 64 65 66 69 6e - BUG!.;;.(defin
1770: 65 20 28 63 6f 6e 66 69 67 66 3a 65 76 61 6c 2d e (configf:eval-
1780: 73 74 72 69 6e 67 2d 69 6e 2d 65 6e 76 69 72 6f string-in-enviro
1790: 6e 6d 65 6e 74 20 73 74 72 29 0a 20 20 3b 3b 20 nment str). ;;
17a0: 28 69 66 20 28 6f 72 20 28 73 74 72 69 6e 67 2d (if (or (string-
17b0: 6e 75 6c 6c 3f 20 73 74 72 29 0a 20 20 3b 3b 09 null? str). ;;.
17c0: 20 20 28 65 71 75 61 6c 3f 20 22 21 22 20 28 73 (equal? "!" (s
17d0: 75 62 73 74 72 69 6e 67 20 73 74 72 20 30 20 31 ubstring str 0 1
17e0: 29 29 29 20 3b 3b 20 6e 75 6c 6c 20 73 74 72 69 ))) ;; null stri
17f0: 6e 67 20 6f 72 20 73 74 61 72 74 73 20 77 69 74 ng or starts wit
1800: 68 20 21 20 61 72 65 20 70 72 65 73 65 72 76 65 h ! are preserve
1810: 64 20 62 75 74 20 4e 4f 54 20 73 65 74 20 69 6e d but NOT set in
1820: 20 74 68 65 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 the environment
1830: 0a 20 20 20 20 20 20 73 74 72 0a 20 20 20 20 20 . str.
1840: 20 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 (handle-excepti
1850: 6f 6e 73 0a 20 20 20 20 20 20 20 65 78 6e 0a 20 ons. exn.
1860: 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 20 28 (begin.. (
1870: 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f debug:print-erro
1880: 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 r 0 *default-log
1890: 2d 70 6f 72 74 2a 20 22 70 72 6f 62 6c 65 6d 20 -port* "problem
18a0: 65 76 61 6c 75 61 74 69 6e 67 20 5c 22 22 20 73 evaluating \"" s
18b0: 74 72 20 22 5c 22 20 69 6e 20 74 68 65 20 73 68 tr "\" in the sh
18c0: 65 6c 6c 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 2c ell environment,
18d0: 20 65 78 6e 3d 22 20 65 78 6e 29 0a 09 20 23 66 exn=" exn).. #f
18e0: 29 0a 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 ). (let ((
18f0: 63 6d 64 72 65 73 20 28 70 72 6f 63 65 73 73 3a cmdres (process:
1900: 63 6d 64 2d 72 75 6e 2d 3e 6c 69 73 74 20 28 63 cmd-run->list (c
1910: 6f 6e 63 20 22 65 63 68 6f 20 22 20 73 74 72 29 onc "echo " str)
1920: 29 29 29 0a 09 20 28 69 66 20 28 6e 75 6c 6c 3f ))).. (if (null?
1930: 20 63 6d 64 72 65 73 29 20 22 22 0a 09 20 20 20 cmdres) ""..
1940: 20 20 28 63 61 61 72 20 63 6d 64 72 65 73 29 29 (caar cmdres))
1950: 29 29 29 20 3b 3b 20 29 0a 0a 3b 3b 3d 3d 3d 3d ))) ;; )..;;====
1960: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1970: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1980: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1990: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
19a0: 3d 3d 0a 3b 3b 20 4d 61 6b 65 20 74 68 65 20 72 ==.;; Make the r
19b0: 65 67 65 78 70 27 73 20 6e 65 65 64 65 64 20 67 egexp's needed g
19c0: 6c 6f 62 61 6c 6c 79 20 61 76 61 69 6c 61 62 6c lobally availabl
19d0: 65 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d e.;;============
19e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
19f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1a00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1a10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 ==========..(def
1a20: 69 6e 65 20 63 6f 6e 66 69 67 66 3a 69 6e 63 6c ine configf:incl
1a30: 75 64 65 2d 72 78 20 28 72 65 67 65 78 70 20 22 ude-rx (regexp "
1a40: 5e 5c 5c 5b 69 6e 63 6c 75 64 65 5c 5c 73 2b 28 ^\\[include\\s+(
1a50: 2e 2a 29 5c 5c 5d 5c 5c 73 2a 24 22 29 29 0a 28 .*)\\]\\s*$")).(
1a60: 64 65 66 69 6e 65 20 63 6f 6e 66 69 67 66 3a 73 define configf:s
1a70: 63 72 69 70 74 2d 72 78 20 20 28 72 65 67 65 78 cript-rx (regex
1a80: 70 20 22 5e 5c 5c 5b 73 63 72 69 70 74 69 6e 63 p "^\\[scriptinc
1a90: 5c 5c 73 2b 28 5c 5c 53 2b 29 28 5b 5e 5c 5c 5d \\s+(\\S+)([^\\]
1aa0: 5d 2a 29 5c 5c 5d 5c 5c 73 2a 24 22 29 29 20 3b ]*)\\]\\s*$")) ;
1ab0: 3b 20 69 6e 63 6c 75 64 65 20 6f 75 74 70 75 74 ; include output
1ac0: 20 66 72 6f 6d 20 61 20 73 63 72 69 70 74 0a 28 from a script.(
1ad0: 64 65 66 69 6e 65 20 63 6f 6e 66 69 67 66 3a 73 define configf:s
1ae0: 65 63 74 69 6f 6e 2d 72 78 20 28 72 65 67 65 78 ection-rx (regex
1af0: 70 20 22 5e 5c 5c 5b 28 2e 2a 29 5c 5c 5d 5c 5c p "^\\[(.*)\\]\\
1b00: 73 2a 24 22 29 29 0a 28 64 65 66 69 6e 65 20 63 s*$")).(define c
1b10: 6f 6e 66 69 67 66 3a 62 6c 61 6e 6b 2d 6c 2d 72 onfigf:blank-l-r
1b20: 78 20 28 72 65 67 65 78 70 20 22 5e 5c 5c 73 2a x (regexp "^\\s*
1b30: 24 22 29 29 0a 28 64 65 66 69 6e 65 20 63 6f 6e $")).(define con
1b40: 66 69 67 66 3a 6b 65 79 2d 73 79 73 2d 70 72 20 figf:key-sys-pr
1b50: 28 72 65 67 65 78 70 20 22 5e 28 5c 5c 53 2b 29 (regexp "^(\\S+)
1b60: 5c 5c 73 2b 5c 5c 5b 73 79 73 74 65 6d 5c 5c 73 \\s+\\[system\\s
1b70: 2b 28 5c 5c 53 2b 2e 2a 29 5c 5c 5d 5c 5c 73 2a +(\\S+.*)\\]\\s*
1b80: 24 22 29 29 0a 28 64 65 66 69 6e 65 20 63 6f 6e $")).(define con
1b90: 66 69 67 66 3a 6b 65 79 2d 76 61 6c 2d 70 72 20 figf:key-val-pr
1ba0: 28 72 65 67 65 78 70 20 22 5e 28 5c 5c 53 2b 29 (regexp "^(\\S+)
1bb0: 28 5c 5c 73 2b 28 2e 2a 29 7c 28 29 29 24 22 29 (\\s+(.*)|())$")
1bc0: 29 0a 28 64 65 66 69 6e 65 20 63 6f 6e 66 69 67 ).(define config
1bd0: 66 3a 6b 65 79 2d 6e 6f 2d 76 61 6c 20 28 72 65 f:key-no-val (re
1be0: 67 65 78 70 20 22 5e 28 5c 5c 53 2b 29 28 5c 5c gexp "^(\\S+)(\\
1bf0: 73 2a 29 24 22 29 29 0a 28 64 65 66 69 6e 65 20 s*)$")).(define
1c00: 63 6f 6e 66 69 67 66 3a 63 6f 6d 6d 65 6e 74 2d configf:comment-
1c10: 72 78 20 28 72 65 67 65 78 70 20 22 5e 5c 5c 73 rx (regexp "^\\s
1c20: 2a 23 2e 2a 22 29 29 0a 28 64 65 66 69 6e 65 20 *#.*")).(define
1c30: 63 6f 6e 66 69 67 66 3a 63 6f 6e 74 2d 6c 6e 2d configf:cont-ln-
1c40: 72 78 20 28 72 65 67 65 78 70 20 22 5e 28 5c 5c rx (regexp "^(\\
1c50: 73 2b 29 28 5c 5c 53 2b 2e 2a 29 24 22 29 29 0a s+)(\\S+.*)$")).
1c60: 28 64 65 66 69 6e 65 20 63 6f 6e 66 69 67 66 3a (define configf:
1c70: 73 65 74 74 69 6e 67 73 20 20 20 28 72 65 67 65 settings (rege
1c80: 78 70 20 22 5e 5c 5c 5b 63 6f 6e 66 69 67 66 3a xp "^\\[configf:
1c90: 73 65 74 74 69 6e 67 73 5c 5c 73 2b 28 5c 5c 53 settings\\s+(\\S
1ca0: 2b 29 5c 5c 73 2b 28 5c 5c 53 2b 29 5d 5c 5c 73 +)\\s+(\\S+)]\\s
1cb0: 2a 24 22 29 29 0a 0a 3b 3b 20 72 65 61 64 20 61 *$"))..;; read a
1cc0: 20 6c 69 6e 65 20 61 6e 64 20 70 72 6f 63 65 73 line and proces
1cd0: 73 20 61 6e 79 20 23 7b 20 2e 2e 2e 20 7d 20 63 s any #{ ... } c
1ce0: 6f 6e 73 74 72 75 63 74 73 0a 0a 28 64 65 66 69 onstructs..(defi
1cf0: 6e 65 20 63 6f 6e 66 69 67 66 3a 76 61 72 2d 65 ne configf:var-e
1d00: 78 70 61 6e 64 2d 72 65 67 65 78 20 28 72 65 67 xpand-regex (reg
1d10: 65 78 70 20 22 5e 28 2e 2a 29 23 5c 5c 7b 28 73 exp "^(.*)#\\{(s
1d20: 63 68 65 6d 65 7c 73 79 73 74 65 6d 7c 73 68 65 cheme|system|she
1d30: 6c 6c 7c 67 65 74 65 6e 76 7c 67 65 74 7c 72 75 ll|getenv|get|ru
1d40: 6e 63 6f 6e 66 69 67 73 2d 67 65 74 7c 72 67 65 nconfigs-get|rge
1d50: 74 7c 73 63 6d 7c 73 68 7c 72 70 7c 67 76 7c 67 t|scm|sh|rp|gv|g
1d60: 7c 6d 74 72 61 68 29 5c 5c 73 2b 28 5b 5e 5c 5c |mtrah)\\s+([^\\
1d70: 7d 5c 5c 7b 5d 2a 29 5c 5c 7d 28 2e 2a 29 22 29 }\\{]*)\\}(.*)")
1d80: 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 )..(define (conf
1d90: 69 67 66 3a 73 79 73 74 65 6d 20 68 74 20 63 6d igf:system ht cm
1da0: 64 29 0a 20 20 28 73 79 73 74 65 6d 20 63 6d 64 d). (system cmd
1db0: 29 0a 20 20 29 0a 0a 3b 3b 20 52 75 6e 20 61 20 ). )..;; Run a
1dc0: 73 68 65 6c 6c 20 63 6f 6d 6d 61 6e 64 20 61 6e shell command an
1dd0: 64 20 72 65 74 75 72 6e 20 74 68 65 20 6f 75 74 d return the out
1de0: 70 75 74 20 61 73 20 61 20 73 74 72 69 6e 67 0a put as a string.
1df0: 28 64 65 66 69 6e 65 20 28 73 68 65 6c 6c 20 63 (define (shell c
1e00: 6d 64 29 0a 20 20 28 6c 65 74 2a 20 28 28 6f 75 md). (let* ((ou
1e10: 74 70 75 74 20 28 70 72 6f 63 65 73 73 3a 63 6d tput (process:cm
1e20: 64 2d 72 75 6e 2d 3e 6c 69 73 74 20 63 6d 64 29 d-run->list cmd)
1e30: 29 0a 09 20 28 72 65 73 20 20 20 20 28 63 61 72 ).. (res (car
1e40: 20 6f 75 74 70 75 74 29 29 0a 09 20 28 73 74 61 output)).. (sta
1e50: 74 75 73 20 28 63 61 64 72 20 6f 75 74 70 75 74 tus (cadr output
1e60: 29 29 29 0a 20 20 20 20 28 69 66 20 28 65 71 75 ))). (if (equ
1e70: 61 6c 3f 20 73 74 61 74 75 73 20 30 29 0a 09 28 al? status 0)..(
1e80: 6c 65 74 20 28 28 6f 75 74 72 65 73 20 28 73 74 let ((outres (st
1e90: 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 ring-intersperse
1ea0: 20 0a 09 09 20 20 20 20 20 20 20 72 65 73 0a 09 ... res..
1eb0: 09 20 20 20 20 20 20 20 22 5c 6e 22 29 29 29 0a . "\n"))).
1ec0: 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d . (debug:print-
1ed0: 69 6e 66 6f 20 34 20 2a 64 65 66 61 75 6c 74 2d info 4 *default-
1ee0: 6c 6f 67 2d 70 6f 72 74 2a 20 22 73 68 65 6c 6c log-port* "shell
1ef0: 20 72 65 73 75 6c 74 3a 5c 6e 22 20 6f 75 74 72 result:\n" outr
1f00: 65 73 29 0a 09 20 20 6f 75 74 72 65 73 29 0a 09 es).. outres)..
1f10: 28 62 65 67 69 6e 0a 09 20 20 28 77 69 74 68 2d (begin.. (with-
1f20: 6f 75 74 70 75 74 2d 74 6f 2d 70 6f 72 74 20 28 output-to-port (
1f30: 63 75 72 72 65 6e 74 2d 65 72 72 6f 72 2d 70 6f current-error-po
1f40: 72 74 29 0a 09 20 20 20 20 28 6c 61 6d 62 64 61 rt).. (lambda
1f50: 20 28 29 0a 09 20 20 20 20 20 20 28 70 72 69 6e ().. (prin
1f60: 74 20 22 45 52 52 4f 52 3a 20 22 20 63 6d 64 20 t "ERROR: " cmd
1f70: 22 20 72 65 74 75 72 6e 65 64 20 62 61 64 20 65 " returned bad e
1f80: 78 69 74 20 63 6f 64 65 20 22 20 73 74 61 74 75 xit code " statu
1f90: 73 29 29 29 0a 09 20 20 22 22 29 29 29 29 0a 0a s))).. ""))))..
1fa0: 3b 3b 20 74 68 69 73 20 77 61 73 20 69 6e 6c 69 ;; this was inli
1fb0: 6e 65 20 62 75 74 20 49 27 6d 20 70 72 65 74 74 ne but I'm prett
1fc0: 79 20 73 75 72 65 20 74 68 61 74 20 69 73 20 61 y sure that is a
1fd0: 20 68 6f 6c 64 20 6f 76 65 72 20 66 72 6f 6d 20 hold over from
1fe0: 77 68 65 6e 20 69 74 20 77 61 73 20 2a 76 65 72 when it was *ver
1ff0: 79 2a 20 73 69 6d 70 6c 65 20 2e 2e 2e 0a 3b 3b y* simple ....;;
2000: 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 .(define (config
2010: 66 3a 72 65 61 64 2d 6c 69 6e 65 20 70 20 68 74 f:read-line p ht
2020: 20 61 6c 6c 6f 77 2d 70 72 6f 63 65 73 73 69 6e allow-processin
2030: 67 20 73 65 74 74 69 6e 67 73 20 65 6e 76 2d 74 g settings env-t
2040: 6f 2d 75 73 65 29 0a 20 20 28 6c 65 74 20 6c 6f o-use). (let lo
2050: 6f 70 20 28 28 69 6e 6c 20 28 72 65 61 64 2d 6c op ((inl (read-l
2060: 69 6e 65 20 70 29 29 29 0a 20 20 20 20 28 6c 65 ine p))). (le
2070: 74 20 28 28 63 6f 6e 74 2d 6c 69 6e 65 20 28 61 t ((cont-line (a
2080: 6e 64 20 28 73 74 72 69 6e 67 3f 20 69 6e 6c 29 nd (string? inl)
2090: 0a 09 09 09 20 20 28 6e 6f 74 20 28 73 74 72 69 .... (not (stri
20a0: 6e 67 2d 6e 75 6c 6c 3f 20 69 6e 6c 29 29 0a 09 ng-null? inl))..
20b0: 09 09 20 20 28 65 71 75 61 6c 3f 20 22 5c 5c 22 .. (equal? "\\"
20c0: 20 28 73 74 72 69 6e 67 2d 74 61 6b 65 2d 72 69 (string-take-ri
20d0: 67 68 74 20 69 6e 6c 20 31 29 29 29 29 29 0a 20 ght inl 1))))).
20e0: 20 20 20 20 20 28 69 66 20 63 6f 6e 74 2d 6c 69 (if cont-li
20f0: 6e 65 20 3b 3b 20 6c 61 73 74 20 63 68 61 72 61 ne ;; last chara
2100: 63 74 65 72 20 69 73 20 5c 20 0a 09 20 20 28 6c cter is \ .. (l
2110: 65 74 20 28 28 6e 65 78 74 6c 20 28 72 65 61 64 et ((nextl (read
2120: 2d 6c 69 6e 65 20 70 29 29 29 0a 09 20 20 20 20 -line p)))..
2130: 28 69 66 20 28 6e 6f 74 20 28 65 6f 66 2d 6f 62 (if (not (eof-ob
2140: 6a 65 63 74 3f 20 6e 65 78 74 6c 29 29 0a 09 09 ject? nextl))...
2150: 28 6c 6f 6f 70 20 28 73 74 72 69 6e 67 2d 61 70 (loop (string-ap
2160: 70 65 6e 64 20 28 69 66 20 63 6f 6e 74 2d 6c 69 pend (if cont-li
2170: 6e 65 20 0a 09 09 09 09 09 20 28 73 74 72 69 6e ne ...... (strin
2180: 67 2d 74 61 6b 65 20 69 6e 6c 20 28 2d 20 28 73 g-take inl (- (s
2190: 74 72 69 6e 67 2d 6c 65 6e 67 74 68 20 69 6e 6c tring-length inl
21a0: 29 20 31 29 29 0a 09 09 09 09 09 20 69 6e 6c 29 ) 1))...... inl)
21b0: 0a 09 09 09 09 20 20 20 20 20 6e 65 78 74 6c 29 ..... nextl)
21c0: 29 29 29 0a 09 20 20 28 6c 65 74 20 28 28 72 65 ))).. (let ((re
21d0: 73 20 28 63 61 73 65 20 61 6c 6c 6f 77 2d 70 72 s (case allow-pr
21e0: 6f 63 65 73 73 69 6e 67 20 3b 3b 20 69 66 20 28 ocessing ;; if (
21f0: 61 6e 64 20 61 6c 6c 6f 77 2d 70 72 6f 63 65 73 and allow-proces
2200: 73 69 6e 67 20 0a 09 09 20 20 20 20 20 20 20 3b sing ... ;
2210: 3b 09 20 20 20 28 6e 6f 74 20 28 65 71 3f 20 61 ;. (not (eq? a
2220: 6c 6c 6f 77 2d 70 72 6f 63 65 73 73 69 6e 67 20 llow-processing
2230: 27 72 65 74 75 72 6e 2d 73 74 72 69 6e 67 29 29 'return-string))
2240: 29 0a 09 09 20 20 20 20 20 20 20 28 28 23 74 20 )... ((#t
2250: 23 66 29 0a 09 09 09 28 63 6f 6e 66 69 67 66 3a #f)....(configf:
2260: 70 72 6f 63 65 73 73 2d 6c 69 6e 65 20 69 6e 6c process-line inl
2270: 20 68 74 20 61 6c 6c 6f 77 2d 70 72 6f 63 65 73 ht allow-proces
2280: 73 69 6e 67 20 65 6e 76 2d 74 6f 2d 75 73 65 29 sing env-to-use)
2290: 29 0a 09 09 20 20 20 20 20 20 20 28 28 72 65 74 )... ((ret
22a0: 75 72 6e 2d 73 74 72 69 6e 67 29 0a 09 09 09 69 urn-string)....i
22b0: 6e 6c 29 0a 09 09 20 20 20 20 20 20 20 28 65 6c nl)... (el
22c0: 73 65 0a 09 09 09 28 63 6f 6e 66 69 67 66 3a 70 se....(configf:p
22d0: 72 6f 63 65 73 73 2d 6c 69 6e 65 20 69 6e 6c 20 rocess-line inl
22e0: 68 74 20 61 6c 6c 6f 77 2d 70 72 6f 63 65 73 73 ht allow-process
22f0: 69 6e 67 20 65 6e 76 2d 74 6f 2d 75 73 65 29 29 ing env-to-use))
2300: 29 29 29 0a 09 20 20 20 20 28 69 66 20 28 61 6e ))).. (if (an
2310: 64 20 28 73 74 72 69 6e 67 3f 20 72 65 73 29 20 d (string? res)
2320: 20 3b 3b 20 6d 75 73 74 20 73 65 74 20 74 6f 20 ;; must set to
2330: 22 6e 6f 22 20 74 6f 20 66 6f 72 63 65 20 4e 4f "no" to force NO
2340: 54 20 74 72 69 6d 6d 69 6e 67 20 74 72 61 69 6c T trimming trail
2350: 69 6e 67 20 73 70 61 63 65 73 0a 09 09 20 20 20 ing spaces...
2360: 20 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 28 (not (equal? (
2370: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d
2380: 65 66 61 75 6c 74 20 73 65 74 74 69 6e 67 73 20 efault settings
2390: 22 74 72 69 6d 2d 74 72 61 69 6c 69 6e 67 2d 73 "trim-trailing-s
23a0: 70 61 63 65 73 22 20 22 79 65 73 22 29 20 22 6e paces" "yes") "n
23b0: 6f 22 29 29 29 0a 09 09 28 73 74 72 69 6e 67 2d o")))...(string-
23c0: 73 75 62 73 74 69 74 75 74 65 20 22 5c 5c 73 2b substitute "\\s+
23d0: 24 22 20 22 22 20 72 65 73 29 0a 09 09 72 65 73 $" "" res)...res
23e0: 29 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 ))))))..(define
23f0: 28 63 6f 6e 66 69 67 66 3a 63 66 67 64 61 74 2d (configf:cfgdat-
2400: 3e 65 6e 76 2d 61 6c 69 73 74 20 73 65 63 74 69 >env-alist secti
2410: 6f 6e 20 63 66 67 64 61 74 2d 68 74 20 61 6c 6c on cfgdat-ht all
2420: 6f 77 2d 73 79 73 74 65 6d 29 0a 20 20 28 66 69 ow-system). (fi
2430: 6c 74 65 72 0a 20 20 20 28 6c 61 6d 62 64 61 20 lter. (lambda
2440: 28 70 61 69 72 29 0a 20 20 20 20 20 28 6c 65 74 (pair). (let
2450: 2a 20 28 28 76 61 72 20 28 63 61 72 20 70 61 69 * ((var (car pai
2460: 72 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 r)).
2470: 28 76 61 6c 20 28 63 64 72 20 70 61 69 72 29 29 (val (cdr pair))
2480: 29 0a 20 20 20 20 20 20 20 28 63 6f 6e 73 20 76 ). (cons v
2490: 61 72 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ar.
24a0: 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 20 20 (cond.
24b0: 20 20 20 20 28 28 61 6e 64 20 61 6c 6c 6f 77 2d ((and allow-
24c0: 73 79 73 74 65 6d 20 28 70 72 6f 63 65 64 75 72 system (procedur
24d0: 65 3f 20 76 61 6c 29 29 20 3b 3b 20 69 66 20 77 e? val)) ;; if w
24e0: 65 20 64 65 63 69 64 65 64 20 74 6f 20 75 73 65 e decided to use
24f0: 20 73 6f 6d 65 74 68 69 6e 67 20 6f 74 68 65 72 something other
2500: 20 74 68 61 6e 20 23 74 20 6f 72 20 23 66 20 66 than #t or #f f
2510: 6f 72 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 or allow-system
2520: 28 27 72 65 74 75 72 6e 2d 70 72 6f 63 73 20 6f ('return-procs o
2530: 72 20 27 72 65 74 75 72 6e 2d 73 74 72 69 6e 67 r 'return-string
2540: 29 20 2c 20 74 68 69 73 20 6d 61 79 20 62 65 63 ) , this may bec
2550: 6f 6d 65 20 70 72 6f 62 6c 65 6d 61 74 69 63 0a ome problematic.
2560: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
2570: 76 61 6c 29 29 0a 20 20 20 20 20 20 20 20 20 20 val)).
2580: 20 20 20 20 28 28 70 72 6f 63 65 64 75 72 65 3f ((procedure?
2590: 20 76 61 6c 29 20 23 66 29 0a 20 20 20 20 20 20 val) #f).
25a0: 20 20 20 20 20 20 20 20 28 28 73 74 72 69 6e 67 ((string
25b0: 3f 20 76 61 6c 29 20 76 61 6c 29 0a 20 20 20 20 ? val) val).
25c0: 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 20 (else
25d0: 22 23 66 22 29 29 29 29 29 0a 20 20 20 28 61 70 "#f"))))). (ap
25e0: 70 65 6e 64 0a 20 20 20 20 28 68 61 73 68 2d 74 pend. (hash-t
25f0: 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 able-ref/default
2600: 20 63 66 67 64 61 74 2d 68 74 20 22 64 65 66 61 cfgdat-ht "defa
2610: 75 6c 74 22 20 27 28 29 29 0a 20 20 20 20 28 69 ult" '()). (i
2620: 66 20 28 65 71 75 61 6c 3f 20 73 65 63 74 69 6f f (equal? sectio
2630: 6e 20 22 64 65 66 61 75 6c 74 22 29 20 27 28 29 n "default") '()
2640: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
2650: 2f 64 65 66 61 75 6c 74 20 63 66 67 64 61 74 2d /default cfgdat-
2660: 68 74 20 73 65 63 74 69 6f 6e 20 27 28 29 29 29 ht section '()))
2670: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 61 )))..(define (ca
2680: 6c 63 2d 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 lc-allow-system
2690: 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 73 65 63 allow-system sec
26a0: 74 69 6f 6e 20 73 65 63 74 69 6f 6e 73 29 0a 20 tion sections).
26b0: 20 28 69 66 20 73 65 63 74 69 6f 6e 73 0a 20 20 (if sections.
26c0: 20 20 20 20 28 61 6e 64 20 28 6f 72 20 28 65 71 (and (or (eq
26d0: 75 61 6c 3f 20 22 64 65 66 61 75 6c 74 22 20 73 ual? "default" s
26e0: 65 63 74 69 6f 6e 29 0a 09 20 20 20 20 20 20 20 ection)..
26f0: 28 6d 65 6d 62 65 72 20 73 65 63 74 69 6f 6e 20 (member section
2700: 73 65 63 74 69 6f 6e 73 29 29 0a 09 20 20 20 61 sections)).. a
2710: 6c 6c 6f 77 2d 73 79 73 74 65 6d 29 20 3b 3b 20 llow-system) ;;
2720: 61 63 63 6f 75 6e 74 20 66 6f 72 20 73 65 63 74 account for sect
2730: 69 6f 6e 73 20 61 6e 64 20 72 65 74 75 72 6e 20 ions and return
2740: 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 61 73 20 allow-system as
2750: 69 74 20 6d 69 67 68 74 20 62 65 20 61 20 73 79 it might be a sy
2760: 6d 62 6f 6c 20 73 75 63 68 20 61 73 20 72 65 74 mbol such as ret
2770: 75 72 6e 2d 73 74 72 69 6e 67 73 0a 20 20 20 20 urn-strings.
2780: 20 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 29 29 allow-system))
2790: 0a 20 20 20 20 0a 3b 3b 20 67 69 76 65 6e 20 61 . .;; given a
27a0: 20 63 6f 6e 66 69 67 20 68 61 73 68 20 61 6e 64 config hash and
27b0: 20 61 20 73 65 63 74 69 6f 6e 20 6e 61 6d 65 2c a section name,
27c0: 20 61 70 70 6c 79 20 74 68 61 74 20 73 65 63 74 apply that sect
27d0: 69 6f 6e 20 74 6f 20 61 6c 6c 20 6d 61 74 63 68 ion to all match
27e0: 69 6e 67 20 73 65 63 74 69 6f 6e 73 20 28 75 73 ing sections (us
27f0: 69 6e 67 20 77 69 6c 64 63 61 72 64 20 25 20 6f ing wildcard % o
2800: 72 20 72 65 67 65 78 20 69 66 20 2f 2e 2e 2e 2e r regex if /....
2810: 2f 29 0a 3b 3b 20 72 65 6d 6f 76 65 20 74 68 65 /).;; remove the
2820: 20 73 65 63 74 69 6f 6e 20 77 68 65 6e 20 64 6f section when do
2830: 6e 65 20 73 6f 20 74 68 61 74 20 74 68 65 72 65 ne so that there
2840: 20 69 73 20 6e 6f 20 64 6f 77 6e 73 74 72 65 61 is no downstrea
2850: 6d 20 63 6c 6f 62 62 65 72 69 6e 67 0a 3b 3b 0a m clobbering.;;.
2860: 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 66 (define (configf
2870: 3a 61 70 70 6c 79 2d 77 69 6c 64 63 61 72 64 73 :apply-wildcards
2880: 20 68 74 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 ht section-name
2890: 29 0a 20 20 28 69 66 20 28 68 61 73 68 2d 74 61 ). (if (hash-ta
28a0: 62 6c 65 2d 65 78 69 73 74 73 3f 20 68 74 20 73 ble-exists? ht s
28b0: 65 63 74 69 6f 6e 2d 6e 61 6d 65 29 0a 20 20 20 ection-name).
28c0: 20 20 20 28 6c 65 74 2a 20 28 28 76 61 72 73 20 (let* ((vars
28d0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
28e0: 20 68 74 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 ht section-name
28f0: 29 29 0a 09 20 20 20 20 20 28 72 78 73 74 72 20 )).. (rxstr
2900: 28 69 66 20 28 73 74 72 69 6e 67 2d 63 6f 6e 74 (if (string-cont
2910: 61 69 6e 73 20 73 65 63 74 69 6f 6e 2d 6e 61 6d ains section-nam
2920: 65 20 22 25 22 29 0a 09 09 09 28 73 74 72 69 6e e "%")....(strin
2930: 67 2d 73 75 62 73 74 69 74 75 74 65 20 28 72 65 g-substitute (re
2940: 67 65 78 70 20 22 25 22 29 20 22 2e 2a 22 20 73 gexp "%") ".*" s
2950: 65 63 74 69 6f 6e 2d 6e 61 6d 65 29 0a 09 09 09 ection-name)....
2960: 28 73 74 72 69 6e 67 2d 73 75 62 73 74 69 74 75 (string-substitu
2970: 74 65 20 28 72 65 67 65 78 70 20 22 5e 2f 28 2e te (regexp "^/(.
2980: 2a 29 2f 24 22 29 20 22 5c 5c 31 22 20 73 65 63 *)/$") "\\1" sec
2990: 74 69 6f 6e 2d 6e 61 6d 65 29 29 29 0a 09 20 20 tion-name)))..
29a0: 20 20 20 28 72 78 20 20 20 20 28 72 65 67 65 78 (rx (regex
29b0: 70 20 72 78 73 74 72 29 29 29 0a 09 3b 3b 20 28 p rxstr)))..;; (
29c0: 70 72 69 6e 74 20 22 5c 6e 73 65 63 74 69 6f 6e print "\nsection
29d0: 2d 6e 61 6d 65 3a 20 22 20 73 65 63 74 69 6f 6e -name: " section
29e0: 2d 6e 61 6d 65 20 22 20 72 78 73 74 72 3a 20 22 -name " rxstr: "
29f0: 20 72 78 73 74 72 29 0a 20 20 20 20 20 20 20 20 rxstr).
2a00: 28 66 6f 72 2d 65 61 63 68 0a 20 20 20 20 20 20 (for-each.
2a10: 20 20 20 28 6c 61 6d 62 64 61 20 28 73 65 63 74 (lambda (sect
2a20: 69 6f 6e 29 0a 09 20 20 20 28 69 66 20 28 73 74 ion).. (if (st
2a30: 72 69 6e 67 3f 20 73 65 63 74 69 6f 6e 29 0a 09 ring? section)..
2a40: 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 73 61 (let ((sa
2a50: 6d 65 2d 73 65 63 74 69 6f 6e 20 28 73 74 72 69 me-section (stri
2a60: 6e 67 3d 3f 20 73 65 63 74 69 6f 6e 2d 6e 61 6d ng=? section-nam
2a70: 65 20 73 65 63 74 69 6f 6e 29 29 0a 09 09 20 20 e section))...
2a80: 20 20 20 28 72 78 2d 6d 61 74 63 68 20 20 20 20 (rx-match
2a90: 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 72 (string-match r
2aa0: 78 20 73 65 63 74 69 6f 6e 29 29 29 0a 09 09 20 x section)))...
2ab0: 3b 3b 20 28 70 72 69 6e 74 20 22 73 65 63 74 69 ;; (print "secti
2ac0: 6f 6e 3a 20 22 20 73 65 63 74 69 6f 6e 20 22 20 on: " section "
2ad0: 76 61 72 73 3a 20 22 20 76 61 72 73 20 22 20 73 vars: " vars " s
2ae0: 61 6d 65 2d 73 65 63 74 69 6f 6e 3a 20 22 20 73 ame-section: " s
2af0: 61 6d 65 2d 73 65 63 74 69 6f 6e 20 22 20 72 78 ame-section " rx
2b00: 2d 6d 61 74 63 68 3a 20 22 20 72 78 2d 6d 61 74 -match: " rx-mat
2b10: 63 68 29 0a 09 09 20 28 69 66 20 28 61 6e 64 20 ch)... (if (and
2b20: 28 6e 6f 74 20 73 61 6d 65 2d 73 65 63 74 69 6f (not same-sectio
2b30: 6e 29 20 72 78 2d 6d 61 74 63 68 29 0a 09 09 20 n) rx-match)...
2b40: 20 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 09 09 (for-each...
2b50: 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 62 (lambda (b
2b60: 75 6e 64 6c 65 29 0a 09 09 09 3b 3b 20 28 70 72 undle)....;; (pr
2b70: 69 6e 74 20 22 62 75 6e 64 6c 65 3a 20 22 20 62 int "bundle: " b
2b80: 75 6e 64 6c 65 29 0a 09 09 09 28 6c 65 74 20 28 undle)....(let (
2b90: 28 6b 65 79 20 20 28 63 61 72 20 62 75 6e 64 6c (key (car bundl
2ba0: 65 29 29 0a 09 09 09 20 20 20 20 20 20 28 76 61 e)).... (va
2bb0: 6c 20 20 28 63 61 64 72 20 62 75 6e 64 6c 65 29 l (cadr bundle)
2bc0: 29 0a 09 09 09 20 20 20 20 20 20 28 6d 65 74 61 ).... (meta
2bd0: 20 28 69 66 20 28 3e 20 28 6c 65 6e 67 74 68 20 (if (> (length
2be0: 62 75 6e 64 6c 65 29 20 32 29 28 63 61 64 64 72 bundle) 2)(caddr
2bf0: 20 62 75 6e 64 6c 65 29 20 23 66 29 29 29 0a 09 bundle) #f)))..
2c00: 09 09 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d .. (hash-table-
2c10: 73 65 74 21 20 68 74 20 73 65 63 74 69 6f 6e 20 set! ht section
2c20: 28 63 6f 6e 66 69 67 66 3a 61 73 73 6f 63 2d 73 (configf:assoc-s
2c30: 61 66 65 2d 61 64 64 20 28 68 61 73 68 2d 74 61 afe-add (hash-ta
2c40: 62 6c 65 2d 72 65 66 20 68 74 20 73 65 63 74 69 ble-ref ht secti
2c50: 6f 6e 29 20 6b 65 79 20 76 61 6c 20 6d 65 74 61 on) key val meta
2c60: 64 61 74 61 3a 20 6d 65 74 61 29 29 29 29 0a 09 data: meta))))..
2c70: 09 20 20 20 20 20 20 76 61 72 73 29 29 29 29 29 . vars)))))
2c80: 0a 20 20 20 20 20 20 20 20 20 28 68 61 73 68 2d . (hash-
2c90: 74 61 62 6c 65 2d 6b 65 79 73 20 68 74 29 29 29 table-keys ht)))
2ca0: 29 0a 20 20 68 74 29 0a 0a 3b 3b 20 72 65 61 64 ). ht)..;; read
2cb0: 20 61 20 63 6f 6e 66 69 67 20 66 69 6c 65 2c 20 a config file,
2cc0: 72 65 74 75 72 6e 73 20 68 61 73 68 20 74 61 62 returns hash tab
2cd0: 6c 65 20 6f 66 20 61 6c 69 73 74 73 0a 0a 3b 3b le of alists..;;
2ce0: 20 72 65 61 64 20 61 20 63 6f 6e 66 69 67 20 66 read a config f
2cf0: 69 6c 65 2c 20 72 65 74 75 72 6e 73 20 68 61 73 ile, returns has
2d00: 68 20 74 61 62 6c 65 20 6f 66 20 61 6c 69 73 74 h table of alist
2d10: 73 0a 3b 3b 20 61 64 64 73 20 74 6f 20 68 74 20 s.;; adds to ht
2d20: 69 66 20 67 69 76 65 6e 20 28 6d 75 73 74 20 62 if given (must b
2d30: 65 20 23 66 20 6f 74 68 65 72 77 69 73 65 29 0a e #f otherwise).
2d40: 3b 3b 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 3a ;; allow-system:
2d50: 0a 3b 3b 20 20 20 20 23 66 20 2d 20 64 6f 20 6e .;; #f - do n
2d60: 6f 74 20 65 76 61 6c 75 61 74 65 20 5b 73 79 73 ot evaluate [sys
2d70: 74 65 6d 0a 3b 3b 20 20 20 20 23 74 20 2d 20 69 tem.;; #t - i
2d80: 6d 6d 65 64 69 61 74 65 6c 79 20 65 76 61 6c 75 mmediately evalu
2d90: 61 74 65 20 5b 73 79 73 74 65 6d 20 61 6e 64 20 ate [system and
2da0: 73 74 6f 72 65 20 72 65 73 75 6c 74 20 61 73 20 store result as
2db0: 73 74 72 69 6e 67 0a 3b 3b 20 20 20 20 27 72 65 string.;; 're
2dc0: 74 75 72 6e 2d 70 72 6f 63 73 20 2d 2d 20 72 65 turn-procs -- re
2dd0: 74 75 72 6e 20 61 20 70 72 6f 63 20 74 61 6b 69 turn a proc taki
2de0: 6e 67 20 68 74 20 61 73 20 61 6e 20 61 72 67 75 ng ht as an argu
2df0: 6d 65 6e 74 20 74 68 61 74 20 6d 61 79 20 62 65 ment that may be
2e00: 20 65 76 61 75 6c 61 74 65 64 20 61 74 20 73 6f evaulated at so
2e10: 6d 65 20 66 75 74 75 72 65 20 74 69 6d 65 0a 3b me future time.;
2e20: 3b 20 20 20 20 27 72 65 74 75 72 6e 2d 73 74 72 ; 'return-str
2e30: 69 6e 67 20 2d 2d 20 72 65 74 75 72 6e 20 61 20 ing -- return a
2e40: 73 74 72 69 6e 67 20 72 65 70 72 65 73 65 6e 74 string represent
2e50: 69 6e 67 20 61 20 70 72 6f 63 20 74 61 6b 69 6e ing a proc takin
2e60: 67 20 68 74 20 61 73 20 61 6e 20 61 72 67 75 6d g ht as an argum
2e70: 65 6e 74 20 74 68 61 74 20 6d 61 79 20 62 65 20 ent that may be
2e80: 65 76 61 75 6c 61 74 65 64 20 61 74 20 73 6f 6d evaulated at som
2e90: 65 20 66 75 74 75 72 65 20 74 69 6d 65 0a 3b 3b e future time.;;
2ea0: 20 65 6e 76 69 6f 6e 2d 70 61 74 74 20 69 73 20 envion-patt is
2eb0: 61 20 72 65 67 65 78 20 73 70 65 63 20 74 68 61 a regex spec tha
2ec0: 74 20 69 64 65 6e 74 69 66 69 65 73 20 73 65 63 t identifies sec
2ed0: 74 69 6f 6e 73 20 74 68 61 74 20 77 69 6c 6c 20 tions that will
2ee0: 62 65 20 65 76 61 6c 27 64 0a 3b 3b 20 69 6e 20 be eval'd.;; in
2ef0: 74 68 65 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 the environment
2f00: 6f 6e 20 74 68 65 20 66 6c 79 0a 3b 3b 20 73 65 on the fly.;; se
2f10: 63 74 69 6f 6e 73 3a 20 23 66 20 3d 3e 20 67 65 ctions: #f => ge
2f20: 74 20 61 6c 6c 2c 20 65 6c 73 65 20 6c 69 73 74 t all, else list
2f30: 20 6f 66 20 73 65 63 74 69 6f 6e 73 20 74 6f 20 of sections to
2f40: 67 61 74 68 65 72 0a 3b 3b 20 70 6f 73 74 2d 73 gather.;; post-s
2f50: 65 63 74 69 6f 6e 2d 70 72 6f 63 73 20 61 6c 69 ection-procs ali
2f60: 73 74 20 6f 66 20 73 65 63 74 69 6f 6e 2d 70 61 st of section-pa
2f70: 74 74 65 72 6e 20 3d 3e 20 70 72 6f 63 2c 20 77 ttern => proc, w
2f80: 68 65 72 65 3a 20 28 70 72 6f 63 20 73 65 63 74 here: (proc sect
2f90: 69 6f 6e 2d 6e 61 6d 65 20 6e 65 78 74 2d 73 65 ion-name next-se
2fa0: 63 74 69 6f 6e 2d 6e 61 6d 65 20 68 74 20 63 75 ction-name ht cu
2fb0: 72 72 2d 70 61 74 68 29 0a 3b 3b 20 61 70 70 6c rr-path).;; appl
2fc0: 79 2d 77 69 6c 64 63 61 72 64 73 3a 20 23 74 2f y-wildcards: #t/
2fd0: 23 66 20 2d 20 61 70 70 6c 79 20 76 61 72 73 20 #f - apply vars
2fe0: 66 72 6f 6d 20 74 61 72 67 65 74 73 20 77 69 74 from targets wit
2ff0: 68 20 25 20 77 69 6c 64 63 61 72 64 73 20 74 6f h % wildcards to
3000: 20 61 6c 6c 20 6d 61 74 63 68 69 6e 67 20 73 65 all matching se
3010: 63 74 69 6f 6e 73 0a 3b 3b 0a 28 64 65 66 69 6e ctions.;;.(defin
3020: 65 20 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d e (configf:read-
3030: 63 6f 6e 66 69 67 20 70 61 74 68 20 68 74 20 61 config path ht a
3040: 6c 6c 6f 77 2d 73 79 73 74 65 6d 0a 09 09 09 20 llow-system....
3050: 20 20 20 20 23 21 6b 65 79 20 28 65 6e 76 69 72 #!key (envir
3060: 6f 6e 2d 70 61 74 74 20 23 66 29 20 20 28 63 75 on-patt #f) (cu
3070: 72 72 2d 73 65 63 74 69 6f 6e 20 23 66 29 20 20 rr-section #f)
3080: 20 0a 09 09 09 20 20 20 20 20 28 73 65 63 74 69 .... (secti
3090: 6f 6e 73 20 23 66 29 20 20 20 20 20 20 20 20 20 ons #f)
30a0: 20 20 20 28 73 65 74 74 69 6e 67 73 20 28 6d 61 (settings (ma
30b0: 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a ke-hash-table)).
30c0: 09 09 09 20 20 20 20 20 28 6b 65 65 70 2d 66 69 ... (keep-fi
30d0: 6c 65 6e 61 6d 65 73 20 23 66 29 20 20 20 20 20 lenames #f)
30e0: 20 28 70 6f 73 74 2d 73 65 63 74 69 6f 6e 2d 70 (post-section-p
30f0: 72 6f 63 73 20 27 28 29 29 0a 09 09 09 20 20 20 rocs '())....
3100: 20 20 28 61 70 70 6c 79 2d 77 69 6c 64 63 61 72 (apply-wildcar
3110: 64 73 20 23 74 29 20 20 20 20 20 28 65 6e 76 2d ds #t) (env-
3120: 74 6f 2d 75 73 65 20 23 66 29 29 0a 20 20 28 64 to-use #f)). (d
3130: 65 62 75 67 3a 70 72 69 6e 74 20 39 20 2a 64 65 ebug:print 9 *de
3140: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
3150: 22 53 54 41 52 54 3a 20 22 20 70 61 74 68 29 0a "START: " path).
3160: 3b 3b 20 28 69 66 20 2a 63 6f 6e 66 69 67 64 61 ;; (if *configda
3170: 74 2a 0a 3b 3b 20 20 20 20 20 28 63 6f 6d 6d 6f t*.;; (commo
3180: 6e 3a 73 61 76 65 2d 70 6b 74 20 60 28 28 61 63 n:save-pkt `((ac
3190: 74 69 6f 6e 20 2e 20 72 65 61 64 2d 63 6f 6e 66 tion . read-conf
31a0: 69 67 29 0a 3b 3b 20 20 20 20 20 20 20 09 09 20 ig).;; ..
31b0: 28 66 20 20 20 20 20 20 2e 20 2c 28 63 6f 6e 64 (f . ,(cond
31c0: 20 28 28 73 74 72 69 6e 67 3f 20 70 61 74 68 29 ((string? path)
31d0: 20 70 61 74 68 29 0a 3b 3b 20 20 20 20 20 20 20 path).;;
31e0: 09 09 09 09 20 20 28 28 70 6f 72 74 3f 20 20 20 .... ((port?
31f0: 70 61 74 68 29 20 22 70 6f 72 74 22 29 0a 3b 3b path) "port").;;
3200: 20 20 20 20 20 20 20 09 09 09 09 20 20 28 65 6c .... (el
3210: 73 65 20 28 63 6f 6e 63 20 70 61 74 68 29 29 29 se (conc path)))
3220: 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 ).;;
3230: 20 20 20 20 20 20 20 20 20 20 20 20 28 54 20 20 (T
3240: 20 20 20 20 2e 20 63 6f 6e 66 69 67 66 29 29 0a . configf)).
3250: 3b 3b 20 20 20 20 20 20 20 09 20 20 20 20 20 20 ;; .
3260: 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 23 74 20 *configdat* #t
3270: 61 64 64 2d 6f 6e 6c 79 3a 20 23 74 29 29 0a 20 add-only: #t)).
3280: 20 28 69 66 20 28 61 6e 64 20 28 6e 6f 74 20 28 (if (and (not (
3290: 70 6f 72 74 3f 20 70 61 74 68 29 29 0a 09 20 20 port? path))..
32a0: 20 28 6e 6f 74 20 28 66 69 6c 65 2d 65 78 69 73 (not (file-exis
32b0: 74 73 3f 20 70 61 74 68 29 29 29 20 3b 3b 20 66 ts? path))) ;; f
32c0: 6f 72 20 63 61 73 65 20 77 68 65 72 65 20 77 65 or case where we
32d0: 20 61 72 65 20 68 61 6e 64 65 64 20 61 20 70 6f are handed a po
32e0: 72 74 0a 20 20 20 20 20 20 28 62 65 67 69 6e 20 rt. (begin
32f0: 0a 09 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 ..(debug:print-i
3300: 6e 66 6f 20 31 20 2a 64 65 66 61 75 6c 74 2d 6c nfo 1 *default-l
3310: 6f 67 2d 70 6f 72 74 2a 20 22 63 6f 6e 66 69 67 og-port* "config
3320: 66 3a 72 65 61 64 2d 63 6f 6e 66 69 67 20 2d 20 f:read-config -
3330: 66 69 6c 65 20 6e 6f 74 20 66 6f 75 6e 64 20 22 file not found "
3340: 20 70 61 74 68 20 22 20 63 75 72 72 65 6e 74 20 path " current
3350: 70 61 74 68 3a 20 22 20 28 63 75 72 72 65 6e 74 path: " (current
3360: 2d 64 69 72 65 63 74 6f 72 79 29 29 0a 09 3b 3b -directory))..;;
3370: 20 57 41 52 4e 49 4e 47 3a 20 54 68 69 73 20 69 WARNING: This i
3380: 73 20 61 20 72 69 73 6b 79 20 63 68 61 6e 67 65 s a risky change
3390: 20 62 75 74 20 72 65 61 6c 6c 79 2c 20 77 65 20 but really, we
33a0: 73 68 6f 75 6c 64 20 6e 6f 74 20 72 65 74 75 72 should not retur
33b0: 6e 20 61 6e 20 65 6d 70 74 79 20 68 61 73 68 20 n an empty hash
33c0: 74 61 62 6c 65 20 69 66 20 6e 6f 20 66 69 6c 65 table if no file
33d0: 20 72 65 61 64 3f 0a 09 23 66 29 20 3b 3b 20 28 read?..#f) ;; (
33e0: 69 66 20 28 6e 6f 74 20 68 74 29 28 6d 61 6b 65 if (not ht)(make
33f0: 2d 68 61 73 68 2d 74 61 62 6c 65 29 20 68 74 29 -hash-table) ht)
3400: 29 0a 20 20 20 20 20 20 28 6c 65 74 20 28 3b 3b ). (let (;;
3410: 20 28 65 6e 76 2d 74 6f 2d 75 73 65 20 28 69 66 (env-to-use (if
3420: 20 65 6e 76 2d 74 6f 2d 75 73 65 20 65 6e 76 2d env-to-use env-
3430: 74 6f 2d 75 73 65 20 28 6d 6f 64 75 6c 65 2d 65 to-use (module-e
3440: 6e 76 69 72 6f 6e 6d 65 6e 74 20 27 63 6f 6e 66 nvironment 'conf
3450: 69 67 66 6d 6f 64 29 29 29 0a 09 20 20 20 20 28 igfmod))).. (
3460: 69 6e 70 20 20 20 20 20 20 20 20 28 69 66 20 28 inp (if (
3470: 73 74 72 69 6e 67 3f 20 70 61 74 68 29 0a 09 09 string? path)...
3480: 09 20 20 20 20 28 6f 70 65 6e 2d 69 6e 70 75 74 . (open-input
3490: 2d 66 69 6c 65 20 70 61 74 68 29 0a 09 09 09 20 -file path)....
34a0: 20 20 20 20 20 70 61 74 68 29 29 20 3b 3b 20 77 path)) ;; w
34b0: 65 20 63 61 6e 20 62 65 20 68 61 6e 64 65 64 20 e can be handed
34c0: 61 20 70 6f 72 74 0a 09 20 20 20 20 28 72 65 73 a port.. (res
34d0: 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 68 (let ((h
34e0: 74 2d 69 6e 20 28 69 66 20 28 6e 6f 74 20 68 74 t-in (if (not ht
34f0: 29 0a 09 09 09 09 09 20 28 6d 61 6b 65 2d 68 61 )...... (make-ha
3500: 73 68 2d 74 61 62 6c 65 29 0a 09 09 09 09 09 20 sh-table)......
3510: 68 74 29 29 29 0a 09 09 09 20 20 28 69 66 20 28 ht))).... (if (
3520: 6e 6f 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d not (hash-table-
3530: 65 78 69 73 74 73 3f 20 68 74 2d 69 6e 20 27 6d exists? ht-in 'm
3540: 65 74 61 64 61 74 61 29 29 0a 09 09 09 20 20 20 etadata))....
3550: 20 20 20 28 62 65 67 69 6e 0a 09 09 09 09 28 68 (begin.....(h
3560: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 68 ash-table-set! h
3570: 74 2d 69 6e 20 27 6d 65 74 61 64 61 74 61 20 28 t-in 'metadata (
3580: 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 make-hash-table)
3590: 29 0a 09 09 09 09 28 68 61 73 68 2d 74 61 62 6c ).....(hash-tabl
35a0: 65 2d 73 65 74 21 20 28 68 61 73 68 2d 74 61 62 e-set! (hash-tab
35b0: 6c 65 2d 72 65 66 20 68 74 2d 69 6e 20 27 6d 65 le-ref ht-in 'me
35c0: 74 61 64 61 74 61 29 20 27 74 6f 70 70 61 74 68 tadata) 'toppath
35d0: 20 70 61 74 68 29 29 29 0a 09 09 09 20 20 68 74 path))).... ht
35e0: 2d 69 6e 29 29 0a 09 20 20 20 20 28 6d 65 74 61 -in)).. (meta
35f0: 70 61 74 68 20 20 20 28 69 66 20 28 6f 72 20 28 path (if (or (
3600: 64 65 62 75 67 3a 64 65 62 75 67 2d 6d 6f 64 65 debug:debug-mode
3610: 20 39 29 0a 09 09 09 09 6b 65 65 70 2d 66 69 6c 9).....keep-fil
3620: 65 6e 61 6d 65 73 29 0a 09 09 09 20 20 20 20 70 enames).... p
3630: 61 74 68 20 23 66 29 29 0a 20 20 20 20 20 20 20 ath #f)).
3640: 20 20 20 20 20 28 70 72 6f 63 65 73 73 2d 77 69 (process-wi
3650: 6c 64 63 61 72 64 73 20 20 28 6c 61 6d 62 64 61 ldcards (lambda
3660: 20 28 72 65 73 20 63 75 72 72 2d 73 65 63 74 69 (res curr-secti
3670: 6f 6e 2d 6e 61 6d 65 29 0a 20 20 20 20 20 20 20 on-name).
3680: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3690: 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 (if (
36a0: 61 6e 64 20 61 70 70 6c 79 2d 77 69 6c 64 63 61 and apply-wildca
36b0: 72 64 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 rds.
36c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
36d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
36e0: 6f 72 20 28 73 74 72 69 6e 67 2d 63 6f 6e 74 61 or (string-conta
36f0: 69 6e 73 20 63 75 72 72 2d 73 65 63 74 69 6f 6e ins curr-section
3700: 2d 6e 61 6d 65 20 22 25 22 29 20 20 20 3b 3b 20 -name "%") ;;
3710: 77 69 6c 64 63 61 72 64 0a 20 20 20 20 20 20 20 wildcard.
3720: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3730: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3740: 20 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d (string-
3750: 6d 61 74 63 68 20 22 2f 2e 2a 2f 22 20 63 75 72 match "/.*/" cur
3760: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 29 29 r-section-name))
3770: 29 20 3b 3b 20 72 65 67 65 78 0a 20 20 20 20 20 ) ;; regex.
3780: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3790: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
37a0: 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 (begin.
37b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
37c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
37d0: 28 63 6f 6e 66 69 67 66 3a 61 70 70 6c 79 2d 77 (configf:apply-w
37e0: 69 6c 64 63 61 72 64 73 20 72 65 73 20 63 75 72 ildcards res cur
37f0: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 29 0a r-section-name).
3800: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3810: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3820: 20 20 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 (hash-ta
3830: 62 6c 65 2d 64 65 6c 65 74 65 21 20 72 65 73 20 ble-delete! res
3840: 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d curr-section-nam
3850: 65 29 29 29 29 29 29 20 20 3b 3b 20 4e 4f 54 45 e)))))) ;; NOTE
3860: 3a 20 69 66 20 74 68 65 20 73 65 63 74 69 6f 6e : if the section
3870: 20 69 73 20 61 20 77 69 6c 64 20 63 61 72 64 20 is a wild card
3880: 69 74 20 77 69 6c 6c 20 62 65 20 52 45 4d 4f 56 it will be REMOV
3890: 45 44 20 66 72 6f 6d 20 72 65 73 20 0a 09 28 6c ED from res ..(l
38a0: 65 74 20 6c 6f 6f 70 20 28 28 69 6e 6c 20 20 20 et loop ((inl
38b0: 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e (con
38c0: 66 69 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 figf:read-line i
38d0: 6e 70 20 72 65 73 20 28 63 61 6c 63 2d 61 6c 6c np res (calc-all
38e0: 6f 77 2d 73 79 73 74 65 6d 20 61 6c 6c 6f 77 2d ow-system allow-
38f0: 73 79 73 74 65 6d 20 63 75 72 72 2d 73 65 63 74 system curr-sect
3900: 69 6f 6e 20 73 65 63 74 69 6f 6e 73 29 20 73 65 ion sections) se
3910: 74 74 69 6e 67 73 20 65 6e 76 2d 74 6f 2d 75 73 ttings env-to-us
3920: 65 29 29 20 3b 3b 20 28 72 65 61 64 2d 6c 69 6e e)) ;; (read-lin
3930: 65 20 69 6e 70 29 29 0a 09 09 20 20 20 28 63 75 e inp))... (cu
3940: 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 rr-section-name
3950: 28 69 66 20 63 75 72 72 2d 73 65 63 74 69 6f 6e (if curr-section
3960: 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 20 22 64 curr-section "d
3970: 65 66 61 75 6c 74 22 29 29 0a 09 09 20 20 20 28 efault"))... (
3980: 76 61 72 2d 66 6c 61 67 20 23 66 29 3b 3b 20 74 var-flag #f);; t
3990: 75 72 6e 20 6f 6e 20 66 6f 72 20 6b 65 79 2d 76 urn on for key-v
39a0: 61 72 2d 70 72 20 61 6e 64 20 63 6f 6e 74 2d 6c ar-pr and cont-l
39b0: 6e 2d 72 78 2c 20 74 75 72 6e 20 6f 66 66 20 65 n-rx, turn off e
39c0: 6c 73 65 77 68 65 72 65 0a 09 09 20 20 20 28 6c lsewhere... (l
39d0: 65 61 64 20 20 20 20 20 23 66 29 29 0a 09 20 20 ead #f))..
39e0: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
39f0: 6f 20 38 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 o 8 *default-log
3a00: 2d 70 6f 72 74 2a 20 22 63 75 72 72 2d 73 65 63 -port* "curr-sec
3a10: 74 69 6f 6e 2d 6e 61 6d 65 3a 20 22 20 63 75 72 tion-name: " cur
3a20: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 22 r-section-name "
3a30: 20 76 61 72 2d 66 6c 61 67 3a 20 22 20 76 61 72 var-flag: " var
3a40: 2d 66 6c 61 67 20 22 5c 6e 20 20 20 69 6e 6c 3a -flag "\n inl:
3a50: 20 5c 22 22 20 69 6e 6c 20 22 5c 22 22 29 0a 09 \"" inl "\"")..
3a60: 20 20 28 69 66 20 28 65 6f 66 2d 6f 62 6a 65 63 (if (eof-objec
3a70: 74 3f 20 69 6e 6c 29 20 0a 09 20 20 20 20 20 20 t? inl) ..
3a80: 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 20 (begin.
3a90: 20 20 20 20 20 20 20 3b 3b 20 70 72 6f 63 65 73 ;; proces
3aa0: 73 20 6c 61 73 74 20 73 65 63 74 69 6f 6e 20 66 s last section f
3ab0: 6f 72 20 77 69 6c 64 63 61 72 64 73 0a 20 20 20 or wildcards.
3ac0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 70 72 (pr
3ad0: 6f 63 65 73 73 2d 77 69 6c 64 63 61 72 64 73 20 ocess-wildcards
3ae0: 72 65 73 20 63 75 72 72 2d 73 65 63 74 69 6f 6e res curr-section
3af0: 2d 6e 61 6d 65 29 0a 09 09 28 69 66 20 28 73 74 -name)...(if (st
3b00: 72 69 6e 67 3f 20 70 61 74 68 29 20 3b 3b 20 77 ring? path) ;; w
3b10: 65 20 72 65 63 65 69 76 65 64 20 61 20 70 61 74 e received a pat
3b20: 68 2c 20 6e 6f 74 20 61 20 70 6f 72 74 2c 20 74 h, not a port, t
3b30: 68 75 73 20 77 65 20 61 72 65 20 72 65 73 70 6f hus we are respo
3b40: 6e 73 69 62 6c 65 20 66 6f 72 20 63 6c 6f 73 69 nsible for closi
3b50: 6e 67 20 69 74 2e 0a 09 09 20 20 20 20 28 63 6c ng it.... (cl
3b60: 6f 73 65 2d 69 6e 70 75 74 2d 70 6f 72 74 20 69 ose-input-port i
3b70: 6e 70 29 29 0a 09 09 28 69 66 20 28 6c 69 73 74 np))...(if (list
3b80: 3f 20 73 65 63 74 69 6f 6e 73 29 20 3b 3b 20 64 ? sections) ;; d
3b90: 65 6c 65 74 65 20 61 6c 6c 20 73 65 63 74 69 6f elete all sectio
3ba0: 6e 73 20 65 78 63 65 70 74 20 67 69 76 65 6e 20 ns except given
3bb0: 77 68 65 6e 20 73 65 63 74 69 6f 6e 73 20 69 73 when sections is
3bc0: 20 70 72 6f 76 69 64 65 64 0a 09 09 20 20 20 20 provided...
3bd0: 28 66 6f 72 2d 65 61 63 68 0a 09 09 20 20 20 20 (for-each...
3be0: 20 28 6c 61 6d 62 64 61 20 28 73 65 63 74 69 6f (lambda (sectio
3bf0: 6e 29 0a 09 09 20 20 20 20 20 20 20 28 69 66 20 n)... (if
3c00: 28 6e 6f 74 20 28 6d 65 6d 62 65 72 20 73 65 63 (not (member sec
3c10: 74 69 6f 6e 20 73 65 63 74 69 6f 6e 73 29 29 0a tion sections)).
3c20: 09 09 09 20 20 20 28 68 61 73 68 2d 74 61 62 6c ... (hash-tabl
3c30: 65 2d 64 65 6c 65 74 65 21 20 72 65 73 20 73 65 e-delete! res se
3c40: 63 74 69 6f 6e 29 29 29 20 3b 3b 20 77 65 20 61 ction))) ;; we a
3c50: 72 65 20 75 73 69 6e 67 20 22 22 20 61 73 20 61 re using "" as a
3c60: 20 64 75 6d 70 69 6e 67 20 67 72 6f 75 6e 64 20 dumping ground
3c70: 61 6e 64 20 6d 75 73 74 20 72 65 6d 6f 76 65 20 and must remove
3c80: 69 74 20 62 65 66 6f 72 65 20 72 65 74 75 72 6e it before return
3c90: 69 6e 67 20 74 68 65 20 68 74 0a 09 09 20 20 20 ing the ht...
3ca0: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 (hash-table-ke
3cb0: 79 73 20 72 65 73 29 29 29 0a 09 09 28 64 65 62 ys res)))...(deb
3cc0: 75 67 3a 70 72 69 6e 74 20 39 20 2a 64 65 66 61 ug:print 9 *defa
3cd0: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 45 ult-log-port* "E
3ce0: 4e 44 3a 20 22 20 70 61 74 68 29 0a 20 20 20 20 ND: " path).
3cf0: 20 20 20 20 20 20 20 20 20 20 20 20 72 65 73 0a res.
3d00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3d10: 29 20 3b 3b 20 72 65 74 76 61 6c 0a 09 20 20 20 ) ;; retval..
3d20: 20 20 20 28 72 65 67 65 78 2d 63 61 73 65 20 0a (regex-case .
3d30: 09 20 20 20 20 20 20 20 69 6e 6c 20 0a 09 20 20 . inl ..
3d40: 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 63 6f (configf:co
3d50: 6d 6d 65 6e 74 2d 72 78 20 5f 20 20 20 20 20 20 mment-rx _
3d60: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f (loo
3d70: 70 20 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d p (configf:read-
3d80: 6c 69 6e 65 20 69 6e 70 20 72 65 73 20 28 63 61 line inp res (ca
3d90: 6c 63 2d 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 lc-allow-system
3da0: 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 63 75 72 allow-system cur
3db0: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 73 r-section-name s
3dc0: 65 63 74 69 6f 6e 73 29 20 73 65 74 74 69 6e 67 ections) setting
3dd0: 73 20 65 6e 76 2d 74 6f 2d 75 73 65 29 0a 20 20 s env-to-use).
3de0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3df0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3e00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3e10: 20 20 20 20 20 20 20 20 20 20 63 75 72 72 2d 73 curr-s
3e20: 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 ection-name #f #
3e30: 66 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 f)).
3e40: 20 20 20 0a 09 20 20 20 20 20 20 20 28 63 6f 6e .. (con
3e50: 66 69 67 66 3a 62 6c 61 6e 6b 2d 6c 2d 72 78 20 figf:blank-l-rx
3e60: 5f 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 _
3e70: 20 20 20 28 6c 6f 6f 70 20 28 63 6f 6e 66 69 67 (loop (config
3e80: 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 20 f:read-line inp
3e90: 72 65 73 20 28 63 61 6c 63 2d 61 6c 6c 6f 77 2d res (calc-allow-
3ea0: 73 79 73 74 65 6d 20 61 6c 6c 6f 77 2d 73 79 73 system allow-sys
3eb0: 74 65 6d 20 63 75 72 72 2d 73 65 63 74 69 6f 6e tem curr-section
3ec0: 2d 6e 61 6d 65 20 73 65 63 74 69 6f 6e 73 29 20 -name sections)
3ed0: 73 65 74 74 69 6e 67 73 20 65 6e 76 2d 74 6f 2d settings env-to-
3ee0: 75 73 65 29 0a 20 20 20 20 20 20 20 20 20 20 20 use).
3ef0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3f00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3f10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3f20: 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 curr-section-na
3f30: 6d 65 20 23 66 20 23 66 29 29 0a 09 20 20 20 20 me #f #f))..
3f40: 20 20 20 28 63 6f 6e 66 69 67 66 3a 73 65 74 74 (configf:sett
3f50: 69 6e 67 73 20 20 20 28 20 78 20 73 65 74 74 69 ings ( x setti
3f60: 6e 67 20 76 61 6c 20 20 29 0a 20 20 20 20 20 20 ng val ).
3f70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3f80: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 62 65 (be
3f90: 67 69 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 gin.
3fa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3fb0: 20 20 20 20 20 20 20 20 20 28 68 61 73 68 2d 74 (hash-t
3fc0: 61 62 6c 65 2d 73 65 74 21 20 73 65 74 74 69 6e able-set! settin
3fd0: 67 73 20 73 65 74 74 69 6e 67 20 76 61 6c 29 0a gs setting val).
3fe0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3ff0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4000: 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 6f 6e 66 (loop (conf
4010: 69 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e igf:read-line in
4020: 70 20 72 65 73 20 28 63 61 6c 63 2d 61 6c 6c 6f p res (calc-allo
4030: 77 2d 73 79 73 74 65 6d 20 61 6c 6c 6f 77 2d 73 w-system allow-s
4040: 79 73 74 65 6d 20 63 75 72 72 2d 73 65 63 74 69 ystem curr-secti
4050: 6f 6e 2d 6e 61 6d 65 20 73 65 63 74 69 6f 6e 73 on-name sections
4060: 29 20 73 65 74 74 69 6e 67 73 20 65 6e 76 2d 74 ) settings env-t
4070: 6f 2d 75 73 65 29 0a 20 20 20 20 20 20 20 20 20 o-use).
4080: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4090: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
40a0: 20 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e curr-section-n
40b0: 61 6d 65 20 23 66 20 23 66 29 29 29 0a 20 20 20 ame #f #f))).
40c0: 20 20 20 20 20 20 20 20 20 20 20 20 0a 09 20 20 ..
40d0: 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 69 6e (configf:in
40e0: 63 6c 75 64 65 2d 72 78 20 28 20 78 20 69 6e 63 clude-rx ( x inc
40f0: 6c 75 64 65 2d 66 69 6c 65 20 29 0a 20 20 20 20 lude-file ).
4100: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4110: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
4120: 6c 65 74 2a 20 28 28 63 75 72 72 2d 63 6f 6e 66 let* ((curr-conf
4130: 2d 64 69 72 20 28 70 61 74 68 6e 61 6d 65 2d 64 -dir (pathname-d
4140: 69 72 65 63 74 6f 72 79 20 70 61 74 68 29 29 0a irectory path)).
4150: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4160: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4170: 20 20 20 20 20 20 20 20 20 20 28 66 75 6c 6c 2d (full-
4180: 63 6f 6e 66 20 20 20 20 20 28 69 66 20 28 61 6e conf (if (an
4190: 64 20 28 61 62 73 6f 6c 75 74 65 2d 70 61 74 68 d (absolute-path
41a0: 6e 61 6d 65 3f 20 69 6e 63 6c 75 64 65 2d 66 69 name? include-fi
41b0: 6c 65 29 20 28 66 69 6c 65 2d 65 78 69 73 74 73 le) (file-exists
41c0: 3f 20 69 6e 63 6c 75 64 65 2d 66 69 6c 65 29 29 ? include-file))
41d0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
41e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
41f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4200: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 69 6e in
4210: 63 6c 75 64 65 2d 66 69 6c 65 0a 20 20 20 20 20 clude-file.
4220: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4230: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4240: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4250: 20 20 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a (common:
4260: 6e 69 63 65 2d 70 61 74 68 20 0a 20 20 20 20 20 nice-path .
4270: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4280: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4290: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
42a0: 20 20 20 20 20 20 20 20 20 28 63 6f 6e 63 20 28 (conc (
42b0: 69 66 20 63 75 72 72 2d 63 6f 6e 66 2d 64 69 72 if curr-conf-dir
42c0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
42d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
42e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
42f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4300: 20 20 20 20 20 20 20 20 20 63 75 72 72 2d 63 6f curr-co
4310: 6e 66 2d 64 69 72 0a 20 20 20 20 20 20 20 20 20 nf-dir.
4320: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4330: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4340: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4350: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 22 "
4360: 2e 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 .").
4370: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4380: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4390: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
43a0: 20 20 20 20 20 20 20 20 22 2f 22 20 69 6e 63 6c "/" incl
43b0: 75 64 65 2d 66 69 6c 65 29 29 29 29 29 0a 09 09 ude-file)))))...
43c0: 09 09 20 20 20 20 20 28 6c 65 74 20 28 28 61 6c .. (let ((al
43d0: 6c 2d 6d 61 74 63 68 65 73 20 28 73 6f 72 74 20 l-matches (sort
43e0: 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f (handle-exceptio
43f0: 6e 73 20 65 78 6e 0a 09 09 09 09 09 09 09 09 28 ns exn.........(
4400: 62 65 67 69 6e 0a 09 09 09 09 09 09 09 09 20 28 begin......... (
4410: 64 65 62 75 67 3a 70 72 69 6e 74 20 27 28 32 20 debug:print '(2
4420: 39 29 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 9) *default-log-
4430: 70 6f 72 74 2a 20 22 67 6c 6f 62 20 6f 66 20 22 port* "glob of "
4440: 20 66 75 6c 6c 2d 63 6f 6e 66 20 22 20 67 61 76 full-conf " gav
4450: 65 20 6e 6f 20 6d 61 74 63 68 2e 20 2c 20 65 78 e no match. , ex
4460: 6e 3d 22 20 65 78 6e 29 0a 09 09 09 09 09 09 09 n=" exn)........
4470: 09 20 28 6c 69 73 74 29 29 0a 09 09 09 09 09 09 . (list)).......
4480: 09 09 28 67 6c 6f 62 20 66 75 6c 6c 2d 63 6f 6e ..(glob full-con
4490: 66 29 29 20 73 74 72 69 6e 67 3c 3d 3f 29 29 29 f)) string<=?)))
44a0: 0a 09 09 09 09 20 20 20 20 20 20 20 28 69 66 20 ..... (if
44b0: 28 6e 75 6c 6c 3f 20 61 6c 6c 2d 6d 61 74 63 68 (null? all-match
44c0: 65 73 29 0a 09 09 09 09 09 20 20 20 28 62 65 67 es)...... (beg
44d0: 69 6e 0a 09 09 09 09 09 20 20 20 20 20 28 64 65 in...... (de
44e0: 62 75 67 3a 70 72 69 6e 74 20 27 28 32 20 39 29 bug:print '(2 9)
44f0: 20 23 66 20 22 49 4e 46 4f 3a 20 69 6e 63 6c 75 #f "INFO: inclu
4500: 64 65 20 66 69 6c 65 28 73 29 20 6d 61 74 63 68 de file(s) match
4510: 69 6e 67 20 22 20 69 6e 63 6c 75 64 65 2d 66 69 ing " include-fi
4520: 6c 65 20 22 20 6e 6f 74 20 66 6f 75 6e 64 20 28 le " not found (
4530: 63 61 6c 6c 65 64 20 66 72 6f 6d 20 22 20 70 61 called from " pa
4540: 74 68 20 22 29 22 29 0a 09 09 09 09 09 20 20 20 th ")")......
4550: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 (debug:print 2
4560: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
4570: 72 74 2a 20 22 20 20 20 20 20 20 20 20 22 20 66 rt* " " f
4580: 75 6c 6c 2d 63 6f 6e 66 29 29 0a 09 09 09 09 09 ull-conf))......
4590: 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 09 09 09 (for-each....
45a0: 09 09 20 20 20 20 28 6c 61 6d 62 64 61 20 28 66 .. (lambda (f
45b0: 70 61 74 68 29 0a 09 09 09 09 09 20 20 20 20 20 path)......
45c0: 20 3b 3b 20 28 70 75 73 68 2d 64 69 72 65 63 74 ;; (push-direct
45d0: 6f 72 79 20 63 6f 6e 66 2d 64 69 72 29 0a 09 09 ory conf-dir)...
45e0: 09 09 09 20 20 20 20 20 20 28 64 65 62 75 67 3a ... (debug:
45f0: 70 72 69 6e 74 20 39 20 2a 64 65 66 61 75 6c 74 print 9 *default
4600: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 49 6e 63 6c -log-port* "Incl
4610: 75 64 69 6e 67 3a 20 22 20 66 75 6c 6c 2d 63 6f uding: " full-co
4620: 6e 66 29 0a 09 09 09 09 09 20 20 20 20 20 20 28 nf)...... (
4630: 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d 63 6f 6e configf:read-con
4640: 66 69 67 20 66 70 61 74 68 20 72 65 73 20 61 6c fig fpath res al
4650: 6c 6f 77 2d 73 79 73 74 65 6d 20 65 6e 76 69 72 low-system envir
4660: 6f 6e 2d 70 61 74 74 3a 20 65 6e 76 69 72 6f 6e on-patt: environ
4670: 2d 70 61 74 74 0a 09 09 09 09 09 09 09 20 20 20 -patt........
4680: 63 75 72 72 2d 73 65 63 74 69 6f 6e 3a 20 63 75 curr-section: cu
4690: 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 rr-section-name
46a0: 73 65 63 74 69 6f 6e 73 3a 20 73 65 63 74 69 6f sections: sectio
46b0: 6e 73 20 73 65 74 74 69 6e 67 73 3a 20 73 65 74 ns settings: set
46c0: 74 69 6e 67 73 0a 09 09 09 09 09 09 09 20 20 20 tings........
46d0: 6b 65 65 70 2d 66 69 6c 65 6e 61 6d 65 73 3a 20 keep-filenames:
46e0: 6b 65 65 70 2d 66 69 6c 65 6e 61 6d 65 73 20 65 keep-filenames e
46f0: 6e 76 2d 74 6f 2d 75 73 65 3a 20 65 6e 76 2d 74 nv-to-use: env-t
4700: 6f 2d 75 73 65 29 29 0a 09 09 09 09 09 20 20 20 o-use))......
4710: 20 61 6c 6c 2d 6d 61 74 63 68 65 73 29 29 0a 09 all-matches))..
4720: 09 09 09 20 20 20 20 20 20 20 28 6c 6f 6f 70 20 ... (loop
4730: 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d 6c 69 (configf:read-li
4740: 6e 65 20 69 6e 70 20 72 65 73 20 28 63 61 6c 63 ne inp res (calc
4750: 2d 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 61 6c -allow-system al
4760: 6c 6f 77 2d 73 79 73 74 65 6d 20 63 75 72 72 2d low-system curr-
4770: 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 73 65 63 section-name sec
4780: 74 69 6f 6e 73 29 20 73 65 74 74 69 6e 67 73 20 tions) settings
4790: 65 6e 76 2d 74 6f 2d 75 73 65 29 0a 09 09 09 09 env-to-use).....
47a0: 09 20 20 20 20 20 63 75 72 72 2d 73 65 63 74 69 . curr-secti
47b0: 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 66 29 29 29 on-name #f #f)))
47c0: 29 0a 09 20 20 20 20 20 20 20 28 63 6f 6e 66 69 ).. (confi
47d0: 67 66 3a 73 63 72 69 70 74 2d 72 78 20 28 20 78 gf:script-rx ( x
47e0: 20 69 6e 63 6c 75 64 65 2d 73 63 72 69 70 74 20 include-script
47f0: 70 61 72 61 6d 73 29 3b 3b 20 68 61 6e 64 6c 65 params);; handle
4800: 2d 65 78 63 65 70 74 69 6f 6e 73 0a 20 20 20 20 -exceptions.
4810: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4820: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b ;;
4830: 20 20 20 20 65 78 6e 0a 20 20 20 20 20 20 20 20 exn.
4840: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4850: 20 20 20 20 20 20 20 20 20 20 3b 3b 20 20 20 20 ;;
4860: 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 20 (begin.
4870: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4880: 20 20 20 20 20 20 20 20 20 3b 3b 20 20 20 20 20 ;;
4890: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 27 28 (debug:print '(
48a0: 30 20 32 20 39 29 20 23 66 20 22 49 4e 46 4f 3a 0 2 9) #f "INFO:
48b0: 20 69 6e 63 6c 75 64 65 20 66 72 6f 6d 20 73 63 include from sc
48c0: 72 69 70 74 20 22 20 69 6e 63 6c 75 64 65 2d 73 ript " include-s
48d0: 63 72 69 70 74 20 22 20 66 61 69 6c 65 64 2e 22 cript " failed."
48e0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
48f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4900: 20 20 20 20 3b 3b 20 20 20 20 20 20 28 6c 6f 6f ;; (loo
4910: 70 20 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d p (configf:read-
4920: 6c 69 6e 65 20 69 6e 70 20 72 65 73 20 28 63 61 line inp res (ca
4930: 6c 63 2d 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 lc-allow-system
4940: 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 63 75 72 allow-system cur
4950: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 73 r-section-name s
4960: 65 63 74 69 6f 6e 73 29 20 73 65 74 74 69 6e 67 ections) setting
4970: 73 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d s) curr-section-
4980: 6e 61 6d 65 20 23 66 20 23 66 29 29 0a 20 20 20 name #f #f)).
4990: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
49a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
49b0: 69 66 20 28 61 6e 64 20 28 66 69 6c 65 2d 65 78 if (and (file-ex
49c0: 69 73 74 73 3f 20 69 6e 63 6c 75 64 65 2d 73 63 ists? include-sc
49d0: 72 69 70 74 29 28 66 69 6c 65 2d 65 78 65 63 75 ript)(file-execu
49e0: 74 61 62 6c 65 3f 20 69 6e 63 6c 75 64 65 2d 73 table? include-s
49f0: 63 72 69 70 74 29 29 0a 20 20 20 20 20 20 20 20 cript)).
4a00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4a10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
4a20: 65 74 2a 20 28 28 6c 6f 63 61 6c 2d 61 6c 6c 6f et* ((local-allo
4a30: 77 2d 73 79 73 74 65 6d 20 20 28 63 61 6c 63 2d w-system (calc-
4a40: 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 61 6c 6c allow-system all
4a50: 6f 77 2d 73 79 73 74 65 6d 20 63 75 72 72 2d 73 ow-system curr-s
4a60: 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 73 65 63 74 ection-name sect
4a70: 69 6f 6e 73 29 29 0a 20 20 20 20 20 20 20 20 20 ions)).
4a80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4a90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4aa0: 20 20 20 20 28 65 6e 76 2d 64 65 6c 74 61 20 20 (env-delta
4ab0: 28 63 6f 6e 66 69 67 66 3a 63 66 67 64 61 74 2d (configf:cfgdat-
4ac0: 3e 65 6e 76 2d 61 6c 69 73 74 20 63 75 72 72 2d >env-alist curr-
4ad0: 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 72 65 73 section-name res
4ae0: 20 6c 6f 63 61 6c 2d 61 6c 6c 6f 77 2d 73 79 73 local-allow-sys
4af0: 74 65 6d 29 29 0a 20 20 20 20 20 20 20 20 20 20 tem)).
4b00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4b10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4b20: 20 20 20 28 6e 65 77 2d 69 6e 70 2d 70 6f 72 74 (new-inp-port
4b30: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4b40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4b50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
4b60: 63 6f 6d 6d 6f 6e 3a 77 69 74 68 2d 65 6e 76 2d common:with-env-
4b70: 76 61 72 73 0a 20 20 20 20 20 20 20 20 20 20 20 vars.
4b80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4b90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4ba0: 20 20 20 20 65 6e 76 2d 64 65 6c 74 61 0a 20 20 env-delta.
4bb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4bc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4bd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 (la
4be0: 6d 62 64 61 20 28 29 0a 20 20 20 20 20 20 20 20 mbda ().
4bf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4c00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4c10: 20 20 20 20 20 20 20 20 20 28 6f 70 65 6e 2d 69 (open-i
4c20: 6e 70 75 74 2d 70 69 70 65 20 28 63 6f 6e 63 20 nput-pipe (conc
4c30: 69 6e 63 6c 75 64 65 2d 73 63 72 69 70 74 20 22 include-script "
4c40: 20 22 20 70 61 72 61 6d 73 29 29 29 29 29 29 0a " params)))))).
4c50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4c60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4c70: 20 20 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 (debug:p
4c80: 72 69 6e 74 20 27 28 32 20 39 29 20 2a 64 65 66 rint '(2 9) *def
4c90: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
4ca0: 49 6e 63 6c 75 64 69 6e 67 20 66 72 6f 6d 20 73 Including from s
4cb0: 63 72 69 70 74 20 6f 75 74 70 75 74 3a 20 22 20 cript output: "
4cc0: 69 6e 63 6c 75 64 65 2d 73 63 72 69 70 74 29 0a include-script).
4cd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4ce0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4cf0: 20 20 20 20 20 20 20 20 3b 3b 20 20 28 70 72 69 ;; (pri
4d00: 6e 74 20 22 57 65 20 67 6f 74 20 68 65 72 65 2c nt "We got here,
4d10: 20 63 61 6c 6c 69 6e 67 20 63 6f 6e 66 69 67 66 calling configf
4d20: 3a 72 65 61 64 2d 63 6f 6e 66 69 67 20 6e 65 78 :read-config nex
4d30: 74 2e 20 50 6f 72 74 20 69 73 3a 20 22 20 6e 65 t. Port is: " ne
4d40: 77 2d 69 6e 70 2d 70 6f 72 74 29 0a 20 20 20 20 w-inp-port).
4d50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4d60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4d70: 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 72 65 61 (configf:rea
4d80: 64 2d 63 6f 6e 66 69 67 20 6e 65 77 2d 69 6e 70 d-config new-inp
4d90: 2d 70 6f 72 74 20 72 65 73 20 61 6c 6c 6f 77 2d -port res allow-
4da0: 73 79 73 74 65 6d 20 65 6e 76 69 72 6f 6e 2d 70 system environ-p
4db0: 61 74 74 3a 20 65 6e 76 69 72 6f 6e 2d 70 61 74 att: environ-pat
4dc0: 74 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 3a 20 t curr-section:
4dd0: 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d curr-section-nam
4de0: 65 20 73 65 63 74 69 6f 6e 73 3a 20 73 65 63 74 e sections: sect
4df0: 69 6f 6e 73 20 73 65 74 74 69 6e 67 73 3a 20 73 ions settings: s
4e00: 65 74 74 69 6e 67 73 20 6b 65 65 70 2d 66 69 6c ettings keep-fil
4e10: 65 6e 61 6d 65 73 3a 20 6b 65 65 70 2d 66 69 6c enames: keep-fil
4e20: 65 6e 61 6d 65 73 20 65 6e 76 2d 74 6f 2d 75 73 enames env-to-us
4e30: 65 3a 20 65 6e 76 2d 74 6f 2d 75 73 65 29 0a 20 e: env-to-use).
4e40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4e50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4e60: 20 20 20 20 20 20 20 28 63 6c 6f 73 65 2d 69 6e (close-in
4e70: 70 75 74 2d 70 6f 72 74 20 6e 65 77 2d 69 6e 70 put-port new-inp
4e80: 2d 70 6f 72 74 29 0a 20 20 20 20 20 20 20 20 20 -port).
4e90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4ea0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
4eb0: 6c 6f 6f 70 20 28 63 6f 6e 66 69 67 66 3a 72 65 loop (configf:re
4ec0: 61 64 2d 6c 69 6e 65 20 69 6e 70 20 72 65 73 20 ad-line inp res
4ed0: 28 63 61 6c 63 2d 61 6c 6c 6f 77 2d 73 79 73 74 (calc-allow-syst
4ee0: 65 6d 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 em allow-system
4ef0: 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d curr-section-nam
4f00: 65 20 73 65 63 74 69 6f 6e 73 29 20 73 65 74 74 e sections) sett
4f10: 69 6e 67 73 20 65 6e 76 2d 74 6f 2d 75 73 65 29 ings env-to-use)
4f20: 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 curr-section-na
4f30: 6d 65 20 23 66 20 23 66 29 29 0a 20 20 20 20 20 me #f #f)).
4f40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4f50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4f60: 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 (begin.
4f70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4f80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4f90: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a (debug:print 0 *
4fa0: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
4fb0: 2a 20 22 53 63 72 69 70 74 20 6e 6f 74 20 66 6f * "Script not fo
4fc0: 75 6e 64 20 6f 72 20 6e 6f 74 20 65 78 65 63 74 und or not exect
4fd0: 75 74 61 62 6c 65 3a 20 22 20 69 6e 63 6c 75 64 utable: " includ
4fe0: 65 2d 73 63 72 69 70 74 29 0a 20 20 20 20 20 20 e-script).
4ff0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5000: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5010: 20 20 28 6c 6f 6f 70 20 28 63 6f 6e 66 69 67 66 (loop (configf
5020: 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 20 72 :read-line inp r
5030: 65 73 20 28 63 61 6c 63 2d 61 6c 6c 6f 77 2d 73 es (calc-allow-s
5040: 79 73 74 65 6d 20 61 6c 6c 6f 77 2d 73 79 73 74 ystem allow-syst
5050: 65 6d 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d em curr-section-
5060: 6e 61 6d 65 20 73 65 63 74 69 6f 6e 73 29 20 73 name sections) s
5070: 65 74 74 69 6e 67 73 20 65 6e 76 2d 74 6f 2d 75 ettings env-to-u
5080: 73 65 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e se) curr-section
5090: 2d 6e 61 6d 65 20 23 66 20 23 66 29 29 29 0a 20 -name #f #f))).
50a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
50b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
50c0: 20 29 20 3b 3b 20 29 0a 09 20 20 20 20 20 20 20 ) ;; )..
50d0: 28 63 6f 6e 66 69 67 66 3a 73 65 63 74 69 6f 6e (configf:section
50e0: 2d 72 78 20 28 20 78 20 73 65 63 74 69 6f 6e 2d -rx ( x section-
50f0: 6e 61 6d 65 20 29 0a 20 20 20 20 20 20 20 20 20 name ).
5100: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5110: 20 20 20 20 20 20 20 20 20 20 28 62 65 67 69 6e (begin
5120: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
5130: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5140: 20 20 20 20 20 20 3b 3b 20 63 61 6c 6c 20 70 6f ;; call po
5150: 73 74 2d 73 65 63 74 69 6f 6e 2d 70 72 6f 63 73 st-section-procs
5160: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
5170: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5180: 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 (for-each
5190: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
51a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
51b0: 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 (lambda (
51c0: 64 61 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 dat).
51d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
51e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 (le
51f0: 74 20 28 28 70 61 74 74 20 28 63 61 72 20 64 61 t ((patt (car da
5200: 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 t)).
5210: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5220: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5230: 20 20 28 70 72 6f 63 20 28 63 64 72 20 64 61 74 (proc (cdr dat
5240: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
5250: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5260: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 (i
5270: 66 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 f (string-match
5280: 70 61 74 74 20 63 75 72 72 2d 73 65 63 74 69 6f patt curr-sectio
5290: 6e 2d 6e 61 6d 65 29 0a 20 20 20 20 20 20 20 20 n-name).
52a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
52b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
52c0: 20 20 20 20 20 20 28 70 72 6f 63 20 63 75 72 72 (proc curr
52d0: 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 73 65 -section-name se
52e0: 63 74 69 6f 6e 2d 6e 61 6d 65 20 72 65 73 20 70 ction-name res p
52f0: 61 74 68 29 29 29 29 0a 20 20 20 20 20 20 20 20 ath)))).
5300: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5310: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 70 6f po
5320: 73 74 2d 73 65 63 74 69 6f 6e 2d 70 72 6f 63 73 st-section-procs
5330: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
5340: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5350: 20 20 20 20 20 20 20 3b 3b 20 61 66 74 65 72 20 ;; after
5360: 67 61 74 68 65 72 69 6e 67 20 74 68 65 20 76 61 gathering the va
5370: 72 73 20 66 6f 72 20 61 20 73 65 63 74 69 6f 6e rs for a section
5380: 20 61 6e 64 20 69 66 20 61 70 70 6c 79 2d 77 69 and if apply-wi
5390: 6c 64 63 61 72 64 73 20 69 73 20 74 72 75 65 20 ldcards is true
53a0: 61 6e 64 20 69 66 20 74 68 65 72 65 20 69 73 20 and if there is
53b0: 61 20 77 69 6c 64 63 61 72 64 20 69 6e 20 74 68 a wildcard in th
53c0: 65 20 73 65 63 74 69 6f 6e 20 6e 61 6d 65 20 70 e section name p
53d0: 72 6f 63 65 73 73 20 77 69 6c 64 63 61 72 64 73 rocess wildcards
53e0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
53f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5400: 20 20 20 20 20 20 3b 3b 20 4e 4f 54 45 3a 20 77 ;; NOTE: w
5410: 65 20 61 72 65 20 70 72 6f 63 65 73 73 69 6e 67 e are processing
5420: 20 74 68 65 20 63 75 72 72 2d 73 65 63 74 69 6f the curr-sectio
5430: 6e 2d 6e 61 6d 65 2c 20 4e 4f 54 20 73 65 63 74 n-name, NOT sect
5440: 69 6f 6e 2d 6e 61 6d 65 2e 0a 20 20 20 20 20 20 ion-name..
5450: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5460: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
5470: 70 72 6f 63 65 73 73 2d 77 69 6c 64 63 61 72 64 process-wildcard
5480: 73 20 72 65 73 20 63 75 72 72 2d 73 65 63 74 69 s res curr-secti
5490: 6f 6e 2d 6e 61 6d 65 29 0a 20 20 20 20 20 20 20 on-name).
54a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
54b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 (i
54c0: 66 20 28 6e 6f 74 20 28 68 61 73 68 2d 74 61 62 f (not (hash-tab
54d0: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 72 le-ref/default r
54e0: 65 73 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 es section-name
54f0: 23 66 29 29 28 68 61 73 68 2d 74 61 62 6c 65 2d #f))(hash-table-
5500: 73 65 74 21 20 72 65 73 20 73 65 63 74 69 6f 6e set! res section
5510: 2d 6e 61 6d 65 20 27 28 29 29 29 20 3b 3b 20 65 -name '())) ;; e
5520: 6e 73 75 72 65 20 74 68 61 74 20 6d 65 72 65 20 nsure that mere
5530: 6d 65 6e 74 69 6f 6e 20 6f 66 20 61 20 73 65 63 mention of a sec
5540: 74 69 6f 6e 20 69 73 20 6e 6f 74 20 6c 6f 73 74 tion is not lost
5550: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
5560: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5570: 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 6f 6e (loop (con
5580: 66 69 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 figf:read-line i
5590: 6e 70 20 72 65 73 20 28 63 61 6c 63 2d 61 6c 6c np res (calc-all
55a0: 6f 77 2d 73 79 73 74 65 6d 20 61 6c 6c 6f 77 2d ow-system allow-
55b0: 73 79 73 74 65 6d 20 63 75 72 72 2d 73 65 63 74 system curr-sect
55c0: 69 6f 6e 2d 6e 61 6d 65 20 73 65 63 74 69 6f 6e ion-name section
55d0: 73 29 20 73 65 74 74 69 6e 67 73 20 65 6e 76 2d s) settings env-
55e0: 74 6f 2d 75 73 65 29 0a 20 20 20 20 20 20 20 20 to-use).
55f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5600: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5610: 20 20 20 3b 3b 20 69 66 20 77 65 20 68 61 76 65 ;; if we have
5620: 20 74 68 65 20 73 65 63 74 69 6f 6e 73 20 6c 69 the sections li
5630: 73 74 20 74 68 65 6e 20 66 6f 72 63 65 20 61 6c st then force al
5640: 6c 20 73 65 74 74 69 6e 67 73 20 69 6e 74 6f 20 l settings into
5650: 22 22 20 61 6e 64 20 64 65 6c 65 74 65 20 69 74 "" and delete it
5660: 20 6c 61 74 65 72 3f 0a 20 20 20 20 20 20 20 20 later?.
5670: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5680: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5690: 20 20 20 3b 3b 20 28 69 66 20 28 6f 72 20 28 6e ;; (if (or (n
56a0: 6f 74 20 73 65 63 74 69 6f 6e 73 29 20 0a 20 20 ot sections) .
56b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
56c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
56d0: 20 20 20 20 20 20 20 20 20 3b 3b 09 20 20 20 20 ;;.
56e0: 20 20 28 6d 65 6d 62 65 72 20 73 65 63 74 69 6f (member sectio
56f0: 6e 2d 6e 61 6d 65 20 73 65 63 74 69 6f 6e 73 29 n-name sections)
5700: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
5710: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5720: 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 09 ;;.
5730: 20 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 22 section-name "
5740: 22 29 20 3b 3b 20 73 74 69 63 6b 20 65 76 65 72 ") ;; stick ever
5750: 79 74 68 69 6e 67 20 69 6e 74 6f 20 22 22 2e 20 ything into "".
5760: 4e 4f 50 45 3a 20 57 65 20 6e 65 65 64 20 6e 65 NOPE: We need ne
5770: 77 20 73 74 72 61 74 65 67 79 2e 20 50 75 74 20 w strategy. Put
5780: 73 74 75 66 66 20 69 6e 20 63 6f 72 72 65 63 74 stuff in correct
5790: 20 73 65 63 74 69 6f 6e 73 20 61 6e 64 20 74 68 sections and th
57a0: 65 6e 20 64 65 6c 65 74 65 20 61 6c 6c 20 73 65 en delete all se
57b0: 63 74 69 6f 6e 73 20 6c 61 74 65 72 2e 0a 20 20 ctions later..
57c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
57d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
57e0: 20 20 20 20 20 20 20 20 20 73 65 63 74 69 6f 6e section
57f0: 2d 6e 61 6d 65 0a 20 20 20 20 20 20 20 20 20 20 -name.
5800: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5810: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5820: 20 23 66 20 23 66 29 29 29 0a 09 20 20 20 20 20 #f #f)))..
5830: 20 20 28 63 6f 6e 66 69 67 66 3a 6b 65 79 2d 73 (configf:key-s
5840: 79 73 2d 70 72 20 28 20 78 20 6b 65 79 20 63 6d ys-pr ( x key cm
5850: 64 20 20 20 20 20 20 29 0a 20 20 20 20 20 20 20 d ).
5860: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5870: 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 (if
5880: 28 63 61 6c 63 2d 61 6c 6c 6f 77 2d 73 79 73 74 (calc-allow-syst
5890: 65 6d 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 em allow-system
58a0: 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d curr-section-nam
58b0: 65 20 73 65 63 74 69 6f 6e 73 29 0a 20 20 20 20 e sections).
58c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
58d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
58e0: 20 20 20 28 6c 65 74 20 28 28 61 6c 69 73 74 20 (let ((alist
58f0: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 (hash-table-r
5900: 65 66 2f 64 65 66 61 75 6c 74 20 72 65 73 20 63 ef/default res c
5910: 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 urr-section-name
5920: 20 27 28 29 29 29 0a 20 20 20 20 20 20 20 20 20 '())).
5930: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5940: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5950: 20 20 20 20 28 76 61 6c 2d 70 72 6f 63 20 28 6c (val-proc (l
5960: 61 6d 62 64 61 20 28 29 0a 20 20 20 20 20 20 20 ambda ().
5970: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5980: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5990: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
59a0: 20 20 28 6c 65 74 2a 20 28 28 73 74 61 72 74 2d (let* ((start-
59b0: 74 69 6d 65 20 28 63 75 72 72 65 6e 74 2d 73 65 time (current-se
59c0: 63 6f 6e 64 73 29 29 0a 20 20 20 20 20 20 20 20 conds)).
59d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
59e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
59f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5a00: 20 20 20 20 20 20 20 20 28 6c 6f 63 61 6c 2d 61 (local-a
5a10: 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 20 28 63 61 llow-system (ca
5a20: 6c 63 2d 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 lc-allow-system
5a30: 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 63 75 72 allow-system cur
5a40: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 73 r-section-name s
5a50: 65 63 74 69 6f 6e 73 29 29 0a 20 20 20 20 20 20 ections)).
5a60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5a70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5a80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5a90: 20 20 20 20 20 20 20 20 20 20 28 65 6e 76 2d 64 (env-d
5aa0: 65 6c 74 61 20 20 28 63 6f 6e 66 69 67 66 3a 63 elta (configf:c
5ab0: 66 67 64 61 74 2d 3e 65 6e 76 2d 61 6c 69 73 74 fgdat->env-alist
5ac0: 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 curr-section-na
5ad0: 6d 65 20 72 65 73 20 6c 6f 63 61 6c 2d 61 6c 6c me res local-all
5ae0: 6f 77 2d 73 79 73 74 65 6d 29 29 0a 20 20 20 20 ow-system)).
5af0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5b00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5b10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5b20: 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6d 64 (cmd
5b30: 72 65 73 20 20 20 20 20 28 70 72 6f 63 65 73 73 res (process
5b40: 3a 63 6d 64 2d 72 75 6e 2d 3e 6c 69 73 74 20 63 :cmd-run->list c
5b50: 6d 64 20 64 65 6c 74 61 2d 65 6e 76 2d 61 6c 69 md delta-env-ali
5b60: 73 74 2d 6f 72 2d 68 61 73 68 2d 74 61 62 6c 65 st-or-hash-table
5b70: 3a 20 65 6e 76 2d 64 65 6c 74 61 29 29 20 3b 3b : env-delta)) ;;
5b80: 20 42 42 3a 20 68 65 72 65 20 69 73 20 77 68 65 BB: here is whe
5b90: 72 65 20 5b 73 79 73 74 65 6d 20 69 73 20 65 78 re [system is ex
5ba0: 65 63 27 64 2e 20 20 6e 65 65 64 73 20 74 6f 20 ec'd. needs to
5bb0: 68 61 76 65 20 65 6e 76 20 66 72 6f 6d 20 6f 74 have env from ot
5bc0: 68 65 72 20 76 61 72 73 21 0a 20 20 20 20 20 20 her vars!.
5bd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5be0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5bf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5c00: 20 20 20 20 20 20 20 20 20 20 28 64 65 6c 74 61 (delta
5c10: 20 20 20 20 20 20 28 2d 20 28 63 75 72 72 65 6e (- (curren
5c20: 74 2d 73 65 63 6f 6e 64 73 29 20 73 74 61 72 74 t-seconds) start
5c30: 2d 74 69 6d 65 29 29 0a 20 20 20 20 20 20 20 20 -time)).
5c40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5c50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5c60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5c70: 20 20 20 20 20 20 20 20 28 73 74 61 74 75 73 20 (status
5c80: 20 20 20 20 28 63 61 64 72 20 63 6d 64 72 65 73 (cadr cmdres
5c90: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
5ca0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5cb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5cc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5cd0: 20 20 20 28 72 65 73 20 20 20 20 20 20 20 20 28 (res (
5ce0: 63 61 72 20 20 63 6d 64 72 65 73 29 29 29 0a 20 car cmdres))).
5cf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5d00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5d10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5d20: 20 20 20 20 20 20 20 20 20 20 28 64 65 62 75 67 (debug
5d30: 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 34 20 2a 64 :print-info 4 *d
5d40: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
5d50: 20 22 22 20 69 6e 6c 20 22 5c 6e 20 3d 3e 20 22 "" inl "\n => "
5d60: 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 (string-intersp
5d70: 65 72 73 65 20 72 65 73 20 22 5c 6e 22 29 29 0a erse res "\n")).
5d80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5d90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5da0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5db0: 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 (if (
5dc0: 6e 6f 74 20 28 65 71 3f 20 73 74 61 74 75 73 20 not (eq? status
5dd0: 30 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 0)).
5de0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5df0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5e00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5e10: 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 (begin.
5e20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5e30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5e40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5e50: 20 20 20 20 20 20 20 20 20 20 20 28 64 65 62 75 (debu
5e60: 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 g:print-error 0
5e70: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
5e80: 74 2a 20 22 70 72 6f 62 6c 65 6d 20 77 69 74 68 t* "problem with
5e90: 20 22 20 69 6e 6c 20 22 2c 20 72 65 74 75 72 6e " inl ", return
5ea0: 20 63 6f 64 65 20 22 20 73 74 61 74 75 73 0a 20 code " status.
5eb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5ec0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5ed0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5ee0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5ef0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5f00: 20 20 20 22 20 6f 75 74 70 75 74 3a 20 22 20 63 " output: " c
5f10: 6d 64 72 65 73 29 29 29 0a 20 20 20 20 20 20 20 mdres))).
5f20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5f30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5f40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5f50: 20 20 20 20 28 69 66 20 28 3e 20 64 65 6c 74 61 (if (> delta
5f60: 20 32 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 2).
5f70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5f80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5f90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5fa0: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d (debug:print-
5fb0: 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d info 0 *default-
5fc0: 6c 6f 67 2d 70 6f 72 74 2a 20 22 66 6f 72 20 6c log-port* "for l
5fd0: 69 6e 65 20 5c 22 22 20 69 6e 6c 20 22 5c 22 5c ine \"" inl "\"\
5fe0: 6e 20 20 63 6f 6d 6d 61 6e 64 3a 20 22 20 63 6d n command: " cm
5ff0: 64 20 22 20 74 6f 6f 6b 20 22 20 64 65 6c 74 61 d " took " delta
6000: 20 22 20 73 65 63 6f 6e 64 73 20 74 6f 20 72 75 " seconds to ru
6010: 6e 20 77 69 74 68 20 6f 75 74 70 75 74 3a 5c 6e n with output:\n
6020: 20 20 20 22 20 72 65 73 29 0a 20 20 20 20 20 20 " res).
6030: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6040: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6050: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6060: 20 20 20 20 20 20 20 20 20 28 64 65 62 75 67 3a (debug:
6070: 70 72 69 6e 74 2d 69 6e 66 6f 20 39 20 2a 64 65 print-info 9 *de
6080: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
6090: 22 66 6f 72 20 6c 69 6e 65 20 5c 22 22 20 69 6e "for line \"" in
60a0: 6c 20 22 5c 22 5c 6e 20 20 63 6f 6d 6d 61 6e 64 l "\"\n command
60b0: 3a 20 22 20 63 6d 64 20 22 20 74 6f 6f 6b 20 22 : " cmd " took "
60c0: 20 64 65 6c 74 61 20 22 20 73 65 63 6f 6e 64 73 delta " seconds
60d0: 20 74 6f 20 72 75 6e 20 77 69 74 68 20 6f 75 74 to run with out
60e0: 70 75 74 3a 5c 6e 20 20 20 22 20 72 65 73 29 29 put:\n " res))
60f0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
6100: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6110: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6120: 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 (if
6130: 28 6e 75 6c 6c 3f 20 72 65 73 29 0a 20 20 20 20 (null? res).
6140: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6150: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6160: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6170: 20 20 20 20 20 20 20 20 20 20 20 22 22 0a 20 20 "".
6180: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6190: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
61a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
61b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 74 (st
61c0: 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 ring-intersperse
61d0: 20 72 65 73 20 22 20 22 29 29 29 29 29 29 0a 20 res " ")))))).
61e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
61f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6200: 20 20 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 (hash-ta
6210: 62 6c 65 2d 73 65 74 21 20 72 65 73 20 63 75 72 ble-set! res cur
6220: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 0a r-section-name .
6230: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6240: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6250: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6260: 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 66 69 (confi
6270: 67 66 3a 61 73 73 6f 63 2d 73 61 66 65 2d 61 64 gf:assoc-safe-ad
6280: 64 20 61 6c 69 73 74 0a 20 20 20 20 20 20 20 20 d alist.
6290: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
62a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
62b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
62c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
62d0: 20 20 20 20 20 20 20 20 20 6b 65 79 20 0a 20 20 key .
62e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
62f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6300: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6310: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6320: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
6330: 63 61 73 65 20 28 63 61 6c 63 2d 61 6c 6c 6f 77 case (calc-allow
6340: 2d 73 79 73 74 65 6d 20 61 6c 6c 6f 77 2d 73 79 -system allow-sy
6350: 73 74 65 6d 20 63 75 72 72 2d 73 65 63 74 69 6f stem curr-sectio
6360: 6e 2d 6e 61 6d 65 20 73 65 63 74 69 6f 6e 73 29 n-name sections)
6370: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
6380: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6390: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
63a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
63b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
63c0: 20 20 20 20 28 28 72 65 74 75 72 6e 2d 70 72 6f ((return-pro
63d0: 63 73 29 20 76 61 6c 2d 70 72 6f 63 29 0a 20 20 cs) val-proc).
63e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
63f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6400: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6410: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6420: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6430: 20 28 28 72 65 74 75 72 6e 2d 73 74 72 69 6e 67 ((return-string
6440: 29 20 63 6d 64 29 0a 20 20 20 20 20 20 20 20 20 ) cmd).
6450: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6460: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6470: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6480: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6490: 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 20 (else
64a0: 28 76 61 6c 2d 70 72 6f 63 29 29 29 0a 20 20 20 (val-proc))).
64b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
64c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
64d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
64e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
64f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6d 65 me
6500: 74 61 64 61 74 61 3a 20 6d 65 74 61 70 61 74 68 tadata: metapath
6510: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
6520: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6530: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f (loo
6540: 70 20 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d p (configf:read-
6550: 6c 69 6e 65 20 69 6e 70 20 72 65 73 20 28 63 61 line inp res (ca
6560: 6c 63 2d 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 lc-allow-system
6570: 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 63 75 72 allow-system cur
6580: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 73 r-section-name s
6590: 65 63 74 69 6f 6e 73 29 20 73 65 74 74 69 6e 67 ections) setting
65a0: 73 20 65 6e 76 2d 74 6f 2d 75 73 65 29 20 63 75 s env-to-use) cu
65b0: 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 rr-section-name
65c0: 23 66 20 23 66 29 29 0a 20 20 20 20 20 20 20 20 #f #f)).
65d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
65e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
65f0: 6c 6f 6f 70 20 28 63 6f 6e 66 69 67 66 3a 72 65 loop (configf:re
6600: 61 64 2d 6c 69 6e 65 20 69 6e 70 20 72 65 73 0a ad-line inp res.
6610: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6620: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6630: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6640: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6650: 28 63 61 6c 63 2d 61 6c 6c 6f 77 2d 73 79 73 74 (calc-allow-syst
6660: 65 6d 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 em allow-system
6670: 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d curr-section-nam
6680: 65 20 73 65 63 74 69 6f 6e 73 29 0a 20 20 20 20 e sections).
6690: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
66a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
66b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
66c0: 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 74 sett
66d0: 69 6e 67 73 20 65 6e 76 2d 74 6f 2d 75 73 65 29 ings env-to-use)
66e0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
66f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6700: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 63 75 cu
6710: 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 rr-section-name
6720: 23 66 20 23 66 29 29 29 0a 20 20 20 20 20 20 20 #f #f))).
6730: 20 20 20 20 20 20 20 20 0a 09 20 20 20 20 20 20 ..
6740: 20 28 63 6f 6e 66 69 67 66 3a 6b 65 79 2d 6e 6f (configf:key-no
6750: 2d 76 61 6c 20 28 20 78 20 6b 65 79 20 76 61 6c -val ( x key val
6760: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
6770: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6780: 20 20 20 20 20 28 6c 65 74 2a 20 28 28 61 6c 69 (let* ((ali
6790: 73 74 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 st (hash-table
67a0: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 72 65 73 -ref/default res
67b0: 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 curr-section-na
67c0: 6d 65 20 27 28 29 29 29 0a 20 20 20 20 20 20 20 me '())).
67d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
67e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
67f0: 20 20 20 28 66 76 61 6c 20 20 20 20 28 6f 72 20 (fval (or
6800: 28 69 66 20 28 73 74 72 69 6e 67 3f 20 76 61 6c (if (string? val
6810: 29 20 76 61 6c 20 23 66 29 20 22 22 29 29 29 20 ) val #f) "")))
6820: 3b 3b 20 66 76 61 6c 20 73 68 6f 75 6c 64 20 62 ;; fval should b
6830: 65 20 65 69 74 68 65 72 20 22 22 20 6f 72 20 22 e either "" or "
6840: 20 22 20 28 6f 6e 65 20 6f 72 20 6d 6f 72 65 20 " (one or more
6850: 73 70 61 63 65 73 29 0a 20 20 20 20 20 20 20 20 spaces).
6860: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6870: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 64 65 (de
6880: 62 75 67 3a 70 72 69 6e 74 20 31 30 20 2a 64 65 bug:print 10 *de
6890: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
68a0: 22 20 20 20 73 65 74 74 69 6e 67 3a 20 5b 22 20 " setting: ["
68b0: 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d curr-section-nam
68c0: 65 20 22 5d 20 22 20 6b 65 79 20 22 20 3d 20 23 e "] " key " = #
68d0: 74 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 t").
68e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
68f0: 20 20 20 20 20 20 20 20 20 28 73 61 66 65 2d 73 (safe-s
6900: 65 74 65 6e 76 20 6b 65 79 20 66 76 61 6c 29 0a etenv key fval).
6910: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6920: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6930: 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 (hash-table
6940: 2d 73 65 74 21 20 72 65 73 20 63 75 72 72 2d 73 -set! res curr-s
6950: 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 0a 20 20 20 ection-name .
6960: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6970: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6980: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6990: 20 20 20 28 63 6f 6e 66 69 67 66 3a 61 73 73 6f (configf:asso
69a0: 63 2d 73 61 66 65 2d 61 64 64 20 61 6c 69 73 74 c-safe-add alist
69b0: 20 6b 65 79 20 66 76 61 6c 20 6d 65 74 61 64 61 key fval metada
69c0: 74 61 3a 20 6d 65 74 61 70 61 74 68 29 29 0a 20 ta: metapath)).
69d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
69e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
69f0: 20 20 20 20 28 6c 6f 6f 70 20 28 63 6f 6e 66 69 (loop (confi
6a00: 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 gf:read-line inp
6a10: 20 72 65 73 0a 20 20 20 20 20 20 20 20 20 20 20 res.
6a20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6a30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6a40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6a50: 20 20 20 28 63 61 6c 63 2d 61 6c 6c 6f 77 2d 73 (calc-allow-s
6a60: 79 73 74 65 6d 20 61 6c 6c 6f 77 2d 73 79 73 74 ystem allow-syst
6a70: 65 6d 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d em curr-section-
6a80: 6e 61 6d 65 20 73 65 63 74 69 6f 6e 73 29 0a 20 name sections).
6a90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6aa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6ab0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6ac0: 20 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 set
6ad0: 74 69 6e 67 73 20 65 6e 76 2d 74 6f 2d 75 73 65 tings env-to-use
6ae0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
6af0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6b00: 20 20 20 20 20 20 20 20 20 20 20 20 20 63 75 72 cur
6b10: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 6b r-section-name k
6b20: 65 79 20 23 66 29 29 29 0a 20 20 20 20 20 20 20 ey #f))).
6b30: 20 20 20 20 20 20 20 20 0a 09 20 20 20 20 20 20 ..
6b40: 20 28 63 6f 6e 66 69 67 66 3a 6b 65 79 2d 76 61 (configf:key-va
6b50: 6c 2d 70 72 20 28 20 78 20 6b 65 79 20 75 6e 6b l-pr ( x key unk
6b60: 31 20 76 61 6c 20 75 6e 6b 32 20 29 0a 20 20 20 1 val unk2 ).
6b70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6b80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6b90: 28 6c 65 74 2a 20 28 28 61 6c 69 73 74 20 20 20 (let* ((alist
6ba0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/
6bb0: 64 65 66 61 75 6c 74 20 72 65 73 20 63 75 72 72 default res curr
6bc0: 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 27 28 -section-name '(
6bd0: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
6be0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6bf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 (e
6c00: 6e 76 61 72 20 20 20 28 61 6e 64 20 65 6e 76 69 nvar (and envi
6c10: 72 6f 6e 2d 70 61 74 74 0a 09 09 09 09 09 09 09 ron-patt........
6c20: 28 73 74 72 69 6e 67 2d 73 65 61 72 63 68 20 28 (string-search (
6c30: 72 65 67 65 78 70 20 65 6e 76 69 72 6f 6e 2d 70 regexp environ-p
6c40: 61 74 74 29 20 63 75 72 72 2d 73 65 63 74 69 6f att) curr-sectio
6c50: 6e 2d 6e 61 6d 65 29 20 3b 3b 20 64 6f 65 73 20 n-name) ;; does
6c60: 74 68 65 20 73 65 63 74 69 6f 6e 20 6d 61 74 63 the section matc
6c70: 68 20 74 68 65 20 65 6e 76 69 6f 6e 70 61 74 74 h the envionpatt
6c80: 3f 0a 09 09 09 09 09 09 09 28 61 6e 64 20 28 6e ?........(and (n
6c90: 6f 74 20 28 73 74 72 69 6e 67 2d 6e 75 6c 6c 3f ot (string-null?
6ca0: 20 6b 65 79 29 29 0a 09 09 09 09 09 09 09 20 20 key))........
6cb0: 20 20 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 (not (equal?
6cc0: 22 21 22 20 28 73 75 62 73 74 72 69 6e 67 20 6b "!" (substring k
6cd0: 65 79 20 30 20 31 29 29 29 29 20 3b 3b 20 21 20 ey 0 1)))) ;; !
6ce0: 61 73 20 6c 65 61 64 69 6e 67 20 63 68 61 72 61 as leading chara
6cf0: 63 74 65 72 20 69 73 20 61 20 73 69 67 6e 61 74 cter is a signat
6d00: 75 72 65 20 74 6f 20 4e 4f 54 20 65 78 70 6f 72 ure to NOT expor
6d10: 74 20 74 6f 20 74 68 65 20 65 6e 76 69 72 6f 6e t to the environ
6d20: 6d 65 6e 74 0a 09 09 09 09 09 09 09 3b 3b 20 28 ment........;; (
6d30: 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 22 5e 2e string-match "^.
6d40: 2a 3a 2e 2a 3a 2e 2a 24 22 20 6b 65 79 29 20 3b *:.*:.*$" key) ;
6d50: 3b 20 3b 3b 20 73 6f 6d 65 74 68 69 6e 67 3a 73 ; ;; something:s
6d60: 6f 6d 65 74 68 69 6e 67 3a 73 6f 6d 65 74 68 69 omething:somethi
6d70: 6e 67 20 72 65 73 65 72 76 65 64 20 66 6f 72 20 ng reserved for
6d80: 74 72 69 67 67 65 72 73 20 69 6e 20 72 75 6e 63 triggers in runc
6d90: 6f 6e 66 69 67 73 0a 09 09 09 09 09 09 09 29 29 onfigs........))
6da0: 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
6db0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6dc0: 20 20 20 20 20 20 20 20 20 20 20 20 28 72 65 61 (rea
6dd0: 6c 76 61 6c 20 28 69 66 20 65 6e 76 61 72 0a 20 lval (if envar.
6de0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6df0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6e00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6e10: 20 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 65 (configf:e
6e20: 76 61 6c 2d 73 74 72 69 6e 67 2d 69 6e 2d 65 6e val-string-in-en
6e30: 76 69 72 6f 6e 6d 65 6e 74 20 76 61 6c 29 0a 20 vironment val).
6e40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6e50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6e60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6e70: 20 20 20 20 20 20 76 61 6c 29 29 29 0a 20 20 20 val))).
6e80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6e90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6ea0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 (debug:print-i
6eb0: 6e 66 6f 20 36 20 2a 64 65 66 61 75 6c 74 2d 6c nfo 6 *default-l
6ec0: 6f 67 2d 70 6f 72 74 2a 20 22 63 6f 6e 66 69 67 og-port* "config
6ed0: 66 3a 72 65 61 64 2d 63 6f 6e 66 69 67 20 65 6e f:read-config en
6ee0: 76 20 73 65 74 74 69 6e 67 2c 20 65 6e 76 61 72 v setting, envar
6ef0: 3a 20 22 20 65 6e 76 61 72 20 22 20 72 65 61 6c : " envar " real
6f00: 76 61 6c 3a 20 22 20 72 65 61 6c 76 61 6c 20 22 val: " realval "
6f10: 20 76 61 6c 3a 20 22 20 76 61 6c 20 22 20 6b 65 val: " val " ke
6f20: 79 3a 20 22 20 6b 65 79 20 22 20 63 75 72 72 2d y: " key " curr-
6f30: 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 3a 20 22 20 section-name: "
6f40: 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d curr-section-nam
6f50: 65 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 e).
6f60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6f70: 20 20 20 20 20 20 20 20 28 69 66 20 65 6e 76 61 (if enva
6f80: 72 20 28 73 61 66 65 2d 73 65 74 65 6e 76 20 6b r (safe-setenv k
6f90: 65 79 20 72 65 61 6c 76 61 6c 29 29 0a 20 20 20 ey realval)).
6fa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6fb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6fc0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 31 (debug:print 1
6fd0: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
6fe0: 6f 72 74 2a 20 22 20 20 20 73 65 74 74 69 6e 67 ort* " setting
6ff0: 3a 20 5b 22 20 63 75 72 72 2d 73 65 63 74 69 6f : [" curr-sectio
7000: 6e 2d 6e 61 6d 65 20 22 5d 20 22 20 6b 65 79 20 n-name "] " key
7010: 22 20 3d 20 22 20 76 61 6c 29 0a 20 20 20 20 20 " = " val).
7020: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7030: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7040: 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 (hash-table-set!
7050: 20 72 65 73 20 63 75 72 72 2d 73 65 63 74 69 6f res curr-sectio
7060: 6e 2d 6e 61 6d 65 20 0a 20 20 20 20 20 20 20 20 n-name .
7070: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7080: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7090: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
70a0: 6f 6e 66 69 67 66 3a 61 73 73 6f 63 2d 73 61 66 onfigf:assoc-saf
70b0: 65 2d 61 64 64 20 61 6c 69 73 74 20 6b 65 79 20 e-add alist key
70c0: 72 65 61 6c 76 61 6c 20 6d 65 74 61 64 61 74 61 realval metadata
70d0: 3a 20 6d 65 74 61 70 61 74 68 29 29 0a 20 20 20 : metapath)).
70e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
70f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7100: 20 20 28 6c 6f 6f 70 20 28 63 6f 6e 66 69 67 66 (loop (configf
7110: 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 20 72 :read-line inp r
7120: 65 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 es.
7130: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7140: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7150: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7160: 20 28 63 61 6c 63 2d 61 6c 6c 6f 77 2d 73 79 73 (calc-allow-sys
7170: 74 65 6d 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d tem allow-system
7180: 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 curr-section-na
7190: 6d 65 20 73 65 63 74 69 6f 6e 73 29 20 73 65 74 me sections) set
71a0: 74 69 6e 67 73 20 65 6e 76 2d 74 6f 2d 75 73 65 tings env-to-use
71b0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
71c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
71d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 63 75 72 cur
71e0: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 6b r-section-name k
71f0: 65 79 20 23 66 29 29 29 0a 09 20 20 20 20 20 20 ey #f)))..
7200: 20 3b 3b 20 69 66 20 61 20 63 6f 6e 74 69 6e 75 ;; if a continu
7210: 65 64 20 6c 69 6e 65 0a 09 20 20 20 20 20 20 20 ed line..
7220: 28 63 6f 6e 66 69 67 66 3a 63 6f 6e 74 2d 6c 6e (configf:cont-ln
7230: 2d 72 78 20 28 20 78 20 77 68 73 70 20 76 61 6c -rx ( x whsp val
7240: 20 20 20 20 20 29 0a 20 20 20 20 20 20 20 20 20 ).
7250: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7260: 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 (let (
7270: 28 61 6c 69 73 74 20 28 68 61 73 68 2d 74 61 62 (alist (hash-tab
7280: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 72 le-ref/default r
7290: 65 73 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d es curr-section-
72a0: 6e 61 6d 65 20 27 28 29 29 29 29 0a 20 20 20 20 name '()))).
72b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
72c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
72d0: 20 28 69 66 20 76 61 72 2d 66 6c 61 67 20 20 20 (if var-flag
72e0: 20 20 20 20 20 20 20 20 20 20 3b 3b 20 69 66 20 ;; if
72f0: 73 65 74 20 74 6f 20 61 20 73 74 72 69 6e 67 20 set to a string
7300: 74 68 65 6e 20 77 65 20 68 61 76 65 20 61 20 63 then we have a c
7310: 6f 6e 74 69 6e 75 65 64 20 76 61 72 0a 20 20 20 ontinued var.
7320: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7330: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7340: 20 20 20 20 20 20 28 6c 65 74 20 28 28 6e 65 77 (let ((new
7350: 76 61 6c 20 28 63 6f 6e 63 20 0a 20 20 20 20 20 val (conc .
7360: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7370: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7380: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7390: 20 20 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b (configf:look
73a0: 75 70 20 72 65 73 20 63 75 72 72 2d 73 65 63 74 up res curr-sect
73b0: 69 6f 6e 2d 6e 61 6d 65 20 76 61 72 2d 66 6c 61 ion-name var-fla
73c0: 67 29 20 22 5c 6e 22 0a 20 20 20 20 20 20 20 20 g) "\n".
73d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
73e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
73f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7400: 3b 3b 20 74 72 69 6d 20 6c 65 61 64 20 66 72 6f ;; trim lead fro
7410: 6d 20 74 68 65 20 69 6e 63 6f 6d 69 6e 67 20 77 m the incoming w
7420: 68 73 70 20 74 6f 20 73 75 70 70 6f 72 74 20 73 hsp to support s
7430: 6f 6d 65 20 69 6e 64 65 6e 74 69 6e 67 2e 0a 20 ome indenting..
7440: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7450: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7460: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7470: 20 20 20 20 20 20 20 28 69 66 20 6c 65 61 64 0a (if lead.
7480: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7490: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
74a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
74b0: 20 20 20 20 20 20 20 20 20 20 20 20 28 73 74 72 (str
74c0: 69 6e 67 2d 73 75 62 73 74 69 74 75 74 65 20 28 ing-substitute (
74d0: 72 65 67 65 78 70 20 6c 65 61 64 29 20 22 22 20 regexp lead) ""
74e0: 77 68 73 70 29 0a 20 20 20 20 20 20 20 20 20 20 whsp).
74f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7500: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7510: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7520: 20 20 22 22 29 0a 20 20 20 20 20 20 20 20 20 20 "").
7530: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7540: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7550: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 76 61 va
7560: 6c 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 l))).
7570: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7580: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7590: 3b 3b 20 28 70 72 69 6e 74 20 22 76 61 6c 3a 20 ;; (print "val:
75a0: 22 20 76 61 6c 20 22 5c 6e 6e 65 77 76 61 6c 3a " val "\nnewval:
75b0: 20 5c 22 22 20 6e 65 77 76 61 6c 20 22 5c 22 5c \"" newval "\"\
75c0: 6e 76 61 72 66 6c 61 67 3a 20 22 20 76 61 72 2d nvarflag: " var-
75d0: 66 6c 61 67 29 0a 20 20 20 20 20 20 20 20 20 20 flag).
75e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
75f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7600: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 (hash-table-set
7610: 21 20 72 65 73 20 63 75 72 72 2d 73 65 63 74 69 ! res curr-secti
7620: 6f 6e 2d 6e 61 6d 65 20 0a 20 20 20 20 20 20 20 on-name .
7630: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7640: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7650: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7660: 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 61 73 (configf:as
7670: 73 6f 63 2d 73 61 66 65 2d 61 64 64 20 61 6c 69 soc-safe-add ali
7680: 73 74 20 76 61 72 2d 66 6c 61 67 20 6e 65 77 76 st var-flag newv
7690: 61 6c 20 6d 65 74 61 64 61 74 61 3a 20 6d 65 74 al metadata: met
76a0: 61 70 61 74 68 29 29 0a 20 20 20 20 20 20 20 20 apath)).
76b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
76c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
76d0: 20 20 20 28 6c 6f 6f 70 20 28 63 6f 6e 66 69 67 (loop (config
76e0: 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 20 f:read-line inp
76f0: 72 65 73 20 28 63 61 6c 63 2d 61 6c 6c 6f 77 2d res (calc-allow-
7700: 73 79 73 74 65 6d 20 61 6c 6c 6f 77 2d 73 79 73 system allow-sys
7710: 74 65 6d 20 63 75 72 72 2d 73 65 63 74 69 6f 6e tem curr-section
7720: 2d 6e 61 6d 65 20 73 65 63 74 69 6f 6e 73 29 20 -name sections)
7730: 73 65 74 74 69 6e 67 73 20 65 6e 76 2d 74 6f 2d settings env-to-
7740: 75 73 65 29 20 63 75 72 72 2d 73 65 63 74 69 6f use) curr-sectio
7750: 6e 2d 6e 61 6d 65 20 76 61 72 2d 66 6c 61 67 20 n-name var-flag
7760: 28 69 66 20 6c 65 61 64 20 6c 65 61 64 20 77 68 (if lead lead wh
7770: 73 70 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 sp))).
7780: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7790: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
77a0: 6c 6f 6f 70 20 28 63 6f 6e 66 69 67 66 3a 72 65 loop (configf:re
77b0: 61 64 2d 6c 69 6e 65 20 69 6e 70 20 72 65 73 20 ad-line inp res
77c0: 28 63 61 6c 63 2d 61 6c 6c 6f 77 2d 73 79 73 74 (calc-allow-syst
77d0: 65 6d 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 em allow-system
77e0: 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d curr-section-nam
77f0: 65 20 73 65 63 74 69 6f 6e 73 29 20 73 65 74 74 e sections) sett
7800: 69 6e 67 73 20 65 6e 76 2d 74 6f 2d 75 73 65 29 ings env-to-use)
7810: 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 curr-section-na
7820: 6d 65 20 23 66 20 23 66 29 29 29 29 0a 09 20 20 me #f #f))))..
7830: 20 20 20 20 20 28 65 6c 73 65 20 28 64 65 62 75 (else (debu
7840: 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 g:print-error 0
7850: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
7860: 74 2a 20 22 70 72 6f 62 6c 65 6d 20 70 61 72 73 t* "problem pars
7870: 69 6e 67 20 22 20 70 61 74 68 20 22 2c 5c 6e 20 ing " path ",\n
7880: 20 20 5c 22 22 20 69 6e 6c 20 22 5c 22 22 29 0a \"" inl "\"").
7890: 09 09 20 20 20 20 20 28 73 65 74 21 20 76 61 72 .. (set! var
78a0: 2d 66 6c 61 67 20 23 66 29 0a 09 09 20 20 20 20 -flag #f)...
78b0: 20 28 6c 6f 6f 70 20 28 63 6f 6e 66 69 67 66 3a (loop (configf:
78c0: 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 20 72 65 read-line inp re
78d0: 73 20 28 63 61 6c 63 2d 61 6c 6c 6f 77 2d 73 79 s (calc-allow-sy
78e0: 73 74 65 6d 20 61 6c 6c 6f 77 2d 73 79 73 74 65 stem allow-syste
78f0: 6d 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e m curr-section-n
7900: 61 6d 65 20 73 65 63 74 69 6f 6e 73 29 20 73 65 ame sections) se
7910: 74 74 69 6e 67 73 20 65 6e 76 2d 74 6f 2d 75 73 ttings env-to-us
7920: 65 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d e) curr-section-
7930: 6e 61 6d 65 20 23 66 20 23 66 29 29 29 29 0a 20 name #f #f)))).
7940: 20 20 20 20 20 20 20 20 20 29 20 3b 3b 20 65 6e ) ;; en
7950: 64 20 6c 6f 6f 70 0a 20 20 20 20 20 20 20 20 29 d loop. )
7960: 29 29 0a 20 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d )). .;;========
7970: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7980: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7990: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
79a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
79b0: 3b 20 6c 6f 6f 6b 75 70 20 61 6e 64 20 6d 61 6e ; lookup and man
79c0: 69 70 75 6c 61 74 69 6f 6e 20 72 6f 75 74 69 6e ipulation routin
79d0: 65 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d es.;;===========
79e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
79f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7a00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7a10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 ===========..;;
7a20: 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 66 (define (configf
7a30: 3a 61 73 73 6f 63 2d 73 61 66 65 2d 61 64 64 20 :assoc-safe-add
7a40: 61 6c 69 73 74 20 6b 65 79 20 76 61 6c 20 23 21 alist key val #!
7a50: 6b 65 79 20 28 6d 65 74 61 64 61 74 61 20 23 66 key (metadata #f
7a60: 29 29 0a 3b 3b 20 20 20 28 6c 65 74 20 28 28 6e )).;; (let ((n
7a70: 65 77 61 6c 69 73 74 20 28 66 69 6c 74 65 72 20 ewalist (filter
7a80: 28 6c 61 6d 62 64 61 20 28 78 29 28 6e 6f 74 20 (lambda (x)(not
7a90: 28 65 71 75 61 6c 3f 20 6b 65 79 20 28 63 61 72 (equal? key (car
7aa0: 20 78 29 29 29 29 20 61 6c 69 73 74 29 29 29 0a x)))) alist))).
7ab0: 3b 3b 20 20 20 20 20 28 61 70 70 65 6e 64 20 6e ;; (append n
7ac0: 65 77 61 6c 69 73 74 20 28 6c 69 73 74 20 28 69 ewalist (list (i
7ad0: 66 20 6d 65 74 61 64 61 74 61 0a 3b 3b 20 09 09 f metadata.;; ..
7ae0: 09 20 20 20 20 20 20 20 28 6c 69 73 74 20 6b 65 . (list ke
7af0: 79 20 76 61 6c 20 6d 65 74 61 64 61 74 61 29 0a y val metadata).
7b00: 3b 3b 20 09 09 09 20 20 20 20 20 20 20 28 6c 69 ;; ... (li
7b10: 73 74 20 6b 65 79 20 76 61 6c 29 29 29 29 29 29 st key val))))))
7b20: 0a 3b 3b 20 0a 3b 3b 20 28 64 65 66 69 6e 65 20 .;; .;; (define
7b30: 28 63 6f 6e 66 69 67 66 3a 73 65 63 74 69 6f 6e (configf:section
7b40: 2d 76 61 72 2d 73 65 74 21 20 63 66 67 64 61 74 -var-set! cfgdat
7b50: 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 76 61 section-name va
7b60: 72 20 76 61 6c 75 65 20 23 21 6b 65 79 20 28 6d r value #!key (m
7b70: 65 74 61 64 61 74 61 20 23 66 29 29 0a 3b 3b 20 etadata #f)).;;
7b80: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 (hash-table-se
7b90: 74 21 20 63 66 67 64 61 74 20 73 65 63 74 69 6f t! cfgdat sectio
7ba0: 6e 2d 6e 61 6d 65 0a 3b 3b 20 09 09 20 20 20 28 n-name.;; .. (
7bb0: 63 6f 6e 66 69 67 66 3a 61 73 73 6f 63 2d 73 61 configf:assoc-sa
7bc0: 66 65 2d 61 64 64 0a 3b 3b 20 09 09 20 20 20 20 fe-add.;; ..
7bd0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/
7be0: 64 65 66 61 75 6c 74 20 63 66 67 64 61 74 20 73 default cfgdat s
7bf0: 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 27 28 29 29 ection-name '())
7c00: 0a 3b 3b 20 09 09 20 20 20 20 76 61 72 20 76 61 .;; .. var va
7c10: 6c 75 65 20 6d 65 74 61 64 61 74 61 3a 20 6d 65 lue metadata: me
7c20: 74 61 64 61 74 61 29 29 29 0a 3b 3b 20 0a 3b 3b tadata))).;; .;;
7c30: 20 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 (define (config
7c40: 66 3a 6c 6f 6f 6b 75 70 20 63 66 67 64 61 74 20 f:lookup cfgdat
7c50: 73 65 63 74 69 6f 6e 20 76 61 72 29 0a 3b 3b 20 section var).;;
7c60: 20 20 28 69 66 20 28 68 61 73 68 2d 74 61 62 6c (if (hash-tabl
7c70: 65 3f 20 63 66 67 64 61 74 29 0a 3b 3b 20 20 20 e? cfgdat).;;
7c80: 20 20 20 20 28 6c 65 74 20 28 28 73 65 63 74 64 (let ((sectd
7c90: 61 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 at (hash-table-r
7ca0: 65 66 2f 64 65 66 61 75 6c 74 20 63 66 67 64 61 ef/default cfgda
7cb0: 74 20 73 65 63 74 69 6f 6e 20 27 28 29 29 29 29 t section '())))
7cc0: 0a 3b 3b 20 09 28 69 66 20 28 6e 75 6c 6c 3f 20 .;; .(if (null?
7cd0: 73 65 63 74 64 61 74 29 0a 3b 3b 20 09 20 20 20 sectdat).;; .
7ce0: 20 23 66 0a 3b 3b 20 09 20 20 20 20 28 6c 65 74 #f.;; . (let
7cf0: 20 28 28 6d 61 74 63 68 20 28 61 73 73 6f 63 20 ((match (assoc
7d00: 76 61 72 20 73 65 63 74 64 61 74 29 29 29 0a 3b var sectdat))).;
7d10: 3b 20 09 20 20 20 20 20 20 28 69 66 20 6d 61 74 ; . (if mat
7d20: 63 68 20 3b 3b 20 28 61 6e 64 20 6d 61 74 63 68 ch ;; (and match
7d30: 20 28 6c 69 73 74 3f 20 6d 61 74 63 68 29 28 3e (list? match)(>
7d40: 20 28 6c 65 6e 67 74 68 20 6d 61 74 63 68 29 20 (length match)
7d50: 31 29 29 0a 3b 3b 20 09 09 20 20 28 63 61 64 72 1)).;; .. (cadr
7d60: 20 6d 61 74 63 68 29 0a 3b 3b 20 09 09 20 20 23 match).;; .. #
7d70: 66 29 29 0a 3b 3b 20 09 20 20 20 20 29 29 0a 3b f)).;; . )).;
7d80: 3b 20 20 20 20 20 20 20 23 66 29 29 0a 3b 3b 20 ; #f)).;;
7d90: 0a 3b 3b 20 3b 3b 20 75 73 65 20 74 6f 20 68 61 .;; ;; use to ha
7da0: 76 65 20 64 65 66 69 6e 69 74 69 76 65 20 73 65 ve definitive se
7db0: 74 74 69 6e 67 3a 0a 3b 3b 20 3b 3b 20 20 5b 66 tting:.;; ;; [f
7dc0: 6f 6f 5d 0a 3b 3b 20 3b 3b 20 20 76 61 72 20 79 oo].;; ;; var y
7dd0: 65 73 0a 3b 3b 20 3b 3b 0a 3b 3b 20 3b 3b 20 20 es.;; ;;.;; ;;
7de0: 28 63 6f 6e 66 69 67 66 3a 76 61 72 2d 69 73 3f (configf:var-is?
7df0: 20 63 66 67 64 61 74 20 22 66 6f 6f 22 20 22 76 cfgdat "foo" "v
7e00: 61 72 22 20 22 79 65 73 22 29 20 3d 3e 20 23 74 ar" "yes") => #t
7e10: 0a 3b 3b 20 3b 3b 0a 3b 3b 20 28 64 65 66 69 6e .;; ;;.;; (defin
7e20: 65 20 28 63 6f 6e 66 69 67 66 3a 76 61 72 2d 69 e (configf:var-i
7e30: 73 3f 20 63 66 67 64 61 74 20 73 65 63 74 69 6f s? cfgdat sectio
7e40: 6e 20 76 61 72 20 65 78 70 65 63 74 65 64 2d 76 n var expected-v
7e50: 61 6c 29 0a 3b 3b 20 20 20 28 65 71 75 61 6c 3f al).;; (equal?
7e60: 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 (configf:lookup
7e70: 20 63 66 67 64 61 74 20 73 65 63 74 69 6f 6e 20 cfgdat section
7e80: 76 61 72 29 20 65 78 70 65 63 74 65 64 2d 76 61 var) expected-va
7e90: 6c 29 29 0a 3b 3b 20 0a 0a 3b 3b 20 3b 3b 20 73 l)).;; ..;; ;; s
7ea0: 61 66 65 6c 79 20 6c 6f 6f 6b 20 75 70 20 61 20 afely look up a
7eb0: 76 61 6c 75 65 20 74 68 61 74 20 69 73 20 65 78 value that is ex
7ec0: 70 65 63 74 65 64 20 74 6f 20 62 65 20 61 20 6e pected to be a n
7ed0: 75 6d 62 65 72 2c 20 72 65 74 75 72 6e 0a 3b 3b umber, return.;;
7ee0: 20 3b 3b 20 61 20 64 65 66 61 75 6c 74 20 28 23 ;; a default (#
7ef0: 66 20 75 6e 6c 65 73 73 20 70 72 6f 76 69 64 65 f unless provide
7f00: 64 29 0a 3b 3b 20 3b 3b 0a 3b 3b 20 28 64 65 66 d).;; ;;.;; (def
7f10: 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f ine (configf:loo
7f20: 6b 75 70 2d 6e 75 6d 62 65 72 20 63 66 64 61 74 kup-number cfdat
7f30: 20 73 65 63 74 69 6f 6e 20 76 61 72 6e 61 6d 65 section varname
7f40: 20 23 21 6b 65 79 20 28 64 65 66 61 75 6c 74 20 #!key (default
7f50: 23 66 29 29 0a 3b 3b 20 20 20 28 6c 65 74 2a 20 #f)).;; (let*
7f60: 28 28 76 61 6c 20 28 63 6f 6e 66 69 67 66 3a 6c ((val (configf:l
7f70: 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 ookup *configdat
7f80: 2a 20 73 65 63 74 69 6f 6e 20 76 61 72 6e 61 6d * section varnam
7f90: 65 29 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 e)).;;
7fa0: 28 72 65 73 20 28 69 66 20 76 61 6c 0a 3b 3b 20 (res (if val.;;
7fb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7fc0: 20 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 (string->numbe
7fd0: 72 20 28 73 74 72 69 6e 67 2d 73 75 62 73 74 69 r (string-substi
7fe0: 74 75 74 65 20 22 5c 5c 73 2b 22 20 22 22 20 76 tute "\\s+" "" v
7ff0: 61 6c 20 23 74 29 29 0a 3b 3b 20 20 20 20 20 20 al #t)).;;
8000: 20 20 20 20 20 20 20 20 20 20 20 20 20 23 66 29 #f)
8010: 29 29 0a 3b 3b 20 20 20 20 20 28 63 6f 6e 64 0a )).;; (cond.
8020: 3b 3b 20 20 20 20 20 20 28 72 65 73 20 20 72 65 ;; (res re
8030: 73 29 0a 3b 3b 20 20 20 20 20 20 28 76 61 6c 20 s).;; (val
8040: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
8050: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
8060: 74 2a 20 22 45 52 52 4f 52 3a 20 6e 6f 20 6e 75 t* "ERROR: no nu
8070: 6d 62 65 72 20 66 6f 75 6e 64 20 66 6f 72 20 5b mber found for [
8080: 22 20 73 65 63 74 69 6f 6e 20 22 5d 2c 20 22 20 " section "], "
8090: 76 61 72 6e 61 6d 65 20 22 2c 20 67 6f 74 3a 20 varname ", got:
80a0: 22 20 76 61 6c 29 29 0a 3b 3b 20 20 20 20 20 20 " val)).;;
80b0: 28 65 6c 73 65 20 64 65 66 61 75 6c 74 29 29 29 (else default)))
80c0: 29 0a 3b 3b 20 0a 3b 3b 20 28 64 65 66 69 6e 65 ).;; .;; (define
80d0: 20 28 63 6f 6e 66 69 67 66 3a 73 65 63 74 69 6f (configf:sectio
80e0: 6e 2d 76 61 72 73 20 63 66 67 64 61 74 20 73 65 n-vars cfgdat se
80f0: 63 74 69 6f 6e 29 0a 3b 3b 20 20 20 28 6c 65 74 ction).;; (let
8100: 20 28 28 73 65 63 74 64 61 74 20 28 68 61 73 68 ((sectdat (hash
8110: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau
8120: 6c 74 20 63 66 67 64 61 74 20 73 65 63 74 69 6f lt cfgdat sectio
8130: 6e 20 27 28 29 29 29 29 0a 3b 3b 20 20 20 20 20 n '()))).;;
8140: 28 69 66 20 28 6e 75 6c 6c 3f 20 73 65 63 74 64 (if (null? sectd
8150: 61 74 29 0a 3b 3b 20 09 27 28 29 0a 3b 3b 20 09 at).;; .'().;; .
8160: 28 6d 61 70 20 63 61 72 20 73 65 63 74 64 61 74 (map car sectdat
8170: 29 29 29 29 0a 3b 3b 20 0a 3b 3b 20 28 64 65 66 )))).;; .;; (def
8180: 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a 67 65 74 ine (configf:get
8190: 2d 73 65 63 74 69 6f 6e 20 63 66 67 64 61 74 20 -section cfgdat
81a0: 73 65 63 74 69 6f 6e 29 0a 3b 3b 20 20 20 28 68 section).;; (h
81b0: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
81c0: 66 61 75 6c 74 20 63 66 67 64 61 74 20 73 65 63 fault cfgdat sec
81d0: 74 69 6f 6e 20 27 28 29 29 29 0a 3b 3b 20 0a 3b tion '())).;; .;
81e0: 3b 20 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 ; (define (confi
81f0: 67 66 3a 73 65 74 2d 73 65 63 74 69 6f 6e 2d 76 gf:set-section-v
8200: 61 72 20 63 66 67 64 61 74 20 73 65 63 74 69 6f ar cfgdat sectio
8210: 6e 20 76 61 72 20 76 61 6c 29 0a 3b 3b 20 20 20 n var val).;;
8220: 28 6c 65 74 20 28 28 73 65 63 74 64 61 74 20 28 (let ((sectdat (
8230: 63 6f 6e 66 69 67 66 3a 67 65 74 2d 73 65 63 74 configf:get-sect
8240: 69 6f 6e 20 63 66 67 64 61 74 20 73 65 63 74 69 ion cfgdat secti
8250: 6f 6e 29 29 29 0a 3b 3b 20 20 20 20 20 28 68 61 on))).;; (ha
8260: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 63 66 sh-table-set! cf
8270: 67 64 61 74 20 73 65 63 74 69 6f 6e 0a 3b 3b 20 gdat section.;;
8280: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8290: 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 61 73 (configf:as
82a0: 73 6f 63 2d 73 61 66 65 2d 61 64 64 20 73 65 63 soc-safe-add sec
82b0: 74 64 61 74 20 76 61 72 20 76 61 6c 29 29 29 29 tdat var val))))
82c0: 0a 3b 3b 20 0a 3b 3b 20 20 20 20 20 3b 3b 28 61 .;; .;; ;;(a
82d0: 70 70 65 6e 64 20 28 66 69 6c 74 65 72 20 28 6c ppend (filter (l
82e0: 61 6d 62 64 61 20 28 78 29 28 6e 6f 74 20 28 61 ambda (x)(not (a
82f0: 73 73 6f 63 20 76 61 72 20 73 65 63 74 64 61 74 ssoc var sectdat
8300: 29 29 29 20 73 65 63 74 64 61 74 29 0a 3b 3b 20 ))) sectdat).;;
8310: 20 20 20 20 3b 3b 09 20 20 20 20 28 6c 69 73 74 ;;. (list
8320: 20 76 61 72 20 76 61 6c 29 29 29 29 0a 3b 3b 20 var val)))).;;
8330: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
8340: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8350: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8360: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8370: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 73 65 74 =========.;; set
8380: 75 70 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d up.;;===========
8390: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
83a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
83b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
83c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 3d 3d ===========.;;==
83d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
83e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
83f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8400: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8410: 3d 3d 3d 3d 0a 0a 3b 3b 20 54 68 69 73 20 73 68 ====..;; This sh
8420: 6f 75 6c 64 20 6e 6f 74 20 62 65 20 68 65 72 65 ould not be here
8430: 2e 0a 23 3b 28 64 65 66 69 6e 65 20 28 73 65 74 ..#;(define (set
8440: 75 70 29 0a 20 20 28 6c 65 74 2a 20 28 28 63 6f up). (let* ((co
8450: 6e 66 69 67 66 20 28 66 69 6e 64 2d 63 6f 6e 66 nfigf (find-conf
8460: 69 67 20 22 6d 65 67 61 74 65 73 74 2e 63 6f 6e ig "megatest.con
8470: 66 69 67 22 29 29 0a 09 20 28 63 6f 6e 66 69 67 fig")).. (config
8480: 20 20 28 69 66 20 63 6f 6e 66 69 67 66 20 28 63 (if configf (c
8490: 6f 6e 66 69 67 66 3a 72 65 61 64 2d 63 6f 6e 66 onfigf:read-conf
84a0: 69 67 20 63 6f 6e 66 69 67 66 20 23 66 20 23 74 ig configf #f #t
84b0: 29 20 23 66 29 29 29 0a 20 20 20 20 28 69 66 20 ) #f))). (if
84c0: 63 6f 6e 66 69 67 0a 09 28 73 65 74 65 6e 76 20 config..(setenv
84d0: 22 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 22 20 "RUN_AREA_HOME"
84e0: 28 70 61 74 68 6e 61 6d 65 2d 64 69 72 65 63 74 (pathname-direct
84f0: 6f 72 79 20 63 6f 6e 66 69 67 66 29 29 29 0a 20 ory configf))).
8500: 20 20 20 63 6f 6e 66 69 67 29 29 0a 0a 28 64 65 config))..(de
8510: 66 69 6e 65 20 28 73 61 66 65 2d 73 65 74 65 6e fine (safe-seten
8520: 76 20 6b 65 79 20 76 61 6c 29 0a 20 20 28 69 66 v key val). (if
8530: 20 28 6f 72 20 28 73 75 62 73 74 72 69 6e 67 2d (or (substring-
8540: 69 6e 64 65 78 20 22 21 22 20 6b 65 79 29 0a 09 index "!" key)..
8550: 20 20 28 73 75 62 73 74 72 69 6e 67 2d 69 6e 64 (substring-ind
8560: 65 78 20 22 3a 22 20 6b 65 79 29 20 20 3b 3b 20 ex ":" key) ;;
8570: 76 61 72 69 61 62 6c 65 73 20 63 6f 6e 74 61 69 variables contai
8580: 6e 69 6e 67 20 3a 20 61 72 65 20 66 6f 72 20 69 ning : are for i
8590: 6e 74 65 72 6e 61 6c 20 75 73 65 20 61 6e 64 20 nternal use and
85a0: 63 61 6e 6e 6f 74 20 62 65 20 65 6e 76 69 72 6f cannot be enviro
85b0: 6e 6d 65 6e 74 20 76 61 72 69 61 62 6c 65 73 2e nment variables.
85c0: 0a 09 20 20 28 73 75 62 73 74 72 69 6e 67 2d 69 .. (substring-i
85d0: 6e 64 65 78 20 22 2e 22 20 6b 65 79 29 29 20 3b ndex "." key)) ;
85e0: 3b 20 70 65 72 69 6f 64 73 20 61 72 65 20 6e 6f ; periods are no
85f0: 74 20 61 6c 6c 6f 77 65 64 20 69 6e 20 65 6e 76 t allowed in env
8600: 69 72 6f 6e 6d 65 6e 74 20 76 61 72 69 61 62 6c ironment variabl
8610: 65 73 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a es. (debug:
8620: 70 72 69 6e 74 2d 65 72 72 6f 72 20 34 20 2a 64 print-error 4 *d
8630: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
8640: 20 22 73 6b 69 70 20 73 65 74 74 69 6e 67 20 69 "skip setting i
8650: 6e 74 65 72 6e 61 6c 20 75 73 65 20 6f 6e 6c 79 nternal use only
8660: 20 76 61 72 69 61 62 6c 65 73 20 63 6f 6e 74 61 variables conta
8670: 69 6e 69 6e 67 20 5c 22 3a 5c 22 20 6f 72 20 73 ining \":\" or s
8680: 74 61 72 74 69 6e 67 20 77 69 74 68 20 5c 22 21 tarting with \"!
8690: 5c 22 22 29 0a 20 20 20 20 20 20 28 69 66 20 28 \""). (if (
86a0: 61 6e 64 20 28 73 74 72 69 6e 67 3f 20 76 61 6c and (string? val
86b0: 29 0a 09 20 20 20 20 20 20 20 28 73 74 72 69 6e ).. (strin
86c0: 67 3f 20 6b 65 79 29 29 0a 09 20 20 28 68 61 6e g? key)).. (han
86d0: 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 dle-exceptions..
86e0: 20 20 20 20 20 20 65 78 6e 0a 09 20 20 20 20 20 exn..
86f0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 (debug:print-er
8700: 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c ror 0 *default-l
8710: 6f 67 2d 70 6f 72 74 2a 20 22 62 61 64 20 76 61 og-port* "bad va
8720: 6c 75 65 20 66 6f 72 20 73 65 74 65 6e 76 2c 20 lue for setenv,
8730: 6b 65 79 3d 22 20 6b 65 79 20 22 2c 20 76 61 6c key=" key ", val
8740: 75 65 3d 22 20 76 61 6c 20 22 2c 20 65 78 6e 3d ue=" val ", exn=
8750: 22 20 65 78 6e 29 0a 09 20 20 20 20 28 73 65 74 " exn).. (set
8760: 65 6e 76 20 6b 65 79 20 76 61 6c 29 29 0a 09 20 env key val))..
8770: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 (debug:print-er
8780: 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c ror 0 *default-l
8790: 6f 67 2d 70 6f 72 74 2a 20 22 62 61 64 20 76 61 og-port* "bad va
87a0: 6c 75 65 20 66 6f 72 20 73 65 74 65 6e 76 2c 20 lue for setenv,
87b0: 6b 65 79 3d 22 20 6b 65 79 20 22 2c 20 76 61 6c key=" key ", val
87c0: 75 65 3d 22 20 76 61 6c 29 29 29 29 0a 0a 3b 3b ue=" val))))..;;
87d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
87e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
87f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8800: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8810: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 61 63 63 65 70 74 ======.;; accept
8820: 20 61 6e 20 61 6c 69 73 74 20 6f 72 20 68 61 73 an alist or has
8830: 68 20 74 61 62 6c 65 20 63 6f 6e 74 61 69 6e 69 h table containi
8840: 6e 67 20 65 6e 76 76 61 72 2f 65 6e 76 20 76 61 ng envvar/env va
8850: 6c 75 65 20 70 61 69 72 73 20 28 76 61 6c 75 65 lue pairs (value
8860: 20 6f 66 20 23 66 20 63 61 75 73 65 73 20 75 6e of #f causes un
8870: 73 65 74 29 20 0a 3b 3b 20 20 20 65 78 65 63 75 set) .;; execu
8880: 74 65 20 74 68 75 6e 6b 20 69 6e 20 63 6f 6e 74 te thunk in cont
8890: 65 78 74 20 6f 66 20 65 6e 76 69 72 6f 6e 6d 65 ext of environme
88a0: 6e 74 20 6d 6f 64 69 66 69 65 64 20 61 73 20 70 nt modified as p
88b0: 65 72 20 74 68 69 73 20 6c 69 73 74 0a 3b 3b 20 er this list.;;
88c0: 20 20 72 65 73 74 6f 72 65 20 65 6e 76 20 74 6f restore env to
88d0: 20 70 72 69 6f 72 20 73 74 61 74 65 20 74 68 65 prior state the
88e0: 6e 20 72 65 74 75 72 6e 20 76 61 6c 75 65 20 6f n return value o
88f0: 66 20 65 76 61 6c 27 64 20 74 68 75 6e 6b 2e 0a f eval'd thunk..
8900: 3b 3b 20 20 20 2a 2a 20 74 68 69 73 20 69 73 20 ;; ** this is
8910: 6e 6f 74 20 74 68 72 65 61 64 20 73 61 66 65 20 not thread safe
8920: 2a 2a 0a 28 64 65 66 69 6e 65 20 28 63 6f 6d 6d **.(define (comm
8930: 6f 6e 3a 77 69 74 68 2d 65 6e 76 2d 76 61 72 73 on:with-env-vars
8940: 20 64 65 6c 74 61 2d 65 6e 76 2d 61 6c 69 73 74 delta-env-alist
8950: 2d 6f 72 2d 68 61 73 68 2d 74 61 62 6c 65 20 74 -or-hash-table t
8960: 68 75 6e 6b 29 0a 20 20 28 6c 65 74 2a 20 28 28 hunk). (let* ((
8970: 64 65 6c 74 61 2d 65 6e 76 2d 61 6c 69 73 74 20 delta-env-alist
8980: 28 69 66 20 28 68 61 73 68 2d 74 61 62 6c 65 3f (if (hash-table?
8990: 20 64 65 6c 74 61 2d 65 6e 76 2d 61 6c 69 73 74 delta-env-alist
89a0: 2d 6f 72 2d 68 61 73 68 2d 74 61 62 6c 65 29 0a -or-hash-table).
89b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
89c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 68 (h
89d0: 61 73 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 74 ash-table->alist
89e0: 20 64 65 6c 74 61 2d 65 6e 76 2d 61 6c 69 73 74 delta-env-alist
89f0: 2d 6f 72 2d 68 61 73 68 2d 74 61 62 6c 65 29 0a -or-hash-table).
8a00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8a10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 64 65 de
8a20: 6c 74 61 2d 65 6e 76 2d 61 6c 69 73 74 2d 6f 72 lta-env-alist-or
8a30: 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a 20 20 -hash-table)).
8a40: 20 20 20 20 20 20 20 28 72 65 73 74 6f 72 65 2d (restore-
8a50: 74 68 75 6e 6b 73 0a 20 20 20 20 20 20 20 20 20 thunks.
8a60: 20 28 66 69 6c 74 65 72 0a 20 20 20 20 20 20 20 (filter.
8a70: 20 20 20 20 69 64 65 6e 74 69 74 79 0a 20 20 20 identity.
8a80: 20 20 20 20 20 20 20 20 28 6d 61 70 20 28 6c 61 (map (la
8a90: 6d 62 64 61 20 28 65 6e 76 2d 70 61 69 72 29 0a mbda (env-pair).
8aa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8ab0: 20 20 28 6c 65 74 2a 20 28 28 65 6e 76 2d 76 61 (let* ((env-va
8ac0: 72 20 20 20 20 20 28 63 61 72 20 65 6e 76 2d 70 r (car env-p
8ad0: 61 69 72 29 29 0a 20 20 20 20 20 20 20 20 20 20 air)).
8ae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
8af0: 6e 65 77 2d 76 61 6c 20 20 20 20 20 28 6c 65 74 new-val (let
8b00: 20 28 28 74 6d 70 20 28 63 64 72 20 65 6e 76 2d ((tmp (cdr env-
8b10: 70 61 69 72 29 29 29 0a 20 20 20 20 20 20 20 20 pair))).
8b20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8b30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8b40: 28 69 66 20 28 6c 69 73 74 3f 20 74 6d 70 29 20 (if (list? tmp)
8b50: 28 63 61 72 20 74 6d 70 29 20 74 6d 70 29 29 29 (car tmp) tmp)))
8b60: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
8b70: 20 20 20 20 20 20 20 20 20 20 28 63 75 72 72 65 (curre
8b80: 6e 74 2d 76 61 6c 20 28 67 65 74 2d 65 6e 76 69 nt-val (get-envi
8b90: 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 ronment-variable
8ba0: 20 65 6e 76 2d 76 61 72 29 29 0a 20 20 20 20 20 env-var)).
8bb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8bc0: 20 20 20 20 28 72 65 73 74 6f 72 65 2d 74 68 75 (restore-thu
8bd0: 6e 6b 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 nk.
8be0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f (co
8bf0: 6e 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 nd.
8c00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
8c10: 6e 6f 74 20 63 75 72 72 65 6e 74 2d 76 61 6c 29 not current-val)
8c20: 20 28 6c 61 6d 62 64 61 20 28 29 20 28 75 6e 73 (lambda () (uns
8c30: 65 74 65 6e 76 20 65 6e 76 2d 76 61 72 29 29 29 etenv env-var)))
8c40: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
8c50: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 6e 6f ((no
8c60: 74 20 28 73 74 72 69 6e 67 3f 20 6e 65 77 2d 76 t (string? new-v
8c70: 61 6c 29 29 20 23 66 29 0a 20 20 20 20 20 20 20 al)) #f).
8c80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8c90: 20 20 20 20 28 28 65 71 3f 20 63 75 72 72 65 6e ((eq? curren
8ca0: 74 2d 76 61 6c 20 6e 65 77 2d 76 61 6c 29 20 23 t-val new-val) #
8cb0: 66 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 f).
8cc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 (e
8cd0: 6c 73 65 20 0a 20 20 20 20 20 20 20 20 20 20 20 lse .
8ce0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8cf0: 20 28 6c 61 6d 62 64 61 20 28 29 20 28 73 65 74 (lambda () (set
8d00: 65 6e 76 20 65 6e 76 2d 76 61 72 20 63 75 72 72 env env-var curr
8d10: 65 6e 74 2d 76 61 6c 29 29 29 29 29 29 0a 20 20 ent-val)))))).
8d20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8d30: 20 20 3b 3b 28 77 68 65 6e 20 28 6e 6f 74 20 28 ;;(when (not (
8d40: 73 74 72 69 6e 67 3f 20 6e 65 77 2d 76 61 6c 29 string? new-val)
8d50: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
8d60: 20 20 20 20 20 20 3b 3b 20 20 20 20 28 64 65 62 ;; (deb
8d70: 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 ug:print 0 *defa
8d80: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 20 ult-log-port* "
8d90: 50 52 4f 42 4c 45 4d 3a 20 6e 6f 74 20 61 20 73 PROBLEM: not a s
8da0: 74 72 69 6e 67 3a 20 22 6e 65 77 2d 76 61 6c 22 tring: "new-val"
8db0: 5c 6e 20 66 72 6f 6d 20 65 6e 76 2d 61 6c 69 73 \n from env-alis
8dc0: 74 3a 5c 6e 22 64 65 6c 74 61 2d 65 6e 76 2d 61 t:\n"delta-env-a
8dd0: 6c 69 73 74 29 0a 20 20 20 20 20 20 20 20 20 20 list).
8de0: 20 20 20 20 20 20 20 20 20 20 3b 3b 20 20 20 20 ;;
8df0: 28 70 70 20 64 65 6c 74 61 2d 65 6e 76 2d 61 6c (pp delta-env-al
8e00: 69 73 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 ist).
8e10: 20 20 20 20 20 20 20 20 20 3b 3b 20 20 20 20 28 ;; (
8e20: 65 78 69 74 20 31 29 29 0a 20 20 20 20 20 20 20 exit 1)).
8e30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8e40: 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
8e50: 20 20 20 20 20 20 0a 20 20 20 20 20 20 20 20 20 .
8e60: 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 64 (cond
8e70: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
8e80: 20 20 20 20 20 20 28 28 6e 6f 74 20 6e 65 77 2d ((not new-
8e90: 76 61 6c 29 20 20 3b 3b 20 6d 6f 64 69 66 79 20 val) ;; modify
8ea0: 65 6e 76 20 68 65 72 65 0a 20 20 20 20 20 20 20 env here.
8eb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
8ec0: 75 6e 73 65 74 65 6e 76 20 65 6e 76 2d 76 61 72 unsetenv env-var
8ed0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
8ee0: 20 20 20 20 20 20 20 20 28 28 73 74 72 69 6e 67 ((string
8ef0: 3f 20 6e 65 77 2d 76 61 6c 29 0a 20 20 20 20 20 ? new-val).
8f00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8f10: 20 28 73 65 74 65 6e 76 20 65 6e 76 2d 76 61 72 (setenv env-var
8f20: 20 6e 65 77 2d 76 61 6c 29 29 29 0a 20 20 20 20 new-val))).
8f30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8f40: 72 65 73 74 6f 72 65 2d 74 68 75 6e 6b 29 29 0a restore-thunk)).
8f50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8f60: 64 65 6c 74 61 2d 65 6e 76 2d 61 6c 69 73 74 29 delta-env-alist)
8f70: 29 29 29 0a 20 20 20 20 28 6c 65 74 20 28 28 72 ))). (let ((r
8f80: 76 20 28 74 68 75 6e 6b 29 29 29 0a 20 20 20 20 v (thunk))).
8f90: 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d (for-each (lam
8fa0: 62 64 61 20 28 78 29 20 28 78 29 29 20 72 65 73 bda (x) (x)) res
8fb0: 74 6f 72 65 2d 74 68 75 6e 6b 73 29 20 3b 3b 20 tore-thunks) ;;
8fc0: 72 65 73 74 6f 72 65 20 65 6e 76 20 74 6f 20 6f restore env to o
8fd0: 72 69 67 69 6e 61 6c 20 73 74 61 74 65 0a 20 20 riginal state.
8fe0: 20 20 20 20 72 76 29 29 29 0a 0a 3b 3b 20 72 65 rv)))..;; re
8ff0: 74 75 72 6e 20 61 20 6e 69 63 65 20 63 6c 65 61 turn a nice clea
9000: 6e 20 70 61 74 68 6e 61 6d 65 20 6d 61 64 65 20 n pathname made
9010: 61 62 73 6f 6c 75 74 65 0a 28 64 65 66 69 6e 65 absolute.(define
9020: 20 28 63 6f 6d 6d 6f 6e 3a 6e 69 63 65 2d 70 61 (common:nice-pa
9030: 74 68 20 64 69 72 29 0a 20 20 28 6c 65 74 20 28 th dir). (let (
9040: 28 72 65 73 20 28 73 74 72 69 6e 67 2d 6d 61 74 (res (string-mat
9050: 63 68 20 22 5e 28 7e 5b 5e 5c 5c 2f 5d 2a 29 28 ch "^(~[^\\/]*)(
9060: 5c 5c 2f 2e 2a 7c 29 24 22 20 64 69 72 29 29 29 \\/.*|)$" dir)))
9070: 0a 20 20 20 20 28 69 66 20 72 65 73 20 3b 3b 20 . (if res ;;
9080: 75 73 69 6e 67 20 7e 20 66 6f 72 20 68 6f 6d 65 using ~ for home
9090: 3f 0a 09 28 63 6f 6d 6d 6f 6e 3a 6e 69 63 65 2d ?..(common:nice-
90a0: 70 61 74 68 20 28 63 6f 6e 63 20 28 63 6f 6d 6d path (conc (comm
90b0: 6f 6e 3a 72 65 61 64 2d 6c 69 6e 6b 2d 66 20 28 on:read-link-f (
90c0: 63 61 64 72 20 72 65 73 29 29 20 22 2f 22 20 28 cadr res)) "/" (
90d0: 63 61 64 64 72 20 72 65 73 29 29 29 0a 09 28 6e caddr res)))..(n
90e0: 6f 72 6d 61 6c 69 7a 65 2d 70 61 74 68 6e 61 6d ormalize-pathnam
90f0: 65 20 28 69 66 20 28 61 62 73 6f 6c 75 74 65 2d e (if (absolute-
9100: 70 61 74 68 6e 61 6d 65 3f 20 64 69 72 29 0a 09 pathname? dir)..
9110: 09 09 09 64 69 72 0a 09 09 09 09 28 63 6f 6e 63 ...dir.....(conc
9120: 20 28 63 75 72 72 65 6e 74 2d 64 69 72 65 63 74 (current-direct
9130: 6f 72 79 29 20 22 2f 22 20 64 69 72 29 29 29 29 ory) "/" dir))))
9140: 29 29 0a 0a 3b 3b 20 6d 61 6b 65 20 22 6e 69 63 ))..;; make "nic
9150: 65 2d 70 61 74 68 22 20 61 76 61 69 6c 61 62 6c e-path" availabl
9160: 65 20 69 6e 20 63 6f 6e 66 69 67 20 66 69 6c 65 e in config file
9170: 73 20 61 6e 64 20 74 68 65 20 72 65 70 6c 0a 28 s and the repl.(
9180: 64 65 66 69 6e 65 20 6e 69 63 65 2d 70 61 74 68 define nice-path
9190: 20 63 6f 6d 6d 6f 6e 3a 6e 69 63 65 2d 70 61 74 common:nice-pat
91a0: 68 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f 6d h)..(define (com
91b0: 6d 6f 6e 3a 72 65 61 64 2d 6c 69 6e 6b 2d 66 20 mon:read-link-f
91c0: 70 61 74 68 29 0a 20 20 28 68 61 6e 64 6c 65 2d path). (handle-
91d0: 65 78 63 65 70 74 69 6f 6e 73 0a 20 20 20 20 20 exceptions.
91e0: 20 65 78 6e 0a 20 20 20 20 20 20 28 62 65 67 69 exn. (begi
91f0: 6e 0a 09 28 64 65 62 75 67 3a 70 72 69 6e 74 2d n..(debug:print-
9200: 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 error 0 *default
9210: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 63 6f 6d 6d -log-port* "comm
9220: 61 6e 64 20 5c 22 2f 62 69 6e 2f 72 65 61 64 6c and \"/bin/readl
9230: 69 6e 6b 20 2d 66 20 22 20 70 61 74 68 20 22 5c ink -f " path "\
9240: 22 20 66 61 69 6c 65 64 2e 20 65 78 6e 3d 22 20 " failed. exn="
9250: 65 78 6e 29 0a 09 70 61 74 68 29 20 3b 3b 20 6a exn)..path) ;; j
9260: 75 73 74 20 67 69 76 65 20 75 70 0a 20 20 20 20 ust give up.
9270: 28 77 69 74 68 2d 69 6e 70 75 74 2d 66 72 6f 6d (with-input-from
9280: 2d 70 69 70 65 0a 09 28 63 6f 6e 63 20 22 2f 62 -pipe..(conc "/b
9290: 69 6e 2f 72 65 61 64 6c 69 6e 6b 20 2d 66 20 22 in/readlink -f "
92a0: 20 70 61 74 68 29 0a 20 20 20 20 20 20 28 6c 61 path). (la
92b0: 6d 62 64 61 20 28 29 0a 09 28 72 65 61 64 2d 6c mbda ()..(read-l
92c0: 69 6e 65 29 29 29 29 29 0a 0a 0a 3b 3b 3d 3d 3d ine)))))...;;===
92d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
92e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
92f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9300: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9310: 3d 3d 3d 0a 3b 3b 20 4e 6f 6e 20 64 65 73 74 72 ===.;; Non destr
9320: 75 63 74 69 76 65 20 77 72 69 74 69 6e 67 20 6f uctive writing o
9330: 66 20 63 6f 6e 66 69 67 20 66 69 6c 65 0a 3b 3b f config file.;;
9340: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9350: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9360: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9370: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9380: 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 ======..(define
9390: 28 63 6f 6e 66 69 67 66 3a 63 6f 6d 70 72 65 73 (configf:compres
93a0: 73 2d 6d 75 6c 74 69 2d 6c 69 6e 65 73 20 66 64 s-multi-lines fd
93b0: 61 74 29 0a 20 20 3b 3b 20 73 74 65 70 20 31 2e at). ;; step 1.
93c0: 35 20 2d 20 63 6f 6d 70 72 65 73 73 20 61 6e 79 5 - compress any
93d0: 20 63 6f 6e 74 69 6e 75 65 64 20 6c 69 6e 65 73 continued lines
93e0: 0a 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 66 64 . (if (null? fd
93f0: 61 74 29 20 66 64 61 74 0a 09 28 6c 65 74 20 6c at) fdat..(let l
9400: 6f 6f 70 20 28 28 68 65 64 20 28 63 61 72 20 66 oop ((hed (car f
9410: 64 61 74 29 29 0a 09 09 20 20 20 28 74 61 6c 20 dat))... (tal
9420: 28 63 64 72 20 66 64 61 74 29 29 0a 09 09 20 20 (cdr fdat))...
9430: 20 28 63 75 72 20 22 22 29 0a 09 09 20 20 20 28 (cur "")... (
9440: 6c 65 64 20 23 66 29 0a 09 09 20 20 20 28 72 65 led #f)... (re
9450: 73 20 27 28 29 29 29 0a 09 20 20 3b 3b 20 41 4c s '())).. ;; AL
9460: 4c 20 57 48 49 54 45 53 50 41 43 45 20 4c 45 41 L WHITESPACE LEA
9470: 44 49 4e 47 20 4c 49 4e 45 53 20 41 52 45 20 54 DING LINES ARE T
9480: 41 43 4b 45 44 20 4f 4e 21 21 0a 09 20 20 3b 3b ACKED ON!!.. ;;
9490: 20 20 31 2e 20 72 65 6d 6f 76 65 20 6c 65 64 20 1. remove led
94a0: 77 68 69 74 65 73 70 61 63 65 0a 09 20 20 3b 3b whitespace.. ;;
94b0: 20 20 32 2e 20 74 61 63 6b 20 6f 6e 20 74 6f 20 2. tack on to
94c0: 68 65 64 20 77 69 74 68 20 22 5c 6e 22 0a 09 20 hed with "\n"..
94d0: 20 28 6c 65 74 20 28 28 72 65 73 20 28 73 74 72 (let ((res (str
94e0: 69 6e 67 2d 6d 61 74 63 68 20 63 6f 6e 66 69 67 ing-match config
94f0: 66 3a 63 6f 6e 74 2d 6c 6e 2d 72 78 20 68 65 64 f:cont-ln-rx hed
9500: 29 29 29 0a 09 20 20 20 20 28 69 66 20 72 65 73 ))).. (if res
9510: 20 3b 3b 20 62 6c 61 73 74 21 20 68 61 76 65 20 ;; blast! have
9520: 74 6f 20 64 65 61 6c 20 77 69 74 68 20 61 20 6d to deal with a m
9530: 75 6c 74 69 6c 69 6e 65 0a 09 09 28 6c 65 74 2a ultiline...(let*
9540: 20 28 28 6c 65 61 64 20 28 63 61 64 72 20 72 65 ((lead (cadr re
9550: 73 29 29 0a 09 09 20 20 20 20 20 20 20 28 6c 76 s))... (lv
9560: 61 6c 20 28 63 61 64 64 72 20 72 65 73 29 29 0a al (caddr res)).
9570: 09 09 20 20 20 20 20 20 20 28 6e 65 77 6c 20 28 .. (newl (
9580: 63 6f 6e 63 20 63 75 72 20 22 5c 6e 22 20 6c 76 conc cur "\n" lv
9590: 61 6c 29 29 29 0a 09 09 20 20 28 69 66 20 28 6e al)))... (if (n
95a0: 6f 74 20 6c 65 64 29 28 73 65 74 21 20 6c 65 64 ot led)(set! led
95b0: 20 6c 65 61 64 29 29 0a 09 09 20 20 28 69 66 20 lead))... (if
95c0: 28 6e 75 6c 6c 3f 20 74 61 6c 29 20 0a 09 09 20 (null? tal) ...
95d0: 20 20 20 20 20 28 73 65 74 21 20 66 64 61 74 20 (set! fdat
95e0: 28 61 70 70 65 6e 64 20 66 64 61 74 20 28 6c 69 (append fdat (li
95f0: 73 74 20 6e 65 77 6c 29 29 29 0a 09 09 20 20 20 st newl)))...
9600: 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 (loop (car ta
9610: 6c 29 28 63 64 72 20 74 61 6c 29 20 6e 65 77 6c l)(cdr tal) newl
9620: 20 6c 65 64 20 72 65 73 29 29 29 20 3b 3b 20 4e led res))) ;; N
9630: 42 2f 2f 20 6e 6f 74 20 74 61 63 6b 69 6e 67 20 B// not tacking
9640: 6e 65 77 6c 20 6f 6e 74 6f 20 72 65 73 0a 09 09 newl onto res...
9650: 28 6c 65 74 20 28 28 6e 65 77 72 65 73 20 28 69 (let ((newres (i
9660: 66 20 6c 65 64 20 0a 09 09 09 09 20 20 28 61 70 f led ..... (ap
9670: 70 65 6e 64 20 72 65 73 20 28 6c 69 73 74 20 63 pend res (list c
9680: 75 72 20 68 65 64 29 29 0a 09 09 09 09 20 20 28 ur hed))..... (
9690: 61 70 70 65 6e 64 20 72 65 73 20 28 6c 69 73 74 append res (list
96a0: 20 68 65 64 29 29 29 29 29 0a 09 09 20 20 3b 3b hed)))))... ;;
96b0: 20 70 72 65 76 20 77 61 73 20 61 20 6d 75 6c 74 prev was a mult
96c0: 69 6c 69 6e 65 0a 09 09 20 20 28 69 66 20 28 6e iline... (if (n
96d0: 75 6c 6c 3f 20 74 61 6c 29 0a 09 09 20 20 20 20 ull? tal)...
96e0: 20 20 6e 65 77 72 65 73 0a 09 09 20 20 20 20 20 newres...
96f0: 20 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 (loop (car tal)
9700: 28 63 64 72 20 74 61 6c 29 20 22 22 20 23 66 20 (cdr tal) "" #f
9710: 6e 65 77 72 65 73 29 29 29 29 29 29 29 29 0a 0a newres))))))))..
9720: 3b 3b 20 6e 6f 74 65 3a 20 49 27 6d 20 63 68 65 ;; note: I'm che
9730: 61 74 69 6e 67 20 61 20 6c 69 74 74 6c 65 20 68 ating a little h
9740: 65 72 65 2e 20 49 20 6d 65 72 65 6c 79 20 72 65 ere. I merely re
9750: 70 6c 61 63 65 20 22 5c 6e 22 20 77 69 74 68 20 place "\n" with
9760: 22 5c 6e 20 20 20 20 20 20 20 20 20 22 0a 28 64 "\n ".(d
9770: 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a 65 efine (configf:e
9780: 78 70 61 6e 64 2d 6d 75 6c 74 69 2d 6c 69 6e 65 xpand-multi-line
9790: 73 20 66 64 61 74 29 0a 20 20 3b 3b 20 73 74 65 s fdat). ;; ste
97a0: 70 20 31 2e 35 20 2d 20 63 6f 6d 70 72 65 73 73 p 1.5 - compress
97b0: 20 61 6e 79 20 63 6f 6e 74 69 6e 75 65 64 20 6c any continued l
97c0: 69 6e 65 73 0a 20 20 28 69 66 20 28 6e 75 6c 6c ines. (if (null
97d0: 3f 20 66 64 61 74 29 20 66 64 61 74 0a 20 20 20 ? fdat) fdat.
97e0: 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 68 (let loop ((h
97f0: 65 64 20 28 63 61 72 20 66 64 61 74 29 29 0a 09 ed (car fdat))..
9800: 09 20 28 74 61 6c 20 28 63 64 72 20 66 64 61 74 . (tal (cdr fdat
9810: 29 29 0a 09 09 20 28 72 65 73 20 27 28 29 29 29 ))... (res '()))
9820: 0a 09 28 6c 65 74 20 28 28 6e 65 77 72 65 73 20 ..(let ((newres
9830: 28 61 70 70 65 6e 64 20 72 65 73 20 28 6c 69 73 (append res (lis
9840: 74 20 28 73 74 72 69 6e 67 2d 73 75 62 73 74 69 t (string-substi
9850: 74 75 74 65 20 28 72 65 67 65 78 70 20 22 5c 6e tute (regexp "\n
9860: 22 29 20 22 5c 6e 20 20 20 20 20 20 20 20 20 22 ") "\n "
9870: 20 68 65 64 20 23 74 29 29 29 29 29 0a 09 20 20 hed #t)))))..
9880: 28 69 66 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 0a (if (null? tal).
9890: 09 20 20 20 20 20 20 6e 65 77 72 65 73 0a 09 20 . newres..
98a0: 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 (loop (car
98b0: 74 61 6c 29 28 63 64 72 20 74 61 6c 29 20 6e 65 tal)(cdr tal) ne
98c0: 77 72 65 73 29 29 29 29 29 29 0a 0a 28 64 65 66 wres))))))..(def
98d0: 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a 66 69 6c ine (configf:fil
98e0: 65 2d 3e 6c 69 73 74 20 66 6e 61 6d 65 29 0a 20 e->list fname).
98f0: 20 28 69 66 20 28 66 69 6c 65 2d 65 78 69 73 74 (if (file-exist
9900: 73 3f 20 66 6e 61 6d 65 29 0a 20 20 20 20 20 20 s? fname).
9910: 28 6c 65 74 20 28 28 69 6e 70 20 28 6f 70 65 6e (let ((inp (open
9920: 2d 69 6e 70 75 74 2d 66 69 6c 65 20 66 6e 61 6d -input-file fnam
9930: 65 29 29 29 0a 09 28 6c 65 74 20 6c 6f 6f 70 20 e)))..(let loop
9940: 28 28 69 6e 6c 20 28 72 65 61 64 2d 6c 69 6e 65 ((inl (read-line
9950: 20 69 6e 70 29 29 0a 09 09 20 20 20 28 72 65 73 inp))... (res
9960: 20 27 28 29 29 29 0a 09 20 20 28 69 66 20 28 65 '())).. (if (e
9970: 6f 66 2d 6f 62 6a 65 63 74 3f 20 69 6e 6c 29 0a of-object? inl).
9980: 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 . (begin...
9990: 28 63 6c 6f 73 65 2d 69 6e 70 75 74 2d 70 6f 72 (close-input-por
99a0: 74 20 69 6e 70 29 0a 09 09 28 72 65 76 65 72 73 t inp)...(revers
99b0: 65 20 72 65 73 29 29 0a 09 20 20 20 20 20 20 28 e res)).. (
99c0: 6c 6f 6f 70 20 28 72 65 61 64 2d 6c 69 6e 65 20 loop (read-line
99d0: 69 6e 70 29 28 63 6f 6e 73 20 69 6e 6c 20 72 65 inp)(cons inl re
99e0: 73 29 29 29 29 29 0a 20 20 20 20 20 20 27 28 29 s))))). '()
99f0: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
9a00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9a10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9a20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9a30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
9a40: 57 72 69 74 65 20 61 20 63 6f 6e 66 69 67 0a 3b Write a config.;
9a50: 3b 20 20 20 30 2e 20 47 69 76 65 6e 20 61 20 72 ; 0. Given a r
9a60: 65 66 65 72 65 72 65 6e 63 65 20 64 61 74 61 20 efererence data
9a70: 73 74 72 75 63 74 75 72 65 20 22 69 6e 64 61 74 structure "indat
9a80: 22 0a 3b 3b 20 20 20 31 2e 20 4f 70 65 6e 20 74 ".;; 1. Open t
9a90: 68 65 20 6f 75 74 70 75 74 20 66 69 6c 65 20 61 he output file a
9aa0: 6e 64 20 72 65 61 64 20 69 74 20 69 6e 74 6f 20 nd read it into
9ab0: 61 20 6c 69 73 74 0a 3b 3b 20 20 20 32 2e 20 46 a list.;; 2. F
9ac0: 6c 61 74 74 65 6e 20 61 6e 79 20 6d 75 6c 74 69 latten any multi
9ad0: 6c 69 6e 65 20 65 6e 74 72 69 65 73 0a 3b 3b 20 line entries.;;
9ae0: 20 20 33 2e 20 4d 6f 64 69 66 79 20 76 61 6c 75 3. Modify valu
9af0: 65 73 20 70 65 72 20 63 6f 6e 74 65 6e 74 73 20 es per contents
9b00: 6f 66 20 22 69 6e 64 61 74 22 20 61 6e 64 20 72 of "indat" and r
9b10: 65 6d 6f 76 65 20 61 62 73 65 6e 74 20 76 61 6c emove absent val
9b20: 75 65 73 0a 3b 3b 20 20 20 34 2e 20 41 70 70 65 ues.;; 4. Appe
9b30: 6e 64 20 6e 65 77 20 76 61 6c 75 65 73 20 74 6f nd new values to
9b40: 20 74 68 65 20 73 65 63 74 69 6f 6e 20 28 69 6d the section (im
9b50: 6d 65 64 69 61 74 65 6c 79 20 61 66 74 65 72 20 mediately after
9b60: 6c 61 73 74 20 6c 65 67 69 74 20 65 6e 74 72 79 last legit entry
9b70: 29 0a 3b 3b 20 20 20 35 2e 20 57 72 69 74 65 20 ).;; 5. Write
9b80: 6f 75 74 20 74 68 65 20 6e 65 77 20 6c 69 73 74 out the new list
9b90: 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;============
9ba0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9bb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9bc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9bd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 ==========..(def
9be0: 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a 77 72 69 ine (configf:wri
9bf0: 74 65 2d 63 6f 6e 66 69 67 20 69 6e 64 61 74 20 te-config indat
9c00: 66 6e 61 6d 65 20 23 21 6b 65 79 20 28 72 65 71 fname #!key (req
9c10: 75 69 72 65 64 2d 73 65 63 74 69 6f 6e 73 20 27 uired-sections '
9c20: 28 29 29 29 0a 20 20 28 6c 65 74 2a 20 28 3b 3b ())). (let* (;;
9c30: 20 73 74 65 70 20 31 3a 20 4f 70 65 6e 20 74 68 step 1: Open th
9c40: 65 20 6f 75 74 70 75 74 20 66 69 6c 65 20 61 6e e output file an
9c50: 64 20 72 65 61 64 20 69 74 20 69 6e 74 6f 20 61 d read it into a
9c60: 20 6c 69 73 74 0a 09 20 28 66 64 61 74 20 20 20 list.. (fdat
9c70: 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 66 69 6c (configf:fil
9c80: 65 2d 3e 6c 69 73 74 20 66 6e 61 6d 65 29 29 0a e->list fname)).
9c90: 09 20 28 72 65 66 64 61 74 20 20 28 6d 61 6b 65 . (refdat (make
9ca0: 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a 09 20 -hash-table))..
9cb0: 28 73 65 63 68 61 73 68 20 28 6d 61 6b 65 2d 68 (sechash (make-h
9cc0: 61 73 68 2d 74 61 62 6c 65 29 29 20 3b 3b 20 63 ash-table)) ;; c
9cd0: 75 72 72 65 6e 74 20 73 65 63 74 69 6f 6e 20 68 urrent section h
9ce0: 61 73 68 2c 20 69 6e 69 74 20 77 69 74 68 20 68 ash, init with h
9cf0: 61 73 68 20 66 6f 72 20 22 64 65 66 61 75 6c 74 ash for "default
9d00: 22 20 73 65 63 74 69 6f 6e 0a 09 20 28 6e 65 77 " section.. (new
9d10: 20 20 20 20 20 23 66 29 20 3b 3b 20 70 75 74 20 #f) ;; put
9d20: 74 68 65 20 6c 69 6e 65 20 74 6f 20 62 65 20 75 the line to be u
9d30: 73 65 64 20 69 6e 20 6e 65 77 2c 20 69 66 20 69 sed in new, if i
9d40: 74 20 69 73 20 74 6f 20 62 65 20 64 65 6c 65 74 t is to be delet
9d50: 65 64 20 74 68 65 20 73 65 74 20 6e 65 77 20 74 ed the set new t
9d60: 6f 20 23 66 0a 09 20 28 73 65 63 6e 61 6d 65 20 o #f.. (secname
9d70: 23 66 29 29 0a 0a 20 20 20 20 3b 3b 20 73 74 65 #f)).. ;; ste
9d80: 70 20 32 3a 20 46 6c 61 74 74 65 6e 20 6d 75 6c p 2: Flatten mul
9d90: 74 69 6c 69 6e 65 20 65 6e 74 72 69 65 73 0a 20 tiline entries.
9da0: 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c (if (not (nul
9db0: 6c 3f 20 66 64 61 74 29 29 28 73 65 74 21 20 66 l? fdat))(set! f
9dc0: 64 61 74 20 28 63 6f 6e 66 69 67 66 3a 63 6f 6d dat (configf:com
9dd0: 70 72 65 73 73 2d 6d 75 6c 74 69 2d 6c 69 6e 65 press-multi-line
9de0: 73 20 66 64 61 74 29 29 29 0a 0a 20 20 20 20 3b s fdat))).. ;
9df0: 3b 20 73 74 65 70 20 33 3a 20 4d 6f 64 69 66 79 ; step 3: Modify
9e00: 20 76 61 6c 75 65 73 20 70 65 72 20 63 6f 6e 74 values per cont
9e10: 65 6e 74 73 20 6f 66 20 22 69 6e 64 61 74 22 20 ents of "indat"
9e20: 61 6e 64 20 72 65 6d 6f 76 65 20 61 62 73 65 6e and remove absen
9e30: 74 20 76 61 6c 75 65 73 0a 20 20 20 20 28 69 66 t values. (if
9e40: 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 66 64 61 (not (null? fda
9e50: 74 29 29 0a 09 28 6c 65 74 20 6c 6f 6f 70 20 28 t))..(let loop (
9e60: 28 68 65 64 20 20 28 63 61 72 20 66 64 61 74 29 (hed (car fdat)
9e70: 29 0a 09 09 20 20 20 28 74 61 6c 20 20 28 63 61 )... (tal (ca
9e80: 64 72 20 66 64 61 74 29 29 0a 09 09 20 20 20 28 dr fdat))... (
9e90: 72 65 73 20 20 27 28 29 29 0a 09 09 20 20 20 28 res '())... (
9ea0: 6c 6e 75 6d 20 30 29 29 0a 09 20 20 28 72 65 67 lnum 0)).. (reg
9eb0: 65 78 2d 63 61 73 65 20 0a 09 20 20 20 68 65 64 ex-case .. hed
9ec0: 0a 09 20 20 20 28 63 6f 6e 66 69 67 66 3a 63 6f .. (configf:co
9ed0: 6d 6d 65 6e 74 2d 72 78 20 5f 20 20 20 20 20 20 mment-rx _
9ee0: 20 20 20 20 20 20 20 20 20 20 20 20 28 73 65 74 (set
9ef0: 21 20 72 65 73 20 28 61 70 70 65 6e 64 20 72 65 ! res (append re
9f00: 73 20 28 6c 69 73 74 20 68 65 64 29 29 29 29 20 s (list hed))))
9f10: 3b 3b 20 28 6c 6f 6f 70 20 28 72 65 61 64 2d 6c ;; (loop (read-l
9f20: 69 6e 65 20 69 6e 70 29 20 63 75 72 72 2d 73 65 ine inp) curr-se
9f30: 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 66 ction-name #f #f
9f40: 29 29 0a 09 20 20 20 28 63 6f 6e 66 69 67 66 3a )).. (configf:
9f50: 62 6c 61 6e 6b 2d 6c 2d 72 78 20 5f 20 20 20 20 blank-l-rx _
9f60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 (s
9f70: 65 74 21 20 72 65 73 20 28 61 70 70 65 6e 64 20 et! res (append
9f80: 72 65 73 20 28 6c 69 73 74 20 68 65 64 29 29 29 res (list hed)))
9f90: 29 20 3b 3b 20 28 6c 6f 6f 70 20 28 72 65 61 64 ) ;; (loop (read
9fa0: 2d 6c 69 6e 65 20 69 6e 70 29 20 63 75 72 72 2d -line inp) curr-
9fb0: 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 section-name #f
9fc0: 23 66 29 29 0a 09 20 20 20 28 63 6f 6e 66 69 67 #f)).. (config
9fd0: 66 3a 73 65 63 74 69 6f 6e 2d 72 78 20 28 20 78 f:section-rx ( x
9fe0: 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 29 20 section-name )
9ff0: 28 6c 65 74 20 28 28 73 65 63 74 69 6f 6e 2d 68 (let ((section-h
a000: 61 73 68 20 28 68 61 73 68 2d 74 61 62 6c 65 2d ash (hash-table-
a010: 72 65 66 2f 64 65 66 61 75 6c 74 20 72 65 66 64 ref/default refd
a020: 61 74 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 at section-name
a030: 23 66 29 29 29 0a 09 09 09 09 09 20 20 20 20 28 #f)))...... (
a040: 69 66 20 28 6e 6f 74 20 73 65 63 74 69 6f 6e 2d if (not section-
a050: 68 61 73 68 29 0a 09 09 09 09 09 09 28 6c 65 74 hash).......(let
a060: 20 28 28 6e 65 77 68 61 73 68 20 28 6d 61 6b 65 ((newhash (make
a070: 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 29 0a 09 -hash-table)))..
a080: 09 09 09 09 09 20 20 28 68 61 73 68 2d 74 61 62 ..... (hash-tab
a090: 6c 65 2d 73 65 74 21 20 72 65 66 64 61 74 20 73 le-set! refdat s
a0a0: 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 6e 65 77 68 ection-name newh
a0b0: 61 73 68 29 20 3b 3b 20 77 61 73 20 72 65 66 68 ash) ;; was refh
a0c0: 61 73 68 20 2d 20 6e 6f 74 20 73 75 72 65 20 74 ash - not sure t
a0d0: 68 61 74 20 72 65 66 64 61 74 20 69 73 20 63 6f hat refdat is co
a0e0: 72 72 65 63 74 20 68 65 72 65 0a 09 09 09 09 09 rrect here......
a0f0: 09 20 20 28 73 65 74 21 20 73 65 63 68 61 73 68 . (set! sechash
a100: 20 6e 65 77 68 61 73 68 29 29 0a 09 09 09 09 09 newhash))......
a110: 09 28 73 65 74 21 20 73 65 63 68 61 73 68 20 73 .(set! sechash s
a120: 65 63 74 69 6f 6e 2d 68 61 73 68 29 29 0a 09 09 ection-hash))...
a130: 09 09 09 20 20 20 20 28 73 65 74 21 20 6e 65 77 ... (set! new
a140: 20 68 65 64 29 20 3b 3b 20 77 69 6c 6c 20 61 70 hed) ;; will ap
a150: 70 65 6e 64 20 74 68 69 73 20 61 74 20 74 68 65 pend this at the
a160: 20 62 6f 74 74 6f 6d 20 6f 66 20 74 68 65 20 6c bottom of the l
a170: 6f 6f 70 0a 09 09 09 09 09 20 20 20 20 28 73 65 oop...... (se
a180: 74 21 20 73 65 63 6e 61 6d 65 20 73 65 63 74 69 t! secname secti
a190: 6f 6e 2d 6e 61 6d 65 29 0a 09 09 09 09 09 20 20 on-name)......
a1a0: 20 20 29 29 0a 09 20 20 20 3b 3b 20 4e 6f 20 6e )).. ;; No n
a1b0: 65 65 64 20 74 6f 20 70 72 6f 63 65 73 73 20 6b eed to process k
a1c0: 65 79 20 63 6d 64 2c 20 6c 65 74 20 69 74 20 66 ey cmd, let it f
a1d0: 61 6c 6c 20 74 68 6f 75 67 68 20 74 6f 20 6b 65 all though to ke
a1e0: 79 20 76 61 6c 0a 09 20 20 20 28 63 6f 6e 66 69 y val.. (confi
a1f0: 67 66 3a 6b 65 79 2d 76 61 6c 2d 70 72 20 28 20 gf:key-val-pr (
a200: 78 20 6b 65 79 20 76 61 6c 20 20 20 20 20 20 29 x key val )
a210: 0a 09 09 20 20 20 20 20 20 20 28 6c 65 74 20 28 ... (let (
a220: 28 6e 65 77 76 61 6c 20 28 63 6f 6e 66 69 67 66 (newval (configf
a230: 3a 6c 6f 6f 6b 75 70 20 69 6e 64 61 74 20 73 65 :lookup indat se
a240: 63 6e 61 6d 65 20 6b 65 79 29 29 29 20 3b 3b 20 cname key))) ;;
a250: 77 61 73 20 73 65 63 2c 20 62 75 67 20 6f 72 20 was sec, bug or
a260: 63 6f 72 72 65 63 74 3f 0a 09 09 09 20 3b 3b 20 correct?.... ;;
a270: 63 61 6e 20 68 61 6e 64 6c 65 20 6e 65 77 76 61 can handle newva
a280: 6c 20 3d 3d 20 23 66 20 68 65 72 65 20 3d 3e 20 l == #f here =>
a290: 74 68 61 74 20 6d 65 61 6e 73 20 6b 65 79 20 69 that means key i
a2a0: 73 20 72 65 6d 6f 76 65 64 0a 09 09 09 20 28 63 s removed.... (c
a2b0: 6f 6e 64 20 0a 09 09 09 20 20 28 28 65 71 75 61 ond .... ((equa
a2c0: 6c 3f 20 6e 65 77 76 61 6c 20 76 61 6c 29 0a 09 l? newval val)..
a2d0: 09 09 20 20 20 28 73 65 74 21 20 72 65 73 20 28 .. (set! res (
a2e0: 61 70 70 65 6e 64 20 72 65 73 20 28 6c 69 73 74 append res (list
a2f0: 20 68 65 64 29 29 29 29 0a 09 09 09 20 20 28 28 hed)))).... ((
a300: 6e 6f 74 20 6e 65 77 76 61 6c 29 20 3b 3b 20 6b not newval) ;; k
a310: 65 79 20 68 61 73 20 62 65 65 6e 20 72 65 6d 6f ey has been remo
a320: 76 65 64 0a 09 09 09 20 20 20 28 73 65 74 21 20 ved.... (set!
a330: 6e 65 77 20 23 66 29 29 0a 09 09 09 20 20 28 28 new #f)).... ((
a340: 6e 6f 74 20 28 65 71 75 61 6c 3f 20 6e 65 77 76 not (equal? newv
a350: 61 6c 20 76 61 6c 29 29 0a 09 09 09 20 20 20 20 al val))....
a360: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 (hash-table-set
a370: 21 20 73 65 63 68 61 73 68 20 6b 65 79 20 6e 65 ! sechash key ne
a380: 77 76 61 6c 29 0a 09 09 09 20 20 20 20 20 28 73 wval).... (s
a390: 65 74 21 20 6e 65 77 20 28 63 6f 6e 63 20 6b 65 et! new (conc ke
a3a0: 79 20 22 20 22 20 6e 65 77 76 61 6c 29 29 29 0a y " " newval))).
a3b0: 09 09 09 20 20 28 65 6c 73 65 0a 09 09 09 20 20 ... (else....
a3c0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 (debug:print-er
a3d0: 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c ror 0 *default-l
a3e0: 6f 67 2d 70 6f 72 74 2a 20 22 70 72 6f 62 6c 65 og-port* "proble
a3f0: 6d 20 70 61 72 73 69 6e 67 20 6c 69 6e 65 20 6e m parsing line n
a400: 75 6d 62 65 72 20 22 20 6c 6e 75 6d 20 22 5c 22 umber " lnum "\"
a410: 22 20 68 65 64 20 22 5c 22 22 29 29 29 29 29 0a " hed "\""))))).
a420: 09 20 20 20 28 65 6c 73 65 0a 09 20 20 20 20 28 . (else.. (
a430: 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f debug:print-erro
a440: 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 r 0 *default-log
a450: 2d 70 6f 72 74 2a 20 22 50 72 6f 62 6c 65 6d 20 -port* "Problem
a460: 70 61 72 73 69 6e 67 20 6c 69 6e 65 20 6e 75 6d parsing line num
a470: 20 22 20 6c 6e 75 6d 20 22 20 3a 5c 6e 20 20 20 " lnum " :\n
a480: 22 20 68 65 64 20 29 29 29 0a 09 20 20 28 69 66 " hed ))).. (if
a490: 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 74 61 6c (not (null? tal
a4a0: 29 29 0a 09 20 20 20 20 20 20 28 6c 6f 6f 70 20 )).. (loop
a4b0: 28 63 61 72 20 74 61 6c 29 28 63 64 72 20 74 61 (car tal)(cdr ta
a4c0: 6c 29 28 69 66 20 6e 65 77 20 28 61 70 70 65 6e l)(if new (appen
a4d0: 64 20 72 65 73 20 28 6c 69 73 74 20 6e 65 77 29 d res (list new)
a4e0: 29 20 72 65 73 29 28 2b 20 6c 6e 75 6d 20 31 29 ) res)(+ lnum 1)
a4f0: 29 29 0a 09 20 20 3b 3b 20 64 72 6f 70 20 74 6f )).. ;; drop to
a500: 20 68 65 72 65 20 77 68 65 6e 20 64 6f 6e 65 20 here when done
a510: 70 72 6f 63 65 73 73 69 6e 67 2c 20 72 65 73 20 processing, res
a520: 63 6f 6e 74 61 69 6e 73 20 6d 6f 64 69 66 69 65 contains modifie
a530: 64 20 6c 69 73 74 20 6f 66 20 6c 69 6e 65 73 0a d list of lines.
a540: 09 20 20 28 73 65 74 21 20 66 64 61 74 20 72 65 . (set! fdat re
a550: 73 29 29 29 0a 0a 20 20 20 20 3b 3b 20 73 74 65 s))).. ;; ste
a560: 70 20 34 3a 20 41 70 70 65 6e 64 20 6e 65 77 20 p 4: Append new
a570: 76 61 6c 75 65 73 20 74 6f 20 74 68 65 20 73 65 values to the se
a580: 63 74 69 6f 6e 0a 20 20 20 20 28 66 6f 72 2d 65 ction. (for-e
a590: 61 63 68 20 0a 20 20 20 20 20 28 6c 61 6d 62 64 ach . (lambd
a5a0: 61 20 28 73 65 63 74 69 6f 6e 29 0a 20 20 20 20 a (section).
a5b0: 20 20 20 28 6c 65 74 20 28 28 73 64 61 74 20 20 (let ((sdat
a5c0: 20 27 28 29 29 20 3b 3b 20 61 70 70 65 6e 64 20 '()) ;; append
a5d0: 6e 65 65 64 65 64 20 62 69 74 73 20 68 65 72 65 needed bits here
a5e0: 0a 09 20 20 20 20 20 28 73 76 61 72 73 20 20 28 .. (svars (
a5f0: 63 6f 6e 66 69 67 66 3a 73 65 63 74 69 6f 6e 2d configf:section-
a600: 76 61 72 73 20 69 6e 64 61 74 20 73 65 63 74 69 vars indat secti
a610: 6f 6e 29 29 29 0a 09 20 28 66 6f 72 2d 65 61 63 on))).. (for-eac
a620: 68 20 0a 09 20 20 28 6c 61 6d 62 64 61 20 28 76 h .. (lambda (v
a630: 61 72 29 0a 09 20 20 20 20 28 6c 65 74 20 28 28 ar).. (let ((
a640: 76 61 6c 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f val (configf:loo
a650: 6b 75 70 20 72 65 66 64 61 74 20 73 65 63 74 69 kup refdat secti
a660: 6f 6e 20 76 61 72 29 29 29 0a 09 20 20 20 20 20 on var)))..
a670: 20 28 69 66 20 28 6e 6f 74 20 76 61 6c 29 20 3b (if (not val) ;
a680: 3b 20 74 68 69 73 20 6f 6e 65 20 69 73 20 6e 65 ; this one is ne
a690: 77 0a 09 09 20 20 28 62 65 67 69 6e 0a 09 09 20 w... (begin...
a6a0: 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 73 64 (if (null? sd
a6b0: 61 74 29 28 73 65 74 21 20 73 64 61 74 20 28 6c at)(set! sdat (l
a6c0: 69 73 74 20 28 63 6f 6e 63 20 22 5b 22 20 73 65 ist (conc "[" se
a6d0: 63 74 69 6f 6e 20 22 5d 22 29 29 29 29 0a 09 09 ction "]"))))...
a6e0: 20 20 20 20 28 73 65 74 21 20 73 64 61 74 20 28 (set! sdat (
a6f0: 61 70 70 65 6e 64 20 73 64 61 74 20 28 6c 69 73 append sdat (lis
a700: 74 20 28 63 6f 6e 63 20 76 61 72 20 22 20 22 20 t (conc var " "
a710: 76 61 6c 29 29 29 29 29 29 29 29 0a 09 20 20 73 val)))))))).. s
a720: 76 61 72 73 29 0a 09 20 28 73 65 74 21 20 66 64 vars).. (set! fd
a730: 61 74 20 28 61 70 70 65 6e 64 20 66 64 61 74 20 at (append fdat
a740: 73 64 61 74 29 29 29 29 0a 20 20 20 20 20 28 64 sdat)))). (d
a750: 65 6c 65 74 65 2d 64 75 70 6c 69 63 61 74 65 73 elete-duplicates
a760: 20 28 61 70 70 65 6e 64 20 72 65 71 75 69 72 65 (append require
a770: 64 2d 73 65 63 74 69 6f 6e 73 20 28 68 61 73 68 d-sections (hash
a780: 2d 74 61 62 6c 65 2d 6b 65 79 73 20 69 6e 64 61 -table-keys inda
a790: 74 29 29 29 29 0a 0a 20 20 20 20 3b 3b 20 73 74 t)))).. ;; st
a7a0: 65 70 20 35 3a 20 57 72 69 74 65 20 6f 75 74 20 ep 5: Write out
a7b0: 6e 65 77 20 66 69 6c 65 0a 20 20 20 20 28 77 69 new file. (wi
a7c0: 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 69 6c th-output-to-fil
a7d0: 65 20 66 6e 61 6d 65 20 0a 20 20 20 20 20 20 28 e fname . (
a7e0: 6c 61 6d 62 64 61 20 28 29 0a 09 28 66 6f 72 2d lambda ()..(for-
a7f0: 65 61 63 68 20 0a 09 20 28 6c 61 6d 62 64 61 20 each .. (lambda
a800: 28 6c 69 6e 65 29 0a 09 20 20 20 28 70 72 69 6e (line).. (prin
a810: 74 20 6c 69 6e 65 29 29 0a 09 20 28 63 6f 6e 66 t line)).. (conf
a820: 69 67 66 3a 65 78 70 61 6e 64 2d 6d 75 6c 74 69 igf:expand-multi
a830: 2d 6c 69 6e 65 73 20 66 64 61 74 29 29 29 29 29 -lines fdat)))))
a840: 29 0a 0a 28 64 65 66 69 6e 65 20 28 70 72 6f 63 )..(define (proc
a850: 65 73 73 3a 63 6d 64 2d 72 75 6e 2d 3e 6c 69 73 ess:cmd-run->lis
a860: 74 20 63 6d 64 20 23 21 6b 65 79 20 28 64 65 6c t cmd #!key (del
a870: 74 61 2d 65 6e 76 2d 61 6c 69 73 74 2d 6f 72 2d ta-env-alist-or-
a880: 68 61 73 68 2d 74 61 62 6c 65 20 27 28 29 29 29 hash-table '()))
a890: 0a 20 20 28 63 6f 6d 6d 6f 6e 3a 77 69 74 68 2d . (common:with-
a8a0: 65 6e 76 2d 76 61 72 73 0a 20 20 20 64 65 6c 74 env-vars. delt
a8b0: 61 2d 65 6e 76 2d 61 6c 69 73 74 2d 6f 72 2d 68 a-env-alist-or-h
a8c0: 61 73 68 2d 74 61 62 6c 65 0a 20 20 20 28 6c 61 ash-table. (la
a8d0: 6d 62 64 61 20 28 29 0a 20 20 20 20 20 28 6c 65 mbda (). (le
a8e0: 74 2a 20 28 28 66 68 20 28 6f 70 65 6e 2d 69 6e t* ((fh (open-in
a8f0: 70 75 74 2d 70 69 70 65 20 63 6d 64 29 29 0a 20 put-pipe cmd)).
a900: 20 20 20 20 20 20 20 20 20 20 20 28 72 65 73 20 (res
a910: 28 70 6f 72 74 2d 3e 6c 69 73 74 20 66 68 29 29 (port->list fh))
a920: 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 73 74 . (st
a930: 61 74 75 73 20 28 63 6c 6f 73 65 2d 69 6e 70 75 atus (close-inpu
a940: 74 2d 70 69 70 65 20 66 68 29 29 29 0a 20 20 20 t-pipe fh))).
a950: 20 20 20 20 28 6c 69 73 74 20 72 65 73 20 73 74 (list res st
a960: 61 74 75 73 29 29 29 29 29 0a 0a 28 64 65 66 69 atus)))))..(defi
a970: 6e 65 20 28 70 6f 72 74 2d 3e 6c 69 73 74 20 66 ne (port->list f
a980: 68 29 0a 20 20 28 69 66 20 28 65 6f 66 2d 6f 62 h). (if (eof-ob
a990: 6a 65 63 74 3f 20 66 68 29 20 23 66 0a 20 20 20 ject? fh) #f.
a9a0: 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 63 (let loop ((c
a9b0: 75 72 72 20 28 72 65 61 64 2d 6c 69 6e 65 20 66 urr (read-line f
a9c0: 68 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 h)).
a9d0: 20 20 20 20 20 28 72 65 73 75 6c 74 20 27 28 29 (result '()
a9e0: 29 29 0a 20 20 20 20 20 20 20 20 28 69 66 20 28 )). (if (
a9f0: 6e 6f 74 20 28 65 6f 66 2d 6f 62 6a 65 63 74 3f not (eof-object?
aa00: 20 63 75 72 72 29 29 0a 20 20 20 20 20 20 20 20 curr)).
aa10: 20 20 20 20 28 6c 6f 6f 70 20 28 72 65 61 64 2d (loop (read-
aa20: 6c 69 6e 65 20 66 68 29 0a 20 20 20 20 20 20 20 line fh).
aa30: 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 65 (appe
aa40: 6e 64 20 72 65 73 75 6c 74 20 28 6c 69 73 74 20 nd result (list
aa50: 63 75 72 72 29 29 29 0a 20 20 20 20 20 20 20 20 curr))).
aa60: 20 20 20 20 72 65 73 75 6c 74 29 29 29 29 0a 0a result))))..
aa70: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
aa80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
aa90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
aaa0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
aab0: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 72 65 66 64 ========.;; refd
aac0: 62 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d b.;;============
aad0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
aae0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
aaf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ab00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 72 ==========..;; r
ab10: 65 61 64 73 20 61 20 72 65 66 64 62 20 69 6e 74 eads a refdb int
ab20: 6f 20 61 6e 20 61 73 73 6f 63 20 61 72 72 61 79 o an assoc array
ab30: 20 6f 66 20 61 73 73 6f 63 20 61 72 72 61 79 73 of assoc arrays
ab40: 0a 3b 3b 20 20 20 72 65 74 75 72 6e 73 20 28 6c .;; returns (l
ab50: 69 73 74 20 64 61 74 20 6d 73 67 29 0a 28 64 65 ist dat msg).(de
ab60: 66 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a 72 65 fine (configf:re
ab70: 61 64 2d 72 65 66 64 62 20 72 65 66 64 62 2d 70 ad-refdb refdb-p
ab80: 61 74 68 29 0a 20 20 28 6c 65 74 20 28 28 73 68 ath). (let ((sh
ab90: 65 65 74 73 2d 66 69 6c 65 20 20 28 63 6f 6e 63 eets-file (conc
aba0: 20 72 65 66 64 62 2d 70 61 74 68 20 22 2f 73 68 refdb-path "/sh
abb0: 65 65 74 2d 6e 61 6d 65 73 2e 63 66 67 22 29 29 eet-names.cfg"))
abc0: 29 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 ). (if (not (
abd0: 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 73 68 65 file-exists? she
abe0: 65 74 73 2d 66 69 6c 65 29 29 0a 09 28 6c 69 73 ets-file))..(lis
abf0: 74 20 23 66 20 28 63 6f 6e 63 20 22 45 52 52 4f t #f (conc "ERRO
ac00: 52 3a 20 6e 6f 20 72 65 66 64 62 20 66 6f 75 6e R: no refdb foun
ac10: 64 20 61 74 20 22 20 72 65 66 64 62 2d 70 61 74 d at " refdb-pat
ac20: 68 29 29 0a 09 28 69 66 20 28 6e 6f 74 20 28 66 h))..(if (not (f
ac30: 69 6c 65 2d 72 65 61 64 61 62 6c 65 3f 20 73 68 ile-readable? sh
ac40: 65 65 74 73 2d 66 69 6c 65 29 29 0a 09 20 20 20 eets-file))..
ac50: 20 28 6c 69 73 74 20 23 66 20 28 63 6f 6e 63 20 (list #f (conc
ac60: 22 45 52 52 4f 52 3a 20 72 65 66 64 62 20 66 69 "ERROR: refdb fi
ac70: 6c 65 20 6e 6f 74 20 72 65 61 64 61 62 6c 65 20 le not readable
ac80: 61 74 20 22 20 72 65 66 64 62 2d 70 61 74 68 29 at " refdb-path)
ac90: 29 0a 09 20 20 20 20 28 6c 65 74 2a 20 28 28 73 ).. (let* ((s
aca0: 68 65 65 74 73 20 28 77 69 74 68 2d 69 6e 70 75 heets (with-inpu
acb0: 74 2d 66 72 6f 6d 2d 66 69 6c 65 20 73 68 65 65 t-from-file shee
acc0: 74 73 2d 66 69 6c 65 0a 09 09 09 20 20 20 20 20 ts-file....
acd0: 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 20 20 (lambda ()....
ace0: 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 (let loop (
acf0: 28 69 6e 6c 20 28 72 65 61 64 2d 6c 69 6e 65 29 (inl (read-line)
ad00: 29 0a 09 09 09 09 09 20 20 28 72 65 73 20 27 28 )...... (res '(
ad10: 29 29 29 0a 09 09 09 09 20 28 69 66 20 28 65 6f )))..... (if (eo
ad20: 66 2d 6f 62 6a 65 63 74 3f 20 69 6e 6c 29 0a 09 f-object? inl)..
ad30: 09 09 09 20 20 20 20 20 28 72 65 76 65 72 73 65 ... (reverse
ad40: 20 72 65 73 29 0a 09 09 09 09 20 20 20 20 20 28 res)..... (
ad50: 6c 6f 6f 70 20 28 72 65 61 64 2d 6c 69 6e 65 29 loop (read-line)
ad60: 28 63 6f 6e 73 20 69 6e 6c 20 72 65 73 29 29 29 (cons inl res)))
ad70: 29 29 29 29 0a 09 09 20 20 20 28 64 61 74 61 20 ))))... (data
ad80: 20 20 27 28 29 29 29 0a 09 20 20 20 20 20 20 28 '())).. (
ad90: 66 6f 72 2d 65 61 63 68 20 0a 09 20 20 20 20 20 for-each ..
ada0: 20 20 28 6c 61 6d 62 64 61 20 28 73 68 65 65 74 (lambda (sheet
adb0: 2d 6e 61 6d 65 29 0a 09 09 20 28 6c 65 74 2a 20 -name)... (let*
adc0: 28 28 64 61 74 2d 70 61 74 68 20 20 28 63 6f 6e ((dat-path (con
add0: 63 20 72 65 66 64 62 2d 70 61 74 68 20 22 2f 22 c refdb-path "/"
ade0: 20 73 68 65 65 74 2d 6e 61 6d 65 20 22 2e 64 61 sheet-name ".da
adf0: 74 22 29 29 0a 09 09 09 28 72 65 66 2d 64 61 74 t"))....(ref-dat
ae00: 20 20 20 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 (configf:read
ae10: 2d 63 6f 6e 66 69 67 20 64 61 74 2d 70 61 74 68 -config dat-path
ae20: 20 23 66 20 23 74 29 29 0a 09 09 09 28 72 65 66 #f #t))....(ref
ae30: 2d 61 73 73 6f 63 20 28 6d 61 70 20 28 6c 61 6d -assoc (map (lam
ae40: 62 64 61 20 28 6b 65 79 29 0a 09 09 09 09 09 20 bda (key)......
ae50: 20 28 6c 69 73 74 20 6b 65 79 20 28 68 61 73 68 (list key (hash
ae60: 2d 74 61 62 6c 65 2d 72 65 66 20 72 65 66 2d 64 -table-ref ref-d
ae70: 61 74 20 6b 65 79 29 29 29 0a 09 09 09 09 09 28 at key)))......(
ae80: 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 hash-table-keys
ae90: 72 65 66 2d 64 61 74 29 29 29 29 0a 09 09 09 09 ref-dat)))).....
aea0: 20 20 20 3b 3b 20 28 68 61 73 68 2d 74 61 62 6c ;; (hash-tabl
aeb0: 65 2d 3e 61 6c 69 73 74 20 72 65 66 2d 64 61 74 e->alist ref-dat
aec0: 29 29 29 0a 09 09 20 20 20 3b 3b 20 28 73 65 74 )))... ;; (set
aed0: 21 20 64 61 74 61 20 28 61 70 70 65 6e 64 20 64 ! data (append d
aee0: 61 74 61 20 28 6c 69 73 74 20 28 6c 69 73 74 20 ata (list (list
aef0: 73 68 65 65 74 2d 6e 61 6d 65 20 72 65 66 2d 61 sheet-name ref-a
af00: 73 73 6f 63 29 29 29 29 29 29 0a 09 09 20 20 20 ssoc))))))...
af10: 28 73 65 74 21 20 64 61 74 61 20 28 63 6f 6e 73 (set! data (cons
af20: 20 28 6c 69 73 74 20 73 68 65 65 74 2d 6e 61 6d (list sheet-nam
af30: 65 20 72 65 66 2d 61 73 73 6f 63 29 20 64 61 74 e ref-assoc) dat
af40: 61 29 29 29 29 0a 09 20 20 20 20 20 20 20 73 68 a)))).. sh
af50: 65 65 74 73 29 0a 09 20 20 20 20 20 20 28 6c 69 eets).. (li
af60: 73 74 20 64 61 74 61 20 22 4e 4f 20 45 52 52 4f st data "NO ERRO
af70: 52 53 22 29 29 29 29 29 29 0a 0a 3b 3b 20 6d 61 RS"))))))..;; ma
af80: 70 20 6f 76 65 72 20 61 6c 6c 20 70 61 69 72 73 p over all pairs
af90: 20 69 6e 20 61 20 74 68 72 65 65 20 6c 65 76 65 in a three leve
afa0: 6c 20 68 69 65 72 61 72 63 68 69 61 6c 20 61 6c l hierarchial al
afb0: 69 73 74 20 61 6e 64 20 61 70 70 6c 79 20 61 20 ist and apply a
afc0: 66 75 6e 63 74 69 6f 6e 20 74 6f 20 74 68 65 20 function to the
afd0: 6b 65 79 73 2f 76 61 6c 0a 3b 3b 0a 28 64 65 66 keys/val.;;.(def
afe0: 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a 6d 61 70 ine (configf:map
aff0: 2d 61 6c 6c 2d 68 69 65 72 2d 61 6c 69 73 74 20 -all-hier-alist
b000: 64 61 74 61 20 70 72 6f 63 20 23 21 6b 65 79 20 data proc #!key
b010: 28 69 6e 69 74 70 72 6f 63 31 20 23 66 29 28 69 (initproc1 #f)(i
b020: 6e 69 74 70 72 6f 63 32 20 23 66 29 28 69 6e 69 nitproc2 #f)(ini
b030: 74 70 72 6f 63 33 20 23 66 29 29 0a 20 20 28 66 tproc3 #f)). (f
b040: 6f 72 2d 65 61 63 68 20 0a 20 20 20 28 6c 61 6d or-each . (lam
b050: 62 64 61 20 28 73 68 65 65 74 6e 61 6d 65 29 0a bda (sheetname).
b060: 20 20 20 20 20 28 6c 65 74 2a 20 28 28 73 68 65 (let* ((she
b070: 65 74 74 6d 70 20 20 28 61 73 73 6f 63 20 73 68 ettmp (assoc sh
b080: 65 65 74 6e 61 6d 65 20 64 61 74 61 29 29 0a 09 eetname data))..
b090: 20 20 20 20 28 73 68 65 65 74 64 61 74 20 20 28 (sheetdat (
b0a0: 69 66 20 73 68 65 65 74 74 6d 70 20 28 63 61 64 if sheettmp (cad
b0b0: 72 20 73 68 65 65 74 74 6d 70 29 20 27 28 29 29 r sheettmp) '())
b0c0: 29 29 0a 20 20 20 20 20 20 20 28 69 66 20 69 6e )). (if in
b0d0: 69 74 70 72 6f 63 31 20 28 69 6e 69 74 70 72 6f itproc1 (initpro
b0e0: 63 31 20 73 68 65 65 74 6e 61 6d 65 29 29 0a 20 c1 sheetname)).
b0f0: 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 (for-each
b100: 0a 09 28 6c 61 6d 62 64 61 20 28 73 65 63 74 69 ..(lambda (secti
b110: 6f 6e 6e 61 6d 65 29 0a 09 20 20 28 6c 65 74 2a onname).. (let*
b120: 20 28 28 73 65 63 74 69 6f 6e 74 6d 70 20 20 28 ((sectiontmp (
b130: 61 73 73 6f 63 20 73 65 63 74 69 6f 6e 6e 61 6d assoc sectionnam
b140: 65 20 73 68 65 65 74 64 61 74 29 29 0a 09 09 20 e sheetdat))...
b150: 28 73 65 63 74 69 6f 6e 64 61 74 20 20 28 69 66 (sectiondat (if
b160: 20 73 65 63 74 69 6f 6e 74 6d 70 20 28 63 61 64 sectiontmp (cad
b170: 72 20 73 65 63 74 69 6f 6e 74 6d 70 29 20 27 28 r sectiontmp) '(
b180: 29 29 29 29 0a 09 20 20 20 20 28 69 66 20 69 6e )))).. (if in
b190: 69 74 70 72 6f 63 32 20 28 69 6e 69 74 70 72 6f itproc2 (initpro
b1a0: 63 32 20 73 68 65 65 74 6e 61 6d 65 20 73 65 63 c2 sheetname sec
b1b0: 74 69 6f 6e 6e 61 6d 65 29 29 0a 09 20 20 20 20 tionname))..
b1c0: 28 66 6f 72 2d 65 61 63 68 0a 09 20 20 20 20 20 (for-each..
b1d0: 28 6c 61 6d 62 64 61 20 28 76 61 72 6e 61 6d 65 (lambda (varname
b1e0: 29 0a 09 20 20 20 20 20 20 20 28 6c 65 74 2a 20 ).. (let*
b1f0: 28 28 76 61 6c 74 6d 70 20 28 61 73 73 6f 63 20 ((valtmp (assoc
b200: 76 61 72 6e 61 6d 65 20 73 65 63 74 69 6f 6e 64 varname sectiond
b210: 61 74 29 29 0a 09 09 20 20 20 20 20 20 28 76 61 at))... (va
b220: 6c 20 20 20 20 28 69 66 20 76 61 6c 74 6d 70 20 l (if valtmp
b230: 28 63 61 64 72 20 76 61 6c 74 6d 70 29 20 22 22 (cadr valtmp) ""
b240: 29 29 29 0a 09 09 20 28 70 72 6f 63 20 73 68 65 )))... (proc she
b250: 65 74 6e 61 6d 65 20 73 65 63 74 69 6f 6e 6e 61 etname sectionna
b260: 6d 65 20 76 61 72 6e 61 6d 65 20 76 61 6c 29 29 me varname val))
b270: 29 0a 09 20 20 20 20 20 28 6d 61 70 20 63 61 72 ).. (map car
b280: 20 73 65 63 74 69 6f 6e 64 61 74 29 29 29 29 0a sectiondat)))).
b290: 09 28 6d 61 70 20 63 61 72 20 73 68 65 65 74 64 .(map car sheetd
b2a0: 61 74 29 29 29 29 0a 20 20 20 28 6d 61 70 20 63 at)))). (map c
b2b0: 61 72 20 64 61 74 61 29 29 0a 20 20 64 61 74 61 ar data)). data
b2c0: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
b2d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b2e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b2f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b300: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 20 ===========.;;
b310: 43 20 4f 20 4e 20 46 20 49 20 47 20 20 20 54 20 C O N F I G T
b320: 4f 20 2f 20 46 20 52 20 4f 20 4d 20 20 20 41 20 O / F R O M A
b330: 4c 20 49 20 53 20 54 0a 3b 3b 3d 3d 3d 3d 3d 3d L I S T.;;======
b340: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b350: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b360: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b370: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b380: 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 ..(define (confi
b390: 67 66 3a 63 6f 6e 66 69 67 2d 3e 61 6c 69 73 74 gf:config->alist
b3a0: 20 63 66 67 64 61 74 29 0a 20 20 28 68 61 73 68 cfgdat). (hash
b3b0: 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 74 20 63 66 -table->alist cf
b3c0: 67 64 61 74 29 29 0a 0a 28 64 65 66 69 6e 65 20 gdat))..(define
b3d0: 28 63 6f 6e 66 69 67 66 3a 61 6c 69 73 74 2d 3e (configf:alist->
b3e0: 63 6f 6e 66 69 67 20 61 64 61 74 29 0a 20 20 28 config adat). (
b3f0: 6c 65 74 20 28 28 68 74 20 28 6d 61 6b 65 2d 68 let ((ht (make-h
b400: 61 73 68 2d 74 61 62 6c 65 29 29 29 0a 20 20 20 ash-table))).
b410: 20 28 66 6f 72 2d 65 61 63 68 0a 20 20 20 20 20 (for-each.
b420: 28 6c 61 6d 62 64 61 20 28 73 65 63 74 69 6f 6e (lambda (section
b430: 29 0a 20 20 20 20 20 20 20 28 68 61 73 68 2d 74 ). (hash-t
b440: 61 62 6c 65 2d 73 65 74 21 20 68 74 20 28 63 61 able-set! ht (ca
b450: 72 20 73 65 63 74 69 6f 6e 29 28 63 64 72 20 73 r section)(cdr s
b460: 65 63 74 69 6f 6e 29 29 29 0a 20 20 20 20 20 61 ection))). a
b470: 64 61 74 29 0a 20 20 20 20 68 74 29 29 0a 0a 3b dat). ht))..;
b480: 3b 20 63 6f 6e 76 65 72 74 20 68 69 65 72 61 72 ; convert hierar
b490: 63 68 69 61 6c 20 6c 69 73 74 20 74 6f 20 69 6e chial list to in
b4a0: 69 20 66 6f 72 6d 61 74 0a 3b 3b 0a 28 64 65 66 i format.;;.(def
b4b0: 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a 63 6f 6e ine (configf:con
b4c0: 66 69 67 2d 3e 69 6e 69 20 64 61 74 61 29 0a 20 fig->ini data).
b4d0: 20 28 6d 61 70 20 0a 20 20 20 28 6c 61 6d 62 64 (map . (lambd
b4e0: 61 20 28 73 65 63 74 69 6f 6e 29 0a 20 20 20 20 a (section).
b4f0: 20 28 6c 65 74 20 28 28 73 65 63 74 69 6f 6e 2d (let ((section-
b500: 6e 61 6d 65 20 28 63 61 72 20 73 65 63 74 69 6f name (car sectio
b510: 6e 29 29 0a 09 20 20 20 28 73 65 63 74 69 6f 6e n)).. (section
b520: 2d 64 61 74 20 20 28 63 64 72 20 73 65 63 74 69 -dat (cdr secti
b530: 6f 6e 29 29 29 0a 20 20 20 20 20 20 20 28 69 66 on))). (if
b540: 20 28 73 74 72 69 6e 67 3f 20 73 65 63 74 69 6f (string? sectio
b550: 6e 2d 6e 61 6d 65 29 0a 09 20 20 20 28 62 65 67 n-name).. (beg
b560: 69 6e 0a 09 20 20 20 20 20 28 70 72 69 6e 74 20 in.. (print
b570: 22 5c 6e 5b 22 20 73 65 63 74 69 6f 6e 2d 6e 61 "\n[" section-na
b580: 6d 65 20 22 5d 22 29 0a 09 20 20 20 20 20 28 6d me "]").. (m
b590: 61 70 20 28 6c 61 6d 62 64 61 20 28 64 61 74 2d ap (lambda (dat-
b5a0: 70 61 69 72 29 0a 09 09 20 20 20 20 28 6c 65 74 pair)... (let
b5b0: 2a 20 28 28 76 61 72 20 28 63 61 72 20 64 61 74 * ((var (car dat
b5c0: 2d 70 61 69 72 29 29 0a 09 09 09 20 20 20 28 76 -pair)).... (v
b5d0: 61 6c 20 28 63 61 64 72 20 64 61 74 2d 70 61 69 al (cadr dat-pai
b5e0: 72 29 29 0a 09 09 09 20 20 20 28 66 6e 61 6d 65 r)).... (fname
b5f0: 20 28 69 66 20 28 3e 20 28 6c 65 6e 67 74 68 20 (if (> (length
b600: 64 61 74 2d 70 61 69 72 29 20 32 29 28 63 61 64 dat-pair) 2)(cad
b610: 64 72 20 64 61 74 2d 70 61 69 72 29 20 23 66 29 dr dat-pair) #f)
b620: 29 29 0a 09 09 20 20 20 20 20 20 28 69 66 20 66 ))... (if f
b630: 6e 61 6d 65 20 28 70 72 69 6e 74 20 22 23 20 22 name (print "# "
b640: 20 76 61 72 20 22 3d 3e 22 20 66 6e 61 6d 65 29 var "=>" fname)
b650: 29 0a 09 09 20 20 20 20 20 20 28 70 72 69 6e 74 )... (print
b660: 20 76 61 72 20 22 20 22 20 76 61 6c 29 29 29 0a var " " val))).
b670: 09 09 20 20 73 65 63 74 69 6f 6e 2d 64 61 74 29 .. section-dat)
b680: 29 29 29 29 20 3b 3b 20 20 20 20 20 20 20 28 70 )))) ;; (p
b690: 72 69 6e 74 20 22 73 65 63 74 69 6f 6e 2d 64 61 rint "section-da
b6a0: 74 3a 20 22 20 73 65 63 74 69 6f 6e 2d 64 61 74 t: " section-dat
b6b0: 29 29 0a 20 20 20 28 68 61 73 68 2d 74 61 62 6c )). (hash-tabl
b6c0: 65 2d 3e 61 6c 69 73 74 20 64 61 74 61 29 29 29 e->alist data)))
b6d0: 0a 0a 28 64 65 66 69 6e 65 20 28 72 75 6e 63 6f ..(define (runco
b6e0: 6e 66 69 67 3a 72 65 61 64 20 66 6e 61 6d 65 20 nfig:read fname
b6f0: 74 61 72 67 65 74 20 65 6e 76 69 72 6f 6e 2d 70 target environ-p
b700: 61 74 74 29 0a 20 20 28 6c 65 74 20 28 28 68 74 att). (let ((ht
b710: 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c (make-hash-tabl
b720: 65 29 29 29 0a 20 20 20 20 28 69 66 20 74 61 72 e))). (if tar
b730: 67 65 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d get (hash-table-
b740: 73 65 74 21 20 68 74 20 74 61 72 67 65 74 20 27 set! ht target '
b750: 28 29 29 29 0a 20 20 20 20 28 63 6f 6e 66 69 67 ())). (config
b760: 66 3a 72 65 61 64 2d 63 6f 6e 66 69 67 20 66 6e f:read-config fn
b770: 61 6d 65 20 68 74 20 23 74 20 65 6e 76 69 72 6f ame ht #t enviro
b780: 6e 2d 70 61 74 74 3a 20 65 6e 76 69 72 6f 6e 2d n-patt: environ-
b790: 70 61 74 74 20 73 65 63 74 69 6f 6e 73 3a 20 28 patt sections: (
b7a0: 69 66 20 74 61 72 67 65 74 20 28 6c 69 73 74 20 if target (list
b7b0: 22 64 65 66 61 75 6c 74 22 20 74 61 72 67 65 74 "default" target
b7c0: 29 20 23 66 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d ) #f))))..;;====
b7d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b7e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b7f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b800: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b810: 3d 3d 0a 3b 3b 20 43 6f 6e 66 69 67 20 66 69 6c ==.;; Config fil
b820: 65 20 68 61 6e 64 6c 69 6e 67 0a 3b 3b 3d 3d 3d e handling.;;===
b830: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b840: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b850: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b860: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b870: 3d 3d 3d 0a 0a 3b 3b 20 63 6f 6e 76 65 72 74 20 ===..;; convert
b880: 74 6f 20 70 61 72 61 6d 3f 0a 28 64 65 66 69 6e to param?.(defin
b890: 65 20 63 6f 6e 66 69 67 66 3a 73 74 64 2d 69 6d e configf:std-im
b8a0: 70 6f 72 74 73 20 22 28 69 6d 70 6f 72 74 20 62 ports "(import b
b8b0: 69 67 2d 63 68 69 63 6b 65 6e 20 63 6f 6e 66 69 ig-chicken confi
b8c0: 67 66 6d 6f 64 20 63 6f 6d 6d 6f 6e 6d 6f 64 20 gfmod commonmod
b8d0: 72 6d 74 6d 6f 64 20 28 70 72 65 66 69 78 20 6d rmtmod (prefix m
b8e0: 74 61 72 67 73 20 61 72 67 73 3a 29 29 22 29 0a targs args:))").
b8f0: 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 66 (define (configf
b900: 3a 70 72 6f 63 65 73 73 2d 6f 6e 65 20 6d 61 74 :process-one mat
b910: 63 68 64 61 74 20 6c 20 68 74 20 61 6c 6c 6f 77 chdat l ht allow
b920: 2d 73 79 73 74 65 6d 20 65 6e 76 2d 74 6f 2d 75 -system env-to-u
b930: 73 65 20 6c 69 6e 65 6e 75 6d 29 0a 20 20 28 6c se linenum). (l
b940: 65 74 2a 20 28 28 70 72 65 73 74 72 20 20 28 6c et* ((prestr (l
b950: 69 73 74 2d 72 65 66 20 6d 61 74 63 68 64 61 74 ist-ref matchdat
b960: 20 31 29 29 0a 09 20 28 63 6d 64 74 79 70 65 20 1)).. (cmdtype
b970: 28 6c 69 73 74 2d 72 65 66 20 6d 61 74 63 68 64 (list-ref matchd
b980: 61 74 20 32 29 29 20 3b 3b 20 65 76 61 6c 2c 20 at 2)) ;; eval,
b990: 73 79 73 74 65 6d 2c 20 73 68 65 6c 6c 2c 20 67 system, shell, g
b9a0: 65 74 65 6e 76 0a 09 20 28 63 6d 64 20 20 20 20 etenv.. (cmd
b9b0: 20 28 6c 69 73 74 2d 72 65 66 20 6d 61 74 63 68 (list-ref match
b9c0: 64 61 74 20 33 29 29 0a 09 20 28 71 75 6f 74 65 dat 3)).. (quote
b9d0: 64 63 6d 64 20 28 63 6f 6e 63 20 22 5c 22 22 63 dcmd (conc "\""c
b9e0: 6d 64 22 5c 22 22 29 29 0a 09 20 28 70 6f 73 74 md"\"")).. (post
b9f0: 73 74 72 20 28 6c 69 73 74 2d 72 65 66 20 6d 61 str (list-ref ma
ba00: 74 63 68 64 61 74 20 34 29 29 0a 09 20 28 72 65 tchdat 4)).. (re
ba10: 73 75 6c 74 20 20 23 66 29 0a 09 20 28 73 74 61 sult #f).. (sta
ba20: 72 74 2d 74 69 6d 65 20 28 63 75 72 72 65 6e 74 rt-time (current
ba30: 2d 73 65 63 6f 6e 64 73 29 29 0a 09 20 28 63 6d -seconds)).. (cm
ba40: 64 73 79 6d 20 20 28 73 74 72 69 6e 67 2d 3e 73 dsym (string->s
ba50: 79 6d 62 6f 6c 20 63 6d 64 74 79 70 65 29 29 0a ymbol cmdtype)).
ba60: 09 20 28 66 75 6c 6c 63 6d 64 0a 09 20 20 28 69 . (fullcmd.. (i
ba70: 66 20 28 6d 65 6d 62 65 72 20 63 6d 64 73 79 6d f (member cmdsym
ba80: 20 27 28 73 63 68 65 6d 65 20 73 63 6d 29 29 0a '(scheme scm)).
ba90: 09 20 20 20 20 20 20 60 28 65 76 61 6c 2d 6e 65 . `(eval-ne
baa0: 65 64 65 64 0a 09 09 2c 28 63 6f 6e 63 20 20 22 eded...,(conc "
bab0: 28 6c 61 6d 62 64 61 20 28 68 74 29 22 0a 09 09 (lambda (ht)"...
bac0: 09 63 6f 6e 66 69 67 66 3a 73 74 64 2d 69 6d 70 .configf:std-imp
bad0: 6f 72 74 73 0a 09 09 09 63 6d 64 20 22 29 22 29 orts....cmd ")")
bae0: 29 0a 09 20 20 20 20 20 20 28 63 61 73 65 20 63 ).. (case c
baf0: 6d 64 73 79 6d 0a 09 09 28 28 73 79 73 74 65 6d mdsym...((system
bb00: 29 20 20 20 20 20 60 28 6e 6f 65 76 61 6c 2d 6e ) `(noeval-n
bb10: 65 65 64 65 64 20 20 2c 28 63 6f 6e 63 20 28 63 eeded ,(conc (c
bb20: 6f 6e 66 69 67 66 3a 73 79 73 74 65 6d 20 68 74 onfigf:system ht
bb30: 20 63 6d 64 29 29 29 29 0a 09 09 3b 3b 20 28 28 cmd))))...;; ((
bb40: 73 68 65 6c 6c 20 73 68 29 20 20 20 60 28 6e 6f shell sh) `(no
bb50: 65 76 61 6c 2d 6e 65 65 64 65 64 20 20 2c 28 63 eval-needed ,(c
bb60: 6f 6e 63 20 28 73 74 72 69 6e 67 2d 74 72 61 6e onc (string-tran
bb70: 73 6c 61 74 65 20 28 73 68 65 6c 6c 20 71 75 6f slate (shell quo
bb80: 74 65 64 63 6d 64 29 20 22 5c 6e 22 20 22 20 22 tedcmd) "\n" " "
bb90: 29 29 29 29 0a 09 09 28 28 73 68 65 6c 6c 20 73 ))))...((shell s
bba0: 68 29 20 20 20 60 28 6e 6f 65 76 61 6c 2d 6e 65 h) `(noeval-ne
bbb0: 65 64 65 64 20 20 2c 28 63 6f 6e 63 20 28 73 74 eded ,(conc (st
bbc0: 72 69 6e 67 2d 74 72 61 6e 73 6c 61 74 65 20 28 ring-translate (
bbd0: 73 68 65 6c 6c 20 63 6d 64 29 20 22 5c 6e 22 20 shell cmd) "\n"
bbe0: 22 20 22 29 29 29 29 0a 09 09 28 28 72 65 61 6c " "))))...((real
bbf0: 70 61 74 68 20 72 70 29 60 28 6e 6f 65 76 61 6c path rp)`(noeval
bc00: 2d 6e 65 65 64 65 64 20 20 2c 28 63 6f 6e 63 20 -needed ,(conc
bc10: 28 63 6f 6d 6d 6f 6e 3a 6e 69 63 65 2d 70 61 74 (common:nice-pat
bc20: 68 20 71 75 6f 74 65 64 63 6d 64 29 29 29 29 0a h quotedcmd)))).
bc30: 09 09 28 28 67 65 74 65 6e 76 20 67 76 29 20 20 ..((getenv gv)
bc40: 60 28 6e 6f 65 76 61 6c 2d 6e 65 65 64 65 64 20 `(noeval-needed
bc50: 20 2c 28 63 6f 6e 63 20 28 67 65 74 2d 65 6e 76 ,(conc (get-env
bc60: 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c ironment-variabl
bc70: 65 20 63 6d 64 29 29 29 29 0a 09 09 3b 3b 20 54 e cmd))))...;; T
bc80: 4f 44 4f 20 2d 20 72 65 70 6c 61 63 65 20 2a 74 ODO - replace *t
bc90: 6f 70 70 61 74 68 2a 20 61 6e 64 20 76 61 72 20 oppath* and var
bca0: 72 65 6c 69 61 6e 63 65 20 77 69 74 68 20 67 65 reliance with ge
bcb0: 74 74 69 6e 67 20 70 61 74 68 20 77 68 65 72 65 tting path where
bcc0: 20 2a 74 68 69 73 2a 20 63 6f 6e 66 69 67 20 66 *this* config f
bcd0: 69 6c 65 20 77 61 73 20 66 6f 75 6e 64 0a 09 09 ile was found...
bce0: 28 28 6d 74 72 61 68 29 20 20 20 20 20 20 60 28 ((mtrah) `(
bcf0: 6e 6f 65 76 61 6c 2d 6e 65 65 64 65 64 20 20 2c noeval-needed ,
bd00: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 (hash-table-ref
bd10: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 (hash-table-ref
bd20: 68 74 20 27 6d 65 74 61 64 61 74 61 29 20 27 74 ht 'metadata) 't
bd30: 6f 70 70 61 74 68 29 29 29 20 20 20 3b 3b 20 28 oppath))) ;; (
bd40: 63 6f 6e 63 20 28 6f 72 20 2a 74 6f 70 70 61 74 conc (or *toppat
bd50: 68 2a 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d h* (get-environm
bd60: 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 5c 22 4d ent-variable \"M
bd70: 54 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 5c T_RUN_AREA_HOME\
bd80: 22 29 29 29 29 0a 09 09 28 28 67 65 74 20 67 29 "))))...((get g)
bd90: 20 20 20 0a 09 09 20 28 6d 61 74 63 68 0a 09 09 ... (match...
bda0: 20 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 (string-split
bdb0: 63 6d 64 29 0a 09 09 20 20 28 28 73 65 63 74 20 cmd)... ((sect
bdc0: 76 61 72 29 20 60 28 6e 6f 65 76 61 6c 2d 6e 65 var) `(noeval-ne
bdd0: 65 64 65 64 20 2c 28 63 6f 6e 66 69 67 66 3a 6c eded ,(configf:l
bde0: 6f 6f 6b 75 70 20 68 74 20 73 65 63 74 20 76 61 ookup ht sect va
bdf0: 72 29 29 29 0a 09 09 20 20 28 65 6c 73 65 0a 09 r)))... (else..
be00: 09 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 . (debug:print
be10: 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c -error 0 *defaul
be20: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 23 7b 67 t-log-port* "#{g
be30: 65 74 20 2e 2e 2e 7d 20 75 73 65 64 20 77 69 74 et ...} used wit
be40: 68 20 6f 6e 6c 79 20 6f 6e 65 20 70 61 72 61 6d h only one param
be50: 65 74 65 72 2c 20 5c 22 22 20 63 6d 64 20 22 5c eter, \"" cmd "\
be60: 22 2c 20 74 77 6f 20 6e 65 65 64 65 64 2e 22 29 ", two needed.")
be70: 0a 09 09 20 20 20 27 28 62 61 64 2d 70 61 72 61 ... '(bad-para
be80: 6d 20 2c 28 63 6f 6e 63 20 22 23 7b 67 65 74 20 m ,(conc "#{get
be90: 2e 2e 2e 7d 20 75 73 65 64 20 77 69 74 68 20 6f ...} used with o
bea0: 6e 6c 79 20 6f 6e 65 20 70 61 72 61 6d 65 74 65 nly one paramete
beb0: 72 2c 20 5c 22 22 20 63 6d 64 20 22 5c 22 2c 20 r, \"" cmd "\",
bec0: 74 77 6f 20 6e 65 65 64 65 64 2e 22 29 29 29 29 two needed."))))
bed0: 29 0a 09 09 28 28 72 75 6e 63 6f 6e 66 69 67 73 )...((runconfigs
bee0: 2d 67 65 74 20 72 67 65 74 29 20 60 28 6e 6f 65 -get rget) `(noe
bef0: 76 61 6c 2d 6e 65 65 64 65 64 20 2c 28 72 75 6e val-needed ,(run
bf00: 63 6f 6e 66 69 67 73 2d 67 65 74 20 68 74 20 71 configs-get ht q
bf10: 75 6f 74 65 64 63 6d 64 29 29 29 20 3b 3b 20 28 uotedcmd))) ;; (
bf20: 63 6f 6e 63 20 22 28 6c 61 6d 62 64 61 20 28 68 conc "(lambda (h
bf30: 74 29 28 72 75 6e 63 6f 6e 66 69 67 73 2d 67 65 t)(runconfigs-ge
bf40: 74 20 68 74 20 5c 22 22 20 63 6d 64 20 22 5c 22 t ht \"" cmd "\"
bf50: 29 29 22 29 29 0a 09 09 28 65 6c 73 65 20 60 28 ))"))...(else `(
bf60: 23 66 20 2c 28 63 6f 6e 63 20 22 63 6d 64 3a 20 #f ,(conc "cmd:
bf70: 22 20 63 6d 64 20 22 20 6e 6f 74 20 72 65 63 6f " cmd " not reco
bf80: 67 6e 69 73 65 64 22 29 29 29 29 29 29 29 0a 20 gnised"))))))).
bf90: 20 20 20 28 6d 61 74 63 68 0a 20 20 20 20 20 66 (match. f
bfa0: 75 6c 6c 63 6d 64 0a 20 20 20 20 20 28 28 27 65 ullcmd. (('e
bfb0: 76 61 6c 2d 6e 65 65 64 65 64 20 6e 65 77 72 65 val-needed newre
bfc0: 73 29 0a 20 20 20 20 20 20 28 68 61 6e 64 6c 65 s). (handle
bfd0: 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 20 65 78 -exceptions.. ex
bfe0: 6e 0a 09 20 28 62 65 67 69 6e 0a 09 20 20 20 28 n.. (begin.. (
bff0: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
c000: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
c010: 20 22 57 41 52 4e 49 4e 47 3a 20 66 61 69 6c 65 "WARNING: faile
c020: 64 20 74 6f 20 70 72 6f 63 65 73 73 20 63 6f 6e d to process con
c030: 66 69 67 20 69 6e 70 75 74 20 5c 22 22 20 6c 20 fig input \"" l
c040: 22 5c 22 2c 20 66 75 6c 6c 63 6d 64 3d 22 66 75 "\", fullcmd="fu
c050: 6c 6c 63 6d 64 22 2c 20 65 78 6e 3d 22 20 65 78 llcmd", exn=" ex
c060: 6e 29 0a 09 20 20 20 28 64 65 62 75 67 3a 70 72 n).. (debug:pr
c070: 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c int 0 *default-l
c080: 6f 67 2d 70 6f 72 74 2a 20 22 20 6d 65 73 73 61 og-port* " messa
c090: 67 65 3a 20 22 20 28 28 63 6f 6e 64 69 74 69 6f ge: " ((conditio
c0a0: 6e 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 65 73 n-property-acces
c0b0: 73 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 61 67 sor 'exn 'messag
c0c0: 65 29 20 65 78 6e 29 29 0a 09 20 20 20 3b 3b 20 e) exn)).. ;;
c0d0: 28 70 72 69 6e 74 20 22 65 78 6e 3d 22 20 28 63 (print "exn=" (c
c0e0: 6f 6e 64 69 74 69 6f 6e 2d 3e 6c 69 73 74 20 65 ondition->list e
c0f0: 78 6e 29 29 0a 09 20 20 20 28 73 65 74 21 20 72 xn)).. (set! r
c100: 65 73 75 6c 74 20 28 63 6f 6e 63 20 22 23 7b 28 esult (conc "#{(
c110: 20 22 20 63 6d 64 74 79 70 65 20 22 29 20 22 20 " cmdtype ") "
c120: 63 6d 64 20 22 7d 2c 20 66 75 6c 6c 20 65 78 70 cmd "}, full exp
c130: 61 6e 73 69 6f 6e 3a 20 22 20 66 75 6c 6c 63 6d ansion: " fullcm
c140: 64 29 29 29 0a 09 20 28 69 66 20 28 6f 72 20 61 d))).. (if (or a
c150: 6c 6c 6f 77 2d 73 79 73 74 65 6d 0a 09 09 20 28 llow-system... (
c160: 6e 6f 74 20 28 6d 65 6d 62 65 72 20 63 6d 64 74 not (member cmdt
c170: 79 70 65 20 27 28 22 73 79 73 74 65 6d 22 20 22 ype '("system" "
c180: 73 68 65 6c 6c 22 20 22 73 68 22 29 29 29 29 0a shell" "sh")))).
c190: 09 20 20 20 20 20 28 77 69 74 68 2d 69 6e 70 75 . (with-inpu
c1a0: 74 2d 66 72 6f 6d 2d 73 74 72 69 6e 67 20 6e 65 t-from-string ne
c1b0: 77 72 65 73 0a 09 20 20 20 20 20 20 20 28 6c 61 wres.. (la
c1c0: 6d 62 64 61 20 28 29 0a 09 09 20 28 73 65 74 21 mbda ()... (set!
c1d0: 20 72 65 73 75 6c 74 20 28 69 66 20 65 6e 76 2d result (if env-
c1e0: 74 6f 2d 75 73 65 0a 09 09 09 09 20 20 28 28 65 to-use..... ((e
c1f0: 76 61 6c 20 28 72 65 61 64 29 20 65 6e 76 2d 74 val (read) env-t
c200: 6f 2d 75 73 65 29 20 68 74 29 0a 09 09 09 09 20 o-use) ht).....
c210: 20 28 28 65 76 61 6c 20 28 72 65 61 64 29 29 20 ((eval (read))
c220: 68 74 29 0a 09 09 09 09 20 20 29 29 29 29 0a 09 ht)..... ))))..
c230: 20 20 20 20 20 28 73 65 74 21 20 72 65 73 75 6c (set! resul
c240: 74 20 28 63 6f 6e 63 20 22 23 7b 28 22 20 63 6d t (conc "#{(" cm
c250: 64 74 79 70 65 20 22 29 20 22 20 20 63 6d 64 20 dtype ") " cmd
c260: 22 7d 22 29 29 29 29 29 0a 20 20 20 20 20 28 28 "}"))))). ((
c270: 27 6e 6f 65 76 61 6c 2d 6e 65 65 64 65 64 20 6e 'noeval-needed n
c280: 65 77 72 65 73 29 28 73 65 74 21 20 72 65 73 75 ewres)(set! resu
c290: 6c 74 20 6e 65 77 72 65 73 29 29 0a 20 20 20 20 lt newres)).
c2a0: 20 28 65 6c 73 65 20 3b 3b 20 28 23 66 20 65 72 (else ;; (#f er
c2b0: 72 72 65 73 29 0a 20 20 20 20 20 20 28 64 65 62 rres). (deb
c2c0: 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 ug:print 0 *defa
c2d0: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 ult-log-port* "W
c2e0: 41 52 4e 49 4e 47 3a 20 66 61 69 6c 65 64 20 74 ARNING: failed t
c2f0: 6f 20 70 72 6f 63 65 73 73 20 63 6f 6e 66 69 67 o process config
c300: 20 69 6e 70 75 74 20 5c 22 22 6c 22 5c 22 2c 20 input \""l"\",
c310: 66 75 6c 6c 63 6d 64 3d 22 66 75 6c 6c 63 6d 64 fullcmd="fullcmd
c320: 22 2e 22 29 29 29 0a 20 20 20 20 3b 3b 20 77 65 "."))). ;; we
c330: 20 70 72 6f 63 65 73 73 20 61 73 20 61 20 72 65 process as a re
c340: 73 75 6c 74 0a 20 20 20 20 28 6c 65 74 20 28 28 sult. (let ((
c350: 64 65 6c 74 61 20 28 2d 20 28 63 75 72 72 65 6e delta (- (curren
c360: 74 2d 73 65 63 6f 6e 64 73 29 20 73 74 61 72 74 t-seconds) start
c370: 2d 74 69 6d 65 29 29 29 0a 20 20 20 20 20 20 28 -time))). (
c380: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
c390: 20 28 69 66 20 28 3e 20 64 65 6c 74 61 20 32 29 (if (> delta 2)
c3a0: 20 30 20 39 29 20 2a 64 65 66 61 75 6c 74 2d 6c 0 9) *default-l
c3b0: 6f 67 2d 70 6f 72 74 2a 20 22 66 6f 72 20 6c 69 og-port* "for li
c3c0: 6e 65 20 5c 22 22 20 6c 20 22 5c 22 5c 6e 20 63 ne \"" l "\"\n c
c3d0: 6f 6d 6d 61 6e 64 3a 20 20 22 20 63 6d 64 20 22 ommand: " cmd "
c3e0: 20 74 6f 6f 6b 20 22 20 64 65 6c 74 61 20 22 20 took " delta "
c3f0: 73 65 63 6f 6e 64 73 20 74 6f 20 72 75 6e 20 77 seconds to run w
c400: 69 74 68 20 6f 75 74 70 75 74 3a 5c 6e 20 20 20 ith output:\n
c410: 22 20 72 65 73 75 6c 74 29 29 0a 20 20 20 20 28 " result)). (
c420: 63 6f 6e 63 20 70 72 65 73 74 72 20 72 65 73 75 conc prestr resu
c430: 6c 74 20 70 6f 73 74 73 74 72 29 29 29 0a 09 20 lt poststr)))..
c440: 20 20 20 20 20 0a 28 64 65 66 69 6e 65 20 28 63 .(define (c
c450: 6f 6e 66 69 67 66 3a 70 72 6f 63 65 73 73 2d 6c onfigf:process-l
c460: 69 6e 65 20 6c 20 68 74 20 61 6c 6c 6f 77 2d 73 ine l ht allow-s
c470: 79 73 74 65 6d 20 65 6e 76 2d 74 6f 2d 75 73 65 ystem env-to-use
c480: 20 23 21 6b 65 79 20 28 6c 69 6e 65 6e 75 6d 20 #!key (linenum
c490: 23 66 29 29 0a 20 20 28 6c 65 74 20 6c 6f 6f 70 #f)). (let loop
c4a0: 20 28 28 72 65 73 20 6c 29 29 0a 20 20 20 20 28 ((res l)). (
c4b0: 69 66 20 28 73 74 72 69 6e 67 3f 20 72 65 73 29 if (string? res)
c4c0: 0a 09 28 6c 65 74 20 28 28 6d 61 74 63 68 64 61 ..(let ((matchda
c4d0: 74 20 28 73 74 72 69 6e 67 2d 73 65 61 72 63 68 t (string-search
c4e0: 20 63 6f 6e 66 69 67 66 3a 76 61 72 2d 65 78 70 configf:var-exp
c4f0: 61 6e 64 2d 72 65 67 65 78 20 72 65 73 29 29 29 and-regex res)))
c500: 0a 09 20 20 28 69 66 20 6d 61 74 63 68 64 61 74 .. (if matchdat
c510: 0a 09 20 20 20 20 20 20 28 6c 65 74 20 28 28 72 .. (let ((r
c520: 65 73 75 6c 74 20 28 63 6f 6e 66 69 67 66 3a 70 esult (configf:p
c530: 72 6f 63 65 73 73 2d 6f 6e 65 20 6d 61 74 63 68 rocess-one match
c540: 64 61 74 20 6c 20 68 74 20 61 6c 6c 6f 77 2d 73 dat l ht allow-s
c550: 79 73 74 65 6d 20 65 6e 76 2d 74 6f 2d 75 73 65 ystem env-to-use
c560: 20 6c 69 6e 65 6e 75 6d 29 29 29 0a 09 09 28 6c linenum)))...(l
c570: 6f 6f 70 20 72 65 73 75 6c 74 29 29 0a 09 20 20 oop result))..
c580: 20 20 20 20 72 65 73 29 29 0a 09 20 20 72 65 73 res)).. res
c590: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f )))..(define (co
c5a0: 6e 66 69 67 66 3a 70 72 6f 63 65 73 73 2d 6c 69 nfigf:process-li
c5b0: 6e 65 2d 6f 6c 64 20 6c 20 68 74 20 61 6c 6c 6f ne-old l ht allo
c5c0: 77 2d 73 79 73 74 65 6d 20 65 6e 76 2d 74 6f 2d w-system env-to-
c5d0: 75 73 65 20 23 21 6b 65 79 20 28 6c 69 6e 65 6e use #!key (linen
c5e0: 75 6d 20 23 66 29 29 0a 20 20 28 6c 65 74 20 6c um #f)). (let l
c5f0: 6f 6f 70 20 28 28 72 65 73 20 6c 29 29 0a 20 20 oop ((res l)).
c600: 20 20 28 69 66 20 28 73 74 72 69 6e 67 3f 20 72 (if (string? r
c610: 65 73 29 0a 09 28 6c 65 74 20 28 28 6d 61 74 63 es)..(let ((matc
c620: 68 64 61 74 20 28 73 74 72 69 6e 67 2d 73 65 61 hdat (string-sea
c630: 72 63 68 20 63 6f 6e 66 69 67 66 3a 76 61 72 2d rch configf:var-
c640: 65 78 70 61 6e 64 2d 72 65 67 65 78 20 72 65 73 expand-regex res
c650: 29 29 29 0a 09 20 20 28 69 66 20 6d 61 74 63 68 ))).. (if match
c660: 64 61 74 0a 09 20 20 20 20 20 20 28 6c 65 74 2a dat.. (let*
c670: 20 28 28 70 72 65 73 74 72 20 20 28 6c 69 73 74 ((prestr (list
c680: 2d 72 65 66 20 6d 61 74 63 68 64 61 74 20 31 29 -ref matchdat 1)
c690: 29 0a 09 09 20 20 20 20 20 28 63 6d 64 74 79 70 )... (cmdtyp
c6a0: 65 20 28 6c 69 73 74 2d 72 65 66 20 6d 61 74 63 e (list-ref matc
c6b0: 68 64 61 74 20 32 29 29 20 3b 3b 20 65 76 61 6c hdat 2)) ;; eval
c6c0: 2c 20 73 79 73 74 65 6d 2c 20 73 68 65 6c 6c 2c , system, shell,
c6d0: 20 67 65 74 65 6e 76 0a 09 09 20 20 20 20 20 28 getenv... (
c6e0: 63 6d 64 20 20 20 20 20 28 6c 69 73 74 2d 72 65 cmd (list-re
c6f0: 66 20 6d 61 74 63 68 64 61 74 20 33 29 29 0a 09 f matchdat 3))..
c700: 09 20 20 20 20 20 28 70 6f 73 74 73 74 72 20 28 . (poststr (
c710: 6c 69 73 74 2d 72 65 66 20 6d 61 74 63 68 64 61 list-ref matchda
c720: 74 20 34 29 29 0a 09 09 20 20 20 20 20 28 72 65 t 4))... (re
c730: 73 75 6c 74 20 20 23 66 29 0a 09 09 20 20 20 20 sult #f)...
c740: 20 28 73 74 61 72 74 2d 74 69 6d 65 20 28 63 75 (start-time (cu
c750: 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 0a rrent-seconds)).
c760: 09 09 20 20 20 20 20 28 63 6d 64 73 79 6d 20 20 .. (cmdsym
c770: 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 (string->symbol
c780: 63 6d 64 74 79 70 65 29 29 0a 09 09 20 20 20 20 cmdtype))...
c790: 20 28 66 75 6c 6c 63 6d 64 0a 09 09 20 20 20 20 (fullcmd...
c7a0: 20 20 28 63 6f 6e 63 20 20 63 6f 6e 66 69 67 66 (conc configf
c7b0: 3a 73 74 64 2d 69 6d 70 6f 72 74 73 0a 09 09 09 :std-imports....
c7c0: 20 20 20 20 20 22 28 69 6d 70 6f 72 74 20 63 68 "(import ch
c7d0: 69 63 6b 65 6e 2e 70 72 6f 63 65 73 73 2d 63 6f icken.process-co
c7e0: 6e 74 65 78 74 2e 70 6f 73 69 78 29 22 0a 09 09 ntext.posix)"...
c7f0: 09 20 20 20 20 20 22 28 64 65 66 69 6e 65 20 73 . "(define s
c800: 65 74 65 6e 76 20 73 65 74 2d 65 6e 76 69 72 6f etenv set-enviro
c810: 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 29 22 nment-variable)"
c820: 0a 09 09 09 20 20 20 20 20 28 63 61 73 65 20 63 .... (case c
c830: 6d 64 73 79 6d 0a 09 09 09 20 20 20 20 20 20 20 mdsym....
c840: 28 28 73 63 68 65 6d 65 20 73 63 6d 29 20 28 63 ((scheme scm) (c
c850: 6f 6e 63 20 22 28 6c 61 6d 62 64 61 20 28 68 74 onc "(lambda (ht
c860: 29 22 20 63 6d 64 20 22 29 22 29 29 0a 09 09 09 )" cmd ")"))....
c870: 20 20 20 20 20 20 20 28 28 73 79 73 74 65 6d 29 ((system)
c880: 20 20 20 20 20 28 63 6f 6e 63 20 22 28 6c 61 6d (conc "(lam
c890: 62 64 61 20 28 68 74 29 28 63 6f 6e 66 69 67 66 bda (ht)(configf
c8a0: 3a 73 79 73 74 65 6d 20 68 74 20 5c 22 22 20 63 :system ht \"" c
c8b0: 6d 64 20 22 5c 22 29 29 22 29 29 0a 09 09 09 20 md "\"))"))....
c8c0: 20 20 20 20 20 20 28 28 73 68 65 6c 6c 20 73 68 ((shell sh
c8d0: 29 20 20 20 28 63 6f 6e 63 20 22 28 6c 61 6d 62 ) (conc "(lamb
c8e0: 64 61 20 28 68 74 29 28 73 74 72 69 6e 67 2d 74 da (ht)(string-t
c8f0: 72 61 6e 73 6c 61 74 65 20 28 73 68 65 6c 6c 20 ranslate (shell
c900: 5c 22 22 20 20 63 6d 64 20 22 5c 22 29 20 5c 22 \"" cmd "\") \"
c910: 5c 6e 5c 22 20 5c 22 20 5c 22 29 29 22 29 29 0a \n\" \" \"))")).
c920: 09 09 09 20 20 20 20 20 20 20 28 28 72 65 61 6c ... ((real
c930: 70 61 74 68 20 72 70 29 28 63 6f 6e 63 20 22 28 path rp)(conc "(
c940: 6c 61 6d 62 64 61 20 28 68 74 29 28 63 6f 6d 6d lambda (ht)(comm
c950: 6f 6e 3a 6e 69 63 65 2d 70 61 74 68 20 5c 22 22 on:nice-path \""
c960: 20 63 6d 64 20 22 5c 22 29 29 22 29 29 0a 09 09 cmd "\"))"))...
c970: 09 20 20 20 20 20 20 20 28 28 67 65 74 65 6e 76 . ((getenv
c980: 20 67 76 29 20 20 28 63 6f 6e 63 20 22 28 6c 61 gv) (conc "(la
c990: 6d 62 64 61 20 28 68 74 29 28 67 65 74 2d 65 6e mbda (ht)(get-en
c9a0: 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 vironment-variab
c9b0: 6c 65 20 5c 22 22 20 63 6d 64 20 22 5c 22 29 29 le \"" cmd "\"))
c9c0: 22 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 28 ")).... ((
c9d0: 6d 74 72 61 68 29 20 20 20 20 20 20 28 63 6f 6e mtrah) (con
c9e0: 63 20 22 28 6c 61 6d 62 64 61 20 28 68 74 29 22 c "(lambda (ht)"
c9f0: 0a 09 09 09 09 09 09 20 20 20 22 20 20 20 20 28 ....... " (
ca00: 6c 65 74 20 28 28 65 78 74 72 61 20 5c 22 22 20 let ((extra \""
ca10: 63 6d 64 20 22 5c 22 29 29 22 0a 09 09 09 09 09 cmd "\"))"......
ca20: 09 20 20 20 22 20 20 20 20 20 20 20 28 63 6f 6e . " (con
ca30: 63 20 28 6f 72 20 2a 74 6f 70 70 61 74 68 2a 20 c (or *toppath*
ca40: 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 (get-environment
ca50: 2d 76 61 72 69 61 62 6c 65 20 5c 22 4d 54 5f 52 -variable \"MT_R
ca60: 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 5c 22 29 29 UN_AREA_HOME\"))
ca70: 22 0a 09 09 09 09 09 09 20 20 20 22 20 20 20 20 "....... "
ca80: 20 20 20 20 20 20 20 20 20 28 69 66 20 28 73 74 (if (st
ca90: 72 69 6e 67 2d 6e 75 6c 6c 3f 20 65 78 74 72 61 ring-null? extra
caa0: 29 20 5c 22 5c 22 20 5c 22 2f 5c 22 29 22 0a 09 ) \"\" \"/\")"..
cab0: 09 09 09 09 09 20 20 20 22 20 20 20 20 20 20 20 ..... "
cac0: 20 20 20 20 20 20 65 78 74 72 61 29 29 29 22 29 extra)))")
cad0: 29 0a 09 09 09 20 20 20 20 20 20 20 28 28 67 65 ).... ((ge
cae0: 74 20 67 29 20 20 20 0a 09 09 09 09 28 6d 61 74 t g) .....(mat
caf0: 63 68 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 ch (string-split
cb00: 20 63 6d 64 29 0a 09 09 09 09 20 20 20 20 20 20 cmd).....
cb10: 20 28 28 73 65 63 74 20 76 61 72 29 28 63 6f 6e ((sect var)(con
cb20: 63 20 22 28 6c 61 6d 62 64 61 20 28 68 74 29 28 c "(lambda (ht)(
cb30: 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 68 configf:lookup h
cb40: 74 20 5c 22 22 20 73 65 63 74 20 22 5c 22 20 5c t \"" sect "\" \
cb50: 22 22 20 76 61 72 20 22 5c 22 29 29 22 29 29 0a "" var "\"))")).
cb60: 09 09 09 09 20 20 20 20 20 20 20 28 65 6c 73 65 .... (else
cb70: 0a 09 09 09 09 09 28 64 65 62 75 67 3a 70 72 69 ......(debug:pri
cb80: 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 nt-error 0 *defa
cb90: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 23 ult-log-port* "#
cba0: 7b 67 65 74 20 2e 2e 2e 7d 20 75 73 65 64 20 77 {get ...} used w
cbb0: 69 74 68 20 6f 6e 6c 79 20 6f 6e 65 20 70 61 72 ith only one par
cbc0: 61 6d 65 74 65 72 2c 20 5c 22 22 20 63 6d 64 20 ameter, \"" cmd
cbd0: 22 5c 22 2c 20 74 77 6f 20 6e 65 65 64 65 64 2e "\", two needed.
cbe0: 22 29 0a 09 09 09 09 09 22 28 6c 61 6d 62 64 61 ")......"(lambda
cbf0: 20 28 68 74 29 20 23 66 29 22 29 29 29 0a 09 09 (ht) #f)")))...
cc00: 09 20 20 20 20 20 20 20 28 28 72 75 6e 63 6f 6e . ((runcon
cc10: 66 69 67 73 2d 67 65 74 20 72 67 65 74 29 20 28 figs-get rget) (
cc20: 63 6f 6e 63 20 22 28 6c 61 6d 62 64 61 20 28 68 conc "(lambda (h
cc30: 74 29 28 72 75 6e 63 6f 6e 66 69 67 73 2d 67 65 t)(runconfigs-ge
cc40: 74 20 68 74 20 5c 22 22 20 63 6d 64 20 22 5c 22 t ht \"" cmd "\"
cc50: 29 29 22 29 29 0a 09 09 09 20 20 20 20 20 20 20 ))"))....
cc60: 3b 3b 20 28 28 72 67 65 74 29 20 20 20 20 20 20 ;; ((rget)
cc70: 20 20 20 20 20 28 63 6f 6e 63 20 22 28 6c 61 6d (conc "(lam
cc80: 62 64 61 20 28 68 74 29 28 72 75 6e 63 6f 6e 66 bda (ht)(runconf
cc90: 69 67 73 2d 67 65 74 20 68 74 20 5c 22 22 20 63 igs-get ht \"" c
cca0: 6d 64 20 22 5c 22 29 29 22 29 29 0a 09 09 09 20 md "\"))"))....
ccb0: 20 20 20 20 20 20 28 65 6c 73 65 20 22 28 6c 61 (else "(la
ccc0: 6d 62 64 61 20 28 68 74 29 28 70 72 69 6e 74 20 mbda (ht)(print
ccd0: 5c 22 45 52 52 4f 52 5c 22 29 20 5c 22 45 52 52 \"ERROR\") \"ERR
cce0: 4f 52 5c 22 29 22 29 29 29 29 29 0a 09 09 3b 3b OR\")")))))...;;
ccf0: 20 28 70 72 69 6e 74 20 22 66 75 6c 6c 63 6d 64 (print "fullcmd
cd00: 3d 22 20 66 75 6c 6c 63 6d 64 29 0a 09 09 28 68 =" fullcmd)...(h
cd10: 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 andle-exceptions
cd20: 0a 09 09 20 65 78 6e 0a 09 09 20 28 62 65 67 69 ... exn... (begi
cd30: 6e 0a 09 09 20 20 20 28 64 65 62 75 67 3a 70 72 n... (debug:pr
cd40: 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c int 0 *default-l
cd50: 6f 67 2d 70 6f 72 74 2a 20 22 57 41 52 4e 49 4e og-port* "WARNIN
cd60: 47 3a 20 66 61 69 6c 65 64 20 74 6f 20 70 72 6f G: failed to pro
cd70: 63 65 73 73 20 63 6f 6e 66 69 67 20 69 6e 70 75 cess config inpu
cd80: 74 20 5c 22 22 20 6c 20 22 5c 22 2c 20 65 78 6e t \"" l "\", exn
cd90: 3d 22 20 65 78 6e 29 0a 09 09 20 20 20 28 64 65 =" exn)... (de
cda0: 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 bug:print 0 *def
cdb0: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
cdc0: 20 6d 65 73 73 61 67 65 3a 20 22 20 28 28 63 6f message: " ((co
cdd0: 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 65 72 74 79 ndition-property
cde0: 2d 61 63 63 65 73 73 6f 72 20 27 65 78 6e 20 27 -accessor 'exn '
cdf0: 6d 65 73 73 61 67 65 29 20 65 78 6e 29 29 0a 09 message) exn))..
ce00: 09 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 65 . ;; (print "e
ce10: 78 6e 3d 22 20 28 63 6f 6e 64 69 74 69 6f 6e 2d xn=" (condition-
ce20: 3e 6c 69 73 74 20 65 78 6e 29 29 0a 09 09 20 20 >list exn))...
ce30: 20 28 73 65 74 21 20 72 65 73 75 6c 74 20 28 63 (set! result (c
ce40: 6f 6e 63 20 22 23 7b 28 20 22 20 63 6d 64 74 79 onc "#{( " cmdty
ce50: 70 65 20 22 29 20 22 20 63 6d 64 20 22 7d 2c 20 pe ") " cmd "},
ce60: 66 75 6c 6c 20 65 78 70 61 6e 73 69 6f 6e 3a 20 full expansion:
ce70: 22 20 66 75 6c 6c 63 6d 64 29 29 29 0a 09 09 20 " fullcmd)))...
ce80: 28 69 66 20 28 6f 72 20 61 6c 6c 6f 77 2d 73 79 (if (or allow-sy
ce90: 73 74 65 6d 0a 09 09 09 20 28 6e 6f 74 20 28 6d stem.... (not (m
cea0: 65 6d 62 65 72 20 63 6d 64 74 79 70 65 20 27 28 ember cmdtype '(
ceb0: 22 73 79 73 74 65 6d 22 20 22 73 68 65 6c 6c 22 "system" "shell"
cec0: 20 22 73 68 22 29 29 29 29 0a 09 09 20 20 20 20 "sh"))))...
ced0: 20 28 77 69 74 68 2d 69 6e 70 75 74 2d 66 72 6f (with-input-fro
cee0: 6d 2d 73 74 72 69 6e 67 20 66 75 6c 6c 63 6d 64 m-string fullcmd
cef0: 0a 09 09 20 20 20 20 20 20 20 28 6c 61 6d 62 64 ... (lambd
cf00: 61 20 28 29 0a 09 09 09 20 28 73 65 74 21 20 72 a ().... (set! r
cf10: 65 73 75 6c 74 20 28 69 66 20 65 6e 76 2d 74 6f esult (if env-to
cf20: 2d 75 73 65 0a 09 09 09 09 09 20 20 28 28 65 76 -use...... ((ev
cf30: 61 6c 20 28 72 65 61 64 29 20 65 6e 76 2d 74 6f al (read) env-to
cf40: 2d 75 73 65 29 20 68 74 29 0a 09 09 09 09 09 20 -use) ht)......
cf50: 20 28 28 65 76 61 6c 20 28 72 65 61 64 29 29 20 ((eval (read))
cf60: 68 74 29 0a 09 09 09 09 09 20 20 29 29 29 29 0a ht)...... )))).
cf70: 09 09 20 20 20 20 20 28 73 65 74 21 20 72 65 73 .. (set! res
cf80: 75 6c 74 20 28 63 6f 6e 63 20 22 23 7b 28 22 20 ult (conc "#{("
cf90: 63 6d 64 74 79 70 65 20 22 29 20 22 20 20 63 6d cmdtype ") " cm
cfa0: 64 20 22 7d 22 29 29 29 29 0a 09 09 28 63 61 73 d "}"))))...(cas
cfb0: 65 20 63 6d 64 73 79 6d 0a 09 09 20 20 28 28 73 e cmdsym... ((s
cfc0: 79 73 74 65 6d 20 73 68 65 6c 6c 20 73 63 68 65 ystem shell sche
cfd0: 6d 65 29 0a 09 09 20 20 20 28 6c 65 74 20 28 28 me)... (let ((
cfe0: 64 65 6c 74 61 20 28 2d 20 28 63 75 72 72 65 6e delta (- (curren
cff0: 74 2d 73 65 63 6f 6e 64 73 29 20 73 74 61 72 74 t-seconds) start
d000: 2d 74 69 6d 65 29 29 29 0a 09 09 20 20 20 20 20 -time)))...
d010: 28 69 66 20 28 3e 20 64 65 6c 74 61 20 32 29 0a (if (> delta 2).
d020: 09 09 09 20 28 64 65 62 75 67 3a 70 72 69 6e 74 ... (debug:print
d030: 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 -info 0 *default
d040: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 66 6f 72 20 -log-port* "for
d050: 6c 69 6e 65 20 5c 22 22 20 6c 20 22 5c 22 5c 6e line \"" l "\"\n
d060: 20 63 6f 6d 6d 61 6e 64 3a 20 20 22 20 63 6d 64 command: " cmd
d070: 20 22 20 74 6f 6f 6b 20 22 20 64 65 6c 74 61 20 " took " delta
d080: 22 20 73 65 63 6f 6e 64 73 20 74 6f 20 72 75 6e " seconds to run
d090: 20 77 69 74 68 20 6f 75 74 70 75 74 3a 5c 6e 20 with output:\n
d0a0: 20 20 22 20 72 65 73 75 6c 74 29 0a 09 09 09 20 " result)....
d0b0: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
d0c0: 6f 20 39 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 o 9 *default-log
d0d0: 2d 70 6f 72 74 2a 20 22 66 6f 72 20 6c 69 6e 65 -port* "for line
d0e0: 20 5c 22 22 20 6c 20 22 5c 22 5c 6e 20 63 6f 6d \"" l "\"\n com
d0f0: 6d 61 6e 64 3a 20 20 22 20 63 6d 64 20 22 20 74 mand: " cmd " t
d100: 6f 6f 6b 20 22 20 64 65 6c 74 61 20 22 20 73 65 ook " delta " se
d110: 63 6f 6e 64 73 20 74 6f 20 72 75 6e 20 77 69 74 conds to run wit
d120: 68 20 6f 75 74 70 75 74 3a 5c 6e 20 20 20 22 20 h output:\n "
d130: 72 65 73 75 6c 74 29 29 29 29 29 0a 09 09 28 6c result)))))...(l
d140: 6f 6f 70 20 28 63 6f 6e 63 20 70 72 65 73 74 72 oop (conc prestr
d150: 20 72 65 73 75 6c 74 20 70 6f 73 74 73 74 72 29 result poststr)
d160: 29 29 0a 09 20 20 20 20 20 20 72 65 73 29 29 0a )).. res)).
d170: 09 72 65 73 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d .res)))..;;=====
d180: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d190: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d1a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d1b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d1c0: 3d 0a 3b 3b 20 4c 6f 6f 6b 75 70 20 61 20 76 61 =.;; Lookup a va
d1d0: 6c 75 65 20 69 6e 20 72 75 6e 63 6f 6e 66 69 67 lue in runconfig
d1e0: 73 20 62 61 73 65 64 20 6f 6e 20 2d 72 65 71 74 s based on -reqt
d1f0: 61 72 67 20 6f 72 20 2d 74 61 72 67 65 74 0a 3b arg or -target.;
d200: 3b 20 0a 28 64 65 66 69 6e 65 20 28 72 75 6e 63 ; .(define (runc
d210: 6f 6e 66 69 67 73 2d 67 65 74 20 63 6f 6e 66 69 onfigs-get confi
d220: 67 20 76 61 72 29 0a 20 20 28 6c 65 74 20 28 28 g var). (let ((
d230: 74 61 72 67 20 28 6d 79 74 61 72 67 65 74 29 20 targ (mytarget)
d240: 23 3b 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 #;(common:args-g
d250: 65 74 2d 74 61 72 67 65 74 29 29 29 20 3b 3b 20 et-target))) ;;
d260: 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
d270: 67 20 22 2d 72 65 71 74 61 72 67 22 29 28 61 72 g "-reqtarg")(ar
d280: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 61 72 gs:get-arg "-tar
d290: 67 65 74 22 29 28 67 65 74 65 6e 76 20 22 4d 54 get")(getenv "MT
d2a0: 5f 54 41 52 47 45 54 22 29 29 29 29 0a 20 20 20 _TARGET")))).
d2b0: 20 28 69 66 20 74 61 72 67 0a 09 28 6f 72 20 28 (if targ..(or (
d2c0: 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 63 configf:lookup c
d2d0: 6f 6e 66 69 67 20 74 61 72 67 20 76 61 72 29 0a onfig targ var).
d2e0: 09 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 6c 6f . (configf:lo
d2f0: 6f 6b 75 70 20 63 6f 6e 66 69 67 20 22 64 65 66 okup config "def
d300: 61 75 6c 74 22 20 76 61 72 29 29 0a 09 28 63 6f ault" var))..(co
d310: 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 63 6f 6e nfigf:lookup con
d320: 66 69 67 20 22 64 65 66 61 75 6c 74 22 20 76 61 fig "default" va
d330: 72 29 29 29 29 0a 0a 0a 3b 3b 20 70 61 74 68 65 r))))...;; pathe
d340: 6e 76 76 61 72 20 77 69 6c 6c 20 73 65 74 20 74 nvvar will set t
d350: 68 65 20 6e 61 6d 65 64 20 76 61 72 20 74 6f 20 he named var to
d360: 74 68 65 20 70 61 74 68 20 6f 66 20 74 68 65 20 the path of the
d370: 63 6f 6e 66 69 67 0a 28 64 65 66 69 6e 65 20 28 config.(define (
d380: 63 6f 6e 66 69 67 66 3a 66 69 6e 64 2d 61 6e 64 configf:find-and
d390: 2d 72 65 61 64 2d 63 6f 6e 66 69 67 20 66 6e 61 -read-config fna
d3a0: 6d 65 20 23 21 6b 65 79 20 28 65 6e 76 69 72 6f me #!key (enviro
d3b0: 6e 2d 70 61 74 74 20 23 66 29 28 67 69 76 65 6e n-patt #f)(given
d3c0: 2d 74 6f 70 70 61 74 68 20 23 66 29 28 70 61 74 -toppath #f)(pat
d3d0: 68 65 6e 76 76 61 72 20 23 66 29 28 65 6e 76 2d henvvar #f)(env-
d3e0: 74 6f 2d 75 73 65 20 23 66 29 29 0a 20 20 28 6c to-use #f)). (l
d3f0: 65 74 2a 20 28 28 63 75 72 72 2d 64 69 72 20 20 et* ((curr-dir
d400: 20 28 63 75 72 72 65 6e 74 2d 64 69 72 65 63 74 (current-direct
d410: 6f 72 79 29 29 0a 20 20 20 20 20 20 20 20 20 28 ory)). (
d420: 63 6f 6e 66 69 67 69 6e 66 6f 20 28 66 69 6e 64 configinfo (find
d430: 2d 63 6f 6e 66 69 67 20 66 6e 61 6d 65 20 74 6f -config fname to
d440: 70 70 61 74 68 3a 20 67 69 76 65 6e 2d 74 6f 70 ppath: given-top
d450: 70 61 74 68 29 29 0a 09 20 28 74 6f 70 70 61 74 path)).. (toppat
d460: 68 20 20 20 20 28 63 61 72 20 63 6f 6e 66 69 67 h (car config
d470: 69 6e 66 6f 29 29 0a 09 20 28 63 6f 6e 66 69 67 info)).. (config
d480: 66 69 6c 65 20 28 63 61 64 72 20 63 6f 6e 66 69 file (cadr confi
d490: 67 69 6e 66 6f 29 29 0a 09 20 28 73 65 74 2d 66 ginfo)).. (set-f
d4a0: 69 65 6c 64 73 20 28 6c 61 6d 62 64 61 20 28 63 ields (lambda (c
d4b0: 75 72 72 2d 73 65 63 74 69 6f 6e 20 6e 65 78 74 urr-section next
d4c0: 2d 73 65 63 74 69 6f 6e 20 68 74 20 70 61 74 68 -section ht path
d4d0: 29 0a 09 09 20 20 20 20 20 20 20 28 6c 65 74 20 )... (let
d4e0: 28 28 66 69 65 6c 64 2d 6e 61 6d 65 73 20 28 69 ((field-names (i
d4f0: 66 20 68 74 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 f ht (common:get
d500: 2d 66 69 65 6c 64 73 20 68 74 29 20 27 28 29 29 -fields ht) '())
d510: 29 0a 09 09 09 20 20 20 20 20 28 74 61 72 67 65 ).... (targe
d520: 74 20 20 20 20 20 20 28 6f 72 20 28 67 65 74 65 t (or (gete
d530: 6e 76 20 22 4d 54 5f 54 41 52 47 45 54 22 29 28 nv "MT_TARGET")(
d540: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
d550: 65 71 74 61 72 67 22 29 28 61 72 67 73 3a 67 65 eqtarg")(args:ge
d560: 74 2d 61 72 67 20 22 2d 74 61 72 67 65 74 22 29 t-arg "-target")
d570: 29 29 29 0a 09 09 09 20 28 64 65 62 75 67 3a 70 ))).... (debug:p
d580: 72 69 6e 74 2d 69 6e 66 6f 20 39 20 2a 64 65 66 rint-info 9 *def
d590: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
d5a0: 73 65 74 2d 66 69 65 6c 64 73 20 77 69 74 68 20 set-fields with
d5b0: 66 69 65 6c 64 2d 6e 61 6d 65 73 3d 22 20 66 69 field-names=" fi
d5c0: 65 6c 64 2d 6e 61 6d 65 73 20 22 20 74 61 72 67 eld-names " targ
d5d0: 65 74 3d 22 20 74 61 72 67 65 74 20 22 20 63 75 et=" target " cu
d5e0: 72 72 2d 73 65 63 74 69 6f 6e 3d 22 20 63 75 72 rr-section=" cur
d5f0: 72 2d 73 65 63 74 69 6f 6e 20 22 20 6e 65 78 74 r-section " next
d600: 2d 73 65 63 74 69 6f 6e 3d 22 20 6e 65 78 74 2d -section=" next-
d610: 73 65 63 74 69 6f 6e 20 22 20 70 61 74 68 3d 22 section " path="
d620: 20 70 61 74 68 20 22 20 68 74 3d 22 20 68 74 29 path " ht=" ht)
d630: 0a 09 09 09 20 28 69 66 20 28 6e 6f 74 20 28 6e .... (if (not (n
d640: 75 6c 6c 3f 20 66 69 65 6c 64 2d 6e 61 6d 65 73 ull? field-names
d650: 29 29 28 6b 65 79 73 3a 74 61 72 67 65 74 2d 73 ))(keys:target-s
d660: 65 74 2d 61 72 67 73 20 66 69 65 6c 64 2d 6e 61 et-args field-na
d670: 6d 65 73 20 74 61 72 67 65 74 20 23 66 29 29 29 mes target #f)))
d680: 29 29 29 0a 20 20 20 20 28 69 66 20 74 6f 70 70 ))). (if topp
d690: 61 74 68 20 28 63 68 61 6e 67 65 2d 64 69 72 65 ath (change-dire
d6a0: 63 74 6f 72 79 20 74 6f 70 70 61 74 68 29 29 20 ctory toppath))
d6b0: 0a 20 20 20 20 28 69 66 20 28 61 6e 64 20 74 6f . (if (and to
d6c0: 70 70 61 74 68 20 70 61 74 68 65 6e 76 76 61 72 ppath pathenvvar
d6d0: 29 28 73 65 74 65 6e 76 20 70 61 74 68 65 6e 76 )(setenv pathenv
d6e0: 76 61 72 20 74 6f 70 70 61 74 68 29 29 0a 20 20 var toppath)).
d6f0: 20 20 28 6c 65 74 20 28 28 63 6f 6e 66 69 67 64 (let ((configd
d700: 61 74 20 20 28 69 66 20 63 6f 6e 66 69 67 66 69 at (if configfi
d710: 6c 65 20 0a 09 09 09 20 20 28 63 6f 6e 66 69 67 le .... (config
d720: 66 3a 72 65 61 64 2d 63 6f 6e 66 69 67 20 63 6f f:read-config co
d730: 6e 66 69 67 66 69 6c 65 20 23 66 20 23 74 20 65 nfigfile #f #t e
d740: 6e 76 69 72 6f 6e 2d 70 61 74 74 3a 20 65 6e 76 nviron-patt: env
d750: 69 72 6f 6e 2d 70 61 74 74 20 70 6f 73 74 2d 73 iron-patt post-s
d760: 65 63 74 69 6f 6e 2d 70 72 6f 63 73 3a 20 28 6c ection-procs: (l
d770: 69 73 74 20 28 63 6f 6e 73 20 22 5e 66 69 65 6c ist (cons "^fiel
d780: 64 73 24 22 20 73 65 74 2d 66 69 65 6c 64 73 29 ds$" set-fields)
d790: 29 20 23 66 20 65 6e 76 2d 74 6f 2d 75 73 65 3a ) #f env-to-use:
d7a0: 20 65 6e 76 2d 74 6f 2d 75 73 65 29 29 29 29 0a env-to-use)))).
d7b0: 20 20 20 20 20 20 28 69 66 20 74 6f 70 70 61 74 (if toppat
d7c0: 68 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 h (change-direct
d7d0: 6f 72 79 20 63 75 72 72 2d 64 69 72 29 29 0a 20 ory curr-dir)).
d7e0: 20 20 20 20 20 28 6c 69 73 74 20 63 6f 6e 66 69 (list confi
d7f0: 67 64 61 74 20 74 6f 70 70 61 74 68 20 63 6f 6e gdat toppath con
d800: 66 69 67 66 69 6c 65 20 66 6e 61 6d 65 29 29 29 figfile fname)))
d810: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
d820: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d830: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d840: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d850: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4e ===========.;; N
d860: 6f 6e 20 64 65 73 74 72 75 63 74 69 76 65 20 77 on destructive w
d870: 72 69 74 69 6e 67 20 6f 66 20 63 6f 6e 66 69 67 riting of config
d880: 20 66 69 6c 65 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d file.;;========
d890: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d8a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d8b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d8c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
d8d0: 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 66 (define (configf
d8e0: 3a 72 65 61 64 2d 61 6c 69 73 74 20 66 6e 61 6d :read-alist fnam
d8f0: 65 29 0a 20 20 28 68 61 6e 64 6c 65 2d 65 78 63 e). (handle-exc
d900: 65 70 74 69 6f 6e 73 0a 20 20 20 20 20 20 65 78 eptions. ex
d910: 6e 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 n. (begin.
d920: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
d930: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
d940: 6f 72 74 2a 20 22 72 65 61 64 20 6f 66 20 61 6c ort* "read of al
d950: 69 73 74 20 22 20 66 6e 61 6d 65 20 22 20 66 61 ist " fname " fa
d960: 69 6c 65 64 2e 20 65 78 6e 3d 22 20 65 78 6e 29 iled. exn=" exn)
d970: 0a 20 20 20 20 20 20 23 66 29 0a 20 20 20 20 28 . #f). (
d980: 63 6f 6e 66 69 67 66 3a 61 6c 69 73 74 2d 3e 63 configf:alist->c
d990: 6f 6e 66 69 67 0a 20 20 20 20 20 28 77 69 74 68 onfig. (with
d9a0: 2d 69 6e 70 75 74 2d 66 72 6f 6d 2d 66 69 6c 65 -input-from-file
d9b0: 20 66 6e 61 6d 65 20 72 65 61 64 29 29 29 29 0a fname read)))).
d9c0: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
d9d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d9e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d9f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
da00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 44 4f 20 =========.;; DO
da10: 54 48 45 20 4c 4f 43 4b 49 4e 47 20 41 52 4f 55 THE LOCKING AROU
da20: 4e 44 20 54 48 45 20 43 41 4c 4c 0a 3b 3b 3d 3d ND THE CALL.;;==
da30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
da40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
da50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
da60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
da70: 3d 3d 3d 3d 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 ====.;;.(define
da80: 28 63 6f 6e 66 69 67 66 3a 77 72 69 74 65 2d 61 (configf:write-a
da90: 6c 69 73 74 20 63 64 61 74 20 66 6e 61 6d 65 29 list cdat fname)
daa0: 0a 20 20 3b 3b 20 28 69 66 20 28 6e 6f 74 20 28 . ;; (if (not (
dab0: 63 6f 6d 6d 6f 6e 3a 66 61 75 78 2d 6c 6f 63 6b common:faux-lock
dac0: 20 66 6e 61 6d 65 29 29 0a 20 20 28 64 65 62 75 fname)). (debu
dad0: 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 g:print 0 *defau
dae0: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 49 4e lt-log-port* "IN
daf0: 46 4f 3a 20 4e 45 45 44 20 4c 4f 43 4b 49 4e 47 FO: NEED LOCKING
db00: 20 41 44 44 45 44 20 48 45 52 45 20 22 20 66 6e ADDED HERE " fn
db10: 61 6d 65 29 0a 20 20 28 6c 65 74 2a 20 28 28 64 ame). (let* ((d
db20: 61 74 20 20 28 63 6f 6e 66 69 67 66 3a 63 6f 6e at (configf:con
db30: 66 69 67 2d 3e 61 6c 69 73 74 20 63 64 61 74 29 fig->alist cdat)
db40: 29 0a 20 20 20 20 20 20 20 20 20 28 72 65 73 0a ). (res.
db50: 20 20 20 20 20 20 20 20 20 20 28 62 65 67 69 6e (begin
db60: 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 77 69 . (wi
db70: 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 69 6c th-output-to-fil
db80: 65 20 66 6e 61 6d 65 20 3b 3b 20 66 69 72 73 74 e fname ;; first
db90: 20 77 72 69 74 65 20 6f 75 74 20 74 68 65 20 66 write out the f
dba0: 69 6c 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 ile.
dbb0: 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 20 20 20 (lambda ().
dbc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 70 70 (pp
dbd0: 20 64 61 74 29 29 29 0a 20 20 20 20 20 20 20 20 dat))).
dbe0: 20 20 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 .
dbf0: 20 28 69 66 20 28 66 69 6c 65 2d 65 78 69 73 74 (if (file-exist
dc00: 73 3f 20 66 6e 61 6d 65 29 20 20 20 3b 3b 20 6e s? fname) ;; n
dc10: 6f 77 20 76 65 72 69 66 79 20 69 74 20 69 73 20 ow verify it is
dc20: 72 65 61 64 61 62 6c 65 0a 20 20 20 20 20 20 20 readable.
dc30: 20 20 20 20 20 20 20 20 20 28 69 66 20 28 63 6f (if (co
dc40: 6e 66 69 67 66 3a 72 65 61 64 2d 61 6c 69 73 74 nfigf:read-alist
dc50: 20 66 6e 61 6d 65 29 0a 20 20 20 20 20 20 20 20 fname).
dc60: 20 20 20 20 20 20 20 20 20 20 20 20 23 74 20 3b #t ;
dc70: 3b 20 64 61 74 61 20 69 73 20 67 6f 6f 64 2e 0a ; data is good..
dc80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
dc90: 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 (begin.
dca0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
dcb0: 20 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 (handle-excepti
dcc0: 6f 6e 73 0a 09 09 09 20 20 65 78 6e 0a 09 09 09 ons.... exn....
dcd0: 28 62 65 67 69 6e 0a 09 09 09 20 20 28 64 65 62 (begin.... (deb
dce0: 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 ug:print 0 *defa
dcf0: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 64 ult-log-port* "d
dd00: 65 6c 65 74 69 6e 67 20 22 20 66 6e 61 6d 65 20 eleting " fname
dd10: 22 20 66 61 69 6c 65 64 2c 20 65 78 6e 3d 22 20 " failed, exn="
dd20: 65 78 6e 29 0a 09 09 09 20 20 23 66 29 0a 09 09 exn).... #f)...
dd30: 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 .(debug:print 0
dd40: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
dd50: 74 2a 20 22 57 41 52 4e 49 4e 47 3a 20 63 6f 6e t* "WARNING: con
dd60: 74 65 6e 74 20 22 20 64 61 74 20 22 20 66 6f 72 tent " dat " for
dd70: 20 63 61 63 68 65 20 22 20 66 6e 61 6d 65 20 22 cache " fname "
dd80: 20 69 73 20 6e 6f 74 20 72 65 61 64 61 62 6c 65 is not readable
dd90: 2e 20 44 65 6c 65 74 69 6e 67 20 67 65 6e 65 72 . Deleting gener
dda0: 61 74 65 64 20 66 69 6c 65 2e 22 29 0a 09 09 09 ated file.")....
ddb0: 28 64 65 6c 65 74 65 2d 66 69 6c 65 20 66 6e 61 (delete-file fna
ddc0: 6d 65 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 me)).
ddd0: 20 20 20 20 20 20 20 20 20 20 20 23 66 29 29 0a #f)).
dde0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ddf0: 23 66 29 29 29 29 0a 20 20 20 20 3b 3b 20 28 63 #f)))). ;; (c
de00: 6f 6d 6d 6f 6e 3a 66 61 75 78 2d 75 6e 6c 6f 63 ommon:faux-unloc
de10: 6b 20 66 6e 61 6d 65 29 0a 20 20 20 20 72 65 73 k fname). res
de20: 29 29 0a 20 20 0a 28 64 65 66 69 6e 65 20 28 63 )). .(define (c
de30: 6f 6d 6d 6f 6e 3a 67 65 74 2d 66 69 65 6c 64 73 ommon:get-fields
de40: 20 63 66 67 64 61 74 29 0a 20 20 28 6c 65 74 20 cfgdat). (let
de50: 28 28 66 69 65 6c 64 73 20 28 68 61 73 68 2d 74 ((fields (hash-t
de60: 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 able-ref/default
de70: 20 63 66 67 64 61 74 20 22 66 69 65 6c 64 73 22 cfgdat "fields"
de80: 20 27 28 29 29 29 29 0a 20 20 20 20 28 6d 61 70 '()))). (map
de90: 20 63 61 72 20 66 69 65 6c 64 73 29 29 29 0a 0a car fields)))..
dea0: 29 0a ).