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 6e 69 find-config.. ni
0610: 63 65 2d 70 61 74 68 0a 09 20 70 72 6f 63 65 73 ce-path.. proces
0620: 73 3a 63 6d 64 2d 72 75 6e 2d 3e 6c 69 73 74 0a s:cmd-run->list.
0630: 09 20 72 75 6e 63 6f 6e 66 69 67 3a 72 65 61 64 . runconfig:read
0640: 0a 09 20 72 75 6e 63 6f 6e 66 69 67 73 2d 67 65 .. runconfigs-ge
0650: 74 0a 09 20 73 61 66 65 2d 73 65 74 65 6e 76 0a t.. safe-setenv.
0660: 09 20 63 6f 6e 66 69 67 66 3a 65 76 61 6c 2d 73 . configf:eval-s
0670: 74 72 69 6e 67 2d 69 6e 2d 65 6e 76 69 72 6f 6e tring-in-environ
0680: 6d 65 6e 74 0a 09 29 0a 09 0a 28 69 6d 70 6f 72 ment..)...(impor
0690: 74 20 73 63 68 65 6d 65 0a 0a 09 63 68 69 63 6b t scheme...chick
06a0: 65 6e 2e 62 61 73 65 0a 09 63 68 69 63 6b 65 6e en.base..chicken
06b0: 2e 63 6f 6e 64 69 74 69 6f 6e 0a 09 63 68 69 63 .condition..chic
06c0: 6b 65 6e 2e 66 69 6c 65 0a 09 63 68 69 63 6b 65 ken.file..chicke
06d0: 6e 2e 69 6f 0a 09 63 68 69 63 6b 65 6e 2e 70 61 n.io..chicken.pa
06e0: 74 68 6e 61 6d 65 0a 09 63 68 69 63 6b 65 6e 2e thname..chicken.
06f0: 70 6f 72 74 0a 09 63 68 69 63 6b 65 6e 2e 70 72 port..chicken.pr
0700: 65 74 74 79 2d 70 72 69 6e 74 0a 09 63 68 69 63 etty-print..chic
0710: 6b 65 6e 2e 70 72 6f 63 65 73 73 0a 09 63 68 69 ken.process..chi
0720: 63 6b 65 6e 2e 70 72 6f 63 65 73 73 2d 63 6f 6e cken.process-con
0730: 74 65 78 74 0a 09 63 68 69 63 6b 65 6e 2e 70 72 text..chicken.pr
0740: 6f 63 65 73 73 2d 63 6f 6e 74 65 78 74 2e 70 6f ocess-context.po
0750: 73 69 78 0a 09 63 68 69 63 6b 65 6e 2e 73 6f 72 six..chicken.sor
0760: 74 0a 09 63 68 69 63 6b 65 6e 2e 73 74 72 69 6e t..chicken.strin
0770: 67 0a 09 63 68 69 63 6b 65 6e 2e 74 69 6d 65 0a g..chicken.time.
0780: 09 63 68 69 63 6b 65 6e 2e 65 76 61 6c 0a 09 0a .chicken.eval...
0790: 09 64 65 62 75 67 70 72 69 6e 74 0a 09 28 70 72 .debugprint..(pr
07a0: 65 66 69 78 20 6d 74 61 72 67 73 20 61 72 67 73 efix mtargs args
07b0: 3a 29 0a 09 70 6b 74 73 0a 09 6b 65 79 73 6d 6f :)..pkts..keysmo
07c0: 64 0a 0a 09 28 70 72 65 66 69 78 20 62 61 73 65 d...(prefix base
07d0: 36 34 20 62 61 73 65 36 34 3a 29 0a 09 28 70 72 64 base64:)..(pr
07e0: 65 66 69 78 20 64 62 69 20 64 62 69 3a 29 0a 09 efix dbi dbi:)..
07f0: 28 70 72 65 66 69 78 20 73 71 6c 69 74 65 33 20 (prefix sqlite3
0800: 73 71 6c 69 74 65 33 3a 29 0a 09 28 73 72 66 69 sqlite3:)..(srfi
0810: 20 31 38 29 0a 09 64 69 72 65 63 74 6f 72 79 2d 18)..directory-
0820: 75 74 69 6c 73 0a 09 66 6f 72 6d 61 74 0a 09 6d utils..format..m
0830: 61 74 63 68 61 62 6c 65 0a 09 6d 64 35 0a 09 6d atchable..md5..m
0840: 65 73 73 61 67 65 2d 64 69 67 65 73 74 0a 09 72 essage-digest..r
0850: 65 67 65 78 0a 09 72 65 67 65 78 2d 63 61 73 65 egex..regex-case
0860: 0a 09 73 70 61 72 73 65 2d 76 65 63 74 6f 72 73 ..sparse-vectors
0870: 0a 09 73 72 66 69 2d 31 0a 09 73 72 66 69 2d 31 ..srfi-1..srfi-1
0880: 33 0a 09 73 72 66 69 2d 36 39 0a 09 73 74 61 63 3..srfi-69..stac
0890: 6b 0a 09 74 79 70 65 64 2d 72 65 63 6f 72 64 73 k..typed-records
08a0: 0a 09 7a 33 0a 09 0a 09 29 0a 0a 28 64 65 66 69 ..z3....)..(defi
08b0: 6e 65 20 67 65 74 65 6e 76 20 67 65 74 2d 65 6e ne getenv get-en
08c0: 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 vironment-variab
08d0: 6c 65 29 0a 28 64 65 66 69 6e 65 20 73 65 74 65 le).(define sete
08e0: 6e 76 20 73 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 nv set-environme
08f0: 6e 74 2d 76 61 72 69 61 62 6c 65 21 29 0a 28 64 nt-variable!).(d
0900: 65 66 69 6e 65 20 75 6e 73 65 74 65 6e 76 20 75 efine unsetenv u
0910: 6e 73 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 nset-environment
0920: 2d 76 61 72 69 61 62 6c 65 21 29 0a 0a 3b 3b 3d -variable!)..;;=
0930: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0940: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0950: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0960: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0970: 3d 3d 3d 3d 3d 0a 3b 3b 20 6d 6f 76 65 20 64 65 =====.;; move de
0980: 62 75 67 20 73 74 75 66 66 20 74 6f 20 73 65 70 bug stuff to sep
0990: 61 72 61 74 65 20 6d 6f 64 75 6c 65 20 74 68 65 arate module the
09a0: 6e 20 70 75 74 20 74 68 65 73 65 20 62 61 63 6b n put these back
09b0: 20 77 68 65 72 65 20 74 68 65 79 20 62 65 6c 6f where they belo
09c0: 6e 67 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ng.;;===========
09d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 3b 3b 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 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0a30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0a40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0a50: 3d 3d 3d 3d 0a 3b 3b 20 6c 6f 6f 6b 75 70 20 72 ====.;; lookup r
0a60: 6f 75 74 69 6e 65 73 20 2d 20 72 65 70 6c 69 63 outines - replic
0a70: 61 74 65 64 20 66 72 6f 6d 20 63 6f 6e 66 69 67 ated from config
0a80: 66 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d f.;;============
0a90: 3d 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 0a 0a 28 64 65 66 ==========..(def
0ad0: 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f ine (configf:loo
0ae0: 6b 75 70 20 63 66 67 64 61 74 20 73 65 63 74 69 kup cfgdat secti
0af0: 6f 6e 20 76 61 72 29 0a 20 20 28 69 66 20 28 68 on var). (if (h
0b00: 61 73 68 2d 74 61 62 6c 65 3f 20 63 66 67 64 61 ash-table? cfgda
0b10: 74 29 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 t). (let ((
0b20: 73 65 63 74 64 61 74 20 28 68 61 73 68 2d 74 61 sectdat (hash-ta
0b30: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default
0b40: 63 66 67 64 61 74 20 73 65 63 74 69 6f 6e 20 27 cfgdat section '
0b50: 28 29 29 29 29 0a 09 28 69 66 20 28 6e 75 6c 6c ())))..(if (null
0b60: 3f 20 73 65 63 74 64 61 74 29 0a 09 20 20 20 20 ? sectdat)..
0b70: 23 66 0a 09 20 20 20 20 28 6c 65 74 20 28 28 6d #f.. (let ((m
0b80: 61 74 63 68 20 28 61 73 73 6f 63 20 76 61 72 20 atch (assoc var
0b90: 73 65 63 74 64 61 74 29 29 29 0a 09 20 20 20 20 sectdat)))..
0ba0: 20 20 28 69 66 20 6d 61 74 63 68 20 3b 3b 20 28 (if match ;; (
0bb0: 61 6e 64 20 6d 61 74 63 68 20 28 6c 69 73 74 3f and match (list?
0bc0: 20 6d 61 74 63 68 29 28 3e 20 28 6c 65 6e 67 74 match)(> (lengt
0bd0: 68 20 6d 61 74 63 68 29 20 31 29 29 0a 09 09 20 h match) 1))...
0be0: 20 28 63 61 64 72 20 6d 61 74 63 68 29 0a 09 09 (cadr match)...
0bf0: 20 20 23 66 29 29 0a 09 20 20 20 20 29 29 0a 20 #f)).. )).
0c00: 20 20 20 20 20 23 66 29 29 0a 0a 28 64 65 66 69 #f))..(defi
0c10: 6e 65 20 28 63 6f 6e 66 69 67 66 3a 61 73 73 6f ne (configf:asso
0c20: 63 2d 73 61 66 65 2d 61 64 64 20 61 6c 69 73 74 c-safe-add alist
0c30: 20 6b 65 79 20 76 61 6c 20 23 21 6b 65 79 20 28 key val #!key (
0c40: 6d 65 74 61 64 61 74 61 20 23 66 29 29 0a 20 20 metadata #f)).
0c50: 28 6c 65 74 20 28 28 6e 65 77 61 6c 69 73 74 20 (let ((newalist
0c60: 28 66 69 6c 74 65 72 20 28 6c 61 6d 62 64 61 20 (filter (lambda
0c70: 28 78 29 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 (x)(not (equal?
0c80: 6b 65 79 20 28 63 61 72 20 78 29 29 29 29 20 61 key (car x)))) a
0c90: 6c 69 73 74 29 29 29 0a 20 20 20 20 28 61 70 70 list))). (app
0ca0: 65 6e 64 20 6e 65 77 61 6c 69 73 74 20 28 6c 69 end newalist (li
0cb0: 73 74 20 28 69 66 20 6d 65 74 61 64 61 74 61 0a st (if metadata.
0cc0: 09 09 09 20 20 20 20 20 20 20 28 6c 69 73 74 20 ... (list
0cd0: 6b 65 79 20 76 61 6c 20 6d 65 74 61 64 61 74 61 key val metadata
0ce0: 29 0a 09 09 09 20 20 20 20 20 20 20 28 6c 69 73 ).... (lis
0cf0: 74 20 6b 65 79 20 76 61 6c 29 29 29 29 29 29 0a t key val)))))).
0d00: 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 .(define (config
0d10: 66 3a 73 65 63 74 69 6f 6e 2d 76 61 72 2d 73 65 f:section-var-se
0d20: 74 21 20 63 66 67 64 61 74 20 73 65 63 74 69 6f t! cfgdat sectio
0d30: 6e 2d 6e 61 6d 65 20 76 61 72 20 76 61 6c 75 65 n-name var value
0d40: 20 23 21 6b 65 79 20 28 6d 65 74 61 64 61 74 61 #!key (metadata
0d50: 20 23 66 29 29 0a 20 20 28 68 61 73 68 2d 74 61 #f)). (hash-ta
0d60: 62 6c 65 2d 73 65 74 21 20 63 66 67 64 61 74 20 ble-set! cfgdat
0d70: 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 0a 09 09 20 section-name...
0d80: 20 20 28 63 6f 6e 66 69 67 66 3a 61 73 73 6f 63 (configf:assoc
0d90: 2d 73 61 66 65 2d 61 64 64 0a 09 09 20 20 20 20 -safe-add...
0da0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/
0db0: 64 65 66 61 75 6c 74 20 63 66 67 64 61 74 20 73 default cfgdat s
0dc0: 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 27 28 29 29 ection-name '())
0dd0: 0a 09 09 20 20 20 20 76 61 72 20 76 61 6c 75 65 ... var value
0de0: 20 6d 65 74 61 64 61 74 61 3a 20 6d 65 74 61 64 metadata: metad
0df0: 61 74 61 29 29 29 0a 0a 3b 3b 20 75 73 65 20 74 ata)))..;; use t
0e00: 6f 20 68 61 76 65 20 64 65 66 69 6e 69 74 69 76 o have definitiv
0e10: 65 20 73 65 74 74 69 6e 67 3a 0a 3b 3b 20 20 5b e setting:.;; [
0e20: 66 6f 6f 5d 0a 3b 3b 20 20 76 61 72 20 79 65 73 foo].;; var yes
0e30: 0a 3b 3b 0a 3b 3b 20 20 28 63 6f 6e 66 69 67 66 .;;.;; (configf
0e40: 3a 76 61 72 2d 69 73 3f 20 63 66 67 64 61 74 20 :var-is? cfgdat
0e50: 22 66 6f 6f 22 20 22 76 61 72 22 20 22 79 65 73 "foo" "var" "yes
0e60: 22 29 20 3d 3e 20 23 74 0a 3b 3b 0a 28 64 65 66 ") => #t.;;.(def
0e70: 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a 76 61 72 ine (configf:var
0e80: 2d 69 73 3f 20 63 66 67 64 61 74 20 73 65 63 74 -is? cfgdat sect
0e90: 69 6f 6e 20 76 61 72 20 65 78 70 65 63 74 65 64 ion var expected
0ea0: 2d 76 61 6c 29 0a 20 20 28 65 71 75 61 6c 3f 20 -val). (equal?
0eb0: 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 (configf:lookup
0ec0: 63 66 67 64 61 74 20 73 65 63 74 69 6f 6e 20 76 cfgdat section v
0ed0: 61 72 29 20 65 78 70 65 63 74 65 64 2d 76 61 6c ar) expected-val
0ee0: 29 29 0a 0a 3b 3b 20 72 65 64 65 66 69 6e 65 73 ))..;; redefines
0ef0: 0a 28 64 65 66 69 6e 65 20 63 6f 6e 66 69 67 2d .(define config-
0f00: 6c 6f 6f 6b 75 70 20 63 6f 6e 66 69 67 66 3a 6c lookup configf:l
0f10: 6f 6f 6b 75 70 29 0a 3b 3b 20 28 64 65 66 69 6e ookup).;; (defin
0f20: 65 20 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d 66 e configf:read-f
0f30: 69 6c 65 20 72 65 61 64 2d 63 6f 6e 66 69 67 29 ile read-config)
0f40: 0a 0a 3b 3b 20 73 61 66 65 6c 79 20 6c 6f 6f 6b ..;; safely look
0f50: 20 75 70 20 61 20 76 61 6c 75 65 20 74 68 61 74 up a value that
0f60: 20 69 73 20 65 78 70 65 63 74 65 64 20 74 6f 20 is expected to
0f70: 62 65 20 61 20 6e 75 6d 62 65 72 2c 20 72 65 74 be a number, ret
0f80: 75 72 6e 0a 3b 3b 20 61 20 64 65 66 61 75 6c 74 urn.;; a default
0f90: 20 28 23 66 20 75 6e 6c 65 73 73 20 70 72 6f 76 (#f unless prov
0fa0: 69 64 65 64 29 0a 3b 3b 0a 28 64 65 66 69 6e 65 ided).;;.(define
0fb0: 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 (configf:lookup
0fc0: 2d 6e 75 6d 62 65 72 20 63 66 64 61 74 20 73 65 -number cfdat se
0fd0: 63 74 69 6f 6e 20 76 61 72 6e 61 6d 65 20 23 21 ction varname #!
0fe0: 6b 65 79 20 28 64 65 66 61 75 6c 74 20 23 66 29 key (default #f)
0ff0: 29 0a 20 20 28 6c 65 74 2a 20 28 28 76 61 6c 20 ). (let* ((val
1000: 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 (configf:lookup
1010: 63 66 64 61 74 20 73 65 63 74 69 6f 6e 20 76 61 cfdat section va
1020: 72 6e 61 6d 65 29 29 0a 20 20 20 20 20 20 20 20 rname)).
1030: 20 28 72 65 73 20 28 69 66 20 76 61 6c 0a 20 20 (res (if val.
1040: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1050: 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 (string->number
1060: 28 73 74 72 69 6e 67 2d 73 75 62 73 74 69 74 75 (string-substitu
1070: 74 65 20 22 5c 5c 73 2b 22 20 22 22 20 76 61 6c te "\\s+" "" val
1080: 20 23 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 #t)).
1090: 20 20 20 20 20 20 20 20 23 66 29 29 29 0a 20 20 #f))).
10a0: 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 28 72 65 (cond. (re
10b0: 73 20 20 72 65 73 29 0a 20 20 20 20 20 28 76 61 s res). (va
10c0: 6c 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 l (debug:print
10d0: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
10e0: 6f 72 74 2a 20 22 45 52 52 4f 52 3a 20 6e 6f 20 ort* "ERROR: no
10f0: 6e 75 6d 62 65 72 20 66 6f 75 6e 64 20 66 6f 72 number found for
1100: 20 5b 22 20 73 65 63 74 69 6f 6e 20 22 5d 2c 20 [" section "],
1110: 22 20 76 61 72 6e 61 6d 65 20 22 2c 20 67 6f 74 " varname ", got
1120: 3a 20 22 20 76 61 6c 29 29 0a 20 20 20 20 20 28 : " val)). (
1130: 65 6c 73 65 20 64 65 66 61 75 6c 74 29 29 29 29 else default))))
1140: 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 ..(define (confi
1150: 67 66 3a 73 65 63 74 69 6f 6e 2d 76 61 72 73 20 gf:section-vars
1160: 63 66 67 64 61 74 20 73 65 63 74 69 6f 6e 29 0a cfgdat section).
1170: 20 20 28 6c 65 74 20 28 28 73 65 63 74 64 61 74 (let ((sectdat
1180: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
1190: 2f 64 65 66 61 75 6c 74 20 63 66 67 64 61 74 20 /default cfgdat
11a0: 73 65 63 74 69 6f 6e 20 27 28 29 29 29 29 0a 20 section '()))).
11b0: 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 73 65 (if (null? se
11c0: 63 74 64 61 74 29 0a 09 27 28 29 0a 09 28 6d 61 ctdat)..'()..(ma
11d0: 70 20 63 61 72 20 73 65 63 74 64 61 74 29 29 29 p car sectdat)))
11e0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 )..(define (conf
11f0: 69 67 66 3a 67 65 74 2d 73 65 63 74 69 6f 6e 20 igf:get-section
1200: 63 66 67 64 61 74 20 73 65 63 74 69 6f 6e 29 0a cfgdat section).
1210: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 (hash-table-re
1220: 66 2f 64 65 66 61 75 6c 74 20 63 66 67 64 61 74 f/default cfgdat
1230: 20 73 65 63 74 69 6f 6e 20 27 28 29 29 29 0a 0a section '()))..
1240: 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 66 (define (configf
1250: 3a 73 65 74 2d 73 65 63 74 69 6f 6e 2d 76 61 72 :set-section-var
1260: 20 63 66 67 64 61 74 20 73 65 63 74 69 6f 6e 20 cfgdat section
1270: 76 61 72 20 76 61 6c 29 0a 20 20 28 6c 65 74 20 var val). (let
1280: 28 28 73 65 63 74 64 61 74 20 28 63 6f 6e 66 69 ((sectdat (confi
1290: 67 66 3a 67 65 74 2d 73 65 63 74 69 6f 6e 20 63 gf:get-section c
12a0: 66 67 64 61 74 20 73 65 63 74 69 6f 6e 29 29 29 fgdat section)))
12b0: 0a 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 . (hash-table
12c0: 2d 73 65 74 21 20 63 66 67 64 61 74 20 73 65 63 -set! cfgdat sec
12d0: 74 69 6f 6e 0a 20 20 20 20 20 20 20 20 20 20 20 tion.
12e0: 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 66 69 (confi
12f0: 67 66 3a 61 73 73 6f 63 2d 73 61 66 65 2d 61 64 gf:assoc-safe-ad
1300: 64 20 73 65 63 74 64 61 74 20 76 61 72 20 76 61 d sectdat var va
1310: 6c 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d l))))..;;=======
1320: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1330: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1340: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1350: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 74 ===============t
1360: 68 65 20 65 6e 64 0a 0a 3b 3b 20 72 65 74 75 72 he end..;; retur
1370: 6e 20 6c 69 73 74 20 28 70 61 74 68 20 66 75 6c n list (path ful
1380: 6c 70 61 74 68 20 63 6f 6e 66 69 67 6e 61 6d 65 lpath configname
1390: 29 0a 28 64 65 66 69 6e 65 20 28 66 69 6e 64 2d ).(define (find-
13a0: 63 6f 6e 66 69 67 20 63 6f 6e 66 69 67 6e 61 6d config confignam
13b0: 65 20 23 21 6b 65 79 20 28 74 6f 70 70 61 74 68 e #!key (toppath
13c0: 20 23 66 29 29 0a 20 20 28 69 66 20 74 6f 70 70 #f)). (if topp
13d0: 61 74 68 0a 20 20 20 20 20 20 28 6c 65 74 20 28 ath. (let (
13e0: 28 63 66 6e 61 6d 65 20 28 63 6f 6e 63 20 74 6f (cfname (conc to
13f0: 70 70 61 74 68 20 22 2f 22 20 63 6f 6e 66 69 67 ppath "/" config
1400: 6e 61 6d 65 29 29 29 0a 09 28 69 66 20 28 66 69 name)))..(if (fi
1410: 6c 65 2d 65 78 69 73 74 73 3f 20 63 66 6e 61 6d le-exists? cfnam
1420: 65 29 0a 09 20 20 20 20 28 6c 69 73 74 20 74 6f e).. (list to
1430: 70 70 61 74 68 20 63 66 6e 61 6d 65 20 63 6f 6e ppath cfname con
1440: 66 69 67 6e 61 6d 65 29 0a 09 20 20 20 20 28 6c figname).. (l
1450: 69 73 74 20 23 66 20 20 20 20 20 20 23 66 20 20 ist #f #f
1460: 20 20 20 23 66 29 29 29 0a 20 20 20 20 20 20 28 #f))). (
1470: 6c 65 74 2a 20 28 28 63 77 64 20 28 73 74 72 69 let* ((cwd (stri
1480: 6e 67 2d 73 70 6c 69 74 20 28 63 75 72 72 65 6e ng-split (curren
1490: 74 2d 64 69 72 65 63 74 6f 72 79 29 20 22 2f 22 t-directory) "/"
14a0: 29 29 29 0a 09 28 6c 65 74 20 6c 6f 6f 70 20 28 )))..(let loop (
14b0: 28 64 69 72 20 63 77 64 29 29 0a 09 20 20 28 6c (dir cwd)).. (l
14c0: 65 74 2a 20 28 28 70 61 74 68 20 20 20 20 20 28 et* ((path (
14d0: 63 6f 6e 63 20 22 2f 22 20 28 73 74 72 69 6e 67 conc "/" (string
14e0: 2d 69 6e 74 65 72 73 70 65 72 73 65 20 64 69 72 -intersperse dir
14f0: 20 22 2f 22 29 29 29 0a 09 09 20 28 66 75 6c 6c "/")))... (full
1500: 70 61 74 68 20 28 63 6f 6e 63 20 70 61 74 68 20 path (conc path
1510: 22 2f 22 20 63 6f 6e 66 69 67 6e 61 6d 65 29 29 "/" configname))
1520: 29 0a 09 20 20 20 20 28 69 66 20 28 66 69 6c 65 ).. (if (file
1530: 2d 65 78 69 73 74 73 3f 20 66 75 6c 6c 70 61 74 -exists? fullpat
1540: 68 29 0a 09 09 28 6c 69 73 74 20 70 61 74 68 20 h)...(list path
1550: 66 75 6c 6c 70 61 74 68 20 63 6f 6e 66 69 67 6e fullpath confign
1560: 61 6d 65 29 0a 09 09 28 6c 65 74 20 28 28 72 65 ame)...(let ((re
1570: 6d 63 77 64 20 28 74 61 6b 65 20 64 69 72 20 28 mcwd (take dir (
1580: 2d 20 28 6c 65 6e 67 74 68 20 64 69 72 29 20 31 - (length dir) 1
1590: 29 29 29 29 0a 09 09 20 20 28 69 66 20 28 6e 75 ))))... (if (nu
15a0: 6c 6c 3f 20 72 65 6d 63 77 64 29 0a 09 09 20 20 ll? remcwd)...
15b0: 20 20 20 20 28 6c 69 73 74 20 23 66 20 23 66 20 (list #f #f
15c0: 23 66 29 20 3b 3b 20 20 23 66 20 23 66 29 20 0a #f) ;; #f #f) .
15d0: 09 09 20 20 28 6c 6f 6f 70 20 72 65 6d 63 77 64 .. (loop remcwd
15e0: 29 29 29 29 29 29 29 29 29 0a 0a 3b 3b 20 53 4f )))))))))..;; SO
15f0: 4d 45 54 48 49 4e 47 20 57 52 4f 4e 47 20 48 45 METHING WRONG HE
1600: 52 45 20 2d 2d 20 42 55 47 21 0a 3b 3b 0a 28 64 RE -- BUG!.;;.(d
1610: 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a 65 efine (configf:e
1620: 76 61 6c 2d 73 74 72 69 6e 67 2d 69 6e 2d 65 6e val-string-in-en
1630: 76 69 72 6f 6e 6d 65 6e 74 20 73 74 72 29 0a 20 vironment str).
1640: 20 3b 3b 20 28 69 66 20 28 6f 72 20 28 73 74 72 ;; (if (or (str
1650: 69 6e 67 2d 6e 75 6c 6c 3f 20 73 74 72 29 0a 20 ing-null? str).
1660: 20 3b 3b 09 20 20 28 65 71 75 61 6c 3f 20 22 21 ;;. (equal? "!
1670: 22 20 28 73 75 62 73 74 72 69 6e 67 20 73 74 72 " (substring str
1680: 20 30 20 31 29 29 29 20 3b 3b 20 6e 75 6c 6c 20 0 1))) ;; null
1690: 73 74 72 69 6e 67 20 6f 72 20 73 74 61 72 74 73 string or starts
16a0: 20 77 69 74 68 20 21 20 61 72 65 20 70 72 65 73 with ! are pres
16b0: 65 72 76 65 64 20 62 75 74 20 4e 4f 54 20 73 65 erved but NOT se
16c0: 74 20 69 6e 20 74 68 65 20 65 6e 76 69 72 6f 6e t in the environ
16d0: 6d 65 6e 74 0a 20 20 20 20 20 20 73 74 72 0a 20 ment. str.
16e0: 20 20 20 20 20 28 68 61 6e 64 6c 65 2d 65 78 63 (handle-exc
16f0: 65 70 74 69 6f 6e 73 0a 20 20 20 20 20 20 20 65 eptions. e
1700: 78 6e 0a 20 20 20 20 20 20 20 28 62 65 67 69 6e xn. (begin
1710: 0a 09 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d .. (debug:print-
1720: 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 error 0 *default
1730: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 70 72 6f 62 -log-port* "prob
1740: 6c 65 6d 20 65 76 61 6c 75 61 74 69 6e 67 20 5c lem evaluating \
1750: 22 22 20 73 74 72 20 22 5c 22 20 69 6e 20 74 68 "" str "\" in th
1760: 65 20 73 68 65 6c 6c 20 65 6e 76 69 72 6f 6e 6d e shell environm
1770: 65 6e 74 2c 20 65 78 6e 3d 22 20 65 78 6e 29 0a ent, exn=" exn).
1780: 09 20 23 66 29 0a 20 20 20 20 20 20 20 28 6c 65 . #f). (le
1790: 74 20 28 28 63 6d 64 72 65 73 20 28 70 72 6f 63 t ((cmdres (proc
17a0: 65 73 73 3a 63 6d 64 2d 72 75 6e 2d 3e 6c 69 73 ess:cmd-run->lis
17b0: 74 20 28 63 6f 6e 63 20 22 65 63 68 6f 20 22 20 t (conc "echo "
17c0: 73 74 72 29 29 29 29 0a 09 20 28 69 66 20 28 6e str)))).. (if (n
17d0: 75 6c 6c 3f 20 63 6d 64 72 65 73 29 20 22 22 0a ull? cmdres) "".
17e0: 09 20 20 20 20 20 28 63 61 61 72 20 63 6d 64 72 . (caar cmdr
17f0: 65 73 29 29 29 29 29 20 3b 3b 20 29 0a 0a 3b 3b es))))) ;; )..;;
1800: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1810: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1820: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1830: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1840: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4d 61 6b 65 20 74 ======.;; Make t
1850: 68 65 20 72 65 67 65 78 70 27 73 20 6e 65 65 64 he regexp's need
1860: 65 64 20 67 6c 6f 62 61 6c 6c 79 20 61 76 61 69 ed globally avai
1870: 6c 61 62 6c 65 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d lable.;;========
1880: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1890: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
18a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
18b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
18c0: 28 64 65 66 69 6e 65 20 63 6f 6e 66 69 67 66 3a (define configf:
18d0: 69 6e 63 6c 75 64 65 2d 72 78 20 28 72 65 67 65 include-rx (rege
18e0: 78 70 20 22 5e 5c 5c 5b 69 6e 63 6c 75 64 65 5c xp "^\\[include\
18f0: 5c 73 2b 28 2e 2a 29 5c 5c 5d 5c 5c 73 2a 24 22 \s+(.*)\\]\\s*$"
1900: 29 29 0a 28 64 65 66 69 6e 65 20 63 6f 6e 66 69 )).(define confi
1910: 67 66 3a 73 63 72 69 70 74 2d 72 78 20 20 28 72 gf:script-rx (r
1920: 65 67 65 78 70 20 22 5e 5c 5c 5b 73 63 72 69 70 egexp "^\\[scrip
1930: 74 69 6e 63 5c 5c 73 2b 28 5c 5c 53 2b 29 28 5b tinc\\s+(\\S+)([
1940: 5e 5c 5c 5d 5d 2a 29 5c 5c 5d 5c 5c 73 2a 24 22 ^\\]]*)\\]\\s*$"
1950: 29 29 20 3b 3b 20 69 6e 63 6c 75 64 65 20 6f 75 )) ;; include ou
1960: 74 70 75 74 20 66 72 6f 6d 20 61 20 73 63 72 69 tput from a scri
1970: 70 74 0a 28 64 65 66 69 6e 65 20 63 6f 6e 66 69 pt.(define confi
1980: 67 66 3a 73 65 63 74 69 6f 6e 2d 72 78 20 28 72 gf:section-rx (r
1990: 65 67 65 78 70 20 22 5e 5c 5c 5b 28 2e 2a 29 5c egexp "^\\[(.*)\
19a0: 5c 5d 5c 5c 73 2a 24 22 29 29 0a 28 64 65 66 69 \]\\s*$")).(defi
19b0: 6e 65 20 63 6f 6e 66 69 67 66 3a 62 6c 61 6e 6b ne configf:blank
19c0: 2d 6c 2d 72 78 20 28 72 65 67 65 78 70 20 22 5e -l-rx (regexp "^
19d0: 5c 5c 73 2a 24 22 29 29 0a 28 64 65 66 69 6e 65 \\s*$")).(define
19e0: 20 63 6f 6e 66 69 67 66 3a 6b 65 79 2d 73 79 73 configf:key-sys
19f0: 2d 70 72 20 28 72 65 67 65 78 70 20 22 5e 28 5c -pr (regexp "^(\
1a00: 5c 53 2b 29 5c 5c 73 2b 5c 5c 5b 73 79 73 74 65 \S+)\\s+\\[syste
1a10: 6d 5c 5c 73 2b 28 5c 5c 53 2b 2e 2a 29 5c 5c 5d m\\s+(\\S+.*)\\]
1a20: 5c 5c 73 2a 24 22 29 29 0a 28 64 65 66 69 6e 65 \\s*$")).(define
1a30: 20 63 6f 6e 66 69 67 66 3a 6b 65 79 2d 76 61 6c configf:key-val
1a40: 2d 70 72 20 28 72 65 67 65 78 70 20 22 5e 28 5c -pr (regexp "^(\
1a50: 5c 53 2b 29 28 5c 5c 73 2b 28 2e 2a 29 7c 28 29 \S+)(\\s+(.*)|()
1a60: 29 24 22 29 29 0a 28 64 65 66 69 6e 65 20 63 6f )$")).(define co
1a70: 6e 66 69 67 66 3a 6b 65 79 2d 6e 6f 2d 76 61 6c nfigf:key-no-val
1a80: 20 28 72 65 67 65 78 70 20 22 5e 28 5c 5c 53 2b (regexp "^(\\S+
1a90: 29 28 5c 5c 73 2a 29 24 22 29 29 0a 28 64 65 66 )(\\s*)$")).(def
1aa0: 69 6e 65 20 63 6f 6e 66 69 67 66 3a 63 6f 6d 6d ine configf:comm
1ab0: 65 6e 74 2d 72 78 20 28 72 65 67 65 78 70 20 22 ent-rx (regexp "
1ac0: 5e 5c 5c 73 2a 23 2e 2a 22 29 29 0a 28 64 65 66 ^\\s*#.*")).(def
1ad0: 69 6e 65 20 63 6f 6e 66 69 67 66 3a 63 6f 6e 74 ine configf:cont
1ae0: 2d 6c 6e 2d 72 78 20 28 72 65 67 65 78 70 20 22 -ln-rx (regexp "
1af0: 5e 28 5c 5c 73 2b 29 28 5c 5c 53 2b 2e 2a 29 24 ^(\\s+)(\\S+.*)$
1b00: 22 29 29 0a 28 64 65 66 69 6e 65 20 63 6f 6e 66 ")).(define conf
1b10: 69 67 66 3a 73 65 74 74 69 6e 67 73 20 20 20 28 igf:settings (
1b20: 72 65 67 65 78 70 20 22 5e 5c 5c 5b 63 6f 6e 66 regexp "^\\[conf
1b30: 69 67 66 3a 73 65 74 74 69 6e 67 73 5c 5c 73 2b igf:settings\\s+
1b40: 28 5c 5c 53 2b 29 5c 5c 73 2b 28 5c 5c 53 2b 29 (\\S+)\\s+(\\S+)
1b50: 5d 5c 5c 73 2a 24 22 29 29 0a 0a 3b 3b 20 72 65 ]\\s*$"))..;; re
1b60: 61 64 20 61 20 6c 69 6e 65 20 61 6e 64 20 70 72 ad a line and pr
1b70: 6f 63 65 73 73 20 61 6e 79 20 23 7b 20 2e 2e 2e ocess any #{ ...
1b80: 20 7d 20 63 6f 6e 73 74 72 75 63 74 73 0a 0a 28 } constructs..(
1b90: 64 65 66 69 6e 65 20 63 6f 6e 66 69 67 66 3a 76 define configf:v
1ba0: 61 72 2d 65 78 70 61 6e 64 2d 72 65 67 65 78 20 ar-expand-regex
1bb0: 28 72 65 67 65 78 70 20 22 5e 28 2e 2a 29 23 5c (regexp "^(.*)#\
1bc0: 5c 7b 28 73 63 68 65 6d 65 7c 73 79 73 74 65 6d \{(scheme|system
1bd0: 7c 73 68 65 6c 6c 7c 67 65 74 65 6e 76 7c 67 65 |shell|getenv|ge
1be0: 74 7c 72 75 6e 63 6f 6e 66 69 67 73 2d 67 65 74 t|runconfigs-get
1bf0: 7c 72 67 65 74 7c 73 63 6d 7c 73 68 7c 72 70 7c |rget|scm|sh|rp|
1c00: 67 76 7c 67 7c 6d 74 72 61 68 29 5c 5c 73 2b 28 gv|g|mtrah)\\s+(
1c10: 5b 5e 5c 5c 7d 5c 5c 7b 5d 2a 29 5c 5c 7d 28 2e [^\\}\\{]*)\\}(.
1c20: 2a 29 22 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 *)"))..(define (
1c30: 63 6f 6e 66 69 67 66 3a 73 79 73 74 65 6d 20 68 configf:system h
1c40: 74 20 63 6d 64 29 0a 20 20 28 73 79 73 74 65 6d t cmd). (system
1c50: 20 63 6d 64 29 0a 20 20 29 0a 0a 3b 3b 20 52 75 cmd). )..;; Ru
1c60: 6e 20 61 20 73 68 65 6c 6c 20 63 6f 6d 6d 61 6e n a shell comman
1c70: 64 20 61 6e 64 20 72 65 74 75 72 6e 20 74 68 65 d and return the
1c80: 20 6f 75 74 70 75 74 20 61 73 20 61 20 73 74 72 output as a str
1c90: 69 6e 67 0a 28 64 65 66 69 6e 65 20 28 73 68 65 ing.(define (she
1ca0: 6c 6c 20 63 6d 64 29 0a 20 20 28 6c 65 74 2a 20 ll cmd). (let*
1cb0: 28 28 6f 75 74 70 75 74 20 28 70 72 6f 63 65 73 ((output (proces
1cc0: 73 3a 63 6d 64 2d 72 75 6e 2d 3e 6c 69 73 74 20 s:cmd-run->list
1cd0: 63 6d 64 29 29 0a 09 20 28 72 65 73 20 20 20 20 cmd)).. (res
1ce0: 28 63 61 72 20 6f 75 74 70 75 74 29 29 0a 09 20 (car output))..
1cf0: 28 73 74 61 74 75 73 20 28 63 61 64 72 20 6f 75 (status (cadr ou
1d00: 74 70 75 74 29 29 29 0a 20 20 20 20 28 69 66 20 tput))). (if
1d10: 28 65 71 75 61 6c 3f 20 73 74 61 74 75 73 20 30 (equal? status 0
1d20: 29 0a 09 28 6c 65 74 20 28 28 6f 75 74 72 65 73 )..(let ((outres
1d30: 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 (string-intersp
1d40: 65 72 73 65 20 0a 09 09 20 20 20 20 20 20 20 72 erse ... r
1d50: 65 73 0a 09 09 20 20 20 20 20 20 20 22 5c 6e 22 es... "\n"
1d60: 29 29 29 0a 09 20 20 28 64 65 62 75 67 3a 70 72 ))).. (debug:pr
1d70: 69 6e 74 2d 69 6e 66 6f 20 34 20 2a 64 65 66 61 int-info 4 *defa
1d80: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 73 ult-log-port* "s
1d90: 68 65 6c 6c 20 72 65 73 75 6c 74 3a 5c 6e 22 20 hell result:\n"
1da0: 6f 75 74 72 65 73 29 0a 09 20 20 6f 75 74 72 65 outres).. outre
1db0: 73 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 77 s)..(begin.. (w
1dc0: 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 70 6f ith-output-to-po
1dd0: 72 74 20 28 63 75 72 72 65 6e 74 2d 65 72 72 6f rt (current-erro
1de0: 72 2d 70 6f 72 74 29 0a 09 20 20 20 20 28 6c 61 r-port).. (la
1df0: 6d 62 64 61 20 28 29 0a 09 20 20 20 20 20 20 28 mbda ().. (
1e00: 70 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 22 20 print "ERROR: "
1e10: 63 6d 64 20 22 20 72 65 74 75 72 6e 65 64 20 62 cmd " returned b
1e20: 61 64 20 65 78 69 74 20 63 6f 64 65 20 22 20 73 ad exit code " s
1e30: 74 61 74 75 73 29 29 29 0a 09 20 20 22 22 29 29 tatus))).. ""))
1e40: 29 29 0a 0a 3b 3b 20 74 68 69 73 20 77 61 73 20 ))..;; this was
1e50: 69 6e 6c 69 6e 65 20 62 75 74 20 49 27 6d 20 70 inline but I'm p
1e60: 72 65 74 74 79 20 73 75 72 65 20 74 68 61 74 20 retty sure that
1e70: 69 73 20 61 20 68 6f 6c 64 20 6f 76 65 72 20 66 is a hold over f
1e80: 72 6f 6d 20 77 68 65 6e 20 69 74 20 77 61 73 20 rom when it was
1e90: 2a 76 65 72 79 2a 20 73 69 6d 70 6c 65 20 2e 2e *very* simple ..
1ea0: 2e 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 63 6f ..;;.(define (co
1eb0: 6e 66 69 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 nfigf:read-line
1ec0: 70 20 68 74 20 61 6c 6c 6f 77 2d 70 72 6f 63 65 p ht allow-proce
1ed0: 73 73 69 6e 67 20 73 65 74 74 69 6e 67 73 20 65 ssing settings e
1ee0: 6e 76 2d 74 6f 2d 75 73 65 29 0a 20 20 28 6c 65 nv-to-use). (le
1ef0: 74 20 6c 6f 6f 70 20 28 28 69 6e 6c 20 28 72 65 t loop ((inl (re
1f00: 61 64 2d 6c 69 6e 65 20 70 29 29 29 0a 20 20 20 ad-line p))).
1f10: 20 28 6c 65 74 20 28 28 63 6f 6e 74 2d 6c 69 6e (let ((cont-lin
1f20: 65 20 28 61 6e 64 20 28 73 74 72 69 6e 67 3f 20 e (and (string?
1f30: 69 6e 6c 29 0a 09 09 09 20 20 28 6e 6f 74 20 28 inl).... (not (
1f40: 73 74 72 69 6e 67 2d 6e 75 6c 6c 3f 20 69 6e 6c string-null? inl
1f50: 29 29 0a 09 09 09 20 20 28 65 71 75 61 6c 3f 20 )).... (equal?
1f60: 22 5c 5c 22 20 28 73 74 72 69 6e 67 2d 74 61 6b "\\" (string-tak
1f70: 65 2d 72 69 67 68 74 20 69 6e 6c 20 31 29 29 29 e-right inl 1)))
1f80: 29 29 0a 20 20 20 20 20 20 28 69 66 20 63 6f 6e )). (if con
1f90: 74 2d 6c 69 6e 65 20 3b 3b 20 6c 61 73 74 20 63 t-line ;; last c
1fa0: 68 61 72 61 63 74 65 72 20 69 73 20 5c 20 0a 09 haracter is \ ..
1fb0: 20 20 28 6c 65 74 20 28 28 6e 65 78 74 6c 20 28 (let ((nextl (
1fc0: 72 65 61 64 2d 6c 69 6e 65 20 70 29 29 29 0a 09 read-line p)))..
1fd0: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 65 6f (if (not (eo
1fe0: 66 2d 6f 62 6a 65 63 74 3f 20 6e 65 78 74 6c 29 f-object? nextl)
1ff0: 29 0a 09 09 28 6c 6f 6f 70 20 28 73 74 72 69 6e )...(loop (strin
2000: 67 2d 61 70 70 65 6e 64 20 28 69 66 20 63 6f 6e g-append (if con
2010: 74 2d 6c 69 6e 65 20 0a 09 09 09 09 09 20 28 73 t-line ...... (s
2020: 74 72 69 6e 67 2d 74 61 6b 65 20 69 6e 6c 20 28 tring-take inl (
2030: 2d 20 28 73 74 72 69 6e 67 2d 6c 65 6e 67 74 68 - (string-length
2040: 20 69 6e 6c 29 20 31 29 29 0a 09 09 09 09 09 20 inl) 1))......
2050: 69 6e 6c 29 0a 09 09 09 09 20 20 20 20 20 6e 65 inl)..... ne
2060: 78 74 6c 29 29 29 29 0a 09 20 20 28 6c 65 74 20 xtl)))).. (let
2070: 28 28 72 65 73 20 28 63 61 73 65 20 61 6c 6c 6f ((res (case allo
2080: 77 2d 70 72 6f 63 65 73 73 69 6e 67 20 3b 3b 20 w-processing ;;
2090: 69 66 20 28 61 6e 64 20 61 6c 6c 6f 77 2d 70 72 if (and allow-pr
20a0: 6f 63 65 73 73 69 6e 67 20 0a 09 09 20 20 20 20 ocessing ...
20b0: 20 20 20 3b 3b 09 20 20 20 28 6e 6f 74 20 28 65 ;;. (not (e
20c0: 71 3f 20 61 6c 6c 6f 77 2d 70 72 6f 63 65 73 73 q? allow-process
20d0: 69 6e 67 20 27 72 65 74 75 72 6e 2d 73 74 72 69 ing 'return-stri
20e0: 6e 67 29 29 29 0a 09 09 20 20 20 20 20 20 20 28 ng)))... (
20f0: 28 23 74 20 23 66 29 0a 09 09 09 28 63 6f 6e 66 (#t #f)....(conf
2100: 69 67 66 3a 70 72 6f 63 65 73 73 2d 6c 69 6e 65 igf:process-line
2110: 20 69 6e 6c 20 68 74 20 61 6c 6c 6f 77 2d 70 72 inl ht allow-pr
2120: 6f 63 65 73 73 69 6e 67 20 65 6e 76 2d 74 6f 2d ocessing env-to-
2130: 75 73 65 29 29 0a 09 09 20 20 20 20 20 20 20 28 use))... (
2140: 28 72 65 74 75 72 6e 2d 73 74 72 69 6e 67 29 0a (return-string).
2150: 09 09 09 69 6e 6c 29 0a 09 09 20 20 20 20 20 20 ...inl)...
2160: 20 28 65 6c 73 65 0a 09 09 09 28 63 6f 6e 66 69 (else....(confi
2170: 67 66 3a 70 72 6f 63 65 73 73 2d 6c 69 6e 65 20 gf:process-line
2180: 69 6e 6c 20 68 74 20 61 6c 6c 6f 77 2d 70 72 6f inl ht allow-pro
2190: 63 65 73 73 69 6e 67 20 65 6e 76 2d 74 6f 2d 75 cessing env-to-u
21a0: 73 65 29 29 29 29 29 0a 09 20 20 20 20 28 69 66 se))))).. (if
21b0: 20 28 61 6e 64 20 28 73 74 72 69 6e 67 3f 20 72 (and (string? r
21c0: 65 73 29 20 20 3b 3b 20 6d 75 73 74 20 73 65 74 es) ;; must set
21d0: 20 74 6f 20 22 6e 6f 22 20 74 6f 20 66 6f 72 63 to "no" to forc
21e0: 65 20 4e 4f 54 20 74 72 69 6d 6d 69 6e 67 20 74 e NOT trimming t
21f0: 72 61 69 6c 69 6e 67 20 73 70 61 63 65 73 0a 09 railing spaces..
2200: 09 20 20 20 20 20 28 6e 6f 74 20 28 65 71 75 61 . (not (equa
2210: 6c 3f 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 l? (hash-table-r
2220: 65 66 2f 64 65 66 61 75 6c 74 20 73 65 74 74 69 ef/default setti
2230: 6e 67 73 20 22 74 72 69 6d 2d 74 72 61 69 6c 69 ngs "trim-traili
2240: 6e 67 2d 73 70 61 63 65 73 22 20 22 79 65 73 22 ng-spaces" "yes"
2250: 29 20 22 6e 6f 22 29 29 29 0a 09 09 28 73 74 72 ) "no")))...(str
2260: 69 6e 67 2d 73 75 62 73 74 69 74 75 74 65 20 22 ing-substitute "
2270: 5c 5c 73 2b 24 22 20 22 22 20 72 65 73 29 0a 09 \\s+$" "" res)..
2280: 09 72 65 73 29 29 29 29 29 29 0a 0a 28 64 65 66 .res))))))..(def
2290: 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a 63 66 67 ine (configf:cfg
22a0: 64 61 74 2d 3e 65 6e 76 2d 61 6c 69 73 74 20 73 dat->env-alist s
22b0: 65 63 74 69 6f 6e 20 63 66 67 64 61 74 2d 68 74 ection cfgdat-ht
22c0: 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 29 0a 20 allow-system).
22d0: 20 28 66 69 6c 74 65 72 0a 20 20 20 28 6c 61 6d (filter. (lam
22e0: 62 64 61 20 28 70 61 69 72 29 0a 20 20 20 20 20 bda (pair).
22f0: 28 6c 65 74 2a 20 28 28 76 61 72 20 28 63 61 72 (let* ((var (car
2300: 20 70 61 69 72 29 29 0a 20 20 20 20 20 20 20 20 pair)).
2310: 20 20 20 20 28 76 61 6c 20 28 63 64 72 20 70 61 (val (cdr pa
2320: 69 72 29 29 29 0a 20 20 20 20 20 20 20 28 63 6f ir))). (co
2330: 6e 73 20 76 61 72 0a 20 20 20 20 20 20 20 20 20 ns var.
2340: 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 (cond.
2350: 20 20 20 20 20 20 20 20 28 28 61 6e 64 20 61 6c ((and al
2360: 6c 6f 77 2d 73 79 73 74 65 6d 20 28 70 72 6f 63 low-system (proc
2370: 65 64 75 72 65 3f 20 76 61 6c 29 29 20 3b 3b 20 edure? val)) ;;
2380: 69 66 20 77 65 20 64 65 63 69 64 65 64 20 74 6f if we decided to
2390: 20 75 73 65 20 73 6f 6d 65 74 68 69 6e 67 20 6f use something o
23a0: 74 68 65 72 20 74 68 61 6e 20 23 74 20 6f 72 20 ther than #t or
23b0: 23 66 20 66 6f 72 20 61 6c 6c 6f 77 2d 73 79 73 #f for allow-sys
23c0: 74 65 6d 20 28 27 72 65 74 75 72 6e 2d 70 72 6f tem ('return-pro
23d0: 63 73 20 6f 72 20 27 72 65 74 75 72 6e 2d 73 74 cs or 'return-st
23e0: 72 69 6e 67 29 20 2c 20 74 68 69 73 20 6d 61 79 ring) , this may
23f0: 20 62 65 63 6f 6d 65 20 70 72 6f 62 6c 65 6d 61 become problema
2400: 74 69 63 0a 20 20 20 20 20 20 20 20 20 20 20 20 tic.
2410: 20 20 20 28 76 61 6c 29 29 0a 20 20 20 20 20 20 (val)).
2420: 20 20 20 20 20 20 20 20 28 28 70 72 6f 63 65 64 ((proced
2430: 75 72 65 3f 20 76 61 6c 29 20 23 66 29 0a 20 20 ure? val) #f).
2440: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 73 74 ((st
2450: 72 69 6e 67 3f 20 76 61 6c 29 20 76 61 6c 29 0a ring? val) val).
2460: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 (e
2470: 6c 73 65 20 22 23 66 22 29 29 29 29 29 0a 20 20 lse "#f"))))).
2480: 20 28 61 70 70 65 6e 64 0a 20 20 20 20 28 68 61 (append. (ha
2490: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def
24a0: 61 75 6c 74 20 63 66 67 64 61 74 2d 68 74 20 22 ault cfgdat-ht "
24b0: 64 65 66 61 75 6c 74 22 20 27 28 29 29 0a 20 20 default" '()).
24c0: 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 73 65 (if (equal? se
24d0: 63 74 69 6f 6e 20 22 64 65 66 61 75 6c 74 22 29 ction "default")
24e0: 20 27 28 29 20 28 68 61 73 68 2d 74 61 62 6c 65 '() (hash-table
24f0: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 63 66 67 -ref/default cfg
2500: 64 61 74 2d 68 74 20 73 65 63 74 69 6f 6e 20 27 dat-ht section '
2510: 28 29 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 ())))))..(define
2520: 20 28 63 61 6c 63 2d 61 6c 6c 6f 77 2d 73 79 73 (calc-allow-sys
2530: 74 65 6d 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d tem allow-system
2540: 20 73 65 63 74 69 6f 6e 20 73 65 63 74 69 6f 6e section section
2550: 73 29 0a 20 20 28 69 66 20 73 65 63 74 69 6f 6e s). (if section
2560: 73 0a 20 20 20 20 20 20 28 61 6e 64 20 28 6f 72 s. (and (or
2570: 20 28 65 71 75 61 6c 3f 20 22 64 65 66 61 75 6c (equal? "defaul
2580: 74 22 20 73 65 63 74 69 6f 6e 29 0a 09 20 20 20 t" section)..
2590: 20 20 20 20 28 6d 65 6d 62 65 72 20 73 65 63 74 (member sect
25a0: 69 6f 6e 20 73 65 63 74 69 6f 6e 73 29 29 0a 09 ion sections))..
25b0: 20 20 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 29 allow-system)
25c0: 20 3b 3b 20 61 63 63 6f 75 6e 74 20 66 6f 72 20 ;; account for
25d0: 73 65 63 74 69 6f 6e 73 20 61 6e 64 20 72 65 74 sections and ret
25e0: 75 72 6e 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d urn allow-system
25f0: 20 61 73 20 69 74 20 6d 69 67 68 74 20 62 65 20 as it might be
2600: 61 20 73 79 6d 62 6f 6c 20 73 75 63 68 20 61 73 a symbol such as
2610: 20 72 65 74 75 72 6e 2d 73 74 72 69 6e 67 73 0a return-strings.
2620: 20 20 20 20 20 20 61 6c 6c 6f 77 2d 73 79 73 74 allow-syst
2630: 65 6d 29 29 0a 20 20 20 20 0a 3b 3b 20 67 69 76 em)). .;; giv
2640: 65 6e 20 61 20 63 6f 6e 66 69 67 20 68 61 73 68 en a config hash
2650: 20 61 6e 64 20 61 20 73 65 63 74 69 6f 6e 20 6e and a section n
2660: 61 6d 65 2c 20 61 70 70 6c 79 20 74 68 61 74 20 ame, apply that
2670: 73 65 63 74 69 6f 6e 20 74 6f 20 61 6c 6c 20 6d section to all m
2680: 61 74 63 68 69 6e 67 20 73 65 63 74 69 6f 6e 73 atching sections
2690: 20 28 75 73 69 6e 67 20 77 69 6c 64 63 61 72 64 (using wildcard
26a0: 20 25 20 6f 72 20 72 65 67 65 78 20 69 66 20 2f % or regex if /
26b0: 2e 2e 2e 2e 2f 29 0a 3b 3b 20 72 65 6d 6f 76 65 ..../).;; remove
26c0: 20 74 68 65 20 73 65 63 74 69 6f 6e 20 77 68 65 the section whe
26d0: 6e 20 64 6f 6e 65 20 73 6f 20 74 68 61 74 20 74 n done so that t
26e0: 68 65 72 65 20 69 73 20 6e 6f 20 64 6f 77 6e 73 here is no downs
26f0: 74 72 65 61 6d 20 63 6c 6f 62 62 65 72 69 6e 67 tream clobbering
2700: 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e .;;.(define (con
2710: 66 69 67 66 3a 61 70 70 6c 79 2d 77 69 6c 64 63 figf:apply-wildc
2720: 61 72 64 73 20 68 74 20 73 65 63 74 69 6f 6e 2d ards ht section-
2730: 6e 61 6d 65 29 0a 20 20 28 69 66 20 28 68 61 73 name). (if (has
2740: 68 2d 74 61 62 6c 65 2d 65 78 69 73 74 73 3f 20 h-table-exists?
2750: 68 74 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 29 ht section-name)
2760: 0a 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 76 . (let* ((v
2770: 61 72 73 20 20 28 68 61 73 68 2d 74 61 62 6c 65 ars (hash-table
2780: 2d 72 65 66 20 68 74 20 73 65 63 74 69 6f 6e 2d -ref ht section-
2790: 6e 61 6d 65 29 29 0a 09 20 20 20 20 20 28 72 78 name)).. (rx
27a0: 73 74 72 20 28 69 66 20 28 73 74 72 69 6e 67 2d str (if (string-
27b0: 63 6f 6e 74 61 69 6e 73 20 73 65 63 74 69 6f 6e contains section
27c0: 2d 6e 61 6d 65 20 22 25 22 29 0a 09 09 09 28 73 -name "%")....(s
27d0: 74 72 69 6e 67 2d 73 75 62 73 74 69 74 75 74 65 tring-substitute
27e0: 20 28 72 65 67 65 78 70 20 22 25 22 29 20 22 2e (regexp "%") ".
27f0: 2a 22 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 29 *" section-name)
2800: 0a 09 09 09 28 73 74 72 69 6e 67 2d 73 75 62 73 ....(string-subs
2810: 74 69 74 75 74 65 20 28 72 65 67 65 78 70 20 22 titute (regexp "
2820: 5e 2f 28 2e 2a 29 2f 24 22 29 20 22 5c 5c 31 22 ^/(.*)/$") "\\1"
2830: 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 29 29 29 section-name)))
2840: 0a 09 20 20 20 20 20 28 72 78 20 20 20 20 28 72 .. (rx (r
2850: 65 67 65 78 70 20 72 78 73 74 72 29 29 29 0a 09 egexp rxstr)))..
2860: 3b 3b 20 28 70 72 69 6e 74 20 22 5c 6e 73 65 63 ;; (print "\nsec
2870: 74 69 6f 6e 2d 6e 61 6d 65 3a 20 22 20 73 65 63 tion-name: " sec
2880: 74 69 6f 6e 2d 6e 61 6d 65 20 22 20 72 78 73 74 tion-name " rxst
2890: 72 3a 20 22 20 72 78 73 74 72 29 0a 20 20 20 20 r: " rxstr).
28a0: 20 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 20 20 (for-each.
28b0: 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 (lambda (
28c0: 73 65 63 74 69 6f 6e 29 0a 09 20 20 20 28 69 66 section).. (if
28d0: 20 73 65 63 74 69 6f 6e 0a 09 20 20 20 20 20 20 section..
28e0: 20 28 6c 65 74 20 28 28 73 61 6d 65 2d 73 65 63 (let ((same-sec
28f0: 74 69 6f 6e 20 28 73 74 72 69 6e 67 3d 3f 20 73 tion (string=? s
2900: 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 73 65 63 74 ection-name sect
2910: 69 6f 6e 29 29 0a 09 09 20 20 20 20 20 28 72 78 ion))... (rx
2920: 2d 6d 61 74 63 68 20 20 20 20 20 28 73 74 72 69 -match (stri
2930: 6e 67 2d 6d 61 74 63 68 20 72 78 20 73 65 63 74 ng-match rx sect
2940: 69 6f 6e 29 29 29 0a 09 09 20 3b 3b 20 28 70 72 ion)))... ;; (pr
2950: 69 6e 74 20 22 73 65 63 74 69 6f 6e 3a 20 22 20 int "section: "
2960: 73 65 63 74 69 6f 6e 20 22 20 76 61 72 73 3a 20 section " vars:
2970: 22 20 76 61 72 73 20 22 20 73 61 6d 65 2d 73 65 " vars " same-se
2980: 63 74 69 6f 6e 3a 20 22 20 73 61 6d 65 2d 73 65 ction: " same-se
2990: 63 74 69 6f 6e 20 22 20 72 78 2d 6d 61 74 63 68 ction " rx-match
29a0: 3a 20 22 20 72 78 2d 6d 61 74 63 68 29 0a 09 09 : " rx-match)...
29b0: 20 28 69 66 20 28 61 6e 64 20 28 6e 6f 74 20 73 (if (and (not s
29c0: 61 6d 65 2d 73 65 63 74 69 6f 6e 29 20 72 78 2d ame-section) rx-
29d0: 6d 61 74 63 68 29 0a 09 09 20 20 20 20 20 28 66 match)... (f
29e0: 6f 72 2d 65 61 63 68 0a 09 09 20 20 20 20 20 20 or-each...
29f0: 28 6c 61 6d 62 64 61 20 28 62 75 6e 64 6c 65 29 (lambda (bundle)
2a00: 0a 09 09 09 3b 3b 20 28 70 72 69 6e 74 20 22 62 ....;; (print "b
2a10: 75 6e 64 6c 65 3a 20 22 20 62 75 6e 64 6c 65 29 undle: " bundle)
2a20: 0a 09 09 09 28 6c 65 74 20 28 28 6b 65 79 20 20 ....(let ((key
2a30: 28 63 61 72 20 62 75 6e 64 6c 65 29 29 0a 09 09 (car bundle))...
2a40: 09 20 20 20 20 20 20 28 76 61 6c 20 20 28 63 61 . (val (ca
2a50: 64 72 20 62 75 6e 64 6c 65 29 29 0a 09 09 09 20 dr bundle))....
2a60: 20 20 20 20 20 28 6d 65 74 61 20 28 69 66 20 28 (meta (if (
2a70: 3e 20 28 6c 65 6e 67 74 68 20 62 75 6e 64 6c 65 > (length bundle
2a80: 29 20 32 29 28 63 61 64 64 72 20 62 75 6e 64 6c ) 2)(caddr bundl
2a90: 65 29 20 23 66 29 29 29 0a 09 09 09 20 20 28 68 e) #f))).... (h
2aa0: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 68 ash-table-set! h
2ab0: 74 20 73 65 63 74 69 6f 6e 20 28 63 6f 6e 66 69 t section (confi
2ac0: 67 66 3a 61 73 73 6f 63 2d 73 61 66 65 2d 61 64 gf:assoc-safe-ad
2ad0: 64 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 d (hash-table-re
2ae0: 66 20 68 74 20 73 65 63 74 69 6f 6e 29 20 6b 65 f ht section) ke
2af0: 79 20 76 61 6c 20 6d 65 74 61 64 61 74 61 3a 20 y val metadata:
2b00: 6d 65 74 61 29 29 29 29 0a 09 09 20 20 20 20 20 meta))))...
2b10: 20 76 61 72 73 29 29 29 29 29 0a 20 20 20 20 20 vars))))).
2b20: 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (hash-table-
2b30: 6b 65 79 73 20 68 74 29 29 29 29 0a 20 20 68 74 keys ht)))). ht
2b40: 29 0a 0a 3b 3b 20 72 65 61 64 20 61 20 63 6f 6e )..;; read a con
2b50: 66 69 67 20 66 69 6c 65 2c 20 72 65 74 75 72 6e fig file, return
2b60: 73 20 68 61 73 68 20 74 61 62 6c 65 20 6f 66 20 s hash table of
2b70: 61 6c 69 73 74 73 0a 0a 3b 3b 20 72 65 61 64 20 alists..;; read
2b80: 61 20 63 6f 6e 66 69 67 20 66 69 6c 65 2c 20 72 a config file, r
2b90: 65 74 75 72 6e 73 20 68 61 73 68 20 74 61 62 6c eturns hash tabl
2ba0: 65 20 6f 66 20 61 6c 69 73 74 73 0a 3b 3b 20 61 e of alists.;; a
2bb0: 64 64 73 20 74 6f 20 68 74 20 69 66 20 67 69 76 dds to ht if giv
2bc0: 65 6e 20 28 6d 75 73 74 20 62 65 20 23 66 20 6f en (must be #f o
2bd0: 74 68 65 72 77 69 73 65 29 0a 3b 3b 20 61 6c 6c therwise).;; all
2be0: 6f 77 2d 73 79 73 74 65 6d 3a 0a 3b 3b 20 20 20 ow-system:.;;
2bf0: 20 23 66 20 2d 20 64 6f 20 6e 6f 74 20 65 76 61 #f - do not eva
2c00: 6c 75 61 74 65 20 5b 73 79 73 74 65 6d 0a 3b 3b luate [system.;;
2c10: 20 20 20 20 23 74 20 2d 20 69 6d 6d 65 64 69 61 #t - immedia
2c20: 74 65 6c 79 20 65 76 61 6c 75 61 74 65 20 5b 73 tely evaluate [s
2c30: 79 73 74 65 6d 20 61 6e 64 20 73 74 6f 72 65 20 ystem and store
2c40: 72 65 73 75 6c 74 20 61 73 20 73 74 72 69 6e 67 result as string
2c50: 0a 3b 3b 20 20 20 20 27 72 65 74 75 72 6e 2d 70 .;; 'return-p
2c60: 72 6f 63 73 20 2d 2d 20 72 65 74 75 72 6e 20 61 rocs -- return a
2c70: 20 70 72 6f 63 20 74 61 6b 69 6e 67 20 68 74 20 proc taking ht
2c80: 61 73 20 61 6e 20 61 72 67 75 6d 65 6e 74 20 74 as an argument t
2c90: 68 61 74 20 6d 61 79 20 62 65 20 65 76 61 75 6c hat may be evaul
2ca0: 61 74 65 64 20 61 74 20 73 6f 6d 65 20 66 75 74 ated at some fut
2cb0: 75 72 65 20 74 69 6d 65 0a 3b 3b 20 20 20 20 27 ure time.;; '
2cc0: 72 65 74 75 72 6e 2d 73 74 72 69 6e 67 20 2d 2d return-string --
2cd0: 20 72 65 74 75 72 6e 20 61 20 73 74 72 69 6e 67 return a string
2ce0: 20 72 65 70 72 65 73 65 6e 74 69 6e 67 20 61 20 representing a
2cf0: 70 72 6f 63 20 74 61 6b 69 6e 67 20 68 74 20 61 proc taking ht a
2d00: 73 20 61 6e 20 61 72 67 75 6d 65 6e 74 20 74 68 s an argument th
2d10: 61 74 20 6d 61 79 20 62 65 20 65 76 61 75 6c 61 at may be evaula
2d20: 74 65 64 20 61 74 20 73 6f 6d 65 20 66 75 74 75 ted at some futu
2d30: 72 65 20 74 69 6d 65 0a 3b 3b 20 65 6e 76 69 6f re time.;; envio
2d40: 6e 2d 70 61 74 74 20 69 73 20 61 20 72 65 67 65 n-patt is a rege
2d50: 78 20 73 70 65 63 20 74 68 61 74 20 69 64 65 6e x spec that iden
2d60: 74 69 66 69 65 73 20 73 65 63 74 69 6f 6e 73 20 tifies sections
2d70: 74 68 61 74 20 77 69 6c 6c 20 62 65 20 65 76 61 that will be eva
2d80: 6c 27 64 0a 3b 3b 20 69 6e 20 74 68 65 20 65 6e l'd.;; in the en
2d90: 76 69 72 6f 6e 6d 65 6e 74 20 6f 6e 20 74 68 65 vironment on the
2da0: 20 66 6c 79 0a 3b 3b 20 73 65 63 74 69 6f 6e 73 fly.;; sections
2db0: 3a 20 23 66 20 3d 3e 20 67 65 74 20 61 6c 6c 2c : #f => get all,
2dc0: 20 65 6c 73 65 20 6c 69 73 74 20 6f 66 20 73 65 else list of se
2dd0: 63 74 69 6f 6e 73 20 74 6f 20 67 61 74 68 65 72 ctions to gather
2de0: 0a 3b 3b 20 70 6f 73 74 2d 73 65 63 74 69 6f 6e .;; post-section
2df0: 2d 70 72 6f 63 73 20 61 6c 69 73 74 20 6f 66 20 -procs alist of
2e00: 73 65 63 74 69 6f 6e 2d 70 61 74 74 65 72 6e 20 section-pattern
2e10: 3d 3e 20 70 72 6f 63 2c 20 77 68 65 72 65 3a 20 => proc, where:
2e20: 28 70 72 6f 63 20 73 65 63 74 69 6f 6e 2d 6e 61 (proc section-na
2e30: 6d 65 20 6e 65 78 74 2d 73 65 63 74 69 6f 6e 2d me next-section-
2e40: 6e 61 6d 65 20 68 74 20 63 75 72 72 2d 70 61 74 name ht curr-pat
2e50: 68 29 0a 3b 3b 20 61 70 70 6c 79 2d 77 69 6c 64 h).;; apply-wild
2e60: 63 61 72 64 73 3a 20 23 74 2f 23 66 20 2d 20 61 cards: #t/#f - a
2e70: 70 70 6c 79 20 76 61 72 73 20 66 72 6f 6d 20 74 pply vars from t
2e80: 61 72 67 65 74 73 20 77 69 74 68 20 25 20 77 69 argets with % wi
2e90: 6c 64 63 61 72 64 73 20 74 6f 20 61 6c 6c 20 6d ldcards to all m
2ea0: 61 74 63 68 69 6e 67 20 73 65 63 74 69 6f 6e 73 atching sections
2eb0: 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e .;;.(define (con
2ec0: 66 69 67 66 3a 72 65 61 64 2d 63 6f 6e 66 69 67 figf:read-config
2ed0: 20 70 61 74 68 20 68 74 20 61 6c 6c 6f 77 2d 73 path ht allow-s
2ee0: 79 73 74 65 6d 20 23 21 6b 65 79 20 28 65 6e 76 ystem #!key (env
2ef0: 69 72 6f 6e 2d 70 61 74 74 20 23 66 29 20 20 20 iron-patt #f)
2f00: 20 20 20 20 20 20 20 20 20 28 63 75 72 72 2d 73 (curr-s
2f10: 65 63 74 69 6f 6e 20 23 66 29 20 20 20 0a 09 09 ection #f) ...
2f20: 20 20 20 20 20 28 73 65 63 74 69 6f 6e 73 20 23 (sections #
2f30: 66 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 f)
2f40: 28 73 65 74 74 69 6e 67 73 20 28 6d 61 6b 65 2d (settings (make-
2f50: 68 61 73 68 2d 74 61 62 6c 65 29 29 20 28 6b 65 hash-table)) (ke
2f60: 65 70 2d 66 69 6c 65 6e 61 6d 65 73 20 23 66 29 ep-filenames #f)
2f70: 0a 09 09 20 20 20 20 20 28 70 6f 73 74 2d 73 65 ... (post-se
2f80: 63 74 69 6f 6e 2d 70 72 6f 63 73 20 27 28 29 29 ction-procs '())
2f90: 20 20 20 28 61 70 70 6c 79 2d 77 69 6c 64 63 61 (apply-wildca
2fa0: 72 64 73 20 23 74 29 20 28 65 6e 76 2d 74 6f 2d rds #t) (env-to-
2fb0: 75 73 65 20 23 66 29 29 0a 20 20 28 64 65 62 75 use #f)). (debu
2fc0: 67 3a 70 72 69 6e 74 20 39 20 2a 64 65 66 61 75 g:print 9 *defau
2fd0: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 53 54 lt-log-port* "ST
2fe0: 41 52 54 3a 20 22 20 70 61 74 68 29 0a 3b 3b 20 ART: " path).;;
2ff0: 28 69 66 20 2a 63 6f 6e 66 69 67 64 61 74 2a 0a (if *configdat*.
3000: 3b 3b 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 73 ;; (common:s
3010: 61 76 65 2d 70 6b 74 20 60 28 28 61 63 74 69 6f ave-pkt `((actio
3020: 6e 20 2e 20 72 65 61 64 2d 63 6f 6e 66 69 67 29 n . read-config)
3030: 0a 3b 3b 20 20 20 20 20 20 20 09 09 20 28 66 20 .;; .. (f
3040: 20 20 20 20 20 2e 20 2c 28 63 6f 6e 64 20 28 28 . ,(cond ((
3050: 73 74 72 69 6e 67 3f 20 70 61 74 68 29 20 70 61 string? path) pa
3060: 74 68 29 0a 3b 3b 20 20 20 20 20 20 20 09 09 09 th).;; ...
3070: 09 20 20 28 28 70 6f 72 74 3f 20 20 20 70 61 74 . ((port? pat
3080: 68 29 20 22 70 6f 72 74 22 29 0a 3b 3b 20 20 20 h) "port").;;
3090: 20 20 20 20 09 09 09 09 20 20 28 65 6c 73 65 20 .... (else
30a0: 28 63 6f 6e 63 20 70 61 74 68 29 29 29 29 0a 3b (conc path)))).;
30b0: 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;
30c0: 20 20 20 20 20 20 20 20 20 28 54 20 20 20 20 20 (T
30d0: 20 2e 20 63 6f 6e 66 69 67 66 29 29 0a 3b 3b 20 . configf)).;;
30e0: 20 20 20 20 20 20 09 20 20 20 20 20 20 20 2a 63 . *c
30f0: 6f 6e 66 69 67 64 61 74 2a 20 23 74 20 61 64 64 onfigdat* #t add
3100: 2d 6f 6e 6c 79 3a 20 23 74 29 29 0a 20 20 28 69 -only: #t)). (i
3110: 66 20 28 61 6e 64 20 28 6e 6f 74 20 28 70 6f 72 f (and (not (por
3120: 74 3f 20 70 61 74 68 29 29 0a 09 20 20 20 28 6e t? path)).. (n
3130: 6f 74 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f ot (file-exists?
3140: 20 70 61 74 68 29 29 29 20 3b 3b 20 66 6f 72 20 path))) ;; for
3150: 63 61 73 65 20 77 68 65 72 65 20 77 65 20 61 72 case where we ar
3160: 65 20 68 61 6e 64 65 64 20 61 20 70 6f 72 74 0a e handed a port.
3170: 20 20 20 20 20 20 28 62 65 67 69 6e 20 0a 09 28 (begin ..(
3180: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
3190: 20 31 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 1 *default-log-
31a0: 70 6f 72 74 2a 20 22 63 6f 6e 66 69 67 66 3a 72 port* "configf:r
31b0: 65 61 64 2d 63 6f 6e 66 69 67 20 2d 20 66 69 6c ead-config - fil
31c0: 65 20 6e 6f 74 20 66 6f 75 6e 64 20 22 20 70 61 e not found " pa
31d0: 74 68 20 22 20 63 75 72 72 65 6e 74 20 70 61 74 th " current pat
31e0: 68 3a 20 22 20 28 63 75 72 72 65 6e 74 2d 64 69 h: " (current-di
31f0: 72 65 63 74 6f 72 79 29 29 0a 09 3b 3b 20 57 41 rectory))..;; WA
3200: 52 4e 49 4e 47 3a 20 54 68 69 73 20 69 73 20 61 RNING: This is a
3210: 20 72 69 73 6b 79 20 63 68 61 6e 67 65 20 62 75 risky change bu
3220: 74 20 72 65 61 6c 6c 79 2c 20 77 65 20 73 68 6f t really, we sho
3230: 75 6c 64 20 6e 6f 74 20 72 65 74 75 72 6e 20 61 uld not return a
3240: 6e 20 65 6d 70 74 79 20 68 61 73 68 20 74 61 62 n empty hash tab
3250: 6c 65 20 69 66 20 6e 6f 20 66 69 6c 65 20 72 65 le if no file re
3260: 61 64 3f 0a 09 23 66 29 20 3b 3b 20 28 69 66 20 ad?..#f) ;; (if
3270: 28 6e 6f 74 20 68 74 29 28 6d 61 6b 65 2d 68 61 (not ht)(make-ha
3280: 73 68 2d 74 61 62 6c 65 29 20 68 74 29 29 0a 20 sh-table) ht)).
3290: 20 20 20 20 20 28 6c 65 74 20 28 3b 3b 20 28 65 (let (;; (e
32a0: 6e 76 2d 74 6f 2d 75 73 65 20 28 69 66 20 65 6e nv-to-use (if en
32b0: 76 2d 74 6f 2d 75 73 65 20 65 6e 76 2d 74 6f 2d v-to-use env-to-
32c0: 75 73 65 20 28 6d 6f 64 75 6c 65 2d 65 6e 76 69 use (module-envi
32d0: 72 6f 6e 6d 65 6e 74 20 27 63 6f 6e 66 69 67 66 ronment 'configf
32e0: 6d 6f 64 29 29 29 0a 09 20 20 20 20 28 69 6e 70 mod))).. (inp
32f0: 20 20 20 20 20 20 20 20 28 69 66 20 28 73 74 72 (if (str
3300: 69 6e 67 3f 20 70 61 74 68 29 0a 09 09 09 20 20 ing? path)....
3310: 20 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 66 69 (open-input-fi
3320: 6c 65 20 70 61 74 68 29 0a 09 09 09 20 20 20 20 le path)....
3330: 20 20 70 61 74 68 29 29 20 3b 3b 20 77 65 20 63 path)) ;; we c
3340: 61 6e 20 62 65 20 68 61 6e 64 65 64 20 61 20 70 an be handed a p
3350: 6f 72 74 0a 09 20 20 20 20 28 72 65 73 20 20 20 ort.. (res
3360: 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 68 74 (if (not ht
3370: 29 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c )(make-hash-tabl
3380: 65 29 20 68 74 29 29 0a 09 20 20 20 20 28 6d 65 e) ht)).. (me
3390: 74 61 70 61 74 68 20 20 20 28 69 66 20 28 6f 72 tapath (if (or
33a0: 20 28 64 65 62 75 67 3a 64 65 62 75 67 2d 6d 6f (debug:debug-mo
33b0: 64 65 20 39 29 0a 09 09 09 09 6b 65 65 70 2d 66 de 9).....keep-f
33c0: 69 6c 65 6e 61 6d 65 73 29 0a 09 09 09 20 20 20 ilenames)....
33d0: 20 70 61 74 68 20 23 66 29 29 0a 20 20 20 20 20 path #f)).
33e0: 20 20 20 20 20 20 20 28 70 72 6f 63 65 73 73 2d (process-
33f0: 77 69 6c 64 63 61 72 64 73 20 20 28 6c 61 6d 62 wildcards (lamb
3400: 64 61 20 28 72 65 73 20 63 75 72 72 2d 73 65 63 da (res curr-sec
3410: 74 69 6f 6e 2d 6e 61 6d 65 29 0a 20 20 20 20 20 tion-name).
3420: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3430: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 (if
3440: 20 28 61 6e 64 20 61 70 70 6c 79 2d 77 69 6c 64 (and apply-wild
3450: 63 61 72 64 73 0a 20 20 20 20 20 20 20 20 20 20 cards.
3460: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3470: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3480: 20 28 6f 72 20 28 73 74 72 69 6e 67 2d 63 6f 6e (or (string-con
3490: 74 61 69 6e 73 20 63 75 72 72 2d 73 65 63 74 69 tains curr-secti
34a0: 6f 6e 2d 6e 61 6d 65 20 22 25 22 29 20 20 20 3b on-name "%") ;
34b0: 3b 20 77 69 6c 64 63 61 72 64 0a 20 20 20 20 20 ; wildcard.
34c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
34d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
34e0: 20 20 20 20 20 20 20 20 20 20 28 73 74 72 69 6e (strin
34f0: 67 2d 6d 61 74 63 68 20 22 2f 2e 2a 2f 22 20 63 g-match "/.*/" c
3500: 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 urr-section-name
3510: 29 29 29 20 3b 3b 20 72 65 67 65 78 0a 20 20 20 ))) ;; regex.
3520: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3530: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3540: 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 (begin.
3550: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3560: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3570: 20 20 28 63 6f 6e 66 69 67 66 3a 61 70 70 6c 79 (configf:apply
3580: 2d 77 69 6c 64 63 61 72 64 73 20 72 65 73 20 63 -wildcards res c
3590: 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 urr-section-name
35a0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
35b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
35c0: 20 20 20 20 20 20 20 20 20 20 28 68 61 73 68 2d (hash-
35d0: 74 61 62 6c 65 2d 64 65 6c 65 74 65 21 20 72 65 table-delete! re
35e0: 73 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e s curr-section-n
35f0: 61 6d 65 29 29 29 29 29 29 20 20 3b 3b 20 4e 4f ame)))))) ;; NO
3600: 54 45 3a 20 69 66 20 74 68 65 20 73 65 63 74 69 TE: if the secti
3610: 6f 6e 20 69 73 20 61 20 77 69 6c 64 20 63 61 72 on is a wild car
3620: 64 20 69 74 20 77 69 6c 6c 20 62 65 20 52 45 4d d it will be REM
3630: 4f 56 45 44 20 66 72 6f 6d 20 72 65 73 20 0a 09 OVED from res ..
3640: 28 6c 65 74 20 6c 6f 6f 70 20 28 28 69 6e 6c 20 (let loop ((inl
3650: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
3660: 6f 6e 66 69 67 66 3a 72 65 61 64 2d 6c 69 6e 65 onfigf:read-line
3670: 20 69 6e 70 20 72 65 73 20 28 63 61 6c 63 2d 61 inp res (calc-a
3680: 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 61 6c 6c 6f llow-system allo
3690: 77 2d 73 79 73 74 65 6d 20 63 75 72 72 2d 73 65 w-system curr-se
36a0: 63 74 69 6f 6e 20 73 65 63 74 69 6f 6e 73 29 20 ction sections)
36b0: 73 65 74 74 69 6e 67 73 20 65 6e 76 2d 74 6f 2d settings env-to-
36c0: 75 73 65 29 29 20 3b 3b 20 28 72 65 61 64 2d 6c use)) ;; (read-l
36d0: 69 6e 65 20 69 6e 70 29 29 0a 09 09 20 20 20 28 ine inp))... (
36e0: 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d curr-section-nam
36f0: 65 20 28 69 66 20 63 75 72 72 2d 73 65 63 74 69 e (if curr-secti
3700: 6f 6e 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 20 on curr-section
3710: 22 64 65 66 61 75 6c 74 22 29 29 0a 09 09 20 20 "default"))...
3720: 20 28 76 61 72 2d 66 6c 61 67 20 23 66 29 3b 3b (var-flag #f);;
3730: 20 74 75 72 6e 20 6f 6e 20 66 6f 72 20 6b 65 79 turn on for key
3740: 2d 76 61 72 2d 70 72 20 61 6e 64 20 63 6f 6e 74 -var-pr and cont
3750: 2d 6c 6e 2d 72 78 2c 20 74 75 72 6e 20 6f 66 66 -ln-rx, turn off
3760: 20 65 6c 73 65 77 68 65 72 65 0a 09 09 20 20 20 elsewhere...
3770: 28 6c 65 61 64 20 20 20 20 20 23 66 29 29 0a 09 (lead #f))..
3780: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 (debug:print-i
3790: 6e 66 6f 20 38 20 2a 64 65 66 61 75 6c 74 2d 6c nfo 8 *default-l
37a0: 6f 67 2d 70 6f 72 74 2a 20 22 63 75 72 72 2d 73 og-port* "curr-s
37b0: 65 63 74 69 6f 6e 2d 6e 61 6d 65 3a 20 22 20 63 ection-name: " c
37c0: 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 urr-section-name
37d0: 20 22 20 76 61 72 2d 66 6c 61 67 3a 20 22 20 76 " var-flag: " v
37e0: 61 72 2d 66 6c 61 67 20 22 5c 6e 20 20 20 69 6e ar-flag "\n in
37f0: 6c 3a 20 5c 22 22 20 69 6e 6c 20 22 5c 22 22 29 l: \"" inl "\"")
3800: 0a 09 20 20 28 69 66 20 28 65 6f 66 2d 6f 62 6a .. (if (eof-obj
3810: 65 63 74 3f 20 69 6e 6c 29 20 0a 09 20 20 20 20 ect? inl) ..
3820: 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 (begin.
3830: 20 20 20 20 20 20 20 20 20 3b 3b 20 70 72 6f 63 ;; proc
3840: 65 73 73 20 6c 61 73 74 20 73 65 63 74 69 6f 6e ess last section
3850: 20 66 6f 72 20 77 69 6c 64 63 61 72 64 73 0a 20 for wildcards.
3860: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
3870: 70 72 6f 63 65 73 73 2d 77 69 6c 64 63 61 72 64 process-wildcard
3880: 73 20 72 65 73 20 63 75 72 72 2d 73 65 63 74 69 s res curr-secti
3890: 6f 6e 2d 6e 61 6d 65 29 0a 09 09 28 69 66 20 28 on-name)...(if (
38a0: 73 74 72 69 6e 67 3f 20 70 61 74 68 29 20 3b 3b string? path) ;;
38b0: 20 77 65 20 72 65 63 65 69 76 65 64 20 61 20 70 we received a p
38c0: 61 74 68 2c 20 6e 6f 74 20 61 20 70 6f 72 74 2c ath, not a port,
38d0: 20 74 68 75 73 20 77 65 20 61 72 65 20 72 65 73 thus we are res
38e0: 70 6f 6e 73 69 62 6c 65 20 66 6f 72 20 63 6c 6f ponsible for clo
38f0: 73 69 6e 67 20 69 74 2e 0a 09 09 20 20 20 20 28 sing it.... (
3900: 63 6c 6f 73 65 2d 69 6e 70 75 74 2d 70 6f 72 74 close-input-port
3910: 20 69 6e 70 29 29 0a 09 09 28 69 66 20 28 6c 69 inp))...(if (li
3920: 73 74 3f 20 73 65 63 74 69 6f 6e 73 29 20 3b 3b st? sections) ;;
3930: 20 64 65 6c 65 74 65 20 61 6c 6c 20 73 65 63 74 delete all sect
3940: 69 6f 6e 73 20 65 78 63 65 70 74 20 67 69 76 65 ions except give
3950: 6e 20 77 68 65 6e 20 73 65 63 74 69 6f 6e 73 20 n when sections
3960: 69 73 20 70 72 6f 76 69 64 65 64 0a 09 09 20 20 is provided...
3970: 20 20 28 66 6f 72 2d 65 61 63 68 0a 09 09 20 20 (for-each...
3980: 20 20 20 28 6c 61 6d 62 64 61 20 28 73 65 63 74 (lambda (sect
3990: 69 6f 6e 29 0a 09 09 20 20 20 20 20 20 20 28 69 ion)... (i
39a0: 66 20 28 6e 6f 74 20 28 6d 65 6d 62 65 72 20 73 f (not (member s
39b0: 65 63 74 69 6f 6e 20 73 65 63 74 69 6f 6e 73 29 ection sections)
39c0: 29 0a 09 09 09 20 20 20 28 68 61 73 68 2d 74 61 ).... (hash-ta
39d0: 62 6c 65 2d 64 65 6c 65 74 65 21 20 72 65 73 20 ble-delete! res
39e0: 73 65 63 74 69 6f 6e 29 29 29 20 3b 3b 20 77 65 section))) ;; we
39f0: 20 61 72 65 20 75 73 69 6e 67 20 22 22 20 61 73 are using "" as
3a00: 20 61 20 64 75 6d 70 69 6e 67 20 67 72 6f 75 6e a dumping groun
3a10: 64 20 61 6e 64 20 6d 75 73 74 20 72 65 6d 6f 76 d and must remov
3a20: 65 20 69 74 20 62 65 66 6f 72 65 20 72 65 74 75 e it before retu
3a30: 72 6e 69 6e 67 20 74 68 65 20 68 74 0a 09 09 20 rning the ht...
3a40: 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (hash-table-
3a50: 6b 65 79 73 20 72 65 73 29 29 29 0a 09 09 28 64 keys res)))...(d
3a60: 65 62 75 67 3a 70 72 69 6e 74 20 39 20 2a 64 65 ebug:print 9 *de
3a70: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
3a80: 22 45 4e 44 3a 20 22 20 70 61 74 68 29 0a 20 20 "END: " path).
3a90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 72 65 re
3aa0: 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 s.
3ab0: 20 20 29 20 3b 3b 20 72 65 74 76 61 6c 0a 09 20 ) ;; retval..
3ac0: 20 20 20 20 20 28 72 65 67 65 78 2d 63 61 73 65 (regex-case
3ad0: 20 0a 09 20 20 20 20 20 20 20 69 6e 6c 20 0a 09 .. inl ..
3ae0: 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a (configf:
3af0: 63 6f 6d 6d 65 6e 74 2d 72 78 20 5f 20 20 20 20 comment-rx _
3b00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
3b10: 6f 6f 70 20 28 63 6f 6e 66 69 67 66 3a 72 65 61 oop (configf:rea
3b20: 64 2d 6c 69 6e 65 20 69 6e 70 20 72 65 73 20 28 d-line inp res (
3b30: 63 61 6c 63 2d 61 6c 6c 6f 77 2d 73 79 73 74 65 calc-allow-syste
3b40: 6d 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 63 m allow-system c
3b50: 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 urr-section-name
3b60: 20 73 65 63 74 69 6f 6e 73 29 20 73 65 74 74 69 sections) setti
3b70: 6e 67 73 20 65 6e 76 2d 74 6f 2d 75 73 65 29 0a ngs env-to-use).
3b80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3b90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3ba0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3bb0: 20 20 20 20 20 20 20 20 20 20 20 20 63 75 72 72 curr
3bc0: 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 -section-name #f
3bd0: 20 23 66 29 29 0a 20 20 20 20 20 20 20 20 20 20 #f)).
3be0: 20 20 20 20 20 0a 09 20 20 20 20 20 20 20 28 63 .. (c
3bf0: 6f 6e 66 69 67 66 3a 62 6c 61 6e 6b 2d 6c 2d 72 onfigf:blank-l-r
3c00: 78 20 5f 20 20 20 20 20 20 20 20 20 20 20 20 20 x _
3c10: 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 6f 6e 66 (loop (conf
3c20: 69 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e igf:read-line in
3c30: 70 20 72 65 73 20 28 63 61 6c 63 2d 61 6c 6c 6f p res (calc-allo
3c40: 77 2d 73 79 73 74 65 6d 20 61 6c 6c 6f 77 2d 73 w-system allow-s
3c50: 79 73 74 65 6d 20 63 75 72 72 2d 73 65 63 74 69 ystem curr-secti
3c60: 6f 6e 2d 6e 61 6d 65 20 73 65 63 74 69 6f 6e 73 on-name sections
3c70: 29 20 73 65 74 74 69 6e 67 73 20 65 6e 76 2d 74 ) settings env-t
3c80: 6f 2d 75 73 65 29 0a 20 20 20 20 20 20 20 20 20 o-use).
3c90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3ca0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3cb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3cc0: 20 20 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d curr-section-
3cd0: 6e 61 6d 65 20 23 66 20 23 66 29 29 0a 09 20 20 name #f #f))..
3ce0: 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 73 65 (configf:se
3cf0: 74 74 69 6e 67 73 20 20 20 28 20 78 20 73 65 74 ttings ( x set
3d00: 74 69 6e 67 20 76 61 6c 20 20 29 0a 20 20 20 20 ting val ).
3d10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3d20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
3d30: 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 20 20 begin.
3d40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3d50: 20 20 20 20 20 20 20 20 20 20 20 28 68 61 73 68 (hash
3d60: 2d 74 61 62 6c 65 2d 73 65 74 21 20 73 65 74 74 -table-set! sett
3d70: 69 6e 67 73 20 73 65 74 74 69 6e 67 20 76 61 6c ings setting val
3d80: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
3d90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3da0: 20 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 6f (loop (co
3db0: 6e 66 69 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 nfigf:read-line
3dc0: 69 6e 70 20 72 65 73 20 28 63 61 6c 63 2d 61 6c inp res (calc-al
3dd0: 6c 6f 77 2d 73 79 73 74 65 6d 20 61 6c 6c 6f 77 low-system allow
3de0: 2d 73 79 73 74 65 6d 20 63 75 72 72 2d 73 65 63 -system curr-sec
3df0: 74 69 6f 6e 2d 6e 61 6d 65 20 73 65 63 74 69 6f tion-name sectio
3e00: 6e 73 29 20 73 65 74 74 69 6e 67 73 20 65 6e 76 ns) settings env
3e10: 2d 74 6f 2d 75 73 65 29 0a 20 20 20 20 20 20 20 -to-use).
3e20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3e30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3e40: 20 20 20 20 63 75 72 72 2d 73 65 63 74 69 6f 6e curr-section
3e50: 2d 6e 61 6d 65 20 23 66 20 23 66 29 29 29 0a 20 -name #f #f))).
3e60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0a 09 ..
3e70: 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a (configf:
3e80: 69 6e 63 6c 75 64 65 2d 72 78 20 28 20 78 20 69 include-rx ( x i
3e90: 6e 63 6c 75 64 65 2d 66 69 6c 65 20 29 0a 20 20 nclude-file ).
3ea0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3eb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3ec0: 20 28 6c 65 74 2a 20 28 28 63 75 72 72 2d 63 6f (let* ((curr-co
3ed0: 6e 66 2d 64 69 72 20 28 70 61 74 68 6e 61 6d 65 nf-dir (pathname
3ee0: 2d 64 69 72 65 63 74 6f 72 79 20 70 61 74 68 29 -directory path)
3ef0: 29 0a 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 28 66 75 6c (ful
3f20: 6c 2d 63 6f 6e 66 20 20 20 20 20 28 69 66 20 28 l-conf (if (
3f30: 61 6e 64 20 28 61 62 73 6f 6c 75 74 65 2d 70 61 and (absolute-pa
3f40: 74 68 6e 61 6d 65 3f 20 69 6e 63 6c 75 64 65 2d thname? include-
3f50: 66 69 6c 65 29 20 28 66 69 6c 65 2d 65 78 69 73 file) (file-exis
3f60: 74 73 3f 20 69 6e 63 6c 75 64 65 2d 66 69 6c 65 ts? include-file
3f70: 29 29 0a 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 20 20 20
3f90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3fa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3fb0: 69 6e 63 6c 75 64 65 2d 66 69 6c 65 0a 20 20 20 include-file.
3fc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3fd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
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 28 63 6f 6d 6d 6f (commo
4000: 6e 3a 6e 69 63 65 2d 70 61 74 68 20 0a 20 20 20 n:nice-path .
4010: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4020: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4030: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4040: 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 63 (conc
4050: 20 28 69 66 20 63 75 72 72 2d 63 6f 6e 66 2d 64 (if curr-conf-d
4060: 69 72 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ir.
4070: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
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 20 20 20 20 20 20 20 20 20 63 75 72 72 2d curr-
40b0: 63 6f 6e 66 2d 64 69 72 0a 20 20 20 20 20 20 20 conf-dir.
40c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
40d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
40e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
40f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4100: 20 22 2e 22 29 0a 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 20
4120: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4130: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4140: 20 20 20 20 20 20 20 20 20 20 22 2f 22 20 69 6e "/" in
4150: 63 6c 75 64 65 2d 66 69 6c 65 29 29 29 29 29 0a clude-file))))).
4160: 09 09 09 09 20 20 20 20 20 28 6c 65 74 20 28 28 .... (let ((
4170: 61 6c 6c 2d 6d 61 74 63 68 65 73 20 28 73 6f 72 all-matches (sor
4180: 74 20 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 t (handle-except
4190: 69 6f 6e 73 20 65 78 6e 0a 09 09 09 09 09 09 09 ions exn........
41a0: 09 28 62 65 67 69 6e 0a 09 09 09 09 09 09 09 09 .(begin.........
41b0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 27 28 (debug:print '(
41c0: 32 20 39 29 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 2 9) *default-lo
41d0: 67 2d 70 6f 72 74 2a 20 22 67 6c 6f 62 20 6f 66 g-port* "glob of
41e0: 20 22 20 66 75 6c 6c 2d 63 6f 6e 66 20 22 20 67 " full-conf " g
41f0: 61 76 65 20 6e 6f 20 6d 61 74 63 68 2e 20 2c 20 ave no match. ,
4200: 65 78 6e 3d 22 20 65 78 6e 29 0a 09 09 09 09 09 exn=" exn)......
4210: 09 09 09 20 28 6c 69 73 74 29 29 0a 09 09 09 09 ... (list)).....
4220: 09 09 09 09 28 67 6c 6f 62 20 66 75 6c 6c 2d 63 ....(glob full-c
4230: 6f 6e 66 29 29 20 73 74 72 69 6e 67 3c 3d 3f 29 onf)) string<=?)
4240: 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 69 ))..... (i
4250: 66 20 28 6e 75 6c 6c 3f 20 61 6c 6c 2d 6d 61 74 f (null? all-mat
4260: 63 68 65 73 29 0a 09 09 09 09 09 20 20 20 28 62 ches)...... (b
4270: 65 67 69 6e 0a 09 09 09 09 09 20 20 20 20 20 28 egin...... (
4280: 64 65 62 75 67 3a 70 72 69 6e 74 20 27 28 32 20 debug:print '(2
4290: 39 29 20 23 66 20 22 49 4e 46 4f 3a 20 69 6e 63 9) #f "INFO: inc
42a0: 6c 75 64 65 20 66 69 6c 65 28 73 29 20 6d 61 74 lude file(s) mat
42b0: 63 68 69 6e 67 20 22 20 69 6e 63 6c 75 64 65 2d ching " include-
42c0: 66 69 6c 65 20 22 20 6e 6f 74 20 66 6f 75 6e 64 file " not found
42d0: 20 28 63 61 6c 6c 65 64 20 66 72 6f 6d 20 22 20 (called from "
42e0: 70 61 74 68 20 22 29 22 29 0a 09 09 09 09 09 20 path ")")......
42f0: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
4300: 20 32 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 2 *default-log-
4310: 70 6f 72 74 2a 20 22 20 20 20 20 20 20 20 20 22 port* " "
4320: 20 66 75 6c 6c 2d 63 6f 6e 66 29 29 0a 09 09 09 full-conf))....
4330: 09 09 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 09 .. (for-each..
4340: 09 09 09 09 20 20 20 20 28 6c 61 6d 62 64 61 20 .... (lambda
4350: 28 66 70 61 74 68 29 0a 09 09 09 09 09 20 20 20 (fpath)......
4360: 20 20 20 3b 3b 20 28 70 75 73 68 2d 64 69 72 65 ;; (push-dire
4370: 63 74 6f 72 79 20 63 6f 6e 66 2d 64 69 72 29 0a ctory conf-dir).
4380: 09 09 09 09 09 20 20 20 20 20 20 28 64 65 62 75 ..... (debu
4390: 67 3a 70 72 69 6e 74 20 39 20 2a 64 65 66 61 75 g:print 9 *defau
43a0: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 49 6e lt-log-port* "In
43b0: 63 6c 75 64 69 6e 67 3a 20 22 20 66 75 6c 6c 2d cluding: " full-
43c0: 63 6f 6e 66 29 0a 09 09 09 09 09 20 20 20 20 20 conf)......
43d0: 20 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d 63 (configf:read-c
43e0: 6f 6e 66 69 67 20 66 70 61 74 68 20 72 65 73 20 onfig fpath res
43f0: 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 65 6e 76 allow-system env
4400: 69 72 6f 6e 2d 70 61 74 74 3a 20 65 6e 76 69 72 iron-patt: envir
4410: 6f 6e 2d 70 61 74 74 0a 09 09 09 09 09 09 09 20 on-patt........
4420: 20 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 3a 20 curr-section:
4430: 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d curr-section-nam
4440: 65 20 73 65 63 74 69 6f 6e 73 3a 20 73 65 63 74 e sections: sect
4450: 69 6f 6e 73 20 73 65 74 74 69 6e 67 73 3a 20 73 ions settings: s
4460: 65 74 74 69 6e 67 73 0a 09 09 09 09 09 09 09 20 ettings........
4470: 20 20 6b 65 65 70 2d 66 69 6c 65 6e 61 6d 65 73 keep-filenames
4480: 3a 20 6b 65 65 70 2d 66 69 6c 65 6e 61 6d 65 73 : keep-filenames
4490: 20 65 6e 76 2d 74 6f 2d 75 73 65 3a 20 65 6e 76 env-to-use: env
44a0: 2d 74 6f 2d 75 73 65 29 29 0a 09 09 09 09 09 20 -to-use))......
44b0: 20 20 20 61 6c 6c 2d 6d 61 74 63 68 65 73 29 29 all-matches))
44c0: 0a 09 09 09 09 20 20 20 20 20 20 20 28 6c 6f 6f ..... (loo
44d0: 70 20 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d p (configf:read-
44e0: 6c 69 6e 65 20 69 6e 70 20 72 65 73 20 28 63 61 line inp res (ca
44f0: 6c 63 2d 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 lc-allow-system
4500: 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 63 75 72 allow-system cur
4510: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 73 r-section-name s
4520: 65 63 74 69 6f 6e 73 29 20 73 65 74 74 69 6e 67 ections) setting
4530: 73 20 65 6e 76 2d 74 6f 2d 75 73 65 29 0a 09 09 s env-to-use)...
4540: 09 09 09 20 20 20 20 20 63 75 72 72 2d 73 65 63 ... curr-sec
4550: 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 66 29 tion-name #f #f)
4560: 29 29 29 0a 09 20 20 20 20 20 20 20 28 63 6f 6e ))).. (con
4570: 66 69 67 66 3a 73 63 72 69 70 74 2d 72 78 20 28 figf:script-rx (
4580: 20 78 20 69 6e 63 6c 75 64 65 2d 73 63 72 69 70 x include-scrip
4590: 74 20 70 61 72 61 6d 73 29 3b 3b 20 68 61 6e 64 t params);; hand
45a0: 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 20 20 le-exceptions.
45b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
45c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
45d0: 3b 3b 20 20 20 20 65 78 6e 0a 20 20 20 20 20 20 ;; exn.
45e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
45f0: 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 20 ;;
4600: 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 (begin.
4610: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4620: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 20 20 ;;
4630: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
4640: 27 28 30 20 32 20 39 29 20 23 66 20 22 49 4e 46 '(0 2 9) #f "INF
4650: 4f 3a 20 69 6e 63 6c 75 64 65 20 66 72 6f 6d 20 O: include from
4660: 73 63 72 69 70 74 20 22 20 69 6e 63 6c 75 64 65 script " include
4670: 2d 73 63 72 69 70 74 20 22 20 66 61 69 6c 65 64 -script " failed
4680: 2e 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 .").
4690: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
46a0: 20 20 20 20 20 20 3b 3b 20 20 20 20 20 20 28 6c ;; (l
46b0: 6f 6f 70 20 28 63 6f 6e 66 69 67 66 3a 72 65 61 oop (configf:rea
46c0: 64 2d 6c 69 6e 65 20 69 6e 70 20 72 65 73 20 28 d-line inp res (
46d0: 63 61 6c 63 2d 61 6c 6c 6f 77 2d 73 79 73 74 65 calc-allow-syste
46e0: 6d 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 63 m allow-system c
46f0: 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 urr-section-name
4700: 20 73 65 63 74 69 6f 6e 73 29 20 73 65 74 74 69 sections) setti
4710: 6e 67 73 29 20 63 75 72 72 2d 73 65 63 74 69 6f ngs) curr-sectio
4720: 6e 2d 6e 61 6d 65 20 23 66 20 23 66 29 29 0a 20 n-name #f #f)).
4730: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4740: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4750: 20 28 69 66 20 28 61 6e 64 20 28 66 69 6c 65 2d (if (and (file-
4760: 65 78 69 73 74 73 3f 20 69 6e 63 6c 75 64 65 2d exists? include-
4770: 73 63 72 69 70 74 29 28 66 69 6c 65 2d 65 78 65 script)(file-exe
4780: 63 75 74 61 62 6c 65 3f 20 69 6e 63 6c 75 64 65 cutable? include
4790: 2d 73 63 72 69 70 74 29 29 0a 20 20 20 20 20 20 -script)).
47a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
47b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
47c0: 28 6c 65 74 2a 20 28 28 6c 6f 63 61 6c 2d 61 6c (let* ((local-al
47d0: 6c 6f 77 2d 73 79 73 74 65 6d 20 20 28 63 61 6c low-system (cal
47e0: 63 2d 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 61 c-allow-system a
47f0: 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 63 75 72 72 llow-system curr
4800: 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 73 65 -section-name se
4810: 63 74 69 6f 6e 73 29 29 0a 20 20 20 20 20 20 20 ctions)).
4820: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4830: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4840: 20 20 20 20 20 20 28 65 6e 76 2d 64 65 6c 74 61 (env-delta
4850: 20 20 28 63 6f 6e 66 69 67 66 3a 63 66 67 64 61 (configf:cfgda
4860: 74 2d 3e 65 6e 76 2d 61 6c 69 73 74 20 63 75 72 t->env-alist cur
4870: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 72 r-section-name r
4880: 65 73 20 6c 6f 63 61 6c 2d 61 6c 6c 6f 77 2d 73 es local-allow-s
4890: 79 73 74 65 6d 29 29 0a 20 20 20 20 20 20 20 20 ystem)).
48a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
48b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
48c0: 20 20 20 20 20 28 6e 65 77 2d 69 6e 70 2d 70 6f (new-inp-po
48d0: 72 74 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 rt.
48e0: 20 20 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 28 63 6f 6d 6d 6f 6e 3a 77 69 74 68 2d 65 6e (common:with-en
4910: 76 2d 76 61 72 73 0a 20 20 20 20 20 20 20 20 20 v-vars.
4920: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4930: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4940: 20 20 20 20 20 20 65 6e 76 2d 64 65 6c 74 61 0a env-delta.
4950: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4960: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4970: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
4980: 6c 61 6d 62 64 61 20 28 29 0a 20 20 20 20 20 20 lambda ().
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 20
49b0: 20 20 20 20 20 20 20 20 20 20 20 28 6f 70 65 6e (open
49c0: 2d 69 6e 70 75 74 2d 70 69 70 65 20 28 63 6f 6e -input-pipe (con
49d0: 63 20 69 6e 63 6c 75 64 65 2d 73 63 72 69 70 74 c include-script
49e0: 20 22 20 22 20 70 61 72 61 6d 73 29 29 29 29 29 " " params)))))
49f0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
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 28 64 65 62 75 67 (debug
4a20: 3a 70 72 69 6e 74 20 27 28 32 20 39 29 20 2a 64 :print '(2 9) *d
4a30: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
4a40: 20 22 49 6e 63 6c 75 64 69 6e 67 20 66 72 6f 6d "Including from
4a50: 20 73 63 72 69 70 74 20 6f 75 74 70 75 74 3a 20 script output:
4a60: 22 20 69 6e 63 6c 75 64 65 2d 73 63 72 69 70 74 " include-script
4a70: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
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 3b 3b 20 20 28 70 ;; (p
4aa0: 72 69 6e 74 20 22 57 65 20 67 6f 74 20 68 65 72 rint "We got her
4ab0: 65 2c 20 63 61 6c 6c 69 6e 67 20 63 6f 6e 66 69 e, calling confi
4ac0: 67 66 3a 72 65 61 64 2d 63 6f 6e 66 69 67 20 6e gf:read-config n
4ad0: 65 78 74 2e 20 50 6f 72 74 20 69 73 3a 20 22 20 ext. Port is: "
4ae0: 6e 65 77 2d 69 6e 70 2d 70 6f 72 74 29 0a 20 20 new-inp-port).
4af0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4b00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4b10: 20 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 72 (configf:r
4b20: 65 61 64 2d 63 6f 6e 66 69 67 20 6e 65 77 2d 69 ead-config new-i
4b30: 6e 70 2d 70 6f 72 74 20 72 65 73 20 61 6c 6c 6f np-port res allo
4b40: 77 2d 73 79 73 74 65 6d 20 65 6e 76 69 72 6f 6e w-system environ
4b50: 2d 70 61 74 74 3a 20 65 6e 76 69 72 6f 6e 2d 70 -patt: environ-p
4b60: 61 74 74 20 63 75 72 72 2d 73 65 63 74 69 6f 6e att curr-section
4b70: 3a 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e : curr-section-n
4b80: 61 6d 65 20 73 65 63 74 69 6f 6e 73 3a 20 73 65 ame sections: se
4b90: 63 74 69 6f 6e 73 20 73 65 74 74 69 6e 67 73 3a ctions settings:
4ba0: 20 73 65 74 74 69 6e 67 73 20 6b 65 65 70 2d 66 settings keep-f
4bb0: 69 6c 65 6e 61 6d 65 73 3a 20 6b 65 65 70 2d 66 ilenames: keep-f
4bc0: 69 6c 65 6e 61 6d 65 73 20 65 6e 76 2d 74 6f 2d ilenames env-to-
4bd0: 75 73 65 3a 20 65 6e 76 2d 74 6f 2d 75 73 65 29 use: env-to-use)
4be0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
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 28 63 6c 6f 73 65 2d (close-
4c10: 69 6e 70 75 74 2d 70 6f 72 74 20 6e 65 77 2d 69 input-port new-i
4c20: 6e 70 2d 70 6f 72 74 29 0a 20 20 20 20 20 20 20 np-port).
4c30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4c40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4c50: 20 28 6c 6f 6f 70 20 28 63 6f 6e 66 69 67 66 3a (loop (configf:
4c60: 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 20 72 65 read-line inp re
4c70: 73 20 28 63 61 6c 63 2d 61 6c 6c 6f 77 2d 73 79 s (calc-allow-sy
4c80: 73 74 65 6d 20 61 6c 6c 6f 77 2d 73 79 73 74 65 stem allow-syste
4c90: 6d 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e m curr-section-n
4ca0: 61 6d 65 20 73 65 63 74 69 6f 6e 73 29 20 73 65 ame sections) se
4cb0: 74 74 69 6e 67 73 20 65 6e 76 2d 74 6f 2d 75 73 ttings env-to-us
4cc0: 65 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d e) curr-section-
4cd0: 6e 61 6d 65 20 23 66 20 23 66 29 29 0a 20 20 20 name #f #f)).
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 20 20 20 20 20 20 20 20
4d00: 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 (begin.
4d10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4d20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4d30: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
4d40: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
4d50: 72 74 2a 20 22 53 63 72 69 70 74 20 6e 6f 74 20 rt* "Script not
4d60: 66 6f 75 6e 64 20 6f 72 20 6e 6f 74 20 65 78 65 found or not exe
4d70: 63 74 75 74 61 62 6c 65 3a 20 22 20 69 6e 63 6c ctutable: " incl
4d80: 75 64 65 2d 73 63 72 69 70 74 29 0a 20 20 20 20 ude-script).
4d90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4da0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4db0: 20 20 20 20 28 6c 6f 6f 70 20 28 63 6f 6e 66 69 (loop (confi
4dc0: 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 gf:read-line inp
4dd0: 20 72 65 73 20 28 63 61 6c 63 2d 61 6c 6c 6f 77 res (calc-allow
4de0: 2d 73 79 73 74 65 6d 20 61 6c 6c 6f 77 2d 73 79 -system allow-sy
4df0: 73 74 65 6d 20 63 75 72 72 2d 73 65 63 74 69 6f stem curr-sectio
4e00: 6e 2d 6e 61 6d 65 20 73 65 63 74 69 6f 6e 73 29 n-name sections)
4e10: 20 73 65 74 74 69 6e 67 73 20 65 6e 76 2d 74 6f settings env-to
4e20: 2d 75 73 65 29 20 63 75 72 72 2d 73 65 63 74 69 -use) curr-secti
4e30: 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 66 29 29 29 on-name #f #f)))
4e40: 0a 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 29 20 3b 3b 20 29 0a 09 20 20 20 20 20 ) ;; )..
4e70: 20 20 28 63 6f 6e 66 69 67 66 3a 73 65 63 74 69 (configf:secti
4e80: 6f 6e 2d 72 78 20 28 20 78 20 73 65 63 74 69 6f on-rx ( x sectio
4e90: 6e 2d 6e 61 6d 65 20 29 0a 20 20 20 20 20 20 20 n-name ).
4ea0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4eb0: 20 20 20 20 20 20 20 20 20 20 20 20 28 62 65 67 (beg
4ec0: 69 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 in.
4ed0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4ee0: 20 20 20 20 20 20 20 20 3b 3b 20 63 61 6c 6c 20 ;; call
4ef0: 70 6f 73 74 2d 73 65 63 74 69 6f 6e 2d 70 72 6f post-section-pro
4f00: 63 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 cs.
4f10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4f20: 20 20 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 (for-eac
4f30: 68 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 h .
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 28 6c 61 6d 62 64 61 (lambda
4f60: 20 28 64 61 74 29 0a 20 20 20 20 20 20 20 20 20 (dat).
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 28 (
4f90: 6c 65 74 20 28 28 70 61 74 74 20 28 63 61 72 20 let ((patt (car
4fa0: 64 61 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 dat)).
4fb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4fc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4fd0: 20 20 20 20 28 70 72 6f 63 20 28 63 64 72 20 64 (proc (cdr d
4fe0: 61 74 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 at))).
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: 28 69 66 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 (if (string-matc
5020: 68 20 70 61 74 74 20 63 75 72 72 2d 73 65 63 74 h patt curr-sect
5030: 69 6f 6e 2d 6e 61 6d 65 29 0a 20 20 20 20 20 20 ion-name).
5040: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5050: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5060: 20 20 20 20 20 20 20 20 28 70 72 6f 63 20 63 75 (proc cu
5070: 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 rr-section-name
5080: 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 72 65 73 section-name res
5090: 20 70 61 74 68 29 29 29 29 0a 20 20 20 20 20 20 path)))).
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: 70 6f 73 74 2d 73 65 63 74 69 6f 6e 2d 70 72 6f post-section-pro
50d0: 63 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 cs).
50e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
50f0: 20 20 20 20 20 20 20 20 20 3b 3b 20 61 66 74 65 ;; afte
5100: 72 20 67 61 74 68 65 72 69 6e 67 20 74 68 65 20 r gathering the
5110: 76 61 72 73 20 66 6f 72 20 61 20 73 65 63 74 69 vars for a secti
5120: 6f 6e 20 61 6e 64 20 69 66 20 61 70 70 6c 79 2d on and if apply-
5130: 77 69 6c 64 63 61 72 64 73 20 69 73 20 74 72 75 wildcards is tru
5140: 65 20 61 6e 64 20 69 66 20 74 68 65 72 65 20 69 e and if there i
5150: 73 20 61 20 77 69 6c 64 63 61 72 64 20 69 6e 20 s a wildcard in
5160: 74 68 65 20 73 65 63 74 69 6f 6e 20 6e 61 6d 65 the section name
5170: 20 70 72 6f 63 65 73 73 20 77 69 6c 64 63 61 72 process wildcar
5180: 64 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ds.
5190: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
51a0: 20 20 20 20 20 20 20 20 3b 3b 20 4e 4f 54 45 3a ;; NOTE:
51b0: 20 77 65 20 61 72 65 20 70 72 6f 63 65 73 73 69 we are processi
51c0: 6e 67 20 74 68 65 20 63 75 72 72 2d 73 65 63 74 ng the curr-sect
51d0: 69 6f 6e 2d 6e 61 6d 65 2c 20 4e 4f 54 20 73 65 ion-name, NOT se
51e0: 63 74 69 6f 6e 2d 6e 61 6d 65 2e 0a 20 20 20 20 ction-name..
51f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5200: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5210: 20 28 70 72 6f 63 65 73 73 2d 77 69 6c 64 63 61 (process-wildca
5220: 72 64 73 20 72 65 73 20 63 75 72 72 2d 73 65 63 rds res curr-sec
5230: 74 69 6f 6e 2d 6e 61 6d 65 29 0a 20 20 20 20 20 tion-name).
5240: 20 20 20 20 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: 28 69 66 20 28 6e 6f 74 20 28 68 61 73 68 2d 74 (if (not (hash-t
5270: 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 able-ref/default
5280: 20 72 65 73 20 73 65 63 74 69 6f 6e 2d 6e 61 6d res section-nam
5290: 65 20 23 66 29 29 28 68 61 73 68 2d 74 61 62 6c e #f))(hash-tabl
52a0: 65 2d 73 65 74 21 20 72 65 73 20 73 65 63 74 69 e-set! res secti
52b0: 6f 6e 2d 6e 61 6d 65 20 27 28 29 29 29 20 3b 3b on-name '())) ;;
52c0: 20 65 6e 73 75 72 65 20 74 68 61 74 20 6d 65 72 ensure that mer
52d0: 65 20 6d 65 6e 74 69 6f 6e 20 6f 66 20 61 20 73 e mention of a s
52e0: 65 63 74 69 6f 6e 20 69 73 20 6e 6f 74 20 6c 6f ection is not lo
52f0: 73 74 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 st.
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 28 6c 6f 6f 70 20 28 63 (loop (c
5320: 6f 6e 66 69 67 66 3a 72 65 61 64 2d 6c 69 6e 65 onfigf:read-line
5330: 20 69 6e 70 20 72 65 73 20 28 63 61 6c 63 2d 61 inp res (calc-a
5340: 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 61 6c 6c 6f llow-system allo
5350: 77 2d 73 79 73 74 65 6d 20 63 75 72 72 2d 73 65 w-system curr-se
5360: 63 74 69 6f 6e 2d 6e 61 6d 65 20 73 65 63 74 69 ction-name secti
5370: 6f 6e 73 29 20 73 65 74 74 69 6e 67 73 20 65 6e ons) settings en
5380: 76 2d 74 6f 2d 75 73 65 29 0a 20 20 20 20 20 20 v-to-use).
5390: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
53a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
53b0: 20 20 20 20 20 3b 3b 20 69 66 20 77 65 20 68 61 ;; if we ha
53c0: 76 65 20 74 68 65 20 73 65 63 74 69 6f 6e 73 20 ve the sections
53d0: 6c 69 73 74 20 74 68 65 6e 20 66 6f 72 63 65 20 list then force
53e0: 61 6c 6c 20 73 65 74 74 69 6e 67 73 20 69 6e 74 all settings int
53f0: 6f 20 22 22 20 61 6e 64 20 64 65 6c 65 74 65 20 o "" and delete
5400: 69 74 20 6c 61 74 65 72 3f 0a 20 20 20 20 20 20 it later?.
5410: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5420: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5430: 20 20 20 20 20 3b 3b 20 28 69 66 20 28 6f 72 20 ;; (if (or
5440: 28 6e 6f 74 20 73 65 63 74 69 6f 6e 73 29 20 0a (not sections) .
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 20
5470: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 09 20 20 ;;.
5480: 20 20 20 20 28 6d 65 6d 62 65 72 20 73 65 63 74 (member sect
5490: 69 6f 6e 2d 6e 61 6d 65 20 73 65 63 74 69 6f 6e ion-name section
54a0: 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 s)).
54b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
54c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
54d0: 3b 09 20 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 ;. section-name
54e0: 20 22 22 29 20 3b 3b 20 73 74 69 63 6b 20 65 76 "") ;; stick ev
54f0: 65 72 79 74 68 69 6e 67 20 69 6e 74 6f 20 22 22 erything into ""
5500: 2e 20 4e 4f 50 45 3a 20 57 65 20 6e 65 65 64 20 . NOPE: We need
5510: 6e 65 77 20 73 74 72 61 74 65 67 79 2e 20 50 75 new strategy. Pu
5520: 74 20 73 74 75 66 66 20 69 6e 20 63 6f 72 72 65 t stuff in corre
5530: 63 74 20 73 65 63 74 69 6f 6e 73 20 61 6e 64 20 ct sections and
5540: 74 68 65 6e 20 64 65 6c 65 74 65 20 61 6c 6c 20 then delete all
5550: 73 65 63 74 69 6f 6e 73 20 6c 61 74 65 72 2e 0a sections later..
5560: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5570: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5580: 20 20 20 20 20 20 20 20 20 20 20 73 65 63 74 69 secti
5590: 6f 6e 2d 6e 61 6d 65 0a 20 20 20 20 20 20 20 20 on-name.
55a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
55b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
55c0: 20 20 20 23 66 20 23 66 29 29 29 0a 09 20 20 20 #f #f)))..
55d0: 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 6b 65 79 (configf:key
55e0: 2d 73 79 73 2d 70 72 20 28 20 78 20 6b 65 79 20 -sys-pr ( x key
55f0: 63 6d 64 20 20 20 20 20 20 29 0a 20 20 20 20 20 cmd ).
5600: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5610: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 (i
5620: 66 20 28 63 61 6c 63 2d 61 6c 6c 6f 77 2d 73 79 f (calc-allow-sy
5630: 73 74 65 6d 20 61 6c 6c 6f 77 2d 73 79 73 74 65 stem allow-syste
5640: 6d 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e m curr-section-n
5650: 61 6d 65 20 73 65 63 74 69 6f 6e 73 29 0a 20 20 ame sections).
5660: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5670: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5680: 20 20 20 20 20 28 6c 65 74 20 28 28 61 6c 69 73 (let ((alis
5690: 74 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 t (hash-table
56a0: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 72 65 73 -ref/default res
56b0: 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 curr-section-na
56c0: 6d 65 20 27 28 29 29 29 0a 20 20 20 20 20 20 20 me '())).
56d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
56e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
56f0: 20 20 20 20 20 20 28 76 61 6c 2d 70 72 6f 63 20 (val-proc
5700: 28 6c 61 6d 62 64 61 20 28 29 0a 20 20 20 20 20 (lambda ().
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 20 20 20
5730: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5740: 20 20 20 20 28 6c 65 74 2a 20 28 28 73 74 61 72 (let* ((star
5750: 74 2d 74 69 6d 65 20 28 63 75 72 72 65 6e 74 2d t-time (current-
5760: 73 65 63 6f 6e 64 73 29 29 0a 20 20 20 20 20 20 seconds)).
5770: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5780: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5790: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
57a0: 20 20 20 20 20 20 20 20 20 20 28 6c 6f 63 61 6c (local
57b0: 2d 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 20 28 -allow-system (
57c0: 63 61 6c 63 2d 61 6c 6c 6f 77 2d 73 79 73 74 65 calc-allow-syste
57d0: 6d 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 63 m allow-system c
57e0: 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 urr-section-name
57f0: 20 73 65 63 74 69 6f 6e 73 29 29 0a 20 20 20 20 sections)).
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 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5830: 20 20 20 20 20 20 20 20 20 20 20 20 28 65 6e 76 (env
5840: 2d 64 65 6c 74 61 20 20 28 63 6f 6e 66 69 67 66 -delta (configf
5850: 3a 63 66 67 64 61 74 2d 3e 65 6e 76 2d 61 6c 69 :cfgdat->env-ali
5860: 73 74 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d st curr-section-
5870: 6e 61 6d 65 20 72 65 73 20 6c 6f 63 61 6c 2d 61 name res local-a
5880: 6c 6c 6f 77 2d 73 79 73 74 65 6d 29 29 0a 20 20 llow-system)).
5890: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
58a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
58b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
58c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
58d0: 6d 64 72 65 73 20 20 20 20 20 28 70 72 6f 63 65 mdres (proce
58e0: 73 73 3a 63 6d 64 2d 72 75 6e 2d 3e 6c 69 73 74 ss:cmd-run->list
58f0: 20 63 6d 64 20 64 65 6c 74 61 2d 65 6e 76 2d 61 cmd delta-env-a
5900: 6c 69 73 74 2d 6f 72 2d 68 61 73 68 2d 74 61 62 list-or-hash-tab
5910: 6c 65 3a 20 65 6e 76 2d 64 65 6c 74 61 29 29 20 le: env-delta))
5920: 3b 3b 20 42 42 3a 20 68 65 72 65 20 69 73 20 77 ;; BB: here is w
5930: 68 65 72 65 20 5b 73 79 73 74 65 6d 20 69 73 20 here [system is
5940: 65 78 65 63 27 64 2e 20 20 6e 65 65 64 73 20 74 exec'd. needs t
5950: 6f 20 68 61 76 65 20 65 6e 76 20 66 72 6f 6d 20 o have env from
5960: 6f 74 68 65 72 20 76 61 72 73 21 0a 20 20 20 20 other vars!.
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 20 20 20 20 20 20 20 20 20 20 28 64 65 6c (del
59b0: 74 61 20 20 20 20 20 20 28 2d 20 28 63 75 72 72 ta (- (curr
59c0: 65 6e 74 2d 73 65 63 6f 6e 64 73 29 20 73 74 61 ent-seconds) sta
59d0: 72 74 2d 74 69 6d 65 29 29 0a 20 20 20 20 20 20 rt-time)).
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 20 20 20 20 20 20 20 20
5a10: 20 20 20 20 20 20 20 20 20 20 28 73 74 61 74 75 (statu
5a20: 73 20 20 20 20 20 28 63 61 64 72 20 63 6d 64 72 s (cadr cmdr
5a30: 65 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 es)).
5a40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5a50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5a60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5a70: 20 20 20 20 20 28 72 65 73 20 20 20 20 20 20 20 (res
5a80: 20 28 63 61 72 20 20 63 6d 64 72 65 73 29 29 29 (car cmdres)))
5a90: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
5aa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5ab0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5ac0: 20 20 20 20 20 20 20 20 20 20 20 20 28 64 65 62 (deb
5ad0: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 34 20 ug:print-info 4
5ae0: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
5af0: 74 2a 20 22 22 20 69 6e 6c 20 22 5c 6e 20 3d 3e t* "" inl "\n =>
5b00: 20 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 " (string-inter
5b10: 73 70 65 72 73 65 20 72 65 73 20 22 5c 6e 22 29 sperse res "\n")
5b20: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
5b30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5b40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5b50: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 (if
5b60: 20 28 6e 6f 74 20 28 65 71 3f 20 73 74 61 74 75 (not (eq? statu
5b70: 73 20 30 29 29 0a 20 20 20 20 20 20 20 20 20 20 s 0)).
5b80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5b90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5ba0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5bb0: 20 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 (begin.
5bc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
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 28 64 65 (de
5c00: 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 bug:print-error
5c10: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
5c20: 6f 72 74 2a 20 22 70 72 6f 62 6c 65 6d 20 77 69 ort* "problem wi
5c30: 74 68 20 22 20 69 6e 6c 20 22 2c 20 72 65 74 75 th " inl ", retu
5c40: 72 6e 20 63 6f 64 65 20 22 20 73 74 61 74 75 73 rn code " status
5c50: 0a 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 20 20 20 20 20 20 20 20
5c80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5c90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5ca0: 20 20 20 20 20 22 20 6f 75 74 70 75 74 3a 20 22 " output: "
5cb0: 20 63 6d 64 72 65 73 29 29 29 0a 20 20 20 20 20 cmdres))).
5cc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5cd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5ce0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5cf0: 20 20 20 20 20 20 28 69 66 20 28 3e 20 64 65 6c (if (> del
5d00: 74 61 20 32 29 0a 20 20 20 20 20 20 20 20 20 20 ta 2).
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 20 20 20 20 20 20
5d30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5d40: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
5d50: 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c t-info 0 *defaul
5d60: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 66 6f 72 t-log-port* "for
5d70: 20 6c 69 6e 65 20 5c 22 22 20 69 6e 6c 20 22 5c line \"" inl "\
5d80: 22 5c 6e 20 20 63 6f 6d 6d 61 6e 64 3a 20 22 20 "\n command: "
5d90: 63 6d 64 20 22 20 74 6f 6f 6b 20 22 20 64 65 6c cmd " took " del
5da0: 74 61 20 22 20 73 65 63 6f 6e 64 73 20 74 6f 20 ta " seconds to
5db0: 72 75 6e 20 77 69 74 68 20 6f 75 74 70 75 74 3a run with output:
5dc0: 5c 6e 20 20 20 22 20 72 65 73 29 0a 20 20 20 20 \n " res).
5dd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
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 28 64 65 62 75 (debu
5e10: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 39 20 2a g:print-info 9 *
5e20: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
5e30: 2a 20 22 66 6f 72 20 6c 69 6e 65 20 5c 22 22 20 * "for line \""
5e40: 69 6e 6c 20 22 5c 22 5c 6e 20 20 63 6f 6d 6d 61 inl "\"\n comma
5e50: 6e 64 3a 20 22 20 63 6d 64 20 22 20 74 6f 6f 6b nd: " cmd " took
5e60: 20 22 20 64 65 6c 74 61 20 22 20 73 65 63 6f 6e " delta " secon
5e70: 64 73 20 74 6f 20 72 75 6e 20 77 69 74 68 20 6f ds to run with o
5e80: 75 74 70 75 74 3a 5c 6e 20 20 20 22 20 72 65 73 utput:\n " res
5e90: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
5ea0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
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 28 69 (i
5ed0: 66 20 28 6e 75 6c 6c 3f 20 72 65 73 29 0a 20 20 f (null? res).
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 20 20 20 20 20 20 20 20 20 20 20 20 20
5f10: 20 20 20 20 20 20 20 20 20 20 20 20 20 22 22 0a "".
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 20 20 20 20 20 20 20 20 20 20 20 28 (
5f60: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
5f70: 73 65 20 72 65 73 20 22 20 22 29 29 29 29 29 29 se res " "))))))
5f80: 0a 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 20 20 20 20 20 20 20 28 68 61 73 68 2d (hash-
5fb0: 74 61 62 6c 65 2d 73 65 74 21 20 72 65 73 20 63 table-set! res c
5fc0: 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 urr-section-name
5fd0: 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
5fe0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5ff0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6000: 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e (con
6010: 66 69 67 66 3a 61 73 73 6f 63 2d 73 61 66 65 2d figf:assoc-safe-
6020: 61 64 64 20 61 6c 69 73 74 0a 20 20 20 20 20 20 add alist.
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 20 20 20 20 20 20 20
6070: 20 20 20 20 20 20 20 20 20 20 20 6b 65 79 20 0a key .
6080: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6090: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
60a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
60b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
60c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
60d0: 20 28 63 61 73 65 20 28 63 61 6c 63 2d 61 6c 6c (case (calc-all
60e0: 6f 77 2d 73 79 73 74 65 6d 20 61 6c 6c 6f 77 2d ow-system allow-
60f0: 73 79 73 74 65 6d 20 63 75 72 72 2d 73 65 63 74 system curr-sect
6100: 69 6f 6e 2d 6e 61 6d 65 20 73 65 63 74 69 6f 6e ion-name section
6110: 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 s).
6120: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6130: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
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 28 28 72 65 74 75 72 6e 2d 70 ((return-p
6170: 72 6f 63 73 29 20 76 61 6c 2d 70 72 6f 63 29 0a rocs) val-proc).
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 20 20 20
61c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
61d0: 20 20 20 28 28 72 65 74 75 72 6e 2d 73 74 72 69 ((return-stri
61e0: 6e 67 29 20 63 6d 64 29 0a 20 20 20 20 20 20 20 ng) cmd).
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 20 20 20 20 20 20 20 20
6210: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6220: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6230: 20 20 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 (els
6240: 65 20 28 76 61 6c 2d 70 72 6f 63 29 29 29 0a 20 e (val-proc))).
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 20 20 20 20 20 20
6270: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6280: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6290: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
62a0: 6d 65 74 61 64 61 74 61 3a 20 6d 65 74 61 70 61 metadata: metapa
62b0: 74 68 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 th)).
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 20 20 20 20 20 28 6c (l
62e0: 6f 6f 70 20 28 63 6f 6e 66 69 67 66 3a 72 65 61 oop (configf:rea
62f0: 64 2d 6c 69 6e 65 20 69 6e 70 20 72 65 73 20 28 d-line inp res (
6300: 63 61 6c 63 2d 61 6c 6c 6f 77 2d 73 79 73 74 65 calc-allow-syste
6310: 6d 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 63 m allow-system c
6320: 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 urr-section-name
6330: 20 73 65 63 74 69 6f 6e 73 29 20 73 65 74 74 69 sections) setti
6340: 6e 67 73 20 65 6e 76 2d 74 6f 2d 75 73 65 29 20 ngs env-to-use)
6350: 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d curr-section-nam
6360: 65 20 23 66 20 23 66 29 29 0a 20 20 20 20 20 20 e #f #f)).
6370: 20 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 28 6c 6f 6f 70 20 28 63 6f 6e 66 69 67 66 3a (loop (configf:
63a0: 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 20 72 65 read-line inp re
63b0: 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 s.
63c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
63d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
63e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
63f0: 20 20 28 63 61 6c 63 2d 61 6c 6c 6f 77 2d 73 79 (calc-allow-sy
6400: 73 74 65 6d 20 61 6c 6c 6f 77 2d 73 79 73 74 65 stem allow-syste
6410: 6d 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e m curr-section-n
6420: 61 6d 65 20 73 65 63 74 69 6f 6e 73 29 0a 20 20 ame sections).
6430: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6440: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
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 73 65 se
6470: 74 74 69 6e 67 73 20 65 6e 76 2d 74 6f 2d 75 73 ttings env-to-us
6480: 65 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 e).
6490: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
64a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
64b0: 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d curr-section-nam
64c0: 65 20 23 66 20 23 66 29 29 29 0a 20 20 20 20 20 e #f #f))).
64d0: 20 20 20 20 20 20 20 20 20 20 0a 09 20 20 20 20 ..
64e0: 20 20 20 28 63 6f 6e 66 69 67 66 3a 6b 65 79 2d (configf:key-
64f0: 6e 6f 2d 76 61 6c 20 28 20 78 20 6b 65 79 20 76 no-val ( x key v
6500: 61 6c 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 al).
6510: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6520: 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 61 (let* ((a
6530: 6c 69 73 74 20 20 20 28 68 61 73 68 2d 74 61 62 list (hash-tab
6540: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 72 le-ref/default r
6550: 65 73 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d es curr-section-
6560: 6e 61 6d 65 20 27 28 29 29 29 0a 20 20 20 20 20 name '())).
6570: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6580: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6590: 20 20 20 20 20 28 66 76 61 6c 20 20 20 20 28 6f (fval (o
65a0: 72 20 28 69 66 20 28 73 74 72 69 6e 67 3f 20 76 r (if (string? v
65b0: 61 6c 29 20 76 61 6c 20 23 66 29 20 22 22 29 29 al) val #f) ""))
65c0: 29 20 3b 3b 20 66 76 61 6c 20 73 68 6f 75 6c 64 ) ;; fval should
65d0: 20 62 65 20 65 69 74 68 65 72 20 22 22 20 6f 72 be either "" or
65e0: 20 22 20 22 20 28 6f 6e 65 20 6f 72 20 6d 6f 72 " " (one or mor
65f0: 65 20 73 70 61 63 65 73 29 0a 20 20 20 20 20 20 e spaces).
6600: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6610: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
6620: 64 65 62 75 67 3a 70 72 69 6e 74 20 31 30 20 2a debug:print 10 *
6630: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
6640: 2a 20 22 20 20 20 73 65 74 74 69 6e 67 3a 20 5b * " setting: [
6650: 22 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e " curr-section-n
6660: 61 6d 65 20 22 5d 20 22 20 6b 65 79 20 22 20 3d ame "] " key " =
6670: 20 23 74 22 29 0a 20 20 20 20 20 20 20 20 20 20 #t").
6680: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6690: 20 20 20 20 20 20 20 20 20 20 20 28 73 61 66 65 (safe
66a0: 2d 73 65 74 65 6e 76 20 6b 65 79 20 66 76 61 6c -setenv key fval
66b0: 29 0a 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 20 20 20 20
66d0: 20 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 (hash-tab
66e0: 6c 65 2d 73 65 74 21 20 72 65 73 20 63 75 72 72 le-set! res curr
66f0: 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 0a 20 -section-name .
6700: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6710: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6720: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6730: 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 61 73 (configf:as
6740: 73 6f 63 2d 73 61 66 65 2d 61 64 64 20 61 6c 69 soc-safe-add ali
6750: 73 74 20 6b 65 79 20 66 76 61 6c 20 6d 65 74 61 st key fval meta
6760: 64 61 74 61 3a 20 6d 65 74 61 70 61 74 68 29 29 data: metapath))
6770: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
6780: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6790: 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 6f 6e (loop (con
67a0: 66 69 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 figf:read-line i
67b0: 6e 70 20 72 65 73 0a 20 20 20 20 20 20 20 20 20 np res.
67c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
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 20 20 28 63 61 6c 63 2d 61 6c 6c 6f 77 (calc-allow
6800: 2d 73 79 73 74 65 6d 20 61 6c 6c 6f 77 2d 73 79 -system allow-sy
6810: 73 74 65 6d 20 63 75 72 72 2d 73 65 63 74 69 6f stem curr-sectio
6820: 6e 2d 6e 61 6d 65 20 73 65 63 74 69 6f 6e 73 29 n-name sections)
6830: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
6840: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6850: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6860: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 s
6870: 65 74 74 69 6e 67 73 20 65 6e 76 2d 74 6f 2d 75 ettings env-to-u
6880: 73 65 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 se).
6890: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
68a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 63 c
68b0: 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 urr-section-name
68c0: 20 6b 65 79 20 23 66 29 29 29 0a 20 20 20 20 20 key #f))).
68d0: 20 20 20 20 20 20 20 20 20 20 0a 09 20 20 20 20 ..
68e0: 20 20 20 28 63 6f 6e 66 69 67 66 3a 6b 65 79 2d (configf:key-
68f0: 76 61 6c 2d 70 72 20 28 20 78 20 6b 65 79 20 75 val-pr ( x key u
6900: 6e 6b 31 20 76 61 6c 20 75 6e 6b 32 20 29 0a 20 nk1 val unk2 ).
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 28 6c 65 74 2a 20 28 28 61 6c 69 73 74 20 (let* ((alist
6940: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 (hash-table-re
6950: 66 2f 64 65 66 61 75 6c 74 20 72 65 73 20 63 75 f/default res cu
6960: 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 rr-section-name
6970: 27 28 29 29 29 0a 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 20 20 20 20 20 20 20 20 20 20 20 20 20
69a0: 28 65 6e 76 61 72 20 20 20 28 61 6e 64 20 65 6e (envar (and en
69b0: 76 69 72 6f 6e 2d 70 61 74 74 0a 09 09 09 09 09 viron-patt......
69c0: 09 09 28 73 74 72 69 6e 67 2d 73 65 61 72 63 68 ..(string-search
69d0: 20 28 72 65 67 65 78 70 20 65 6e 76 69 72 6f 6e (regexp environ
69e0: 2d 70 61 74 74 29 20 63 75 72 72 2d 73 65 63 74 -patt) curr-sect
69f0: 69 6f 6e 2d 6e 61 6d 65 29 20 3b 3b 20 64 6f 65 ion-name) ;; doe
6a00: 73 20 74 68 65 20 73 65 63 74 69 6f 6e 20 6d 61 s the section ma
6a10: 74 63 68 20 74 68 65 20 65 6e 76 69 6f 6e 70 61 tch the envionpa
6a20: 74 74 3f 0a 09 09 09 09 09 09 09 28 61 6e 64 20 tt?........(and
6a30: 28 6e 6f 74 20 28 73 74 72 69 6e 67 2d 6e 75 6c (not (string-nul
6a40: 6c 3f 20 6b 65 79 29 29 0a 09 09 09 09 09 09 09 l? key))........
6a50: 20 20 20 20 20 28 6e 6f 74 20 28 65 71 75 61 6c (not (equal
6a60: 3f 20 22 21 22 20 28 73 75 62 73 74 72 69 6e 67 ? "!" (substring
6a70: 20 6b 65 79 20 30 20 31 29 29 29 29 20 3b 3b 20 key 0 1)))) ;;
6a80: 21 20 61 73 20 6c 65 61 64 69 6e 67 20 63 68 61 ! as leading cha
6a90: 72 61 63 74 65 72 20 69 73 20 61 20 73 69 67 6e racter is a sign
6aa0: 61 74 75 72 65 20 74 6f 20 4e 4f 54 20 65 78 70 ature to NOT exp
6ab0: 6f 72 74 20 74 6f 20 74 68 65 20 65 6e 76 69 72 ort to the envir
6ac0: 6f 6e 6d 65 6e 74 0a 09 09 09 09 09 09 09 3b 3b onment........;;
6ad0: 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 22 (string-match "
6ae0: 5e 2e 2a 3a 2e 2a 3a 2e 2a 24 22 20 6b 65 79 29 ^.*:.*:.*$" key)
6af0: 20 3b 3b 20 3b 3b 20 73 6f 6d 65 74 68 69 6e 67 ;; ;; something
6b00: 3a 73 6f 6d 65 74 68 69 6e 67 3a 73 6f 6d 65 74 :something:somet
6b10: 68 69 6e 67 20 72 65 73 65 72 76 65 64 20 66 6f hing reserved fo
6b20: 72 20 74 72 69 67 67 65 72 73 20 69 6e 20 72 75 r triggers in ru
6b30: 6e 63 6f 6e 66 69 67 73 0a 09 09 09 09 09 09 09 nconfigs........
6b40: 29 29 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 )) .
6b50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6b60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 72 (r
6b70: 65 61 6c 76 61 6c 20 28 69 66 20 65 6e 76 61 72 ealval (if envar
6b80: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
6b90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6ba0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6bb0: 20 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 66 (configf
6bc0: 3a 65 76 61 6c 2d 73 74 72 69 6e 67 2d 69 6e 2d :eval-string-in-
6bd0: 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 76 61 6c 29 environment val)
6be0: 0a 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 20 20
6c00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6c10: 20 20 20 20 20 20 20 20 76 61 6c 29 29 29 0a 20 val))).
6c20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6c30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6c40: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
6c50: 2d 69 6e 66 6f 20 36 20 2a 64 65 66 61 75 6c 74 -info 6 *default
6c60: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 63 6f 6e 66 -log-port* "conf
6c70: 69 67 66 3a 72 65 61 64 2d 63 6f 6e 66 69 67 20 igf:read-config
6c80: 65 6e 76 20 73 65 74 74 69 6e 67 2c 20 65 6e 76 env setting, env
6c90: 61 72 3a 20 22 20 65 6e 76 61 72 20 22 20 72 65 ar: " envar " re
6ca0: 61 6c 76 61 6c 3a 20 22 20 72 65 61 6c 76 61 6c alval: " realval
6cb0: 20 22 20 76 61 6c 3a 20 22 20 76 61 6c 20 22 20 " val: " val "
6cc0: 6b 65 79 3a 20 22 20 6b 65 79 20 22 20 63 75 72 key: " key " cur
6cd0: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 3a 20 r-section-name:
6ce0: 22 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e " curr-section-n
6cf0: 61 6d 65 29 0a 20 20 20 20 20 20 20 20 20 20 20 ame).
6d00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6d10: 20 20 20 20 20 20 20 20 20 20 28 69 66 20 65 6e (if en
6d20: 76 61 72 20 28 73 61 66 65 2d 73 65 74 65 6e 76 var (safe-setenv
6d30: 20 6b 65 79 20 72 65 61 6c 76 61 6c 29 29 0a 20 key realval)).
6d40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6d50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6d60: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
6d70: 20 31 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 10 *default-log
6d80: 2d 70 6f 72 74 2a 20 22 20 20 20 73 65 74 74 69 -port* " setti
6d90: 6e 67 3a 20 5b 22 20 63 75 72 72 2d 73 65 63 74 ng: [" curr-sect
6da0: 69 6f 6e 2d 6e 61 6d 65 20 22 5d 20 22 20 6b 65 ion-name "] " ke
6db0: 79 20 22 20 3d 20 22 20 76 61 6c 29 0a 20 20 20 y " = " val).
6dc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6dd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6de0: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 (hash-table-se
6df0: 74 21 20 72 65 73 20 63 75 72 72 2d 73 65 63 74 t! res curr-sect
6e00: 69 6f 6e 2d 6e 61 6d 65 20 0a 20 20 20 20 20 20 ion-name .
6e10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6e20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6e30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6e40: 28 63 6f 6e 66 69 67 66 3a 61 73 73 6f 63 2d 73 (configf:assoc-s
6e50: 61 66 65 2d 61 64 64 20 61 6c 69 73 74 20 6b 65 afe-add alist ke
6e60: 79 20 72 65 61 6c 76 61 6c 20 6d 65 74 61 64 61 y realval metada
6e70: 74 61 3a 20 6d 65 74 61 70 61 74 68 29 29 0a 20 ta: metapath)).
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 20 20 28 6c 6f 6f 70 20 28 63 6f 6e 66 69 (loop (confi
6eb0: 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 gf:read-line inp
6ec0: 20 72 65 73 0a 20 20 20 20 20 20 20 20 20 20 20 res.
6ed0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6ee0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6ef0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6f00: 20 20 20 28 63 61 6c 63 2d 61 6c 6c 6f 77 2d 73 (calc-allow-s
6f10: 79 73 74 65 6d 20 61 6c 6c 6f 77 2d 73 79 73 74 ystem allow-syst
6f20: 65 6d 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d em curr-section-
6f30: 6e 61 6d 65 20 73 65 63 74 69 6f 6e 73 29 20 73 name sections) s
6f40: 65 74 74 69 6e 67 73 20 65 6e 76 2d 74 6f 2d 75 ettings env-to-u
6f50: 73 65 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 se).
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 20 20 20 20 20 20 20 63 c
6f80: 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 urr-section-name
6f90: 20 6b 65 79 20 23 66 29 29 29 0a 09 20 20 20 20 key #f)))..
6fa0: 20 20 20 3b 3b 20 69 66 20 61 20 63 6f 6e 74 69 ;; if a conti
6fb0: 6e 75 65 64 20 6c 69 6e 65 0a 09 20 20 20 20 20 nued line..
6fc0: 20 20 28 63 6f 6e 66 69 67 66 3a 63 6f 6e 74 2d (configf:cont-
6fd0: 6c 6e 2d 72 78 20 28 20 78 20 77 68 73 70 20 76 ln-rx ( x whsp v
6fe0: 61 6c 20 20 20 20 20 29 0a 20 20 20 20 20 20 20 al ).
6ff0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7000: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 (let
7010: 20 28 28 61 6c 69 73 74 20 28 68 61 73 68 2d 74 ((alist (hash-t
7020: 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 able-ref/default
7030: 20 72 65 73 20 63 75 72 72 2d 73 65 63 74 69 6f res curr-sectio
7040: 6e 2d 6e 61 6d 65 20 27 28 29 29 29 29 0a 20 20 n-name '()))).
7050: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7060: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7070: 20 20 20 28 69 66 20 76 61 72 2d 66 6c 61 67 20 (if var-flag
7080: 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 69 ;; i
7090: 66 20 73 65 74 20 74 6f 20 61 20 73 74 72 69 6e f set to a strin
70a0: 67 20 74 68 65 6e 20 77 65 20 68 61 76 65 20 61 g then we have a
70b0: 20 63 6f 6e 74 69 6e 75 65 64 20 76 61 72 0a 20 continued var.
70c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
70d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
70e0: 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 6e (let ((n
70f0: 65 77 76 61 6c 20 28 63 6f 6e 63 20 0a 20 20 20 ewval (conc .
7100: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7110: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7120: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7130: 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 6c 6f (configf:lo
7140: 6f 6b 75 70 20 72 65 73 20 63 75 72 72 2d 73 65 okup res curr-se
7150: 63 74 69 6f 6e 2d 6e 61 6d 65 20 76 61 72 2d 66 ction-name var-f
7160: 6c 61 67 29 20 22 5c 6e 22 0a 20 20 20 20 20 20 lag) "\n".
7170: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7180: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7190: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
71a0: 20 20 3b 3b 20 74 72 69 6d 20 6c 65 61 64 20 66 ;; trim lead f
71b0: 72 6f 6d 20 74 68 65 20 69 6e 63 6f 6d 69 6e 67 rom the incoming
71c0: 20 77 68 73 70 20 74 6f 20 73 75 70 70 6f 72 74 whsp to support
71d0: 20 73 6f 6d 65 20 69 6e 64 65 6e 74 69 6e 67 2e some indenting.
71e0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
71f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7200: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7210: 20 20 20 20 20 20 20 20 20 28 69 66 20 6c 65 61 (if lea
7220: 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 d.
7230: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7240: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7250: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 (s
7260: 74 72 69 6e 67 2d 73 75 62 73 74 69 74 75 74 65 tring-substitute
7270: 20 28 72 65 67 65 78 70 20 6c 65 61 64 29 20 22 (regexp lead) "
7280: 22 20 77 68 73 70 29 0a 20 20 20 20 20 20 20 20 " whsp).
7290: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
72a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
72b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
72c0: 20 20 20 20 22 22 29 0a 20 20 20 20 20 20 20 20 "").
72d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
72e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
72f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7300: 76 61 6c 29 29 29 0a 20 20 20 20 20 20 20 20 20 val))).
7310: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7320: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7330: 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 76 61 6c ;; (print "val
7340: 3a 20 22 20 76 61 6c 20 22 5c 6e 6e 65 77 76 61 : " val "\nnewva
7350: 6c 3a 20 5c 22 22 20 6e 65 77 76 61 6c 20 22 5c l: \"" newval "\
7360: 22 5c 6e 76 61 72 66 6c 61 67 3a 20 22 20 76 61 "\nvarflag: " va
7370: 72 2d 66 6c 61 67 29 0a 20 20 20 20 20 20 20 20 r-flag).
7380: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7390: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
73a0: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 (hash-table-s
73b0: 65 74 21 20 72 65 73 20 63 75 72 72 2d 73 65 63 et! res curr-sec
73c0: 74 69 6f 6e 2d 6e 61 6d 65 20 0a 20 20 20 20 20 tion-name .
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: 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a (configf:
7410: 61 73 73 6f 63 2d 73 61 66 65 2d 61 64 64 20 61 assoc-safe-add a
7420: 6c 69 73 74 20 76 61 72 2d 66 6c 61 67 20 6e 65 list var-flag ne
7430: 77 76 61 6c 20 6d 65 74 61 64 61 74 61 3a 20 6d wval metadata: m
7440: 65 74 61 70 61 74 68 29 29 0a 20 20 20 20 20 20 etapath)).
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 28 6c 6f 6f 70 20 28 63 6f 6e 66 (loop (conf
7480: 69 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e igf:read-line in
7490: 70 20 72 65 73 20 28 63 61 6c 63 2d 61 6c 6c 6f p res (calc-allo
74a0: 77 2d 73 79 73 74 65 6d 20 61 6c 6c 6f 77 2d 73 w-system allow-s
74b0: 79 73 74 65 6d 20 63 75 72 72 2d 73 65 63 74 69 ystem curr-secti
74c0: 6f 6e 2d 6e 61 6d 65 20 73 65 63 74 69 6f 6e 73 on-name sections
74d0: 29 20 73 65 74 74 69 6e 67 73 20 65 6e 76 2d 74 ) settings env-t
74e0: 6f 2d 75 73 65 29 20 63 75 72 72 2d 73 65 63 74 o-use) curr-sect
74f0: 69 6f 6e 2d 6e 61 6d 65 20 76 61 72 2d 66 6c 61 ion-name var-fla
7500: 67 20 28 69 66 20 6c 65 61 64 20 6c 65 61 64 20 g (if lead lead
7510: 77 68 73 70 29 29 29 0a 20 20 20 20 20 20 20 20 whsp))).
7520: 20 20 20 20 20 20 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 28 6c 6f 6f 70 20 28 63 6f 6e 66 69 67 66 3a (loop (configf:
7550: 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 20 72 65 read-line inp re
7560: 73 20 28 63 61 6c 63 2d 61 6c 6c 6f 77 2d 73 79 s (calc-allow-sy
7570: 73 74 65 6d 20 61 6c 6c 6f 77 2d 73 79 73 74 65 stem allow-syste
7580: 6d 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e m curr-section-n
7590: 61 6d 65 20 73 65 63 74 69 6f 6e 73 29 20 73 65 ame sections) se
75a0: 74 74 69 6e 67 73 20 65 6e 76 2d 74 6f 2d 75 73 ttings env-to-us
75b0: 65 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d e) curr-section-
75c0: 6e 61 6d 65 20 23 66 20 23 66 29 29 29 29 0a 09 name #f #f))))..
75d0: 20 20 20 20 20 20 20 28 65 6c 73 65 20 28 64 65 (else (de
75e0: 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 bug:print-error
75f0: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
7600: 6f 72 74 2a 20 22 70 72 6f 62 6c 65 6d 20 70 61 ort* "problem pa
7610: 72 73 69 6e 67 20 22 20 70 61 74 68 20 22 2c 5c rsing " path ",\
7620: 6e 20 20 20 5c 22 22 20 69 6e 6c 20 22 5c 22 22 n \"" inl "\""
7630: 29 0a 09 09 20 20 20 20 20 28 73 65 74 21 20 76 )... (set! v
7640: 61 72 2d 66 6c 61 67 20 23 66 29 0a 09 09 20 20 ar-flag #f)...
7650: 20 20 20 28 6c 6f 6f 70 20 28 63 6f 6e 66 69 67 (loop (config
7660: 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 20 f:read-line inp
7670: 72 65 73 20 28 63 61 6c 63 2d 61 6c 6c 6f 77 2d res (calc-allow-
7680: 73 79 73 74 65 6d 20 61 6c 6c 6f 77 2d 73 79 73 system allow-sys
7690: 74 65 6d 20 63 75 72 72 2d 73 65 63 74 69 6f 6e tem curr-section
76a0: 2d 6e 61 6d 65 20 73 65 63 74 69 6f 6e 73 29 20 -name sections)
76b0: 73 65 74 74 69 6e 67 73 20 65 6e 76 2d 74 6f 2d settings env-to-
76c0: 75 73 65 29 20 63 75 72 72 2d 73 65 63 74 69 6f use) curr-sectio
76d0: 6e 2d 6e 61 6d 65 20 23 66 20 23 66 29 29 29 29 n-name #f #f))))
76e0: 0a 20 20 20 20 20 20 20 20 20 20 29 20 3b 3b 20 . ) ;;
76f0: 65 6e 64 20 6c 6f 6f 70 0a 20 20 20 20 20 20 20 end loop.
7700: 20 29 29 29 0a 20 20 0a 3b 3b 3d 3d 3d 3d 3d 3d ))). .;;======
7710: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7720: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7730: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7740: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7750: 0a 3b 3b 20 6c 6f 6f 6b 75 70 20 61 6e 64 20 6d .;; lookup and m
7760: 61 6e 69 70 75 6c 61 74 69 6f 6e 20 72 6f 75 74 anipulation rout
7770: 69 6e 65 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d ines.;;=========
7780: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7790: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
77a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
77b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b =============..;
77c0: 3b 20 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 ; (define (confi
77d0: 67 66 3a 61 73 73 6f 63 2d 73 61 66 65 2d 61 64 gf:assoc-safe-ad
77e0: 64 20 61 6c 69 73 74 20 6b 65 79 20 76 61 6c 20 d alist key val
77f0: 23 21 6b 65 79 20 28 6d 65 74 61 64 61 74 61 20 #!key (metadata
7800: 23 66 29 29 0a 3b 3b 20 20 20 28 6c 65 74 20 28 #f)).;; (let (
7810: 28 6e 65 77 61 6c 69 73 74 20 28 66 69 6c 74 65 (newalist (filte
7820: 72 20 28 6c 61 6d 62 64 61 20 28 78 29 28 6e 6f r (lambda (x)(no
7830: 74 20 28 65 71 75 61 6c 3f 20 6b 65 79 20 28 63 t (equal? key (c
7840: 61 72 20 78 29 29 29 29 20 61 6c 69 73 74 29 29 ar x)))) alist))
7850: 29 0a 3b 3b 20 20 20 20 20 28 61 70 70 65 6e 64 ).;; (append
7860: 20 6e 65 77 61 6c 69 73 74 20 28 6c 69 73 74 20 newalist (list
7870: 28 69 66 20 6d 65 74 61 64 61 74 61 0a 3b 3b 20 (if metadata.;;
7880: 09 09 09 20 20 20 20 20 20 20 28 6c 69 73 74 20 ... (list
7890: 6b 65 79 20 76 61 6c 20 6d 65 74 61 64 61 74 61 key val metadata
78a0: 29 0a 3b 3b 20 09 09 09 20 20 20 20 20 20 20 28 ).;; ... (
78b0: 6c 69 73 74 20 6b 65 79 20 76 61 6c 29 29 29 29 list key val))))
78c0: 29 29 0a 3b 3b 20 0a 3b 3b 20 28 64 65 66 69 6e )).;; .;; (defin
78d0: 65 20 28 63 6f 6e 66 69 67 66 3a 73 65 63 74 69 e (configf:secti
78e0: 6f 6e 2d 76 61 72 2d 73 65 74 21 20 63 66 67 64 on-var-set! cfgd
78f0: 61 74 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 at section-name
7900: 76 61 72 20 76 61 6c 75 65 20 23 21 6b 65 79 20 var value #!key
7910: 28 6d 65 74 61 64 61 74 61 20 23 66 29 29 0a 3b (metadata #f)).;
7920: 3b 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d ; (hash-table-
7930: 73 65 74 21 20 63 66 67 64 61 74 20 73 65 63 74 set! cfgdat sect
7940: 69 6f 6e 2d 6e 61 6d 65 0a 3b 3b 20 09 09 20 20 ion-name.;; ..
7950: 20 28 63 6f 6e 66 69 67 66 3a 61 73 73 6f 63 2d (configf:assoc-
7960: 73 61 66 65 2d 61 64 64 0a 3b 3b 20 09 09 20 20 safe-add.;; ..
7970: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 (hash-table-re
7980: 66 2f 64 65 66 61 75 6c 74 20 63 66 67 64 61 74 f/default cfgdat
7990: 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 27 28 section-name '(
79a0: 29 29 0a 3b 3b 20 09 09 20 20 20 20 76 61 72 20 )).;; .. var
79b0: 76 61 6c 75 65 20 6d 65 74 61 64 61 74 61 3a 20 value metadata:
79c0: 6d 65 74 61 64 61 74 61 29 29 29 0a 3b 3b 20 0a metadata))).;; .
79d0: 3b 3b 20 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 ;; (define (conf
79e0: 69 67 66 3a 6c 6f 6f 6b 75 70 20 63 66 67 64 61 igf:lookup cfgda
79f0: 74 20 73 65 63 74 69 6f 6e 20 76 61 72 29 0a 3b t section var).;
7a00: 3b 20 20 20 28 69 66 20 28 68 61 73 68 2d 74 61 ; (if (hash-ta
7a10: 62 6c 65 3f 20 63 66 67 64 61 74 29 0a 3b 3b 20 ble? cfgdat).;;
7a20: 20 20 20 20 20 20 28 6c 65 74 20 28 28 73 65 63 (let ((sec
7a30: 74 64 61 74 20 28 68 61 73 68 2d 74 61 62 6c 65 tdat (hash-table
7a40: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 63 66 67 -ref/default cfg
7a50: 64 61 74 20 73 65 63 74 69 6f 6e 20 27 28 29 29 dat section '())
7a60: 29 29 0a 3b 3b 20 09 28 69 66 20 28 6e 75 6c 6c )).;; .(if (null
7a70: 3f 20 73 65 63 74 64 61 74 29 0a 3b 3b 20 09 20 ? sectdat).;; .
7a80: 20 20 20 23 66 0a 3b 3b 20 09 20 20 20 20 28 6c #f.;; . (l
7a90: 65 74 20 28 28 6d 61 74 63 68 20 28 61 73 73 6f et ((match (asso
7aa0: 63 20 76 61 72 20 73 65 63 74 64 61 74 29 29 29 c var sectdat)))
7ab0: 0a 3b 3b 20 09 20 20 20 20 20 20 28 69 66 20 6d .;; . (if m
7ac0: 61 74 63 68 20 3b 3b 20 28 61 6e 64 20 6d 61 74 atch ;; (and mat
7ad0: 63 68 20 28 6c 69 73 74 3f 20 6d 61 74 63 68 29 ch (list? match)
7ae0: 28 3e 20 28 6c 65 6e 67 74 68 20 6d 61 74 63 68 (> (length match
7af0: 29 20 31 29 29 0a 3b 3b 20 09 09 20 20 28 63 61 ) 1)).;; .. (ca
7b00: 64 72 20 6d 61 74 63 68 29 0a 3b 3b 20 09 09 20 dr match).;; ..
7b10: 20 23 66 29 29 0a 3b 3b 20 09 20 20 20 20 29 29 #f)).;; . ))
7b20: 0a 3b 3b 20 20 20 20 20 20 20 23 66 29 29 0a 3b .;; #f)).;
7b30: 3b 20 0a 3b 3b 20 3b 3b 20 75 73 65 20 74 6f 20 ; .;; ;; use to
7b40: 68 61 76 65 20 64 65 66 69 6e 69 74 69 76 65 20 have definitive
7b50: 73 65 74 74 69 6e 67 3a 0a 3b 3b 20 3b 3b 20 20 setting:.;; ;;
7b60: 5b 66 6f 6f 5d 0a 3b 3b 20 3b 3b 20 20 76 61 72 [foo].;; ;; var
7b70: 20 79 65 73 0a 3b 3b 20 3b 3b 0a 3b 3b 20 3b 3b yes.;; ;;.;; ;;
7b80: 20 20 28 63 6f 6e 66 69 67 66 3a 76 61 72 2d 69 (configf:var-i
7b90: 73 3f 20 63 66 67 64 61 74 20 22 66 6f 6f 22 20 s? cfgdat "foo"
7ba0: 22 76 61 72 22 20 22 79 65 73 22 29 20 3d 3e 20 "var" "yes") =>
7bb0: 23 74 0a 3b 3b 20 3b 3b 0a 3b 3b 20 28 64 65 66 #t.;; ;;.;; (def
7bc0: 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a 76 61 72 ine (configf:var
7bd0: 2d 69 73 3f 20 63 66 67 64 61 74 20 73 65 63 74 -is? cfgdat sect
7be0: 69 6f 6e 20 76 61 72 20 65 78 70 65 63 74 65 64 ion var expected
7bf0: 2d 76 61 6c 29 0a 3b 3b 20 20 20 28 65 71 75 61 -val).;; (equa
7c00: 6c 3f 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b l? (configf:look
7c10: 75 70 20 63 66 67 64 61 74 20 73 65 63 74 69 6f up cfgdat sectio
7c20: 6e 20 76 61 72 29 20 65 78 70 65 63 74 65 64 2d n var) expected-
7c30: 76 61 6c 29 29 0a 3b 3b 20 0a 0a 3b 3b 20 3b 3b val)).;; ..;; ;;
7c40: 20 73 61 66 65 6c 79 20 6c 6f 6f 6b 20 75 70 20 safely look up
7c50: 61 20 76 61 6c 75 65 20 74 68 61 74 20 69 73 20 a value that is
7c60: 65 78 70 65 63 74 65 64 20 74 6f 20 62 65 20 61 expected to be a
7c70: 20 6e 75 6d 62 65 72 2c 20 72 65 74 75 72 6e 0a number, return.
7c80: 3b 3b 20 3b 3b 20 61 20 64 65 66 61 75 6c 74 20 ;; ;; a default
7c90: 28 23 66 20 75 6e 6c 65 73 73 20 70 72 6f 76 69 (#f unless provi
7ca0: 64 65 64 29 0a 3b 3b 20 3b 3b 0a 3b 3b 20 28 64 ded).;; ;;.;; (d
7cb0: 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a 6c efine (configf:l
7cc0: 6f 6f 6b 75 70 2d 6e 75 6d 62 65 72 20 63 66 64 ookup-number cfd
7cd0: 61 74 20 73 65 63 74 69 6f 6e 20 76 61 72 6e 61 at section varna
7ce0: 6d 65 20 23 21 6b 65 79 20 28 64 65 66 61 75 6c me #!key (defaul
7cf0: 74 20 23 66 29 29 0a 3b 3b 20 20 20 28 6c 65 74 t #f)).;; (let
7d00: 2a 20 28 28 76 61 6c 20 28 63 6f 6e 66 69 67 66 * ((val (configf
7d10: 3a 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 :lookup *configd
7d20: 61 74 2a 20 73 65 63 74 69 6f 6e 20 76 61 72 6e at* section varn
7d30: 61 6d 65 29 29 0a 3b 3b 20 20 20 20 20 20 20 20 ame)).;;
7d40: 20 20 28 72 65 73 20 28 69 66 20 76 61 6c 0a 3b (res (if val.;
7d50: 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;
7d60: 20 20 20 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d (string->num
7d70: 62 65 72 20 28 73 74 72 69 6e 67 2d 73 75 62 73 ber (string-subs
7d80: 74 69 74 75 74 65 20 22 5c 5c 73 2b 22 20 22 22 titute "\\s+" ""
7d90: 20 76 61 6c 20 23 74 29 29 0a 3b 3b 20 20 20 20 val #t)).;;
7da0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 23 #
7db0: 66 29 29 29 0a 3b 3b 20 20 20 20 20 28 63 6f 6e f))).;; (con
7dc0: 64 0a 3b 3b 20 20 20 20 20 20 28 72 65 73 20 20 d.;; (res
7dd0: 72 65 73 29 0a 3b 3b 20 20 20 20 20 20 28 76 61 res).;; (va
7de0: 6c 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 l (debug:print
7df0: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
7e00: 6f 72 74 2a 20 22 45 52 52 4f 52 3a 20 6e 6f 20 ort* "ERROR: no
7e10: 6e 75 6d 62 65 72 20 66 6f 75 6e 64 20 66 6f 72 number found for
7e20: 20 5b 22 20 73 65 63 74 69 6f 6e 20 22 5d 2c 20 [" section "],
7e30: 22 20 76 61 72 6e 61 6d 65 20 22 2c 20 67 6f 74 " varname ", got
7e40: 3a 20 22 20 76 61 6c 29 29 0a 3b 3b 20 20 20 20 : " val)).;;
7e50: 20 20 28 65 6c 73 65 20 64 65 66 61 75 6c 74 29 (else default)
7e60: 29 29 29 0a 3b 3b 20 0a 3b 3b 20 28 64 65 66 69 ))).;; .;; (defi
7e70: 6e 65 20 28 63 6f 6e 66 69 67 66 3a 73 65 63 74 ne (configf:sect
7e80: 69 6f 6e 2d 76 61 72 73 20 63 66 67 64 61 74 20 ion-vars cfgdat
7e90: 73 65 63 74 69 6f 6e 29 0a 3b 3b 20 20 20 28 6c section).;; (l
7ea0: 65 74 20 28 28 73 65 63 74 64 61 74 20 28 68 61 et ((sectdat (ha
7eb0: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def
7ec0: 61 75 6c 74 20 63 66 67 64 61 74 20 73 65 63 74 ault cfgdat sect
7ed0: 69 6f 6e 20 27 28 29 29 29 29 0a 3b 3b 20 20 20 ion '()))).;;
7ee0: 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 73 65 63 (if (null? sec
7ef0: 74 64 61 74 29 0a 3b 3b 20 09 27 28 29 0a 3b 3b tdat).;; .'().;;
7f00: 20 09 28 6d 61 70 20 63 61 72 20 73 65 63 74 64 .(map car sectd
7f10: 61 74 29 29 29 29 0a 3b 3b 20 0a 3b 3b 20 28 64 at)))).;; .;; (d
7f20: 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a 67 efine (configf:g
7f30: 65 74 2d 73 65 63 74 69 6f 6e 20 63 66 67 64 61 et-section cfgda
7f40: 74 20 73 65 63 74 69 6f 6e 29 0a 3b 3b 20 20 20 t section).;;
7f50: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/
7f60: 64 65 66 61 75 6c 74 20 63 66 67 64 61 74 20 73 default cfgdat s
7f70: 65 63 74 69 6f 6e 20 27 28 29 29 29 0a 3b 3b 20 ection '())).;;
7f80: 0a 3b 3b 20 28 64 65 66 69 6e 65 20 28 63 6f 6e .;; (define (con
7f90: 66 69 67 66 3a 73 65 74 2d 73 65 63 74 69 6f 6e figf:set-section
7fa0: 2d 76 61 72 20 63 66 67 64 61 74 20 73 65 63 74 -var cfgdat sect
7fb0: 69 6f 6e 20 76 61 72 20 76 61 6c 29 0a 3b 3b 20 ion var val).;;
7fc0: 20 20 28 6c 65 74 20 28 28 73 65 63 74 64 61 74 (let ((sectdat
7fd0: 20 28 63 6f 6e 66 69 67 66 3a 67 65 74 2d 73 65 (configf:get-se
7fe0: 63 74 69 6f 6e 20 63 66 67 64 61 74 20 73 65 63 ction cfgdat sec
7ff0: 74 69 6f 6e 29 29 29 0a 3b 3b 20 20 20 20 20 28 tion))).;; (
8000: 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 hash-table-set!
8010: 63 66 67 64 61 74 20 73 65 63 74 69 6f 6e 0a 3b cfgdat section.;
8020: 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;
8030: 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a (configf:
8040: 61 73 73 6f 63 2d 73 61 66 65 2d 61 64 64 20 73 assoc-safe-add s
8050: 65 63 74 64 61 74 20 76 61 72 20 76 61 6c 29 29 ectdat var val))
8060: 29 29 0a 3b 3b 20 0a 3b 3b 20 20 20 20 20 3b 3b )).;; .;; ;;
8070: 28 61 70 70 65 6e 64 20 28 66 69 6c 74 65 72 20 (append (filter
8080: 28 6c 61 6d 62 64 61 20 28 78 29 28 6e 6f 74 20 (lambda (x)(not
8090: 28 61 73 73 6f 63 20 76 61 72 20 73 65 63 74 64 (assoc var sectd
80a0: 61 74 29 29 29 20 73 65 63 74 64 61 74 29 0a 3b at))) sectdat).;
80b0: 3b 20 20 20 20 20 3b 3b 09 20 20 20 20 28 6c 69 ; ;;. (li
80c0: 73 74 20 76 61 72 20 76 61 6c 29 29 29 29 0a 3b st var val)))).;
80d0: 3b 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ; .;;===========
80e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
80f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8100: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8110: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 73 ===========.;; s
8120: 65 74 75 70 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d etup.;;=========
8130: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8140: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8150: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8160: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
8170: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8180: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8190: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
81a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
81b0: 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 54 68 69 73 20 ======..;; This
81c0: 73 68 6f 75 6c 64 20 6e 6f 74 20 62 65 20 68 65 should not be he
81d0: 72 65 2e 0a 23 3b 28 64 65 66 69 6e 65 20 28 73 re..#;(define (s
81e0: 65 74 75 70 29 0a 20 20 28 6c 65 74 2a 20 28 28 etup). (let* ((
81f0: 63 6f 6e 66 69 67 66 20 28 66 69 6e 64 2d 63 6f configf (find-co
8200: 6e 66 69 67 20 22 6d 65 67 61 74 65 73 74 2e 63 nfig "megatest.c
8210: 6f 6e 66 69 67 22 29 29 0a 09 20 28 63 6f 6e 66 onfig")).. (conf
8220: 69 67 20 20 28 69 66 20 63 6f 6e 66 69 67 66 20 ig (if configf
8230: 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d 63 6f (configf:read-co
8240: 6e 66 69 67 20 63 6f 6e 66 69 67 66 20 23 66 20 nfig configf #f
8250: 23 74 29 20 23 66 29 29 29 0a 20 20 20 20 28 69 #t) #f))). (i
8260: 66 20 63 6f 6e 66 69 67 0a 09 28 73 65 74 65 6e f config..(seten
8270: 76 20 22 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 v "RUN_AREA_HOME
8280: 22 20 28 70 61 74 68 6e 61 6d 65 2d 64 69 72 65 " (pathname-dire
8290: 63 74 6f 72 79 20 63 6f 6e 66 69 67 66 29 29 29 ctory configf)))
82a0: 0a 20 20 20 20 63 6f 6e 66 69 67 29 29 0a 0a 28 . config))..(
82b0: 64 65 66 69 6e 65 20 28 73 61 66 65 2d 73 65 74 define (safe-set
82c0: 65 6e 76 20 6b 65 79 20 76 61 6c 29 0a 20 20 28 env key val). (
82d0: 69 66 20 28 6f 72 20 28 73 75 62 73 74 72 69 6e if (or (substrin
82e0: 67 2d 69 6e 64 65 78 20 22 21 22 20 6b 65 79 29 g-index "!" key)
82f0: 0a 09 20 20 28 73 75 62 73 74 72 69 6e 67 2d 69 .. (substring-i
8300: 6e 64 65 78 20 22 3a 22 20 6b 65 79 29 20 20 3b ndex ":" key) ;
8310: 3b 20 76 61 72 69 61 62 6c 65 73 20 63 6f 6e 74 ; variables cont
8320: 61 69 6e 69 6e 67 20 3a 20 61 72 65 20 66 6f 72 aining : are for
8330: 20 69 6e 74 65 72 6e 61 6c 20 75 73 65 20 61 6e internal use an
8340: 64 20 63 61 6e 6e 6f 74 20 62 65 20 65 6e 76 69 d cannot be envi
8350: 72 6f 6e 6d 65 6e 74 20 76 61 72 69 61 62 6c 65 ronment variable
8360: 73 2e 0a 09 20 20 28 73 75 62 73 74 72 69 6e 67 s... (substring
8370: 2d 69 6e 64 65 78 20 22 2e 22 20 6b 65 79 29 29 -index "." key))
8380: 20 3b 3b 20 70 65 72 69 6f 64 73 20 61 72 65 20 ;; periods are
8390: 6e 6f 74 20 61 6c 6c 6f 77 65 64 20 69 6e 20 65 not allowed in e
83a0: 6e 76 69 72 6f 6e 6d 65 6e 74 20 76 61 72 69 61 nvironment varia
83b0: 62 6c 65 73 0a 20 20 20 20 20 20 28 64 65 62 75 bles. (debu
83c0: 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 34 20 g:print-error 4
83d0: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
83e0: 74 2a 20 22 73 6b 69 70 20 73 65 74 74 69 6e 67 t* "skip setting
83f0: 20 69 6e 74 65 72 6e 61 6c 20 75 73 65 20 6f 6e internal use on
8400: 6c 79 20 76 61 72 69 61 62 6c 65 73 20 63 6f 6e ly variables con
8410: 74 61 69 6e 69 6e 67 20 5c 22 3a 5c 22 20 6f 72 taining \":\" or
8420: 20 73 74 61 72 74 69 6e 67 20 77 69 74 68 20 5c starting with \
8430: 22 21 5c 22 22 29 0a 20 20 20 20 20 20 28 69 66 "!\""). (if
8440: 20 28 61 6e 64 20 28 73 74 72 69 6e 67 3f 20 76 (and (string? v
8450: 61 6c 29 0a 09 20 20 20 20 20 20 20 28 73 74 72 al).. (str
8460: 69 6e 67 3f 20 6b 65 79 29 29 0a 09 20 20 28 68 ing? key)).. (h
8470: 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 andle-exceptions
8480: 0a 09 20 20 20 20 20 20 65 78 6e 0a 09 20 20 20 .. exn..
8490: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d (debug:print-
84a0: 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 error 0 *default
84b0: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 62 61 64 20 -log-port* "bad
84c0: 76 61 6c 75 65 20 66 6f 72 20 73 65 74 65 6e 76 value for setenv
84d0: 2c 20 6b 65 79 3d 22 20 6b 65 79 20 22 2c 20 76 , key=" key ", v
84e0: 61 6c 75 65 3d 22 20 76 61 6c 20 22 2c 20 65 78 alue=" val ", ex
84f0: 6e 3d 22 20 65 78 6e 29 0a 09 20 20 20 20 28 73 n=" exn).. (s
8500: 65 74 65 6e 76 20 6b 65 79 20 76 61 6c 29 29 0a etenv key val)).
8510: 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d . (debug:print-
8520: 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 error 0 *default
8530: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 62 61 64 20 -log-port* "bad
8540: 76 61 6c 75 65 20 66 6f 72 20 73 65 74 65 6e 76 value for setenv
8550: 2c 20 6b 65 79 3d 22 20 6b 65 79 20 22 2c 20 76 , key=" key ", v
8560: 61 6c 75 65 3d 22 20 76 61 6c 29 29 29 29 0a 0a alue=" val))))..
8570: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
8580: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8590: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
85a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
85b0: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 61 63 63 65 ========.;; acce
85c0: 70 74 20 61 6e 20 61 6c 69 73 74 20 6f 72 20 68 pt an alist or h
85d0: 61 73 68 20 74 61 62 6c 65 20 63 6f 6e 74 61 69 ash table contai
85e0: 6e 69 6e 67 20 65 6e 76 76 61 72 2f 65 6e 76 20 ning envvar/env
85f0: 76 61 6c 75 65 20 70 61 69 72 73 20 28 76 61 6c value pairs (val
8600: 75 65 20 6f 66 20 23 66 20 63 61 75 73 65 73 20 ue of #f causes
8610: 75 6e 73 65 74 29 20 0a 3b 3b 20 20 20 65 78 65 unset) .;; exe
8620: 63 75 74 65 20 74 68 75 6e 6b 20 69 6e 20 63 6f cute thunk in co
8630: 6e 74 65 78 74 20 6f 66 20 65 6e 76 69 72 6f 6e ntext of environ
8640: 6d 65 6e 74 20 6d 6f 64 69 66 69 65 64 20 61 73 ment modified as
8650: 20 70 65 72 20 74 68 69 73 20 6c 69 73 74 0a 3b per this list.;
8660: 3b 20 20 20 72 65 73 74 6f 72 65 20 65 6e 76 20 ; restore env
8670: 74 6f 20 70 72 69 6f 72 20 73 74 61 74 65 20 74 to prior state t
8680: 68 65 6e 20 72 65 74 75 72 6e 20 76 61 6c 75 65 hen return value
8690: 20 6f 66 20 65 76 61 6c 27 64 20 74 68 75 6e 6b of eval'd thunk
86a0: 2e 0a 3b 3b 20 20 20 2a 2a 20 74 68 69 73 20 69 ..;; ** this i
86b0: 73 20 6e 6f 74 20 74 68 72 65 61 64 20 73 61 66 s not thread saf
86c0: 65 20 2a 2a 0a 28 64 65 66 69 6e 65 20 28 63 6f e **.(define (co
86d0: 6d 6d 6f 6e 3a 77 69 74 68 2d 65 6e 76 2d 76 61 mmon:with-env-va
86e0: 72 73 20 64 65 6c 74 61 2d 65 6e 76 2d 61 6c 69 rs delta-env-ali
86f0: 73 74 2d 6f 72 2d 68 61 73 68 2d 74 61 62 6c 65 st-or-hash-table
8700: 20 74 68 75 6e 6b 29 0a 20 20 28 6c 65 74 2a 20 thunk). (let*
8710: 28 28 64 65 6c 74 61 2d 65 6e 76 2d 61 6c 69 73 ((delta-env-alis
8720: 74 20 28 69 66 20 28 68 61 73 68 2d 74 61 62 6c t (if (hash-tabl
8730: 65 3f 20 64 65 6c 74 61 2d 65 6e 76 2d 61 6c 69 e? delta-env-ali
8740: 73 74 2d 6f 72 2d 68 61 73 68 2d 74 61 62 6c 65 st-or-hash-table
8750: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
8760: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8770: 28 68 61 73 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 (hash-table->ali
8780: 73 74 20 64 65 6c 74 61 2d 65 6e 76 2d 61 6c 69 st delta-env-ali
8790: 73 74 2d 6f 72 2d 68 61 73 68 2d 74 61 62 6c 65 st-or-hash-table
87a0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
87b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
87c0: 64 65 6c 74 61 2d 65 6e 76 2d 61 6c 69 73 74 2d delta-env-alist-
87d0: 6f 72 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a or-hash-table)).
87e0: 20 20 20 20 20 20 20 20 20 28 72 65 73 74 6f 72 (restor
87f0: 65 2d 74 68 75 6e 6b 73 0a 20 20 20 20 20 20 20 e-thunks.
8800: 20 20 20 28 66 69 6c 74 65 72 0a 20 20 20 20 20 (filter.
8810: 20 20 20 20 20 20 69 64 65 6e 74 69 74 79 0a 20 identity.
8820: 20 20 20 20 20 20 20 20 20 20 28 6d 61 70 20 28 (map (
8830: 6c 61 6d 62 64 61 20 28 65 6e 76 2d 70 61 69 72 lambda (env-pair
8840: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
8850: 20 20 20 20 28 6c 65 74 2a 20 28 28 65 6e 76 2d (let* ((env-
8860: 76 61 72 20 20 20 20 20 28 63 61 72 20 65 6e 76 var (car env
8870: 2d 70 61 69 72 29 29 0a 20 20 20 20 20 20 20 20 -pair)).
8880: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8890: 20 28 6e 65 77 2d 76 61 6c 20 20 20 20 20 28 6c (new-val (l
88a0: 65 74 20 28 28 74 6d 70 20 28 63 64 72 20 65 6e et ((tmp (cdr en
88b0: 76 2d 70 61 69 72 29 29 29 0a 20 20 20 20 20 20 v-pair))).
88c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
88d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
88e0: 20 20 28 69 66 20 28 6c 69 73 74 3f 20 74 6d 70 (if (list? tmp
88f0: 29 20 28 63 61 72 20 74 6d 70 29 20 74 6d 70 29 ) (car tmp) tmp)
8900: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
8910: 20 20 20 20 20 20 20 20 20 20 20 20 28 63 75 72 (cur
8920: 72 65 6e 74 2d 76 61 6c 20 28 67 65 74 2d 65 6e rent-val (get-en
8930: 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 vironment-variab
8940: 6c 65 20 65 6e 76 2d 76 61 72 29 29 0a 20 20 20 le env-var)).
8950: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8960: 20 20 20 20 20 20 28 72 65 73 74 6f 72 65 2d 74 (restore-t
8970: 68 75 6e 6b 0a 20 20 20 20 20 20 20 20 20 20 20 hunk.
8980: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
8990: 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 20 20 20 cond.
89a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
89b0: 28 28 6e 6f 74 20 63 75 72 72 65 6e 74 2d 76 61 ((not current-va
89c0: 6c 29 20 28 6c 61 6d 62 64 61 20 28 29 20 28 75 l) (lambda () (u
89d0: 6e 73 65 74 65 6e 76 20 65 6e 76 2d 76 61 72 29 nsetenv env-var)
89e0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
89f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
8a00: 6e 6f 74 20 28 73 74 72 69 6e 67 3f 20 6e 65 77 not (string? new
8a10: 2d 76 61 6c 29 29 20 23 66 29 0a 20 20 20 20 20 -val)) #f).
8a20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8a30: 20 20 20 20 20 20 28 28 65 71 3f 20 63 75 72 72 ((eq? curr
8a40: 65 6e 74 2d 76 61 6c 20 6e 65 77 2d 76 61 6c 29 ent-val new-val)
8a50: 20 23 66 29 0a 20 20 20 20 20 20 20 20 20 20 20 #f).
8a60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8a70: 28 65 6c 73 65 20 0a 20 20 20 20 20 20 20 20 20 (else .
8a80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8a90: 20 20 20 28 6c 61 6d 62 64 61 20 28 29 20 28 73 (lambda () (s
8aa0: 65 74 65 6e 76 20 65 6e 76 2d 76 61 72 20 63 75 etenv env-var cu
8ab0: 72 72 65 6e 74 2d 76 61 6c 29 29 29 29 29 29 0a rrent-val)))))).
8ac0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8ad0: 20 20 20 20 3b 3b 28 77 68 65 6e 20 28 6e 6f 74 ;;(when (not
8ae0: 20 28 73 74 72 69 6e 67 3f 20 6e 65 77 2d 76 61 (string? new-va
8af0: 6c 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 l)).
8b00: 20 20 20 20 20 20 20 20 3b 3b 20 20 20 20 28 64 ;; (d
8b10: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 ebug:print 0 *de
8b20: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
8b30: 22 20 50 52 4f 42 4c 45 4d 3a 20 6e 6f 74 20 61 " PROBLEM: not a
8b40: 20 73 74 72 69 6e 67 3a 20 22 6e 65 77 2d 76 61 string: "new-va
8b50: 6c 22 5c 6e 20 66 72 6f 6d 20 65 6e 76 2d 61 6c l"\n from env-al
8b60: 69 73 74 3a 5c 6e 22 64 65 6c 74 61 2d 65 6e 76 ist:\n"delta-env
8b70: 2d 61 6c 69 73 74 29 0a 20 20 20 20 20 20 20 20 -alist).
8b80: 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 20 ;;
8b90: 20 20 28 70 70 20 64 65 6c 74 61 2d 65 6e 76 2d (pp delta-env-
8ba0: 61 6c 69 73 74 29 0a 20 20 20 20 20 20 20 20 20 alist).
8bb0: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 20 20 ;;
8bc0: 20 28 65 78 69 74 20 31 29 29 0a 20 20 20 20 20 (exit 1)).
8bd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8be0: 20 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 .
8bf0: 20 20 20 20 20 20 20 20 0a 20 20 20 20 20 20 20 .
8c00: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f (co
8c10: 6e 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 nd.
8c20: 20 20 20 20 20 20 20 20 28 28 6e 6f 74 20 6e 65 ((not ne
8c30: 77 2d 76 61 6c 29 20 20 3b 3b 20 6d 6f 64 69 66 w-val) ;; modif
8c40: 79 20 65 6e 76 20 68 65 72 65 0a 20 20 20 20 20 y env here.
8c50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8c60: 20 28 75 6e 73 65 74 65 6e 76 20 65 6e 76 2d 76 (unsetenv env-v
8c70: 61 72 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ar)).
8c80: 20 20 20 20 20 20 20 20 20 20 28 28 73 74 72 69 ((stri
8c90: 6e 67 3f 20 6e 65 77 2d 76 61 6c 29 0a 20 20 20 ng? new-val).
8ca0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8cb0: 20 20 20 28 73 65 74 65 6e 76 20 65 6e 76 2d 76 (setenv env-v
8cc0: 61 72 20 6e 65 77 2d 76 61 6c 29 29 29 0a 20 20 ar new-val))).
8cd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8ce0: 20 20 72 65 73 74 6f 72 65 2d 74 68 75 6e 6b 29 restore-thunk)
8cf0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
8d00: 20 20 64 65 6c 74 61 2d 65 6e 76 2d 61 6c 69 73 delta-env-alis
8d10: 74 29 29 29 29 0a 20 20 20 20 28 6c 65 74 20 28 t)))). (let (
8d20: 28 72 76 20 28 74 68 75 6e 6b 29 29 29 0a 20 20 (rv (thunk))).
8d30: 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c (for-each (l
8d40: 61 6d 62 64 61 20 28 78 29 20 28 78 29 29 20 72 ambda (x) (x)) r
8d50: 65 73 74 6f 72 65 2d 74 68 75 6e 6b 73 29 20 3b estore-thunks) ;
8d60: 3b 20 72 65 73 74 6f 72 65 20 65 6e 76 20 74 6f ; restore env to
8d70: 20 6f 72 69 67 69 6e 61 6c 20 73 74 61 74 65 0a original state.
8d80: 20 20 20 20 20 20 72 76 29 29 29 0a 0a 3b 3b 20 rv)))..;;
8d90: 72 65 74 75 72 6e 20 61 20 6e 69 63 65 20 63 6c return a nice cl
8da0: 65 61 6e 20 70 61 74 68 6e 61 6d 65 20 6d 61 64 ean pathname mad
8db0: 65 20 61 62 73 6f 6c 75 74 65 0a 28 64 65 66 69 e absolute.(defi
8dc0: 6e 65 20 28 63 6f 6d 6d 6f 6e 3a 6e 69 63 65 2d ne (common:nice-
8dd0: 70 61 74 68 20 64 69 72 29 0a 20 20 28 6c 65 74 path dir). (let
8de0: 20 28 28 6d 61 74 63 68 20 28 73 74 72 69 6e 67 ((match (string
8df0: 2d 6d 61 74 63 68 20 22 5e 28 7e 5b 5e 5c 5c 2f -match "^(~[^\\/
8e00: 5d 2a 29 28 5c 5c 2f 2e 2a 7c 29 24 22 20 64 69 ]*)(\\/.*|)$" di
8e10: 72 29 29 29 0a 20 20 20 20 28 69 66 20 6d 61 74 r))). (if mat
8e20: 63 68 20 3b 3b 20 75 73 69 6e 67 20 7e 20 66 6f ch ;; using ~ fo
8e30: 72 20 68 6f 6d 65 3f 0a 09 28 63 6f 6d 6d 6f 6e r home?..(common
8e40: 3a 6e 69 63 65 2d 70 61 74 68 20 28 63 6f 6e 63 :nice-path (conc
8e50: 20 28 63 6f 6d 6d 6f 6e 3a 72 65 61 64 2d 6c 69 (common:read-li
8e60: 6e 6b 2d 66 20 28 63 61 64 72 20 6d 61 74 63 68 nk-f (cadr match
8e70: 29 29 20 22 2f 22 20 28 63 61 64 64 72 20 6d 61 )) "/" (caddr ma
8e80: 74 63 68 29 29 29 0a 09 28 6e 6f 72 6d 61 6c 69 tch)))..(normali
8e90: 7a 65 2d 70 61 74 68 6e 61 6d 65 20 28 69 66 20 ze-pathname (if
8ea0: 28 61 62 73 6f 6c 75 74 65 2d 70 61 74 68 6e 61 (absolute-pathna
8eb0: 6d 65 3f 20 64 69 72 29 0a 09 09 09 09 64 69 72 me? dir).....dir
8ec0: 0a 09 09 09 09 28 63 6f 6e 63 20 28 63 75 72 72 .....(conc (curr
8ed0: 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 20 22 ent-directory) "
8ee0: 2f 22 20 64 69 72 29 29 29 29 29 29 0a 0a 3b 3b /" dir))))))..;;
8ef0: 20 6d 61 6b 65 20 22 6e 69 63 65 2d 70 61 74 68 make "nice-path
8f00: 22 20 61 76 61 69 6c 61 62 6c 65 20 69 6e 20 63 " available in c
8f10: 6f 6e 66 69 67 20 66 69 6c 65 73 20 61 6e 64 20 onfig files and
8f20: 74 68 65 20 72 65 70 6c 0a 28 64 65 66 69 6e 65 the repl.(define
8f30: 20 6e 69 63 65 2d 70 61 74 68 20 63 6f 6d 6d 6f nice-path commo
8f40: 6e 3a 6e 69 63 65 2d 70 61 74 68 29 0a 0a 28 64 n:nice-path)..(d
8f50: 65 66 69 6e 65 20 28 63 6f 6d 6d 6f 6e 3a 72 65 efine (common:re
8f60: 61 64 2d 6c 69 6e 6b 2d 66 20 70 61 74 68 29 0a ad-link-f path).
8f70: 20 20 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 (handle-except
8f80: 69 6f 6e 73 0a 20 20 20 20 20 20 65 78 6e 0a 20 ions. exn.
8f90: 20 20 20 20 20 28 62 65 67 69 6e 0a 09 28 64 65 (begin..(de
8fa0: 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 bug:print-error
8fb0: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
8fc0: 6f 72 74 2a 20 22 63 6f 6d 6d 61 6e 64 20 5c 22 ort* "command \"
8fd0: 2f 62 69 6e 2f 72 65 61 64 6c 69 6e 6b 20 2d 66 /bin/readlink -f
8fe0: 20 22 20 70 61 74 68 20 22 5c 22 20 66 61 69 6c " path "\" fail
8ff0: 65 64 2e 20 65 78 6e 3d 22 20 65 78 6e 29 0a 09 ed. exn=" exn)..
9000: 70 61 74 68 29 20 3b 3b 20 6a 75 73 74 20 67 69 path) ;; just gi
9010: 76 65 20 75 70 0a 20 20 20 20 28 77 69 74 68 2d ve up. (with-
9020: 69 6e 70 75 74 2d 66 72 6f 6d 2d 70 69 70 65 0a input-from-pipe.
9030: 09 28 63 6f 6e 63 20 22 2f 62 69 6e 2f 72 65 61 .(conc "/bin/rea
9040: 64 6c 69 6e 6b 20 2d 66 20 22 20 70 61 74 68 29 dlink -f " path)
9050: 0a 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 . (lambda (
9060: 29 0a 09 28 72 65 61 64 2d 6c 69 6e 65 29 29 29 )..(read-line)))
9070: 29 29 0a 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d ))...;;=========
9080: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9090: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
90a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
90b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
90c0: 20 4e 6f 6e 20 64 65 73 74 72 75 63 74 69 76 65 Non destructive
90d0: 20 77 72 69 74 69 6e 67 20 6f 66 20 63 6f 6e 66 writing of conf
90e0: 69 67 20 66 69 6c 65 0a 3b 3b 3d 3d 3d 3d 3d 3d ig file.;;======
90f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9100: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9110: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9120: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9130: 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 ..(define (confi
9140: 67 66 3a 63 6f 6d 70 72 65 73 73 2d 6d 75 6c 74 gf:compress-mult
9150: 69 2d 6c 69 6e 65 73 20 66 64 61 74 29 0a 20 20 i-lines fdat).
9160: 3b 3b 20 73 74 65 70 20 31 2e 35 20 2d 20 63 6f ;; step 1.5 - co
9170: 6d 70 72 65 73 73 20 61 6e 79 20 63 6f 6e 74 69 mpress any conti
9180: 6e 75 65 64 20 6c 69 6e 65 73 0a 20 20 28 69 66 nued lines. (if
9190: 20 28 6e 75 6c 6c 3f 20 66 64 61 74 29 20 66 64 (null? fdat) fd
91a0: 61 74 0a 09 28 6c 65 74 20 6c 6f 6f 70 20 28 28 at..(let loop ((
91b0: 68 65 64 20 28 63 61 72 20 66 64 61 74 29 29 0a hed (car fdat)).
91c0: 09 09 20 20 20 28 74 61 6c 20 28 63 64 72 20 66 .. (tal (cdr f
91d0: 64 61 74 29 29 0a 09 09 20 20 20 28 63 75 72 20 dat))... (cur
91e0: 22 22 29 0a 09 09 20 20 20 28 6c 65 64 20 23 66 "")... (led #f
91f0: 29 0a 09 09 20 20 20 28 72 65 73 20 27 28 29 29 )... (res '())
9200: 29 0a 09 20 20 3b 3b 20 41 4c 4c 20 57 48 49 54 ).. ;; ALL WHIT
9210: 45 53 50 41 43 45 20 4c 45 41 44 49 4e 47 20 4c ESPACE LEADING L
9220: 49 4e 45 53 20 41 52 45 20 54 41 43 4b 45 44 20 INES ARE TACKED
9230: 4f 4e 21 21 0a 09 20 20 3b 3b 20 20 31 2e 20 72 ON!!.. ;; 1. r
9240: 65 6d 6f 76 65 20 6c 65 64 20 77 68 69 74 65 73 emove led whites
9250: 70 61 63 65 0a 09 20 20 3b 3b 20 20 32 2e 20 74 pace.. ;; 2. t
9260: 61 63 6b 20 6f 6e 20 74 6f 20 68 65 64 20 77 69 ack on to hed wi
9270: 74 68 20 22 5c 6e 22 0a 09 20 20 28 6c 65 74 20 th "\n".. (let
9280: 28 28 6d 61 74 63 68 20 28 73 74 72 69 6e 67 2d ((match (string-
9290: 6d 61 74 63 68 20 63 6f 6e 66 69 67 66 3a 63 6f match configf:co
92a0: 6e 74 2d 6c 6e 2d 72 78 20 68 65 64 29 29 29 0a nt-ln-rx hed))).
92b0: 09 20 20 20 20 28 69 66 20 6d 61 74 63 68 20 3b . (if match ;
92c0: 3b 20 62 6c 61 73 74 21 20 68 61 76 65 20 74 6f ; blast! have to
92d0: 20 64 65 61 6c 20 77 69 74 68 20 61 20 6d 75 6c deal with a mul
92e0: 74 69 6c 69 6e 65 0a 09 09 28 6c 65 74 2a 20 28 tiline...(let* (
92f0: 28 6c 65 61 64 20 28 63 61 64 72 20 6d 61 74 63 (lead (cadr matc
9300: 68 29 29 0a 09 09 20 20 20 20 20 20 20 28 6c 76 h))... (lv
9310: 61 6c 20 28 63 61 64 64 72 20 6d 61 74 63 68 29 al (caddr match)
9320: 29 0a 09 09 20 20 20 20 20 20 20 28 6e 65 77 6c )... (newl
9330: 20 28 63 6f 6e 63 20 63 75 72 20 22 5c 6e 22 20 (conc cur "\n"
9340: 6c 76 61 6c 29 29 29 0a 09 09 20 20 28 69 66 20 lval)))... (if
9350: 28 6e 6f 74 20 6c 65 64 29 28 73 65 74 21 20 6c (not led)(set! l
9360: 65 64 20 6c 65 61 64 29 29 0a 09 09 20 20 28 69 ed lead))... (i
9370: 66 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 20 0a 09 f (null? tal) ..
9380: 09 20 20 20 20 20 20 28 73 65 74 21 20 66 64 61 . (set! fda
9390: 74 20 28 61 70 70 65 6e 64 20 66 64 61 74 20 28 t (append fdat (
93a0: 6c 69 73 74 20 6e 65 77 6c 29 29 29 0a 09 09 20 list newl)))...
93b0: 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 (loop (car
93c0: 74 61 6c 29 28 63 64 72 20 74 61 6c 29 20 6e 65 tal)(cdr tal) ne
93d0: 77 6c 20 6c 65 64 20 72 65 73 29 29 29 20 3b 3b wl led res))) ;;
93e0: 20 4e 42 2f 2f 20 6e 6f 74 20 74 61 63 6b 69 6e NB// not tackin
93f0: 67 20 6e 65 77 6c 20 6f 6e 74 6f 20 72 65 73 0a g newl onto res.
9400: 09 09 28 6c 65 74 20 28 28 6e 65 77 72 65 73 20 ..(let ((newres
9410: 28 69 66 20 6c 65 64 20 0a 09 09 09 09 20 20 28 (if led ..... (
9420: 61 70 70 65 6e 64 20 72 65 73 20 28 6c 69 73 74 append res (list
9430: 20 63 75 72 20 68 65 64 29 29 0a 09 09 09 09 20 cur hed)).....
9440: 20 28 61 70 70 65 6e 64 20 72 65 73 20 28 6c 69 (append res (li
9450: 73 74 20 68 65 64 29 29 29 29 29 0a 09 09 20 20 st hed)))))...
9460: 3b 3b 20 70 72 65 76 20 77 61 73 20 61 20 6d 75 ;; prev was a mu
9470: 6c 74 69 6c 69 6e 65 0a 09 09 20 20 28 69 66 20 ltiline... (if
9480: 28 6e 75 6c 6c 3f 20 74 61 6c 29 0a 09 09 20 20 (null? tal)...
9490: 20 20 20 20 6e 65 77 72 65 73 0a 09 09 20 20 20 newres...
94a0: 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 (loop (car ta
94b0: 6c 29 28 63 64 72 20 74 61 6c 29 20 22 22 20 23 l)(cdr tal) "" #
94c0: 66 20 6e 65 77 72 65 73 29 29 29 29 29 29 29 29 f newres))))))))
94d0: 0a 0a 3b 3b 20 6e 6f 74 65 3a 20 49 27 6d 20 63 ..;; note: I'm c
94e0: 68 65 61 74 69 6e 67 20 61 20 6c 69 74 74 6c 65 heating a little
94f0: 20 68 65 72 65 2e 20 49 20 6d 65 72 65 6c 79 20 here. I merely
9500: 72 65 70 6c 61 63 65 20 22 5c 6e 22 20 77 69 74 replace "\n" wit
9510: 68 20 22 5c 6e 20 20 20 20 20 20 20 20 20 22 0a h "\n ".
9520: 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 66 (define (configf
9530: 3a 65 78 70 61 6e 64 2d 6d 75 6c 74 69 2d 6c 69 :expand-multi-li
9540: 6e 65 73 20 66 64 61 74 29 0a 20 20 3b 3b 20 73 nes fdat). ;; s
9550: 74 65 70 20 31 2e 35 20 2d 20 63 6f 6d 70 72 65 tep 1.5 - compre
9560: 73 73 20 61 6e 79 20 63 6f 6e 74 69 6e 75 65 64 ss any continued
9570: 20 6c 69 6e 65 73 0a 20 20 28 69 66 20 28 6e 75 lines. (if (nu
9580: 6c 6c 3f 20 66 64 61 74 29 20 66 64 61 74 0a 20 ll? fdat) fdat.
9590: 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 (let loop (
95a0: 28 68 65 64 20 28 63 61 72 20 66 64 61 74 29 29 (hed (car fdat))
95b0: 0a 09 09 20 28 74 61 6c 20 28 63 64 72 20 66 64 ... (tal (cdr fd
95c0: 61 74 29 29 0a 09 09 20 28 72 65 73 20 27 28 29 at))... (res '()
95d0: 29 29 0a 09 28 6c 65 74 20 28 28 6e 65 77 72 65 ))..(let ((newre
95e0: 73 20 28 61 70 70 65 6e 64 20 72 65 73 20 28 6c s (append res (l
95f0: 69 73 74 20 28 73 74 72 69 6e 67 2d 73 75 62 73 ist (string-subs
9600: 74 69 74 75 74 65 20 28 72 65 67 65 78 70 20 22 titute (regexp "
9610: 5c 6e 22 29 20 22 5c 6e 20 20 20 20 20 20 20 20 \n") "\n
9620: 20 22 20 68 65 64 20 23 74 29 29 29 29 29 0a 09 " hed #t)))))..
9630: 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 61 6c (if (null? tal
9640: 29 0a 09 20 20 20 20 20 20 6e 65 77 72 65 73 0a ).. newres.
9650: 09 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 . (loop (ca
9660: 72 20 74 61 6c 29 28 63 64 72 20 74 61 6c 29 20 r tal)(cdr tal)
9670: 6e 65 77 72 65 73 29 29 29 29 29 29 0a 0a 28 64 newres))))))..(d
9680: 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a 66 efine (configf:f
9690: 69 6c 65 2d 3e 6c 69 73 74 20 66 6e 61 6d 65 29 ile->list fname)
96a0: 0a 20 20 28 69 66 20 28 66 69 6c 65 2d 65 78 69 . (if (file-exi
96b0: 73 74 73 3f 20 66 6e 61 6d 65 29 0a 20 20 20 20 sts? fname).
96c0: 20 20 28 6c 65 74 20 28 28 69 6e 70 20 28 6f 70 (let ((inp (op
96d0: 65 6e 2d 69 6e 70 75 74 2d 66 69 6c 65 20 66 6e en-input-file fn
96e0: 61 6d 65 29 29 29 0a 09 28 6c 65 74 20 6c 6f 6f ame)))..(let loo
96f0: 70 20 28 28 69 6e 6c 20 28 72 65 61 64 2d 6c 69 p ((inl (read-li
9700: 6e 65 20 69 6e 70 29 29 0a 09 09 20 20 20 28 72 ne inp))... (r
9710: 65 73 20 27 28 29 29 29 0a 09 20 20 28 69 66 20 es '())).. (if
9720: 28 65 6f 66 2d 6f 62 6a 65 63 74 3f 20 69 6e 6c (eof-object? inl
9730: 29 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a ).. (begin.
9740: 09 09 28 63 6c 6f 73 65 2d 69 6e 70 75 74 2d 70 ..(close-input-p
9750: 6f 72 74 20 69 6e 70 29 0a 09 09 28 72 65 76 65 ort inp)...(reve
9760: 72 73 65 20 72 65 73 29 29 0a 09 20 20 20 20 20 rse res))..
9770: 20 28 6c 6f 6f 70 20 28 72 65 61 64 2d 6c 69 6e (loop (read-lin
9780: 65 20 69 6e 70 29 28 63 6f 6e 73 20 69 6e 6c 20 e inp)(cons inl
9790: 72 65 73 29 29 29 29 29 0a 20 20 20 20 20 20 27 res))))). '
97a0: 28 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d ()))..;;========
97b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
97c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
97d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
97e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
97f0: 3b 20 57 72 69 74 65 20 61 20 63 6f 6e 66 69 67 ; Write a config
9800: 0a 3b 3b 20 20 20 30 2e 20 47 69 76 65 6e 20 61 .;; 0. Given a
9810: 20 72 65 66 65 72 65 72 65 6e 63 65 20 64 61 74 refererence dat
9820: 61 20 73 74 72 75 63 74 75 72 65 20 22 69 6e 64 a structure "ind
9830: 61 74 22 0a 3b 3b 20 20 20 31 2e 20 4f 70 65 6e at".;; 1. Open
9840: 20 74 68 65 20 6f 75 74 70 75 74 20 66 69 6c 65 the output file
9850: 20 61 6e 64 20 72 65 61 64 20 69 74 20 69 6e 74 and read it int
9860: 6f 20 61 20 6c 69 73 74 0a 3b 3b 20 20 20 32 2e o a list.;; 2.
9870: 20 46 6c 61 74 74 65 6e 20 61 6e 79 20 6d 75 6c Flatten any mul
9880: 74 69 6c 69 6e 65 20 65 6e 74 72 69 65 73 0a 3b tiline entries.;
9890: 3b 20 20 20 33 2e 20 4d 6f 64 69 66 79 20 76 61 ; 3. Modify va
98a0: 6c 75 65 73 20 70 65 72 20 63 6f 6e 74 65 6e 74 lues per content
98b0: 73 20 6f 66 20 22 69 6e 64 61 74 22 20 61 6e 64 s of "indat" and
98c0: 20 72 65 6d 6f 76 65 20 61 62 73 65 6e 74 20 76 remove absent v
98d0: 61 6c 75 65 73 0a 3b 3b 20 20 20 34 2e 20 41 70 alues.;; 4. Ap
98e0: 70 65 6e 64 20 6e 65 77 20 76 61 6c 75 65 73 20 pend new values
98f0: 74 6f 20 74 68 65 20 73 65 63 74 69 6f 6e 20 28 to the section (
9900: 69 6d 6d 65 64 69 61 74 65 6c 79 20 61 66 74 65 immediately afte
9910: 72 20 6c 61 73 74 20 6c 65 67 69 74 20 65 6e 74 r last legit ent
9920: 72 79 29 0a 3b 3b 20 20 20 35 2e 20 57 72 69 74 ry).;; 5. Writ
9930: 65 20 6f 75 74 20 74 68 65 20 6e 65 77 20 6c 69 e out the new li
9940: 73 74 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d st .;;==========
9950: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9960: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9970: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9980: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 ============..(d
9990: 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a 77 efine (configf:w
99a0: 72 69 74 65 2d 63 6f 6e 66 69 67 20 69 6e 64 61 rite-config inda
99b0: 74 20 66 6e 61 6d 65 20 23 21 6b 65 79 20 28 72 t fname #!key (r
99c0: 65 71 75 69 72 65 64 2d 73 65 63 74 69 6f 6e 73 equired-sections
99d0: 20 27 28 29 29 29 0a 20 20 28 6c 65 74 2a 20 28 '())). (let* (
99e0: 3b 3b 20 73 74 65 70 20 31 3a 20 4f 70 65 6e 20 ;; step 1: Open
99f0: 74 68 65 20 6f 75 74 70 75 74 20 66 69 6c 65 20 the output file
9a00: 61 6e 64 20 72 65 61 64 20 69 74 20 69 6e 74 6f and read it into
9a10: 20 61 20 6c 69 73 74 0a 09 20 28 66 64 61 74 20 a list.. (fdat
9a20: 20 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 66 (configf:f
9a30: 69 6c 65 2d 3e 6c 69 73 74 20 66 6e 61 6d 65 29 ile->list fname)
9a40: 29 0a 09 20 28 72 65 66 64 61 74 20 20 28 6d 61 ).. (refdat (ma
9a50: 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a ke-hash-table)).
9a60: 09 20 28 73 65 63 68 61 73 68 20 28 6d 61 6b 65 . (sechash (make
9a70: 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 20 3b 3b -hash-table)) ;;
9a80: 20 63 75 72 72 65 6e 74 20 73 65 63 74 69 6f 6e current section
9a90: 20 68 61 73 68 2c 20 69 6e 69 74 20 77 69 74 68 hash, init with
9aa0: 20 68 61 73 68 20 66 6f 72 20 22 64 65 66 61 75 hash for "defau
9ab0: 6c 74 22 20 73 65 63 74 69 6f 6e 0a 09 20 28 6e lt" section.. (n
9ac0: 65 77 20 20 20 20 20 23 66 29 20 3b 3b 20 70 75 ew #f) ;; pu
9ad0: 74 20 74 68 65 20 6c 69 6e 65 20 74 6f 20 62 65 t the line to be
9ae0: 20 75 73 65 64 20 69 6e 20 6e 65 77 2c 20 69 66 used in new, if
9af0: 20 69 74 20 69 73 20 74 6f 20 62 65 20 64 65 6c it is to be del
9b00: 65 74 65 64 20 74 68 65 20 73 65 74 20 6e 65 77 eted the set new
9b10: 20 74 6f 20 23 66 0a 09 20 28 73 65 63 6e 61 6d to #f.. (secnam
9b20: 65 20 23 66 29 29 0a 0a 20 20 20 20 3b 3b 20 73 e #f)).. ;; s
9b30: 74 65 70 20 32 3a 20 46 6c 61 74 74 65 6e 20 6d tep 2: Flatten m
9b40: 75 6c 74 69 6c 69 6e 65 20 65 6e 74 72 69 65 73 ultiline entries
9b50: 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6e . (if (not (n
9b60: 75 6c 6c 3f 20 66 64 61 74 29 29 28 73 65 74 21 ull? fdat))(set!
9b70: 20 66 64 61 74 20 28 63 6f 6e 66 69 67 66 3a 63 fdat (configf:c
9b80: 6f 6d 70 72 65 73 73 2d 6d 75 6c 74 69 2d 6c 69 ompress-multi-li
9b90: 6e 65 73 20 66 64 61 74 29 29 29 0a 0a 20 20 20 nes fdat)))..
9ba0: 20 3b 3b 20 73 74 65 70 20 33 3a 20 4d 6f 64 69 ;; step 3: Modi
9bb0: 66 79 20 76 61 6c 75 65 73 20 70 65 72 20 63 6f fy values per co
9bc0: 6e 74 65 6e 74 73 20 6f 66 20 22 69 6e 64 61 74 ntents of "indat
9bd0: 22 20 61 6e 64 20 72 65 6d 6f 76 65 20 61 62 73 " and remove abs
9be0: 65 6e 74 20 76 61 6c 75 65 73 0a 20 20 20 20 28 ent values. (
9bf0: 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 66 if (not (null? f
9c00: 64 61 74 29 29 0a 09 28 6c 65 74 20 6c 6f 6f 70 dat))..(let loop
9c10: 20 28 28 68 65 64 20 20 28 63 61 72 20 66 64 61 ((hed (car fda
9c20: 74 29 29 0a 09 09 20 20 20 28 74 61 6c 20 20 28 t))... (tal (
9c30: 63 61 64 72 20 66 64 61 74 29 29 0a 09 09 20 20 cadr fdat))...
9c40: 20 28 72 65 73 20 20 27 28 29 29 0a 09 09 20 20 (res '())...
9c50: 20 28 6c 6e 75 6d 20 30 29 29 0a 09 20 20 28 72 (lnum 0)).. (r
9c60: 65 67 65 78 2d 63 61 73 65 20 0a 09 20 20 20 68 egex-case .. h
9c70: 65 64 0a 09 20 20 20 28 63 6f 6e 66 69 67 66 3a ed.. (configf:
9c80: 63 6f 6d 6d 65 6e 74 2d 72 78 20 5f 20 20 20 20 comment-rx _
9c90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 (s
9ca0: 65 74 21 20 72 65 73 20 28 61 70 70 65 6e 64 20 et! res (append
9cb0: 72 65 73 20 28 6c 69 73 74 20 68 65 64 29 29 29 res (list hed)))
9cc0: 29 20 3b 3b 20 28 6c 6f 6f 70 20 28 72 65 61 64 ) ;; (loop (read
9cd0: 2d 6c 69 6e 65 20 69 6e 70 29 20 63 75 72 72 2d -line inp) curr-
9ce0: 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 section-name #f
9cf0: 23 66 29 29 0a 09 20 20 20 28 63 6f 6e 66 69 67 #f)).. (config
9d00: 66 3a 62 6c 61 6e 6b 2d 6c 2d 72 78 20 5f 20 20 f:blank-l-rx _
9d10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9d20: 28 73 65 74 21 20 72 65 73 20 28 61 70 70 65 6e (set! res (appen
9d30: 64 20 72 65 73 20 28 6c 69 73 74 20 68 65 64 29 d res (list hed)
9d40: 29 29 29 20 3b 3b 20 28 6c 6f 6f 70 20 28 72 65 ))) ;; (loop (re
9d50: 61 64 2d 6c 69 6e 65 20 69 6e 70 29 20 63 75 72 ad-line inp) cur
9d60: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 r-section-name #
9d70: 66 20 23 66 29 29 0a 09 20 20 20 28 63 6f 6e 66 f #f)).. (conf
9d80: 69 67 66 3a 73 65 63 74 69 6f 6e 2d 72 78 20 28 igf:section-rx (
9d90: 20 78 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 x section-name
9da0: 29 20 28 6c 65 74 20 28 28 73 65 63 74 69 6f 6e ) (let ((section
9db0: 2d 68 61 73 68 20 28 68 61 73 68 2d 74 61 62 6c -hash (hash-tabl
9dc0: 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 72 65 e-ref/default re
9dd0: 66 64 61 74 20 73 65 63 74 69 6f 6e 2d 6e 61 6d fdat section-nam
9de0: 65 20 23 66 29 29 29 0a 09 09 09 09 09 20 20 20 e #f)))......
9df0: 20 28 69 66 20 28 6e 6f 74 20 73 65 63 74 69 6f (if (not sectio
9e00: 6e 2d 68 61 73 68 29 0a 09 09 09 09 09 09 28 6c n-hash).......(l
9e10: 65 74 20 28 28 6e 65 77 68 61 73 68 20 28 6d 61 et ((newhash (ma
9e20: 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 29 ke-hash-table)))
9e30: 0a 09 09 09 09 09 09 20 20 28 68 61 73 68 2d 74 ....... (hash-t
9e40: 61 62 6c 65 2d 73 65 74 21 20 72 65 66 64 61 74 able-set! refdat
9e50: 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 6e 65 section-name ne
9e60: 77 68 61 73 68 29 20 3b 3b 20 77 61 73 20 72 65 whash) ;; was re
9e70: 66 68 61 73 68 20 2d 20 6e 6f 74 20 73 75 72 65 fhash - not sure
9e80: 20 74 68 61 74 20 72 65 66 64 61 74 20 69 73 20 that refdat is
9e90: 63 6f 72 72 65 63 74 20 68 65 72 65 0a 09 09 09 correct here....
9ea0: 09 09 09 20 20 28 73 65 74 21 20 73 65 63 68 61 ... (set! secha
9eb0: 73 68 20 6e 65 77 68 61 73 68 29 29 0a 09 09 09 sh newhash))....
9ec0: 09 09 09 28 73 65 74 21 20 73 65 63 68 61 73 68 ...(set! sechash
9ed0: 20 73 65 63 74 69 6f 6e 2d 68 61 73 68 29 29 0a section-hash)).
9ee0: 09 09 09 09 09 20 20 20 20 28 73 65 74 21 20 6e ..... (set! n
9ef0: 65 77 20 68 65 64 29 20 3b 3b 20 77 69 6c 6c 20 ew hed) ;; will
9f00: 61 70 70 65 6e 64 20 74 68 69 73 20 61 74 20 74 append this at t
9f10: 68 65 20 62 6f 74 74 6f 6d 20 6f 66 20 74 68 65 he bottom of the
9f20: 20 6c 6f 6f 70 0a 09 09 09 09 09 20 20 20 20 28 loop...... (
9f30: 73 65 74 21 20 73 65 63 6e 61 6d 65 20 73 65 63 set! secname sec
9f40: 74 69 6f 6e 2d 6e 61 6d 65 29 0a 09 09 09 09 09 tion-name)......
9f50: 20 20 20 20 29 29 0a 09 20 20 20 3b 3b 20 4e 6f )).. ;; No
9f60: 20 6e 65 65 64 20 74 6f 20 70 72 6f 63 65 73 73 need to process
9f70: 20 6b 65 79 20 63 6d 64 2c 20 6c 65 74 20 69 74 key cmd, let it
9f80: 20 66 61 6c 6c 20 74 68 6f 75 67 68 20 74 6f 20 fall though to
9f90: 6b 65 79 20 76 61 6c 0a 09 20 20 20 28 63 6f 6e key val.. (con
9fa0: 66 69 67 66 3a 6b 65 79 2d 76 61 6c 2d 70 72 20 figf:key-val-pr
9fb0: 28 20 78 20 6b 65 79 20 76 61 6c 20 20 20 20 20 ( x key val
9fc0: 20 29 0a 09 09 20 20 20 20 20 20 20 28 6c 65 74 )... (let
9fd0: 20 28 28 6e 65 77 76 61 6c 20 28 63 6f 6e 66 69 ((newval (confi
9fe0: 67 66 3a 6c 6f 6f 6b 75 70 20 69 6e 64 61 74 20 gf:lookup indat
9ff0: 73 65 63 6e 61 6d 65 20 6b 65 79 29 29 29 20 3b secname key))) ;
a000: 3b 20 77 61 73 20 73 65 63 2c 20 62 75 67 20 6f ; was sec, bug o
a010: 72 20 63 6f 72 72 65 63 74 3f 0a 09 09 09 20 3b r correct?.... ;
a020: 3b 20 63 61 6e 20 68 61 6e 64 6c 65 20 6e 65 77 ; can handle new
a030: 76 61 6c 20 3d 3d 20 23 66 20 68 65 72 65 20 3d val == #f here =
a040: 3e 20 74 68 61 74 20 6d 65 61 6e 73 20 6b 65 79 > that means key
a050: 20 69 73 20 72 65 6d 6f 76 65 64 0a 09 09 09 20 is removed....
a060: 28 63 6f 6e 64 20 0a 09 09 09 20 20 28 28 65 71 (cond .... ((eq
a070: 75 61 6c 3f 20 6e 65 77 76 61 6c 20 76 61 6c 29 ual? newval val)
a080: 0a 09 09 09 20 20 20 28 73 65 74 21 20 72 65 73 .... (set! res
a090: 20 28 61 70 70 65 6e 64 20 72 65 73 20 28 6c 69 (append res (li
a0a0: 73 74 20 68 65 64 29 29 29 29 0a 09 09 09 20 20 st hed))))....
a0b0: 28 28 6e 6f 74 20 6e 65 77 76 61 6c 29 20 3b 3b ((not newval) ;;
a0c0: 20 6b 65 79 20 68 61 73 20 62 65 65 6e 20 72 65 key has been re
a0d0: 6d 6f 76 65 64 0a 09 09 09 20 20 20 28 73 65 74 moved.... (set
a0e0: 21 20 6e 65 77 20 23 66 29 29 0a 09 09 09 20 20 ! new #f))....
a0f0: 28 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 6e 65 ((not (equal? ne
a100: 77 76 61 6c 20 76 61 6c 29 29 0a 09 09 09 20 20 wval val))....
a110: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 (hash-table-s
a120: 65 74 21 20 73 65 63 68 61 73 68 20 6b 65 79 20 et! sechash key
a130: 6e 65 77 76 61 6c 29 0a 09 09 09 20 20 20 20 20 newval)....
a140: 28 73 65 74 21 20 6e 65 77 20 28 63 6f 6e 63 20 (set! new (conc
a150: 6b 65 79 20 22 20 22 20 6e 65 77 76 61 6c 29 29 key " " newval))
a160: 29 0a 09 09 09 20 20 28 65 6c 73 65 0a 09 09 09 ).... (else....
a170: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d (debug:print-
a180: 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 error 0 *default
a190: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 70 72 6f 62 -log-port* "prob
a1a0: 6c 65 6d 20 70 61 72 73 69 6e 67 20 6c 69 6e 65 lem parsing line
a1b0: 20 6e 75 6d 62 65 72 20 22 20 6c 6e 75 6d 20 22 number " lnum "
a1c0: 5c 22 22 20 68 65 64 20 22 5c 22 22 29 29 29 29 \"" hed "\""))))
a1d0: 29 0a 09 20 20 20 28 65 6c 73 65 0a 09 20 20 20 ).. (else..
a1e0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 (debug:print-er
a1f0: 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c ror 0 *default-l
a200: 6f 67 2d 70 6f 72 74 2a 20 22 50 72 6f 62 6c 65 og-port* "Proble
a210: 6d 20 70 61 72 73 69 6e 67 20 6c 69 6e 65 20 6e m parsing line n
a220: 75 6d 20 22 20 6c 6e 75 6d 20 22 20 3a 5c 6e 20 um " lnum " :\n
a230: 20 20 22 20 68 65 64 20 29 29 29 0a 09 20 20 28 " hed ))).. (
a240: 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 74 if (not (null? t
a250: 61 6c 29 29 0a 09 20 20 20 20 20 20 28 6c 6f 6f al)).. (loo
a260: 70 20 28 63 61 72 20 74 61 6c 29 28 63 64 72 20 p (car tal)(cdr
a270: 74 61 6c 29 28 69 66 20 6e 65 77 20 28 61 70 70 tal)(if new (app
a280: 65 6e 64 20 72 65 73 20 28 6c 69 73 74 20 6e 65 end res (list ne
a290: 77 29 29 20 72 65 73 29 28 2b 20 6c 6e 75 6d 20 w)) res)(+ lnum
a2a0: 31 29 29 29 0a 09 20 20 3b 3b 20 64 72 6f 70 20 1))).. ;; drop
a2b0: 74 6f 20 68 65 72 65 20 77 68 65 6e 20 64 6f 6e to here when don
a2c0: 65 20 70 72 6f 63 65 73 73 69 6e 67 2c 20 72 65 e processing, re
a2d0: 73 20 63 6f 6e 74 61 69 6e 73 20 6d 6f 64 69 66 s contains modif
a2e0: 69 65 64 20 6c 69 73 74 20 6f 66 20 6c 69 6e 65 ied list of line
a2f0: 73 0a 09 20 20 28 73 65 74 21 20 66 64 61 74 20 s.. (set! fdat
a300: 72 65 73 29 29 29 0a 0a 20 20 20 20 3b 3b 20 73 res))).. ;; s
a310: 74 65 70 20 34 3a 20 41 70 70 65 6e 64 20 6e 65 tep 4: Append ne
a320: 77 20 76 61 6c 75 65 73 20 74 6f 20 74 68 65 20 w values to the
a330: 73 65 63 74 69 6f 6e 0a 20 20 20 20 28 66 6f 72 section. (for
a340: 2d 65 61 63 68 20 0a 20 20 20 20 20 28 6c 61 6d -each . (lam
a350: 62 64 61 20 28 73 65 63 74 69 6f 6e 29 0a 20 20 bda (section).
a360: 20 20 20 20 20 28 6c 65 74 20 28 28 73 64 61 74 (let ((sdat
a370: 20 20 20 27 28 29 29 20 3b 3b 20 61 70 70 65 6e '()) ;; appen
a380: 64 20 6e 65 65 64 65 64 20 62 69 74 73 20 68 65 d needed bits he
a390: 72 65 0a 09 20 20 20 20 20 28 73 76 61 72 73 20 re.. (svars
a3a0: 20 28 63 6f 6e 66 69 67 66 3a 73 65 63 74 69 6f (configf:sectio
a3b0: 6e 2d 76 61 72 73 20 69 6e 64 61 74 20 73 65 63 n-vars indat sec
a3c0: 74 69 6f 6e 29 29 29 0a 09 20 28 66 6f 72 2d 65 tion))).. (for-e
a3d0: 61 63 68 20 0a 09 20 20 28 6c 61 6d 62 64 61 20 ach .. (lambda
a3e0: 28 76 61 72 29 0a 09 20 20 20 20 28 6c 65 74 20 (var).. (let
a3f0: 28 28 76 61 6c 20 28 63 6f 6e 66 69 67 66 3a 6c ((val (configf:l
a400: 6f 6f 6b 75 70 20 72 65 66 64 61 74 20 73 65 63 ookup refdat sec
a410: 74 69 6f 6e 20 76 61 72 29 29 29 0a 09 20 20 20 tion var)))..
a420: 20 20 20 28 69 66 20 28 6e 6f 74 20 76 61 6c 29 (if (not val)
a430: 20 3b 3b 20 74 68 69 73 20 6f 6e 65 20 69 73 20 ;; this one is
a440: 6e 65 77 0a 09 09 20 20 28 62 65 67 69 6e 0a 09 new... (begin..
a450: 09 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 . (if (null?
a460: 73 64 61 74 29 28 73 65 74 21 20 73 64 61 74 20 sdat)(set! sdat
a470: 28 6c 69 73 74 20 28 63 6f 6e 63 20 22 5b 22 20 (list (conc "["
a480: 73 65 63 74 69 6f 6e 20 22 5d 22 29 29 29 29 0a section "]")))).
a490: 09 09 20 20 20 20 28 73 65 74 21 20 73 64 61 74 .. (set! sdat
a4a0: 20 28 61 70 70 65 6e 64 20 73 64 61 74 20 28 6c (append sdat (l
a4b0: 69 73 74 20 28 63 6f 6e 63 20 76 61 72 20 22 20 ist (conc var "
a4c0: 22 20 76 61 6c 29 29 29 29 29 29 29 29 0a 09 20 " val))))))))..
a4d0: 20 73 76 61 72 73 29 0a 09 20 28 73 65 74 21 20 svars).. (set!
a4e0: 66 64 61 74 20 28 61 70 70 65 6e 64 20 66 64 61 fdat (append fda
a4f0: 74 20 73 64 61 74 29 29 29 29 0a 20 20 20 20 20 t sdat)))).
a500: 28 64 65 6c 65 74 65 2d 64 75 70 6c 69 63 61 74 (delete-duplicat
a510: 65 73 20 28 61 70 70 65 6e 64 20 72 65 71 75 69 es (append requi
a520: 72 65 64 2d 73 65 63 74 69 6f 6e 73 20 28 68 61 red-sections (ha
a530: 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 69 6e sh-table-keys in
a540: 64 61 74 29 29 29 29 0a 0a 20 20 20 20 3b 3b 20 dat)))).. ;;
a550: 73 74 65 70 20 35 3a 20 57 72 69 74 65 20 6f 75 step 5: Write ou
a560: 74 20 6e 65 77 20 66 69 6c 65 0a 20 20 20 20 28 t new file. (
a570: 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 with-output-to-f
a580: 69 6c 65 20 66 6e 61 6d 65 20 0a 20 20 20 20 20 ile fname .
a590: 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 28 66 6f (lambda ()..(fo
a5a0: 72 2d 65 61 63 68 20 0a 09 20 28 6c 61 6d 62 64 r-each .. (lambd
a5b0: 61 20 28 6c 69 6e 65 29 0a 09 20 20 20 28 70 72 a (line).. (pr
a5c0: 69 6e 74 20 6c 69 6e 65 29 29 0a 09 20 28 63 6f int line)).. (co
a5d0: 6e 66 69 67 66 3a 65 78 70 61 6e 64 2d 6d 75 6c nfigf:expand-mul
a5e0: 74 69 2d 6c 69 6e 65 73 20 66 64 61 74 29 29 29 ti-lines fdat)))
a5f0: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 70 72 )))..(define (pr
a600: 6f 63 65 73 73 3a 63 6d 64 2d 72 75 6e 2d 3e 6c ocess:cmd-run->l
a610: 69 73 74 20 63 6d 64 20 23 21 6b 65 79 20 28 64 ist cmd #!key (d
a620: 65 6c 74 61 2d 65 6e 76 2d 61 6c 69 73 74 2d 6f elta-env-alist-o
a630: 72 2d 68 61 73 68 2d 74 61 62 6c 65 20 27 28 29 r-hash-table '()
a640: 29 29 0a 20 20 28 63 6f 6d 6d 6f 6e 3a 77 69 74 )). (common:wit
a650: 68 2d 65 6e 76 2d 76 61 72 73 0a 20 20 20 64 65 h-env-vars. de
a660: 6c 74 61 2d 65 6e 76 2d 61 6c 69 73 74 2d 6f 72 lta-env-alist-or
a670: 2d 68 61 73 68 2d 74 61 62 6c 65 0a 20 20 20 28 -hash-table. (
a680: 6c 61 6d 62 64 61 20 28 29 0a 20 20 20 20 20 28 lambda (). (
a690: 6c 65 74 2a 20 28 28 66 68 20 28 6f 70 65 6e 2d let* ((fh (open-
a6a0: 69 6e 70 75 74 2d 70 69 70 65 20 63 6d 64 29 29 input-pipe cmd))
a6b0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 72 65 . (re
a6c0: 73 20 28 70 6f 72 74 2d 3e 6c 69 73 74 20 66 68 s (port->list fh
a6d0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 )). (
a6e0: 73 74 61 74 75 73 20 28 63 6c 6f 73 65 2d 69 6e status (close-in
a6f0: 70 75 74 2d 70 69 70 65 20 66 68 29 29 29 0a 20 put-pipe fh))).
a700: 20 20 20 20 20 20 28 6c 69 73 74 20 72 65 73 20 (list res
a710: 73 74 61 74 75 73 29 29 29 29 29 0a 0a 28 64 65 status)))))..(de
a720: 66 69 6e 65 20 28 70 6f 72 74 2d 3e 6c 69 73 74 fine (port->list
a730: 20 66 68 29 0a 20 20 28 69 66 20 28 65 6f 66 2d fh). (if (eof-
a740: 6f 62 6a 65 63 74 3f 20 66 68 29 20 23 66 0a 20 object? fh) #f.
a750: 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 (let loop (
a760: 28 63 75 72 72 20 28 72 65 61 64 2d 6c 69 6e 65 (curr (read-line
a770: 20 66 68 29 29 0a 20 20 20 20 20 20 20 20 20 20 fh)).
a780: 20 20 20 20 20 20 20 28 72 65 73 75 6c 74 20 27 (result '
a790: 28 29 29 29 0a 20 20 20 20 20 20 20 20 28 69 66 ())). (if
a7a0: 20 28 6e 6f 74 20 28 65 6f 66 2d 6f 62 6a 65 63 (not (eof-objec
a7b0: 74 3f 20 63 75 72 72 29 29 0a 20 20 20 20 20 20 t? curr)).
a7c0: 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 72 65 61 (loop (rea
a7d0: 64 2d 6c 69 6e 65 20 66 68 29 0a 20 20 20 20 20 d-line fh).
a7e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 (ap
a7f0: 70 65 6e 64 20 72 65 73 75 6c 74 20 28 6c 69 73 pend result (lis
a800: 74 20 63 75 72 72 29 29 29 0a 20 20 20 20 20 20 t curr))).
a810: 20 20 20 20 20 20 72 65 73 75 6c 74 29 29 29 29 result))))
a820: 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
a830: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a840: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a850: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a860: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 72 65 ==========.;; re
a870: 66 64 62 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d fdb.;;==========
a880: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a890: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a8a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a8b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b ============..;;
a8c0: 20 72 65 61 64 73 20 61 20 72 65 66 64 62 20 69 reads a refdb i
a8d0: 6e 74 6f 20 61 6e 20 61 73 73 6f 63 20 61 72 72 nto an assoc arr
a8e0: 61 79 20 6f 66 20 61 73 73 6f 63 20 61 72 72 61 ay of assoc arra
a8f0: 79 73 0a 3b 3b 20 20 20 72 65 74 75 72 6e 73 20 ys.;; returns
a900: 28 6c 69 73 74 20 64 61 74 20 6d 73 67 29 0a 28 (list dat msg).(
a910: 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a define (configf:
a920: 72 65 61 64 2d 72 65 66 64 62 20 72 65 66 64 62 read-refdb refdb
a930: 2d 70 61 74 68 29 0a 20 20 28 6c 65 74 20 28 28 -path). (let ((
a940: 73 68 65 65 74 73 2d 66 69 6c 65 20 20 28 63 6f sheets-file (co
a950: 6e 63 20 72 65 66 64 62 2d 70 61 74 68 20 22 2f nc refdb-path "/
a960: 73 68 65 65 74 2d 6e 61 6d 65 73 2e 63 66 67 22 sheet-names.cfg"
a970: 29 29 29 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 ))). (if (not
a980: 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 73 (file-exists? s
a990: 68 65 65 74 73 2d 66 69 6c 65 29 29 0a 09 28 6c heets-file))..(l
a9a0: 69 73 74 20 23 66 20 28 63 6f 6e 63 20 22 45 52 ist #f (conc "ER
a9b0: 52 4f 52 3a 20 6e 6f 20 72 65 66 64 62 20 66 6f ROR: no refdb fo
a9c0: 75 6e 64 20 61 74 20 22 20 72 65 66 64 62 2d 70 und at " refdb-p
a9d0: 61 74 68 29 29 0a 09 28 69 66 20 28 6e 6f 74 20 ath))..(if (not
a9e0: 28 66 69 6c 65 2d 72 65 61 64 61 62 6c 65 3f 20 (file-readable?
a9f0: 73 68 65 65 74 73 2d 66 69 6c 65 29 29 0a 09 20 sheets-file))..
aa00: 20 20 20 28 6c 69 73 74 20 23 66 20 28 63 6f 6e (list #f (con
aa10: 63 20 22 45 52 52 4f 52 3a 20 72 65 66 64 62 20 c "ERROR: refdb
aa20: 66 69 6c 65 20 6e 6f 74 20 72 65 61 64 61 62 6c file not readabl
aa30: 65 20 61 74 20 22 20 72 65 66 64 62 2d 70 61 74 e at " refdb-pat
aa40: 68 29 29 0a 09 20 20 20 20 28 6c 65 74 2a 20 28 h)).. (let* (
aa50: 28 73 68 65 65 74 73 20 28 77 69 74 68 2d 69 6e (sheets (with-in
aa60: 70 75 74 2d 66 72 6f 6d 2d 66 69 6c 65 20 73 68 put-from-file sh
aa70: 65 65 74 73 2d 66 69 6c 65 0a 09 09 09 20 20 20 eets-file....
aa80: 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 (lambda ()....
aa90: 20 20 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 (let loop
aaa0: 20 28 28 69 6e 6c 20 28 72 65 61 64 2d 6c 69 6e ((inl (read-lin
aab0: 65 29 29 0a 09 09 09 09 09 20 20 28 72 65 73 20 e))...... (res
aac0: 27 28 29 29 29 0a 09 09 09 09 20 28 69 66 20 28 '()))..... (if (
aad0: 65 6f 66 2d 6f 62 6a 65 63 74 3f 20 69 6e 6c 29 eof-object? inl)
aae0: 0a 09 09 09 09 20 20 20 20 20 28 72 65 76 65 72 ..... (rever
aaf0: 73 65 20 72 65 73 29 0a 09 09 09 09 20 20 20 20 se res).....
ab00: 20 28 6c 6f 6f 70 20 28 72 65 61 64 2d 6c 69 6e (loop (read-lin
ab10: 65 29 28 63 6f 6e 73 20 69 6e 6c 20 72 65 73 29 e)(cons inl res)
ab20: 29 29 29 29 29 29 0a 09 09 20 20 20 28 64 61 74 ))))))... (dat
ab30: 61 20 20 20 27 28 29 29 29 0a 09 20 20 20 20 20 a '()))..
ab40: 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 20 20 20 (for-each ..
ab50: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 73 68 65 (lambda (she
ab60: 65 74 2d 6e 61 6d 65 29 0a 09 09 20 28 6c 65 74 et-name)... (let
ab70: 2a 20 28 28 64 61 74 2d 70 61 74 68 20 20 28 63 * ((dat-path (c
ab80: 6f 6e 63 20 72 65 66 64 62 2d 70 61 74 68 20 22 onc refdb-path "
ab90: 2f 22 20 73 68 65 65 74 2d 6e 61 6d 65 20 22 2e /" sheet-name ".
aba0: 64 61 74 22 29 29 0a 09 09 09 28 72 65 66 2d 64 dat"))....(ref-d
abb0: 61 74 20 20 20 28 63 6f 6e 66 69 67 66 3a 72 65 at (configf:re
abc0: 61 64 2d 63 6f 6e 66 69 67 20 64 61 74 2d 70 61 ad-config dat-pa
abd0: 74 68 20 23 66 20 23 74 29 29 0a 09 09 09 28 72 th #f #t))....(r
abe0: 65 66 2d 61 73 73 6f 63 20 28 6d 61 70 20 28 6c ef-assoc (map (l
abf0: 61 6d 62 64 61 20 28 6b 65 79 29 0a 09 09 09 09 ambda (key).....
ac00: 09 20 20 28 6c 69 73 74 20 6b 65 79 20 28 68 61 . (list key (ha
ac10: 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 72 65 66 sh-table-ref ref
ac20: 2d 64 61 74 20 6b 65 79 29 29 29 0a 09 09 09 09 -dat key))).....
ac30: 09 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 .(hash-table-key
ac40: 73 20 72 65 66 2d 64 61 74 29 29 29 29 0a 09 09 s ref-dat))))...
ac50: 09 09 20 20 20 3b 3b 20 28 68 61 73 68 2d 74 61 .. ;; (hash-ta
ac60: 62 6c 65 2d 3e 61 6c 69 73 74 20 72 65 66 2d 64 ble->alist ref-d
ac70: 61 74 29 29 29 0a 09 09 20 20 20 3b 3b 20 28 73 at)))... ;; (s
ac80: 65 74 21 20 64 61 74 61 20 28 61 70 70 65 6e 64 et! data (append
ac90: 20 64 61 74 61 20 28 6c 69 73 74 20 28 6c 69 73 data (list (lis
aca0: 74 20 73 68 65 65 74 2d 6e 61 6d 65 20 72 65 66 t sheet-name ref
acb0: 2d 61 73 73 6f 63 29 29 29 29 29 29 0a 09 09 20 -assoc))))))...
acc0: 20 20 28 73 65 74 21 20 64 61 74 61 20 28 63 6f (set! data (co
acd0: 6e 73 20 28 6c 69 73 74 20 73 68 65 65 74 2d 6e ns (list sheet-n
ace0: 61 6d 65 20 72 65 66 2d 61 73 73 6f 63 29 20 64 ame ref-assoc) d
acf0: 61 74 61 29 29 29 29 0a 09 20 20 20 20 20 20 20 ata))))..
ad00: 73 68 65 65 74 73 29 0a 09 20 20 20 20 20 20 28 sheets).. (
ad10: 6c 69 73 74 20 64 61 74 61 20 22 4e 4f 20 45 52 list data "NO ER
ad20: 52 4f 52 53 22 29 29 29 29 29 29 0a 0a 3b 3b 20 RORS"))))))..;;
ad30: 6d 61 70 20 6f 76 65 72 20 61 6c 6c 20 70 61 69 map over all pai
ad40: 72 73 20 69 6e 20 61 20 74 68 72 65 65 20 6c 65 rs in a three le
ad50: 76 65 6c 20 68 69 65 72 61 72 63 68 69 61 6c 20 vel hierarchial
ad60: 61 6c 69 73 74 20 61 6e 64 20 61 70 70 6c 79 20 alist and apply
ad70: 61 20 66 75 6e 63 74 69 6f 6e 20 74 6f 20 74 68 a function to th
ad80: 65 20 6b 65 79 73 2f 76 61 6c 0a 3b 3b 0a 28 64 e keys/val.;;.(d
ad90: 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a 6d efine (configf:m
ada0: 61 70 2d 61 6c 6c 2d 68 69 65 72 2d 61 6c 69 73 ap-all-hier-alis
adb0: 74 20 64 61 74 61 20 70 72 6f 63 20 23 21 6b 65 t data proc #!ke
adc0: 79 20 28 69 6e 69 74 70 72 6f 63 31 20 23 66 29 y (initproc1 #f)
add0: 28 69 6e 69 74 70 72 6f 63 32 20 23 66 29 28 69 (initproc2 #f)(i
ade0: 6e 69 74 70 72 6f 63 33 20 23 66 29 29 0a 20 20 nitproc3 #f)).
adf0: 28 66 6f 72 2d 65 61 63 68 20 0a 20 20 20 28 6c (for-each . (l
ae00: 61 6d 62 64 61 20 28 73 68 65 65 74 6e 61 6d 65 ambda (sheetname
ae10: 29 0a 20 20 20 20 20 28 6c 65 74 2a 20 28 28 73 ). (let* ((s
ae20: 68 65 65 74 74 6d 70 20 20 28 61 73 73 6f 63 20 heettmp (assoc
ae30: 73 68 65 65 74 6e 61 6d 65 20 64 61 74 61 29 29 sheetname data))
ae40: 0a 09 20 20 20 20 28 73 68 65 65 74 64 61 74 20 .. (sheetdat
ae50: 20 28 69 66 20 73 68 65 65 74 74 6d 70 20 28 63 (if sheettmp (c
ae60: 61 64 72 20 73 68 65 65 74 74 6d 70 29 20 27 28 adr sheettmp) '(
ae70: 29 29 29 29 0a 20 20 20 20 20 20 20 28 69 66 20 )))). (if
ae80: 69 6e 69 74 70 72 6f 63 31 20 28 69 6e 69 74 70 initproc1 (initp
ae90: 72 6f 63 31 20 73 68 65 65 74 6e 61 6d 65 29 29 roc1 sheetname))
aea0: 0a 20 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 . (for-eac
aeb0: 68 20 0a 09 28 6c 61 6d 62 64 61 20 28 73 65 63 h ..(lambda (sec
aec0: 74 69 6f 6e 6e 61 6d 65 29 0a 09 20 20 28 6c 65 tionname).. (le
aed0: 74 2a 20 28 28 73 65 63 74 69 6f 6e 74 6d 70 20 t* ((sectiontmp
aee0: 20 28 61 73 73 6f 63 20 73 65 63 74 69 6f 6e 6e (assoc sectionn
aef0: 61 6d 65 20 73 68 65 65 74 64 61 74 29 29 0a 09 ame sheetdat))..
af00: 09 20 28 73 65 63 74 69 6f 6e 64 61 74 20 20 28 . (sectiondat (
af10: 69 66 20 73 65 63 74 69 6f 6e 74 6d 70 20 28 63 if sectiontmp (c
af20: 61 64 72 20 73 65 63 74 69 6f 6e 74 6d 70 29 20 adr sectiontmp)
af30: 27 28 29 29 29 29 0a 09 20 20 20 20 28 69 66 20 '()))).. (if
af40: 69 6e 69 74 70 72 6f 63 32 20 28 69 6e 69 74 70 initproc2 (initp
af50: 72 6f 63 32 20 73 68 65 65 74 6e 61 6d 65 20 73 roc2 sheetname s
af60: 65 63 74 69 6f 6e 6e 61 6d 65 29 29 0a 09 20 20 ectionname))..
af70: 20 20 28 66 6f 72 2d 65 61 63 68 0a 09 20 20 20 (for-each..
af80: 20 20 28 6c 61 6d 62 64 61 20 28 76 61 72 6e 61 (lambda (varna
af90: 6d 65 29 0a 09 20 20 20 20 20 20 20 28 6c 65 74 me).. (let
afa0: 2a 20 28 28 76 61 6c 74 6d 70 20 28 61 73 73 6f * ((valtmp (asso
afb0: 63 20 76 61 72 6e 61 6d 65 20 73 65 63 74 69 6f c varname sectio
afc0: 6e 64 61 74 29 29 0a 09 09 20 20 20 20 20 20 28 ndat))... (
afd0: 76 61 6c 20 20 20 20 28 69 66 20 76 61 6c 74 6d val (if valtm
afe0: 70 20 28 63 61 64 72 20 76 61 6c 74 6d 70 29 20 p (cadr valtmp)
aff0: 22 22 29 29 29 0a 09 09 20 28 70 72 6f 63 20 73 "")))... (proc s
b000: 68 65 65 74 6e 61 6d 65 20 73 65 63 74 69 6f 6e heetname section
b010: 6e 61 6d 65 20 76 61 72 6e 61 6d 65 20 76 61 6c name varname val
b020: 29 29 29 0a 09 20 20 20 20 20 28 6d 61 70 20 63 ))).. (map c
b030: 61 72 20 73 65 63 74 69 6f 6e 64 61 74 29 29 29 ar sectiondat)))
b040: 29 0a 09 28 6d 61 70 20 63 61 72 20 73 68 65 65 )..(map car shee
b050: 74 64 61 74 29 29 29 29 0a 20 20 20 28 6d 61 70 tdat)))). (map
b060: 20 63 61 72 20 64 61 74 61 29 29 0a 20 20 64 61 car data)). da
b070: 74 61 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d ta)..;;=========
b080: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b090: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b0a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b0b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
b0c0: 20 20 43 20 4f 20 4e 20 46 20 49 20 47 20 20 20 C O N F I G
b0d0: 54 20 4f 20 2f 20 46 20 52 20 4f 20 4d 20 20 20 T O / F R O M
b0e0: 41 20 4c 20 49 20 53 20 54 0a 3b 3b 3d 3d 3d 3d A L I S T.;;====
b0f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b100: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b110: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b120: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b130: 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e ==..(define (con
b140: 66 69 67 66 3a 63 6f 6e 66 69 67 2d 3e 61 6c 69 figf:config->ali
b150: 73 74 20 63 66 67 64 61 74 29 0a 20 20 28 68 61 st cfgdat). (ha
b160: 73 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 74 20 sh-table->alist
b170: 63 66 67 64 61 74 29 29 0a 0a 28 64 65 66 69 6e cfgdat))..(defin
b180: 65 20 28 63 6f 6e 66 69 67 66 3a 61 6c 69 73 74 e (configf:alist
b190: 2d 3e 63 6f 6e 66 69 67 20 61 64 61 74 29 0a 20 ->config adat).
b1a0: 20 28 6c 65 74 20 28 28 68 74 20 28 6d 61 6b 65 (let ((ht (make
b1b0: 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 29 0a 20 -hash-table))).
b1c0: 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 20 20 20 (for-each.
b1d0: 20 20 28 6c 61 6d 62 64 61 20 28 73 65 63 74 69 (lambda (secti
b1e0: 6f 6e 29 0a 20 20 20 20 20 20 20 28 68 61 73 68 on). (hash
b1f0: 2d 74 61 62 6c 65 2d 73 65 74 21 20 68 74 20 28 -table-set! ht (
b200: 63 61 72 20 73 65 63 74 69 6f 6e 29 28 63 64 72 car section)(cdr
b210: 20 73 65 63 74 69 6f 6e 29 29 29 0a 20 20 20 20 section))).
b220: 20 61 64 61 74 29 0a 20 20 20 20 68 74 29 29 0a adat). ht)).
b230: 0a 3b 3b 20 63 6f 6e 76 65 72 74 20 68 69 65 72 .;; convert hier
b240: 61 72 63 68 69 61 6c 20 6c 69 73 74 20 74 6f 20 archial list to
b250: 69 6e 69 20 66 6f 72 6d 61 74 0a 3b 3b 0a 28 64 ini format.;;.(d
b260: 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a 63 efine (configf:c
b270: 6f 6e 66 69 67 2d 3e 69 6e 69 20 64 61 74 61 29 onfig->ini data)
b280: 0a 20 20 28 6d 61 70 20 0a 20 20 20 28 6c 61 6d . (map . (lam
b290: 62 64 61 20 28 73 65 63 74 69 6f 6e 29 0a 20 20 bda (section).
b2a0: 20 20 20 28 6c 65 74 20 28 28 73 65 63 74 69 6f (let ((sectio
b2b0: 6e 2d 6e 61 6d 65 20 28 63 61 72 20 73 65 63 74 n-name (car sect
b2c0: 69 6f 6e 29 29 0a 09 20 20 20 28 73 65 63 74 69 ion)).. (secti
b2d0: 6f 6e 2d 64 61 74 20 20 28 63 64 72 20 73 65 63 on-dat (cdr sec
b2e0: 74 69 6f 6e 29 29 29 0a 20 20 20 20 20 20 20 28 tion))). (
b2f0: 70 72 69 6e 74 20 22 5c 6e 5b 22 20 73 65 63 74 print "\n[" sect
b300: 69 6f 6e 2d 6e 61 6d 65 20 22 5d 22 29 0a 20 20 ion-name "]").
b310: 20 20 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 (map (lambd
b320: 61 20 28 64 61 74 2d 70 61 69 72 29 0a 09 20 20 a (dat-pair)..
b330: 20 20 20 20 28 6c 65 74 2a 20 28 28 76 61 72 20 (let* ((var
b340: 28 63 61 72 20 64 61 74 2d 70 61 69 72 29 29 0a (car dat-pair)).
b350: 09 09 20 20 20 20 20 28 76 61 6c 20 28 63 61 64 .. (val (cad
b360: 72 20 64 61 74 2d 70 61 69 72 29 29 0a 09 09 20 r dat-pair))...
b370: 20 20 20 20 28 66 6e 61 6d 65 20 28 69 66 20 28 (fname (if (
b380: 3e 20 28 6c 65 6e 67 74 68 20 64 61 74 2d 70 61 > (length dat-pa
b390: 69 72 29 20 32 29 28 63 61 64 64 72 20 64 61 74 ir) 2)(caddr dat
b3a0: 2d 70 61 69 72 29 20 23 66 29 29 29 0a 09 09 28 -pair) #f)))...(
b3b0: 69 66 20 66 6e 61 6d 65 20 28 70 72 69 6e 74 20 if fname (print
b3c0: 22 23 20 22 20 76 61 72 20 22 3d 3e 22 20 66 6e "# " var "=>" fn
b3d0: 61 6d 65 29 29 0a 09 09 28 70 72 69 6e 74 20 76 ame))...(print v
b3e0: 61 72 20 22 20 22 20 76 61 6c 29 29 29 0a 09 20 ar " " val)))..
b3f0: 20 20 20 73 65 63 74 69 6f 6e 2d 64 61 74 29 29 section-dat))
b400: 29 20 3b 3b 20 20 20 20 20 20 20 28 70 72 69 6e ) ;; (prin
b410: 74 20 22 73 65 63 74 69 6f 6e 2d 64 61 74 3a 20 t "section-dat:
b420: 22 20 73 65 63 74 69 6f 6e 2d 64 61 74 29 29 0a " section-dat)).
b430: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 3e (hash-table->
b440: 61 6c 69 73 74 20 64 61 74 61 29 29 29 0a 0a 28 alist data)))..(
b450: 64 65 66 69 6e 65 20 28 72 75 6e 63 6f 6e 66 69 define (runconfi
b460: 67 3a 72 65 61 64 20 66 6e 61 6d 65 20 74 61 72 g:read fname tar
b470: 67 65 74 20 65 6e 76 69 72 6f 6e 2d 70 61 74 74 get environ-patt
b480: 29 0a 20 20 28 6c 65 74 20 28 28 68 74 20 28 6d ). (let ((ht (m
b490: 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 ake-hash-table))
b4a0: 29 0a 20 20 20 20 28 69 66 20 74 61 72 67 65 74 ). (if target
b4b0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 (hash-table-set
b4c0: 21 20 68 74 20 74 61 72 67 65 74 20 27 28 29 29 ! ht target '())
b4d0: 29 0a 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 72 ). (configf:r
b4e0: 65 61 64 2d 63 6f 6e 66 69 67 20 66 6e 61 6d 65 ead-config fname
b4f0: 20 68 74 20 23 74 20 65 6e 76 69 72 6f 6e 2d 70 ht #t environ-p
b500: 61 74 74 3a 20 65 6e 76 69 72 6f 6e 2d 70 61 74 att: environ-pat
b510: 74 20 73 65 63 74 69 6f 6e 73 3a 20 28 69 66 20 t sections: (if
b520: 74 61 72 67 65 74 20 28 6c 69 73 74 20 22 64 65 target (list "de
b530: 66 61 75 6c 74 22 20 74 61 72 67 65 74 29 20 23 fault" target) #
b540: 66 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d f))))..;;=======
b550: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b560: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b570: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b580: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
b590: 3b 3b 20 43 6f 6e 66 69 67 20 66 69 6c 65 20 68 ;; Config file h
b5a0: 61 6e 64 6c 69 6e 67 0a 3b 3b 3d 3d 3d 3d 3d 3d andling.;;======
b5b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b5c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b5d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b5e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b5f0: 0a 0a 3b 3b 20 63 6f 6e 76 65 72 74 20 74 6f 20 ..;; convert to
b600: 70 61 72 61 6d 3f 0a 28 64 65 66 69 6e 65 20 63 param?.(define c
b610: 6f 6e 66 69 67 66 3a 73 74 64 2d 69 6d 70 6f 72 onfigf:std-impor
b620: 74 73 20 22 28 69 6d 70 6f 72 74 20 63 6f 6e 66 ts "(import conf
b630: 69 67 66 6d 6f 64 20 63 6f 6d 6d 6f 6e 6d 6f 64 igfmod commonmod
b640: 29 22 29 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e )").(define (con
b650: 66 69 67 66 3a 70 72 6f 63 65 73 73 2d 6f 6e 65 figf:process-one
b660: 20 6d 61 74 63 68 64 61 74 20 6c 20 68 74 20 61 matchdat l ht a
b670: 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 65 6e 76 2d llow-system env-
b680: 74 6f 2d 75 73 65 20 6c 69 6e 65 6e 75 6d 29 0a to-use linenum).
b690: 20 20 28 6c 65 74 2a 20 28 28 70 72 65 73 74 72 (let* ((prestr
b6a0: 20 20 28 6c 69 73 74 2d 72 65 66 20 6d 61 74 63 (list-ref matc
b6b0: 68 64 61 74 20 31 29 29 0a 09 20 28 63 6d 64 74 hdat 1)).. (cmdt
b6c0: 79 70 65 20 28 6c 69 73 74 2d 72 65 66 20 6d 61 ype (list-ref ma
b6d0: 74 63 68 64 61 74 20 32 29 29 20 3b 3b 20 65 76 tchdat 2)) ;; ev
b6e0: 61 6c 2c 20 73 79 73 74 65 6d 2c 20 73 68 65 6c al, system, shel
b6f0: 6c 2c 20 67 65 74 65 6e 76 0a 09 20 28 63 6d 64 l, getenv.. (cmd
b700: 20 20 20 20 20 28 6c 69 73 74 2d 72 65 66 20 6d (list-ref m
b710: 61 74 63 68 64 61 74 20 33 29 29 0a 09 20 28 71 atchdat 3)).. (q
b720: 75 6f 74 65 64 63 6d 64 20 28 63 6f 6e 63 20 22 uotedcmd (conc "
b730: 5c 22 22 63 6d 64 22 5c 22 22 29 29 0a 09 20 28 \""cmd"\"")).. (
b740: 70 6f 73 74 73 74 72 20 28 6c 69 73 74 2d 72 65 poststr (list-re
b750: 66 20 6d 61 74 63 68 64 61 74 20 34 29 29 0a 09 f matchdat 4))..
b760: 20 28 72 65 73 75 6c 74 20 20 23 66 29 0a 09 20 (result #f)..
b770: 28 73 74 61 72 74 2d 74 69 6d 65 20 28 63 75 72 (start-time (cur
b780: 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 0a 09 rent-seconds))..
b790: 20 28 63 6d 64 73 79 6d 20 20 28 73 74 72 69 6e (cmdsym (strin
b7a0: 67 2d 3e 73 79 6d 62 6f 6c 20 63 6d 64 74 79 70 g->symbol cmdtyp
b7b0: 65 29 29 0a 09 20 28 66 75 6c 6c 63 6d 64 0a 09 e)).. (fullcmd..
b7c0: 20 20 28 69 66 20 28 6d 65 6d 62 65 72 20 63 6d (if (member cm
b7d0: 64 73 79 6d 20 27 28 73 63 68 65 6d 65 20 73 63 dsym '(scheme sc
b7e0: 6d 29 29 0a 09 20 20 20 20 20 20 60 28 65 76 61 m)).. `(eva
b7f0: 6c 2d 6e 65 65 64 65 64 0a 09 09 20 2c 28 63 6f l-needed... ,(co
b800: 6e 63 20 20 63 6f 6e 66 69 67 66 3a 73 74 64 2d nc configf:std-
b810: 69 6d 70 6f 72 74 73 0a 09 09 09 20 20 22 28 69 imports.... "(i
b820: 6d 70 6f 72 74 20 63 68 69 63 6b 65 6e 2e 70 72 mport chicken.pr
b830: 6f 63 65 73 73 2d 63 6f 6e 74 65 78 74 2e 70 6f ocess-context.po
b840: 73 69 78 20 63 68 69 63 6b 65 6e 2e 70 72 6f 63 six chicken.proc
b850: 65 73 73 2d 63 6f 6e 74 65 78 74 29 22 0a 09 09 ess-context)"...
b860: 09 20 20 22 28 64 65 66 69 6e 65 20 73 65 74 65 . "(define sete
b870: 6e 76 20 73 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 nv set-environme
b880: 6e 74 2d 76 61 72 69 61 62 6c 65 29 22 0a 09 09 nt-variable)"...
b890: 09 20 20 28 63 6f 6e 63 20 22 28 6c 61 6d 62 64 . (conc "(lambd
b8a0: 61 20 28 68 74 29 22 20 63 6d 64 20 22 29 22 29 a (ht)" cmd ")")
b8b0: 29 29 0a 09 20 20 20 20 20 20 28 63 61 73 65 20 )).. (case
b8c0: 63 6d 64 73 79 6d 0a 09 09 28 28 73 79 73 74 65 cmdsym...((syste
b8d0: 6d 29 20 20 20 20 20 60 28 6e 6f 65 76 61 6c 2d m) `(noeval-
b8e0: 6e 65 65 64 65 64 20 20 2c 28 63 6f 6e 63 20 28 needed ,(conc (
b8f0: 63 6f 6e 66 69 67 66 3a 73 79 73 74 65 6d 20 68 configf:system h
b900: 74 20 71 75 6f 74 65 64 63 6d 64 29 29 29 29 0a t quotedcmd)))).
b910: 09 09 28 28 73 68 65 6c 6c 20 73 68 29 20 20 20 ..((shell sh)
b920: 60 28 6e 6f 65 76 61 6c 2d 6e 65 65 64 65 64 20 `(noeval-needed
b930: 20 2c 28 63 6f 6e 63 20 28 73 74 72 69 6e 67 2d ,(conc (string-
b940: 74 72 61 6e 73 6c 61 74 65 20 28 73 68 65 6c 6c translate (shell
b950: 20 71 75 6f 74 65 64 63 6d 64 29 20 22 5c 6e 22 quotedcmd) "\n"
b960: 20 22 20 22 29 29 29 29 0a 09 09 28 28 72 65 61 " "))))...((rea
b970: 6c 70 61 74 68 20 72 70 29 60 28 6e 6f 65 76 61 lpath rp)`(noeva
b980: 6c 2d 6e 65 65 64 65 64 20 20 2c 28 63 6f 6e 63 l-needed ,(conc
b990: 20 28 63 6f 6d 6d 6f 6e 3a 6e 69 63 65 2d 70 61 (common:nice-pa
b9a0: 74 68 20 71 75 6f 74 65 64 63 6d 64 29 29 29 29 th quotedcmd))))
b9b0: 0a 09 09 28 28 67 65 74 65 6e 76 20 67 76 29 20 ...((getenv gv)
b9c0: 20 60 28 6e 6f 65 76 61 6c 2d 6e 65 65 64 65 64 `(noeval-needed
b9d0: 20 20 2c 28 63 6f 6e 63 20 28 67 65 74 2d 65 6e ,(conc (get-en
b9e0: 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 vironment-variab
b9f0: 6c 65 20 63 6d 64 29 29 29 29 0a 09 09 3b 3b 20 le cmd))))...;;
ba00: 28 28 6d 74 72 61 68 29 20 20 20 20 20 20 28 63 ((mtrah) (c
ba10: 6f 6e 63 20 28 6f 72 20 2a 74 6f 70 70 61 74 68 onc (or *toppath
ba20: 2a 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 * (get-environme
ba30: 6e 74 2d 76 61 72 69 61 62 6c 65 20 5c 22 4d 54 nt-variable \"MT
ba40: 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 5c 22 _RUN_AREA_HOME\"
ba50: 29 29 29 29 0a 09 09 28 28 67 65 74 20 67 29 20 ))))...((get g)
ba60: 20 20 0a 09 09 20 28 6d 61 74 63 68 0a 09 09 20 ... (match...
ba70: 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 63 (string-split c
ba80: 6d 64 29 0a 09 09 20 20 28 28 73 65 63 74 20 76 md)... ((sect v
ba90: 61 72 29 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b ar)(configf:look
baa0: 75 70 20 68 74 20 73 65 63 74 20 76 61 72 29 29 up ht sect var))
bab0: 0a 09 09 20 20 28 65 6c 73 65 0a 09 09 20 20 20 ... (else...
bac0: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 (debug:print-err
bad0: 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f or 0 *default-lo
bae0: 67 2d 70 6f 72 74 2a 20 22 23 7b 67 65 74 20 2e g-port* "#{get .
baf0: 2e 2e 7d 20 75 73 65 64 20 77 69 74 68 20 6f 6e ..} used with on
bb00: 6c 79 20 6f 6e 65 20 70 61 72 61 6d 65 74 65 72 ly one parameter
bb10: 2c 20 5c 22 22 20 63 6d 64 20 22 5c 22 2c 20 74 , \"" cmd "\", t
bb20: 77 6f 20 6e 65 65 64 65 64 2e 22 29 0a 09 09 20 wo needed.")...
bb30: 20 20 27 28 62 61 64 2d 70 61 72 61 6d 20 2c 28 '(bad-param ,(
bb40: 63 6f 6e 63 20 22 23 7b 67 65 74 20 2e 2e 2e 7d conc "#{get ...}
bb50: 20 75 73 65 64 20 77 69 74 68 20 6f 6e 6c 79 20 used with only
bb60: 6f 6e 65 20 70 61 72 61 6d 65 74 65 72 2c 20 5c one parameter, \
bb70: 22 22 20 63 6d 64 20 22 5c 22 2c 20 74 77 6f 20 "" cmd "\", two
bb80: 6e 65 65 64 65 64 2e 22 29 29 29 29 29 0a 09 09 needed.")))))...
bb90: 28 28 72 75 6e 63 6f 6e 66 69 67 73 2d 67 65 74 ((runconfigs-get
bba0: 20 72 67 65 74 29 20 60 28 6e 6f 65 76 61 6c 2d rget) `(noeval-
bbb0: 6e 65 65 64 65 64 20 2c 28 72 75 6e 63 6f 6e 66 needed ,(runconf
bbc0: 69 67 73 2d 67 65 74 20 68 74 20 71 75 6f 74 65 igs-get ht quote
bbd0: 64 63 6d 64 29 29 29 20 3b 3b 20 28 63 6f 6e 63 dcmd))) ;; (conc
bbe0: 20 22 28 6c 61 6d 62 64 61 20 28 68 74 29 28 72 "(lambda (ht)(r
bbf0: 75 6e 63 6f 6e 66 69 67 73 2d 67 65 74 20 68 74 unconfigs-get ht
bc00: 20 5c 22 22 20 63 6d 64 20 22 5c 22 29 29 22 29 \"" cmd "\"))")
bc10: 29 0a 09 09 28 65 6c 73 65 20 60 28 23 66 20 2c )...(else `(#f ,
bc20: 28 63 6f 6e 63 20 22 63 6d 64 3a 20 22 20 63 6d (conc "cmd: " cm
bc30: 64 20 22 20 6e 6f 74 20 72 65 63 6f 67 6e 69 73 d " not recognis
bc40: 65 64 22 29 29 29 29 29 29 29 0a 20 20 20 20 28 ed"))))))). (
bc50: 6d 61 74 63 68 0a 20 20 20 20 20 66 75 6c 6c 63 match. fullc
bc60: 6d 64 0a 20 20 20 20 20 28 28 27 65 76 61 6c 2d md. (('eval-
bc70: 6e 65 65 64 65 64 20 6e 65 77 72 65 73 29 0a 20 needed newres).
bc80: 20 20 20 20 20 28 68 61 6e 64 6c 65 2d 65 78 63 (handle-exc
bc90: 65 70 74 69 6f 6e 73 0a 09 20 65 78 6e 0a 09 20 eptions.. exn..
bca0: 28 62 65 67 69 6e 0a 09 20 20 20 28 64 65 62 75 (begin.. (debu
bcb0: 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 g:print 0 *defau
bcc0: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 41 lt-log-port* "WA
bcd0: 52 4e 49 4e 47 3a 20 66 61 69 6c 65 64 20 74 6f RNING: failed to
bce0: 20 70 72 6f 63 65 73 73 20 63 6f 6e 66 69 67 20 process config
bcf0: 69 6e 70 75 74 20 5c 22 22 20 6c 20 22 5c 22 2c input \"" l "\",
bd00: 20 66 75 6c 6c 63 6d 64 3d 22 66 75 6c 6c 63 6d fullcmd="fullcm
bd10: 64 22 2c 20 65 78 6e 3d 22 20 65 78 6e 29 0a 09 d", exn=" exn)..
bd20: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
bd30: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
bd40: 6f 72 74 2a 20 22 20 6d 65 73 73 61 67 65 3a 20 ort* " message:
bd50: 22 20 28 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 " ((condition-pr
bd60: 6f 70 65 72 74 79 2d 61 63 63 65 73 73 6f 72 20 operty-accessor
bd70: 27 65 78 6e 20 27 6d 65 73 73 61 67 65 29 20 65 'exn 'message) e
bd80: 78 6e 29 29 0a 09 20 20 20 3b 3b 20 28 70 72 69 xn)).. ;; (pri
bd90: 6e 74 20 22 65 78 6e 3d 22 20 28 63 6f 6e 64 69 nt "exn=" (condi
bda0: 74 69 6f 6e 2d 3e 6c 69 73 74 20 65 78 6e 29 29 tion->list exn))
bdb0: 0a 09 20 20 20 28 73 65 74 21 20 72 65 73 75 6c .. (set! resul
bdc0: 74 20 28 63 6f 6e 63 20 22 23 7b 28 20 22 20 63 t (conc "#{( " c
bdd0: 6d 64 74 79 70 65 20 22 29 20 22 20 63 6d 64 20 mdtype ") " cmd
bde0: 22 7d 2c 20 66 75 6c 6c 20 65 78 70 61 6e 73 69 "}, full expansi
bdf0: 6f 6e 3a 20 22 20 66 75 6c 6c 63 6d 64 29 29 29 on: " fullcmd)))
be00: 0a 09 20 28 69 66 20 28 6f 72 20 61 6c 6c 6f 77 .. (if (or allow
be10: 2d 73 79 73 74 65 6d 0a 09 09 20 28 6e 6f 74 20 -system... (not
be20: 28 6d 65 6d 62 65 72 20 63 6d 64 74 79 70 65 20 (member cmdtype
be30: 27 28 22 73 79 73 74 65 6d 22 20 22 73 68 65 6c '("system" "shel
be40: 6c 22 20 22 73 68 22 29 29 29 29 0a 09 20 20 20 l" "sh"))))..
be50: 20 20 28 77 69 74 68 2d 69 6e 70 75 74 2d 66 72 (with-input-fr
be60: 6f 6d 2d 73 74 72 69 6e 67 20 6e 65 77 72 65 73 om-string newres
be70: 0a 09 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 .. (lambda
be80: 20 28 29 0a 09 09 20 28 73 65 74 21 20 72 65 73 ()... (set! res
be90: 75 6c 74 20 28 69 66 20 65 6e 76 2d 74 6f 2d 75 ult (if env-to-u
bea0: 73 65 0a 09 09 09 09 20 20 28 28 65 76 61 6c 20 se..... ((eval
beb0: 28 72 65 61 64 29 20 65 6e 76 2d 74 6f 2d 75 73 (read) env-to-us
bec0: 65 29 20 68 74 29 0a 09 09 09 09 20 20 28 28 65 e) ht)..... ((e
bed0: 76 61 6c 20 28 72 65 61 64 29 29 20 68 74 29 0a val (read)) ht).
bee0: 09 09 09 09 20 20 29 29 29 29 0a 09 20 20 20 20 .... ))))..
bef0: 20 28 73 65 74 21 20 72 65 73 75 6c 74 20 28 63 (set! result (c
bf00: 6f 6e 63 20 22 23 7b 28 22 20 63 6d 64 74 79 70 onc "#{(" cmdtyp
bf10: 65 20 22 29 20 22 20 20 63 6d 64 20 22 7d 22 29 e ") " cmd "}")
bf20: 29 29 29 29 0a 20 20 20 20 20 28 28 27 6e 6f 65 )))). (('noe
bf30: 76 61 6c 2d 6e 65 65 64 65 64 20 6e 65 77 72 65 val-needed newre
bf40: 73 29 28 73 65 74 21 20 72 65 73 75 6c 74 20 6e s)(set! result n
bf50: 65 77 72 65 73 29 29 0a 20 20 20 20 20 28 28 23 ewres)). ((#
bf60: 66 20 65 72 72 72 65 73 29 0a 20 20 20 20 20 20 f errres).
bf70: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a (debug:print 0 *
bf80: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
bf90: 2a 20 22 57 41 52 4e 49 4e 47 3a 20 66 61 69 6c * "WARNING: fail
bfa0: 65 64 20 74 6f 20 70 72 6f 63 65 73 73 20 63 6f ed to process co
bfb0: 6e 66 69 67 20 69 6e 70 75 74 20 5c 22 22 20 6c nfig input \"" l
bfc0: 20 22 5c 22 2e 22 29 29 29 0a 20 20 20 20 3b 3b "\"."))). ;;
bfd0: 20 77 65 20 70 72 6f 63 65 73 73 20 61 73 20 61 we process as a
bfe0: 20 72 65 73 75 6c 74 0a 20 20 20 20 28 6c 65 74 result. (let
bff0: 20 28 28 64 65 6c 74 61 20 28 2d 20 28 63 75 72 ((delta (- (cur
c000: 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 20 73 74 rent-seconds) st
c010: 61 72 74 2d 74 69 6d 65 29 29 29 0a 20 20 20 20 art-time))).
c020: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 (debug:print-i
c030: 6e 66 6f 20 28 69 66 20 28 3e 20 64 65 6c 74 61 nfo (if (> delta
c040: 20 32 29 20 30 20 39 29 20 2a 64 65 66 61 75 6c 2) 0 9) *defaul
c050: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 66 6f 72 t-log-port* "for
c060: 20 6c 69 6e 65 20 5c 22 22 20 6c 20 22 5c 22 5c line \"" l "\"\
c070: 6e 20 63 6f 6d 6d 61 6e 64 3a 20 20 22 20 63 6d n command: " cm
c080: 64 20 22 20 74 6f 6f 6b 20 22 20 64 65 6c 74 61 d " took " delta
c090: 20 22 20 73 65 63 6f 6e 64 73 20 74 6f 20 72 75 " seconds to ru
c0a0: 6e 20 77 69 74 68 20 6f 75 74 70 75 74 3a 5c 6e n with output:\n
c0b0: 20 20 20 22 20 72 65 73 75 6c 74 29 29 0a 20 20 " result)).
c0c0: 20 20 28 63 6f 6e 63 20 70 72 65 73 74 72 20 72 (conc prestr r
c0d0: 65 73 75 6c 74 20 70 6f 73 74 73 74 72 29 29 29 esult poststr)))
c0e0: 0a 09 20 20 20 20 20 20 0a 28 64 65 66 69 6e 65 .. .(define
c0f0: 20 28 63 6f 6e 66 69 67 66 3a 70 72 6f 63 65 73 (configf:proces
c100: 73 2d 6c 69 6e 65 20 6c 20 68 74 20 61 6c 6c 6f s-line l ht allo
c110: 77 2d 73 79 73 74 65 6d 20 65 6e 76 2d 74 6f 2d w-system env-to-
c120: 75 73 65 20 23 21 6b 65 79 20 28 6c 69 6e 65 6e use #!key (linen
c130: 75 6d 20 23 66 29 29 0a 20 20 28 6c 65 74 20 6c um #f)). (let l
c140: 6f 6f 70 20 28 28 72 65 73 20 6c 29 29 0a 20 20 oop ((res l)).
c150: 20 20 28 69 66 20 28 73 74 72 69 6e 67 3f 20 72 (if (string? r
c160: 65 73 29 0a 09 28 6c 65 74 20 28 28 6d 61 74 63 es)..(let ((matc
c170: 68 64 61 74 20 28 73 74 72 69 6e 67 2d 73 65 61 hdat (string-sea
c180: 72 63 68 20 63 6f 6e 66 69 67 66 3a 76 61 72 2d rch configf:var-
c190: 65 78 70 61 6e 64 2d 72 65 67 65 78 20 72 65 73 expand-regex res
c1a0: 29 29 29 0a 09 20 20 28 69 66 20 6d 61 74 63 68 ))).. (if match
c1b0: 64 61 74 0a 09 20 20 20 20 20 20 28 6c 65 74 20 dat.. (let
c1c0: 28 28 72 65 73 75 6c 74 20 28 63 6f 6e 66 69 67 ((result (config
c1d0: 66 3a 70 72 6f 63 65 73 73 2d 6f 6e 65 20 6d 61 f:process-one ma
c1e0: 74 63 68 64 61 74 20 6c 20 68 74 20 61 6c 6c 6f tchdat l ht allo
c1f0: 77 2d 73 79 73 74 65 6d 20 65 6e 76 2d 74 6f 2d w-system env-to-
c200: 75 73 65 20 6c 69 6e 65 6e 75 6d 29 29 29 0a 09 use linenum)))..
c210: 09 28 6c 6f 6f 70 20 72 65 73 75 6c 74 29 29 0a .(loop result)).
c220: 09 20 20 20 20 20 20 72 65 73 29 29 0a 09 20 20 . res))..
c230: 72 65 73 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 res)))..(define
c240: 28 63 6f 6e 66 69 67 66 3a 70 72 6f 63 65 73 73 (configf:process
c250: 2d 6c 69 6e 65 2d 6f 6c 64 20 6c 20 68 74 20 61 -line-old l ht a
c260: 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 65 6e 76 2d llow-system env-
c270: 74 6f 2d 75 73 65 20 23 21 6b 65 79 20 28 6c 69 to-use #!key (li
c280: 6e 65 6e 75 6d 20 23 66 29 29 0a 20 20 28 6c 65 nenum #f)). (le
c290: 74 20 6c 6f 6f 70 20 28 28 72 65 73 20 6c 29 29 t loop ((res l))
c2a0: 0a 20 20 20 20 28 69 66 20 28 73 74 72 69 6e 67 . (if (string
c2b0: 3f 20 72 65 73 29 0a 09 28 6c 65 74 20 28 28 6d ? res)..(let ((m
c2c0: 61 74 63 68 64 61 74 20 28 73 74 72 69 6e 67 2d atchdat (string-
c2d0: 73 65 61 72 63 68 20 63 6f 6e 66 69 67 66 3a 76 search configf:v
c2e0: 61 72 2d 65 78 70 61 6e 64 2d 72 65 67 65 78 20 ar-expand-regex
c2f0: 72 65 73 29 29 29 0a 09 20 20 28 69 66 20 6d 61 res))).. (if ma
c300: 74 63 68 64 61 74 0a 09 20 20 20 20 20 20 28 6c tchdat.. (l
c310: 65 74 2a 20 28 28 70 72 65 73 74 72 20 20 28 6c et* ((prestr (l
c320: 69 73 74 2d 72 65 66 20 6d 61 74 63 68 64 61 74 ist-ref matchdat
c330: 20 31 29 29 0a 09 09 20 20 20 20 20 28 63 6d 64 1))... (cmd
c340: 74 79 70 65 20 28 6c 69 73 74 2d 72 65 66 20 6d type (list-ref m
c350: 61 74 63 68 64 61 74 20 32 29 29 20 3b 3b 20 65 atchdat 2)) ;; e
c360: 76 61 6c 2c 20 73 79 73 74 65 6d 2c 20 73 68 65 val, system, she
c370: 6c 6c 2c 20 67 65 74 65 6e 76 0a 09 09 20 20 20 ll, getenv...
c380: 20 20 28 63 6d 64 20 20 20 20 20 28 6c 69 73 74 (cmd (list
c390: 2d 72 65 66 20 6d 61 74 63 68 64 61 74 20 33 29 -ref matchdat 3)
c3a0: 29 0a 09 09 20 20 20 20 20 28 70 6f 73 74 73 74 )... (postst
c3b0: 72 20 28 6c 69 73 74 2d 72 65 66 20 6d 61 74 63 r (list-ref matc
c3c0: 68 64 61 74 20 34 29 29 0a 09 09 20 20 20 20 20 hdat 4))...
c3d0: 28 72 65 73 75 6c 74 20 20 23 66 29 0a 09 09 20 (result #f)...
c3e0: 20 20 20 20 28 73 74 61 72 74 2d 74 69 6d 65 20 (start-time
c3f0: 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 (current-seconds
c400: 29 29 0a 09 09 20 20 20 20 20 28 63 6d 64 73 79 ))... (cmdsy
c410: 6d 20 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 m (string->symb
c420: 6f 6c 20 63 6d 64 74 79 70 65 29 29 0a 09 09 20 ol cmdtype))...
c430: 20 20 20 20 28 66 75 6c 6c 63 6d 64 0a 09 09 20 (fullcmd...
c440: 20 20 20 20 20 28 63 6f 6e 63 20 20 63 6f 6e 66 (conc conf
c450: 69 67 66 3a 73 74 64 2d 69 6d 70 6f 72 74 73 0a igf:std-imports.
c460: 09 09 09 20 20 20 20 20 22 28 69 6d 70 6f 72 74 ... "(import
c470: 20 63 68 69 63 6b 65 6e 2e 70 72 6f 63 65 73 73 chicken.process
c480: 2d 63 6f 6e 74 65 78 74 2e 70 6f 73 69 78 29 22 -context.posix)"
c490: 0a 09 09 09 20 20 20 20 20 22 28 64 65 66 69 6e .... "(defin
c4a0: 65 20 73 65 74 65 6e 76 20 73 65 74 2d 65 6e 76 e setenv set-env
c4b0: 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c ironment-variabl
c4c0: 65 29 22 0a 09 09 09 20 20 20 20 20 28 63 61 73 e)".... (cas
c4d0: 65 20 63 6d 64 73 79 6d 0a 09 09 09 20 20 20 20 e cmdsym....
c4e0: 20 20 20 28 28 73 63 68 65 6d 65 20 73 63 6d 29 ((scheme scm)
c4f0: 20 28 63 6f 6e 63 20 22 28 6c 61 6d 62 64 61 20 (conc "(lambda
c500: 28 68 74 29 22 20 63 6d 64 20 22 29 22 29 29 0a (ht)" cmd ")")).
c510: 09 09 09 20 20 20 20 20 20 20 28 28 73 79 73 74 ... ((syst
c520: 65 6d 29 20 20 20 20 20 28 63 6f 6e 63 20 22 28 em) (conc "(
c530: 6c 61 6d 62 64 61 20 28 68 74 29 28 63 6f 6e 66 lambda (ht)(conf
c540: 69 67 66 3a 73 79 73 74 65 6d 20 68 74 20 5c 22 igf:system ht \"
c550: 22 20 63 6d 64 20 22 5c 22 29 29 22 29 29 0a 09 " cmd "\"))"))..
c560: 09 09 20 20 20 20 20 20 20 28 28 73 68 65 6c 6c .. ((shell
c570: 20 73 68 29 20 20 20 28 63 6f 6e 63 20 22 28 6c sh) (conc "(l
c580: 61 6d 62 64 61 20 28 68 74 29 28 73 74 72 69 6e ambda (ht)(strin
c590: 67 2d 74 72 61 6e 73 6c 61 74 65 20 28 73 68 65 g-translate (she
c5a0: 6c 6c 20 5c 22 22 20 20 63 6d 64 20 22 5c 22 29 ll \"" cmd "\")
c5b0: 20 5c 22 5c 6e 5c 22 20 5c 22 20 5c 22 29 29 22 \"\n\" \" \"))"
c5c0: 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 28 72 )).... ((r
c5d0: 65 61 6c 70 61 74 68 20 72 70 29 28 63 6f 6e 63 ealpath rp)(conc
c5e0: 20 22 28 6c 61 6d 62 64 61 20 28 68 74 29 28 63 "(lambda (ht)(c
c5f0: 6f 6d 6d 6f 6e 3a 6e 69 63 65 2d 70 61 74 68 20 ommon:nice-path
c600: 5c 22 22 20 63 6d 64 20 22 5c 22 29 29 22 29 29 \"" cmd "\"))"))
c610: 0a 09 09 09 20 20 20 20 20 20 20 28 28 67 65 74 .... ((get
c620: 65 6e 76 20 67 76 29 20 20 28 63 6f 6e 63 20 22 env gv) (conc "
c630: 28 6c 61 6d 62 64 61 20 28 68 74 29 28 67 65 74 (lambda (ht)(get
c640: 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 -environment-var
c650: 69 61 62 6c 65 20 5c 22 22 20 63 6d 64 20 22 5c iable \"" cmd "\
c660: 22 29 29 22 29 29 0a 09 09 09 20 20 20 20 20 20 "))"))....
c670: 20 28 28 6d 74 72 61 68 29 20 20 20 20 20 20 28 ((mtrah) (
c680: 63 6f 6e 63 20 22 28 6c 61 6d 62 64 61 20 28 68 conc "(lambda (h
c690: 74 29 22 0a 09 09 09 09 09 09 20 20 20 22 20 20 t)"....... "
c6a0: 20 20 28 6c 65 74 20 28 28 65 78 74 72 61 20 5c (let ((extra \
c6b0: 22 22 20 63 6d 64 20 22 5c 22 29 29 22 0a 09 09 "" cmd "\"))"...
c6c0: 09 09 09 09 20 20 20 22 20 20 20 20 20 20 20 28 .... " (
c6d0: 63 6f 6e 63 20 28 6f 72 20 2a 74 6f 70 70 61 74 conc (or *toppat
c6e0: 68 2a 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d h* (get-environm
c6f0: 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 5c 22 4d ent-variable \"M
c700: 54 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 5c T_RUN_AREA_HOME\
c710: 22 29 29 22 0a 09 09 09 09 09 09 20 20 20 22 20 "))"....... "
c720: 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 (if
c730: 28 73 74 72 69 6e 67 2d 6e 75 6c 6c 3f 20 65 78 (string-null? ex
c740: 74 72 61 29 20 5c 22 5c 22 20 5c 22 2f 5c 22 29 tra) \"\" \"/\")
c750: 22 0a 09 09 09 09 09 09 20 20 20 22 20 20 20 20 "....... "
c760: 20 20 20 20 20 20 20 20 20 65 78 74 72 61 29 29 extra))
c770: 29 22 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 )")).... (
c780: 28 67 65 74 20 67 29 20 20 20 0a 09 09 09 09 28 (get g) .....(
c790: 6d 61 74 63 68 20 28 73 74 72 69 6e 67 2d 73 70 match (string-sp
c7a0: 6c 69 74 20 63 6d 64 29 0a 09 09 09 09 20 20 20 lit cmd).....
c7b0: 20 20 20 20 28 28 73 65 63 74 20 76 61 72 29 28 ((sect var)(
c7c0: 63 6f 6e 63 20 22 28 6c 61 6d 62 64 61 20 28 68 conc "(lambda (h
c7d0: 74 29 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 t)(configf:looku
c7e0: 70 20 68 74 20 5c 22 22 20 73 65 63 74 20 22 5c p ht \"" sect "\
c7f0: 22 20 5c 22 22 20 76 61 72 20 22 5c 22 29 29 22 " \"" var "\"))"
c800: 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 65 ))..... (e
c810: 6c 73 65 0a 09 09 09 09 09 28 64 65 62 75 67 3a lse......(debug:
c820: 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 print-error 0 *d
c830: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
c840: 20 22 23 7b 67 65 74 20 2e 2e 2e 7d 20 75 73 65 "#{get ...} use
c850: 64 20 77 69 74 68 20 6f 6e 6c 79 20 6f 6e 65 20 d with only one
c860: 70 61 72 61 6d 65 74 65 72 2c 20 5c 22 22 20 63 parameter, \"" c
c870: 6d 64 20 22 5c 22 2c 20 74 77 6f 20 6e 65 65 64 md "\", two need
c880: 65 64 2e 22 29 0a 09 09 09 09 09 22 28 6c 61 6d ed.")......"(lam
c890: 62 64 61 20 28 68 74 29 20 23 66 29 22 29 29 29 bda (ht) #f)")))
c8a0: 0a 09 09 09 20 20 20 20 20 20 20 28 28 72 75 6e .... ((run
c8b0: 63 6f 6e 66 69 67 73 2d 67 65 74 20 72 67 65 74 configs-get rget
c8c0: 29 20 28 63 6f 6e 63 20 22 28 6c 61 6d 62 64 61 ) (conc "(lambda
c8d0: 20 28 68 74 29 28 72 75 6e 63 6f 6e 66 69 67 73 (ht)(runconfigs
c8e0: 2d 67 65 74 20 68 74 20 5c 22 22 20 63 6d 64 20 -get ht \"" cmd
c8f0: 22 5c 22 29 29 22 29 29 0a 09 09 09 20 20 20 20 "\"))"))....
c900: 20 20 20 3b 3b 20 28 28 72 67 65 74 29 20 20 20 ;; ((rget)
c910: 20 20 20 20 20 20 20 20 28 63 6f 6e 63 20 22 28 (conc "(
c920: 6c 61 6d 62 64 61 20 28 68 74 29 28 72 75 6e 63 lambda (ht)(runc
c930: 6f 6e 66 69 67 73 2d 67 65 74 20 68 74 20 5c 22 onfigs-get ht \"
c940: 22 20 63 6d 64 20 22 5c 22 29 29 22 29 29 0a 09 " cmd "\"))"))..
c950: 09 09 20 20 20 20 20 20 20 28 65 6c 73 65 20 22 .. (else "
c960: 28 6c 61 6d 62 64 61 20 28 68 74 29 28 70 72 69 (lambda (ht)(pri
c970: 6e 74 20 5c 22 45 52 52 4f 52 5c 22 29 20 5c 22 nt \"ERROR\") \"
c980: 45 52 52 4f 52 5c 22 29 22 29 29 29 29 29 0a 09 ERROR\")")))))..
c990: 09 3b 3b 20 28 70 72 69 6e 74 20 22 66 75 6c 6c .;; (print "full
c9a0: 63 6d 64 3d 22 20 66 75 6c 6c 63 6d 64 29 0a 09 cmd=" fullcmd)..
c9b0: 09 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 .(handle-excepti
c9c0: 6f 6e 73 0a 09 09 20 65 78 6e 0a 09 09 20 28 62 ons... exn... (b
c9d0: 65 67 69 6e 0a 09 09 20 20 20 28 64 65 62 75 67 egin... (debug
c9e0: 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
c9f0: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 41 52 t-log-port* "WAR
ca00: 4e 49 4e 47 3a 20 66 61 69 6c 65 64 20 74 6f 20 NING: failed to
ca10: 70 72 6f 63 65 73 73 20 63 6f 6e 66 69 67 20 69 process config i
ca20: 6e 70 75 74 20 5c 22 22 20 6c 20 22 5c 22 2c 20 nput \"" l "\",
ca30: 65 78 6e 3d 22 20 65 78 6e 29 0a 09 09 20 20 20 exn=" exn)...
ca40: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a (debug:print 0 *
ca50: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
ca60: 2a 20 22 20 6d 65 73 73 61 67 65 3a 20 22 20 28 * " message: " (
ca70: 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 65 (condition-prope
ca80: 72 74 79 2d 61 63 63 65 73 73 6f 72 20 27 65 78 rty-accessor 'ex
ca90: 6e 20 27 6d 65 73 73 61 67 65 29 20 65 78 6e 29 n 'message) exn)
caa0: 29 0a 09 09 20 20 20 3b 3b 20 28 70 72 69 6e 74 )... ;; (print
cab0: 20 22 65 78 6e 3d 22 20 28 63 6f 6e 64 69 74 69 "exn=" (conditi
cac0: 6f 6e 2d 3e 6c 69 73 74 20 65 78 6e 29 29 0a 09 on->list exn))..
cad0: 09 20 20 20 28 73 65 74 21 20 72 65 73 75 6c 74 . (set! result
cae0: 20 28 63 6f 6e 63 20 22 23 7b 28 20 22 20 63 6d (conc "#{( " cm
caf0: 64 74 79 70 65 20 22 29 20 22 20 63 6d 64 20 22 dtype ") " cmd "
cb00: 7d 2c 20 66 75 6c 6c 20 65 78 70 61 6e 73 69 6f }, full expansio
cb10: 6e 3a 20 22 20 66 75 6c 6c 63 6d 64 29 29 29 0a n: " fullcmd))).
cb20: 09 09 20 28 69 66 20 28 6f 72 20 61 6c 6c 6f 77 .. (if (or allow
cb30: 2d 73 79 73 74 65 6d 0a 09 09 09 20 28 6e 6f 74 -system.... (not
cb40: 20 28 6d 65 6d 62 65 72 20 63 6d 64 74 79 70 65 (member cmdtype
cb50: 20 27 28 22 73 79 73 74 65 6d 22 20 22 73 68 65 '("system" "she
cb60: 6c 6c 22 20 22 73 68 22 29 29 29 29 0a 09 09 20 ll" "sh"))))...
cb70: 20 20 20 20 28 77 69 74 68 2d 69 6e 70 75 74 2d (with-input-
cb80: 66 72 6f 6d 2d 73 74 72 69 6e 67 20 66 75 6c 6c from-string full
cb90: 63 6d 64 0a 09 09 20 20 20 20 20 20 20 28 6c 61 cmd... (la
cba0: 6d 62 64 61 20 28 29 0a 09 09 09 20 28 73 65 74 mbda ().... (set
cbb0: 21 20 72 65 73 75 6c 74 20 28 69 66 20 65 6e 76 ! result (if env
cbc0: 2d 74 6f 2d 75 73 65 0a 09 09 09 09 09 20 20 28 -to-use...... (
cbd0: 28 65 76 61 6c 20 28 72 65 61 64 29 20 65 6e 76 (eval (read) env
cbe0: 2d 74 6f 2d 75 73 65 29 20 68 74 29 0a 09 09 09 -to-use) ht)....
cbf0: 09 09 20 20 28 28 65 76 61 6c 20 28 72 65 61 64 .. ((eval (read
cc00: 29 29 20 68 74 29 0a 09 09 09 09 09 20 20 29 29 )) ht)...... ))
cc10: 29 29 0a 09 09 20 20 20 20 20 28 73 65 74 21 20 ))... (set!
cc20: 72 65 73 75 6c 74 20 28 63 6f 6e 63 20 22 23 7b result (conc "#{
cc30: 28 22 20 63 6d 64 74 79 70 65 20 22 29 20 22 20 (" cmdtype ") "
cc40: 20 63 6d 64 20 22 7d 22 29 29 29 29 0a 09 09 28 cmd "}"))))...(
cc50: 63 61 73 65 20 63 6d 64 73 79 6d 0a 09 09 20 20 case cmdsym...
cc60: 28 28 73 79 73 74 65 6d 20 73 68 65 6c 6c 20 73 ((system shell s
cc70: 63 68 65 6d 65 29 0a 09 09 20 20 20 28 6c 65 74 cheme)... (let
cc80: 20 28 28 64 65 6c 74 61 20 28 2d 20 28 63 75 72 ((delta (- (cur
cc90: 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 20 73 74 rent-seconds) st
cca0: 61 72 74 2d 74 69 6d 65 29 29 29 0a 09 09 20 20 art-time)))...
ccb0: 20 20 20 28 69 66 20 28 3e 20 64 65 6c 74 61 20 (if (> delta
ccc0: 32 29 0a 09 09 09 20 28 64 65 62 75 67 3a 70 72 2).... (debug:pr
ccd0: 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 int-info 0 *defa
cce0: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 66 ult-log-port* "f
ccf0: 6f 72 20 6c 69 6e 65 20 5c 22 22 20 6c 20 22 5c or line \"" l "\
cd00: 22 5c 6e 20 63 6f 6d 6d 61 6e 64 3a 20 20 22 20 "\n command: "
cd10: 63 6d 64 20 22 20 74 6f 6f 6b 20 22 20 64 65 6c cmd " took " del
cd20: 74 61 20 22 20 73 65 63 6f 6e 64 73 20 74 6f 20 ta " seconds to
cd30: 72 75 6e 20 77 69 74 68 20 6f 75 74 70 75 74 3a run with output:
cd40: 5c 6e 20 20 20 22 20 72 65 73 75 6c 74 29 0a 09 \n " result)..
cd50: 09 09 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d .. (debug:print-
cd60: 69 6e 66 6f 20 39 20 2a 64 65 66 61 75 6c 74 2d info 9 *default-
cd70: 6c 6f 67 2d 70 6f 72 74 2a 20 22 66 6f 72 20 6c log-port* "for l
cd80: 69 6e 65 20 5c 22 22 20 6c 20 22 5c 22 5c 6e 20 ine \"" l "\"\n
cd90: 63 6f 6d 6d 61 6e 64 3a 20 20 22 20 63 6d 64 20 command: " cmd
cda0: 22 20 74 6f 6f 6b 20 22 20 64 65 6c 74 61 20 22 " took " delta "
cdb0: 20 73 65 63 6f 6e 64 73 20 74 6f 20 72 75 6e 20 seconds to run
cdc0: 77 69 74 68 20 6f 75 74 70 75 74 3a 5c 6e 20 20 with output:\n
cdd0: 20 22 20 72 65 73 75 6c 74 29 29 29 29 29 0a 09 " result)))))..
cde0: 09 28 6c 6f 6f 70 20 28 63 6f 6e 63 20 70 72 65 .(loop (conc pre
cdf0: 73 74 72 20 72 65 73 75 6c 74 20 70 6f 73 74 73 str result posts
ce00: 74 72 29 29 29 0a 09 20 20 20 20 20 20 72 65 73 tr))).. res
ce10: 29 29 0a 09 72 65 73 29 29 29 0a 0a 3b 3b 3d 3d ))..res)))..;;==
ce20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ce30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ce40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ce50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ce60: 3d 3d 3d 3d 0a 3b 3b 20 4c 6f 6f 6b 75 70 20 61 ====.;; Lookup a
ce70: 20 76 61 6c 75 65 20 69 6e 20 72 75 6e 63 6f 6e value in runcon
ce80: 66 69 67 73 20 62 61 73 65 64 20 6f 6e 20 2d 72 figs based on -r
ce90: 65 71 74 61 72 67 20 6f 72 20 2d 74 61 72 67 65 eqtarg or -targe
cea0: 74 0a 3b 3b 20 0a 28 64 65 66 69 6e 65 20 28 72 t.;; .(define (r
ceb0: 75 6e 63 6f 6e 66 69 67 73 2d 67 65 74 20 63 6f unconfigs-get co
cec0: 6e 66 69 67 20 74 61 72 67 65 74 20 76 61 72 29 nfig target var)
ced0: 0a 20 20 28 6c 65 74 20 28 28 74 61 72 67 20 74 . (let ((targ t
cee0: 61 72 67 65 74 20 23 3b 28 63 6f 6d 6d 6f 6e 3a arget #;(common:
cef0: 61 72 67 73 2d 67 65 74 2d 74 61 72 67 65 74 29 args-get-target)
cf00: 29 29 20 3b 3b 20 28 6f 72 20 28 61 72 67 73 3a )) ;; (or (args:
cf10: 67 65 74 2d 61 72 67 20 22 2d 72 65 71 74 61 72 get-arg "-reqtar
cf20: 67 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 g")(args:get-arg
cf30: 20 22 2d 74 61 72 67 65 74 22 29 28 67 65 74 65 "-target")(gete
cf40: 6e 76 20 22 4d 54 5f 54 41 52 47 45 54 22 29 29 nv "MT_TARGET"))
cf50: 29 29 0a 20 20 20 20 28 69 66 20 74 61 72 67 0a )). (if targ.
cf60: 09 28 6f 72 20 28 63 6f 6e 66 69 67 66 3a 6c 6f .(or (configf:lo
cf70: 6f 6b 75 70 20 63 6f 6e 66 69 67 20 74 61 72 67 okup config targ
cf80: 20 76 61 72 29 0a 09 20 20 20 20 28 63 6f 6e 66 var).. (conf
cf90: 69 67 66 3a 6c 6f 6f 6b 75 70 20 63 6f 6e 66 69 igf:lookup confi
cfa0: 67 20 22 64 65 66 61 75 6c 74 22 20 76 61 72 29 g "default" var)
cfb0: 29 0a 09 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b )..(configf:look
cfc0: 75 70 20 63 6f 6e 66 69 67 20 22 64 65 66 61 75 up config "defau
cfd0: 6c 74 22 20 76 61 72 29 29 29 29 0a 0a 0a 3b 3b lt" var))))...;;
cfe0: 20 70 61 74 68 65 6e 76 76 61 72 20 77 69 6c 6c pathenvvar will
cff0: 20 73 65 74 20 74 68 65 20 6e 61 6d 65 64 20 76 set the named v
d000: 61 72 20 74 6f 20 74 68 65 20 70 61 74 68 20 6f ar to the path o
d010: 66 20 74 68 65 20 63 6f 6e 66 69 67 0a 28 64 65 f the config.(de
d020: 66 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a 66 69 fine (configf:fi
d030: 6e 64 2d 61 6e 64 2d 72 65 61 64 2d 63 6f 6e 66 nd-and-read-conf
d040: 69 67 20 66 6e 61 6d 65 20 23 21 6b 65 79 20 28 ig fname #!key (
d050: 65 6e 76 69 72 6f 6e 2d 70 61 74 74 20 23 66 29 environ-patt #f)
d060: 28 67 69 76 65 6e 2d 74 6f 70 70 61 74 68 20 23 (given-toppath #
d070: 66 29 28 70 61 74 68 65 6e 76 76 61 72 20 23 66 f)(pathenvvar #f
d080: 29 28 65 6e 76 2d 74 6f 2d 75 73 65 20 23 66 29 )(env-to-use #f)
d090: 29 0a 20 20 28 6c 65 74 2a 20 28 28 63 75 72 72 ). (let* ((curr
d0a0: 2d 64 69 72 20 20 20 28 63 75 72 72 65 6e 74 2d -dir (current-
d0b0: 64 69 72 65 63 74 6f 72 79 29 29 0a 20 20 20 20 directory)).
d0c0: 20 20 20 20 20 28 63 6f 6e 66 69 67 69 6e 66 6f (configinfo
d0d0: 20 28 66 69 6e 64 2d 63 6f 6e 66 69 67 20 66 6e (find-config fn
d0e0: 61 6d 65 20 74 6f 70 70 61 74 68 3a 20 67 69 76 ame toppath: giv
d0f0: 65 6e 2d 74 6f 70 70 61 74 68 29 29 0a 09 20 28 en-toppath)).. (
d100: 74 6f 70 70 61 74 68 20 20 20 20 28 63 61 72 20 toppath (car
d110: 63 6f 6e 66 69 67 69 6e 66 6f 29 29 0a 09 20 28 configinfo)).. (
d120: 63 6f 6e 66 69 67 66 69 6c 65 20 28 63 61 64 72 configfile (cadr
d130: 20 63 6f 6e 66 69 67 69 6e 66 6f 29 29 0a 09 20 configinfo))..
d140: 28 73 65 74 2d 66 69 65 6c 64 73 20 28 6c 61 6d (set-fields (lam
d150: 62 64 61 20 28 63 75 72 72 2d 73 65 63 74 69 6f bda (curr-sectio
d160: 6e 20 6e 65 78 74 2d 73 65 63 74 69 6f 6e 20 68 n next-section h
d170: 74 20 70 61 74 68 29 0a 09 09 20 20 20 20 20 20 t path)...
d180: 20 28 6c 65 74 20 28 28 66 69 65 6c 64 2d 6e 61 (let ((field-na
d190: 6d 65 73 20 28 69 66 20 68 74 20 28 63 6f 6d 6d mes (if ht (comm
d1a0: 6f 6e 3a 67 65 74 2d 66 69 65 6c 64 73 20 68 74 on:get-fields ht
d1b0: 29 20 27 28 29 29 29 0a 09 09 09 20 20 20 20 20 ) '()))....
d1c0: 28 74 61 72 67 65 74 20 20 20 20 20 20 28 6f 72 (target (or
d1d0: 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 54 41 52 (getenv "MT_TAR
d1e0: 47 45 54 22 29 28 61 72 67 73 3a 67 65 74 2d 61 GET")(args:get-a
d1f0: 72 67 20 22 2d 72 65 71 74 61 72 67 22 29 28 61 rg "-reqtarg")(a
d200: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 61 rgs:get-arg "-ta
d210: 72 67 65 74 22 29 29 29 29 0a 09 09 09 20 28 64 rget")))).... (d
d220: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
d230: 39 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 9 *default-log-p
d240: 6f 72 74 2a 20 22 73 65 74 2d 66 69 65 6c 64 73 ort* "set-fields
d250: 20 77 69 74 68 20 66 69 65 6c 64 2d 6e 61 6d 65 with field-name
d260: 73 3d 22 20 66 69 65 6c 64 2d 6e 61 6d 65 73 20 s=" field-names
d270: 22 20 74 61 72 67 65 74 3d 22 20 74 61 72 67 65 " target=" targe
d280: 74 20 22 20 63 75 72 72 2d 73 65 63 74 69 6f 6e t " curr-section
d290: 3d 22 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 20 =" curr-section
d2a0: 22 20 6e 65 78 74 2d 73 65 63 74 69 6f 6e 3d 22 " next-section="
d2b0: 20 6e 65 78 74 2d 73 65 63 74 69 6f 6e 20 22 20 next-section "
d2c0: 70 61 74 68 3d 22 20 70 61 74 68 20 22 20 68 74 path=" path " ht
d2d0: 3d 22 20 68 74 29 0a 09 09 09 20 28 69 66 20 28 =" ht).... (if (
d2e0: 6e 6f 74 20 28 6e 75 6c 6c 3f 20 66 69 65 6c 64 not (null? field
d2f0: 2d 6e 61 6d 65 73 29 29 28 6b 65 79 73 3a 74 61 -names))(keys:ta
d300: 72 67 65 74 2d 73 65 74 2d 61 72 67 73 20 66 69 rget-set-args fi
d310: 65 6c 64 2d 6e 61 6d 65 73 20 74 61 72 67 65 74 eld-names target
d320: 20 23 66 29 29 29 29 29 29 0a 20 20 20 20 28 69 #f)))))). (i
d330: 66 20 74 6f 70 70 61 74 68 20 28 63 68 61 6e 67 f toppath (chang
d340: 65 2d 64 69 72 65 63 74 6f 72 79 20 74 6f 70 70 e-directory topp
d350: 61 74 68 29 29 20 0a 20 20 20 20 28 69 66 20 28 ath)) . (if (
d360: 61 6e 64 20 74 6f 70 70 61 74 68 20 70 61 74 68 and toppath path
d370: 65 6e 76 76 61 72 29 28 73 65 74 65 6e 76 20 70 envvar)(setenv p
d380: 61 74 68 65 6e 76 76 61 72 20 74 6f 70 70 61 74 athenvvar toppat
d390: 68 29 29 0a 20 20 20 20 28 6c 65 74 20 28 28 63 h)). (let ((c
d3a0: 6f 6e 66 69 67 64 61 74 20 20 28 69 66 20 63 6f onfigdat (if co
d3b0: 6e 66 69 67 66 69 6c 65 20 0a 09 09 09 20 20 28 nfigfile .... (
d3c0: 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d 63 6f 6e configf:read-con
d3d0: 66 69 67 20 63 6f 6e 66 69 67 66 69 6c 65 20 23 fig configfile #
d3e0: 66 20 23 74 20 65 6e 76 69 72 6f 6e 2d 70 61 74 f #t environ-pat
d3f0: 74 3a 20 65 6e 76 69 72 6f 6e 2d 70 61 74 74 20 t: environ-patt
d400: 70 6f 73 74 2d 73 65 63 74 69 6f 6e 2d 70 72 6f post-section-pro
d410: 63 73 3a 20 28 6c 69 73 74 20 28 63 6f 6e 73 20 cs: (list (cons
d420: 22 5e 66 69 65 6c 64 73 24 22 20 73 65 74 2d 66 "^fields$" set-f
d430: 69 65 6c 64 73 29 29 20 23 66 20 65 6e 76 2d 74 ields)) #f env-t
d440: 6f 2d 75 73 65 3a 20 65 6e 76 2d 74 6f 2d 75 73 o-use: env-to-us
d450: 65 29 29 29 29 0a 20 20 20 20 20 20 28 69 66 20 e)))). (if
d460: 74 6f 70 70 61 74 68 20 28 63 68 61 6e 67 65 2d toppath (change-
d470: 64 69 72 65 63 74 6f 72 79 20 63 75 72 72 2d 64 directory curr-d
d480: 69 72 29 29 0a 20 20 20 20 20 20 28 6c 69 73 74 ir)). (list
d490: 20 63 6f 6e 66 69 67 64 61 74 20 74 6f 70 70 61 configdat toppa
d4a0: 74 68 20 63 6f 6e 66 69 67 66 69 6c 65 20 66 6e th configfile fn
d4b0: 61 6d 65 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d ame))))..;;=====
d4c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d4d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d4e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d4f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d500: 3d 0a 3b 3b 20 4e 6f 6e 20 64 65 73 74 72 75 63 =.;; Non destruc
d510: 74 69 76 65 20 77 72 69 74 69 6e 67 20 6f 66 20 tive writing of
d520: 63 6f 6e 66 69 67 20 66 69 6c 65 0a 3b 3b 3d 3d config file.;;==
d530: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d540: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d550: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d560: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d570: 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 63 ====..(define (c
d580: 6f 6e 66 69 67 66 3a 72 65 61 64 2d 61 6c 69 73 onfigf:read-alis
d590: 74 20 66 6e 61 6d 65 29 0a 20 20 28 68 61 6e 64 t fname). (hand
d5a0: 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 20 20 le-exceptions.
d5b0: 20 20 20 20 65 78 6e 0a 20 20 20 20 28 62 65 67 exn. (beg
d5c0: 69 6e 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a in. (debug:
d5d0: 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 print 0 *default
d5e0: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 72 65 61 64 -log-port* "read
d5f0: 20 6f 66 20 61 6c 69 73 74 20 22 20 66 6e 61 6d of alist " fnam
d600: 65 20 22 20 66 61 69 6c 65 64 2e 20 65 78 6e 3d e " failed. exn=
d610: 22 20 65 78 6e 29 0a 20 20 20 20 20 20 23 66 29 " exn). #f)
d620: 0a 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 61 6c . (configf:al
d630: 69 73 74 2d 3e 63 6f 6e 66 69 67 0a 20 20 20 20 ist->config.
d640: 20 28 77 69 74 68 2d 69 6e 70 75 74 2d 66 72 6f (with-input-fro
d650: 6d 2d 66 69 6c 65 20 66 6e 61 6d 65 20 72 65 61 m-file fname rea
d660: 64 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d d))))..;;=======
d670: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d680: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d690: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d6a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
d6b0: 3b 3b 20 44 4f 20 54 48 45 20 4c 4f 43 4b 49 4e ;; DO THE LOCKIN
d6c0: 47 20 41 52 4f 55 4e 44 20 54 48 45 20 43 41 4c G AROUND THE CAL
d6d0: 4c 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d L.;;============
d6e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d6f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d700: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d710: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 0a 28 64 ==========.;;.(d
d720: 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a 77 efine (configf:w
d730: 72 69 74 65 2d 61 6c 69 73 74 20 63 64 61 74 20 rite-alist cdat
d740: 66 6e 61 6d 65 29 0a 20 20 3b 3b 20 28 69 66 20 fname). ;; (if
d750: 28 6e 6f 74 20 28 63 6f 6d 6d 6f 6e 3a 66 61 75 (not (common:fau
d760: 78 2d 6c 6f 63 6b 20 66 6e 61 6d 65 29 29 0a 20 x-lock fname)).
d770: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
d780: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
d790: 74 2a 20 22 49 4e 46 4f 3a 20 4e 45 45 44 20 4c t* "INFO: NEED L
d7a0: 4f 43 4b 49 4e 47 20 41 44 44 45 44 20 48 45 52 OCKING ADDED HER
d7b0: 45 20 22 20 66 6e 61 6d 65 29 0a 20 20 28 6c 65 E " fname). (le
d7c0: 74 2a 20 28 28 64 61 74 20 20 28 63 6f 6e 66 69 t* ((dat (confi
d7d0: 67 66 3a 63 6f 6e 66 69 67 2d 3e 61 6c 69 73 74 gf:config->alist
d7e0: 20 63 64 61 74 29 29 0a 20 20 20 20 20 20 20 20 cdat)).
d7f0: 20 28 72 65 73 0a 20 20 20 20 20 20 20 20 20 20 (res.
d800: 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 20 (begin.
d810: 20 20 20 28 77 69 74 68 2d 6f 75 74 70 75 74 2d (with-output-
d820: 74 6f 2d 66 69 6c 65 20 66 6e 61 6d 65 20 3b 3b to-file fname ;;
d830: 20 66 69 72 73 74 20 77 72 69 74 65 20 6f 75 74 first write out
d840: 20 74 68 65 20 66 69 6c 65 0a 20 20 20 20 20 20 the file.
d850: 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 (lambda
d860: 28 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ().
d870: 20 20 20 28 70 70 20 64 61 74 29 29 29 0a 20 20 (pp dat))).
d880: 20 20 20 20 20 20 20 20 20 20 0a 20 20 20 20 20 .
d890: 20 20 20 20 20 20 20 28 69 66 20 28 66 69 6c 65 (if (file
d8a0: 2d 65 78 69 73 74 73 3f 20 66 6e 61 6d 65 29 20 -exists? fname)
d8b0: 20 20 3b 3b 20 6e 6f 77 20 76 65 72 69 66 79 20 ;; now verify
d8c0: 69 74 20 69 73 20 72 65 61 64 61 62 6c 65 0a 20 it is readable.
d8d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
d8e0: 69 66 20 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 if (configf:read
d8f0: 2d 61 6c 69 73 74 20 66 6e 61 6d 65 29 0a 20 20 -alist fname).
d900: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d910: 20 20 23 74 20 3b 3b 20 64 61 74 61 20 69 73 20 #t ;; data is
d920: 67 6f 6f 64 2e 0a 20 20 20 20 20 20 20 20 20 20 good..
d930: 20 20 20 20 20 20 20 20 20 20 28 62 65 67 69 6e (begin
d940: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
d950: 20 20 20 20 20 20 20 28 68 61 6e 64 6c 65 2d 65 (handle-e
d960: 78 63 65 70 74 69 6f 6e 73 0a 09 09 09 20 20 65 xceptions.... e
d970: 78 6e 0a 09 09 09 28 62 65 67 69 6e 0a 09 09 09 xn....(begin....
d980: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
d990: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
d9a0: 72 74 2a 20 22 64 65 6c 65 74 69 6e 67 20 22 20 rt* "deleting "
d9b0: 66 6e 61 6d 65 20 22 20 66 61 69 6c 65 64 2c 20 fname " failed,
d9c0: 65 78 6e 3d 22 20 65 78 6e 29 0a 09 09 09 20 20 exn=" exn)....
d9d0: 23 66 29 0a 09 09 09 28 64 65 62 75 67 3a 70 72 #f)....(debug:pr
d9e0: 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c int 0 *default-l
d9f0: 6f 67 2d 70 6f 72 74 2a 20 22 57 41 52 4e 49 4e og-port* "WARNIN
da00: 47 3a 20 63 6f 6e 74 65 6e 74 20 22 20 64 61 74 G: content " dat
da10: 20 22 20 66 6f 72 20 63 61 63 68 65 20 22 20 66 " for cache " f
da20: 6e 61 6d 65 20 22 20 69 73 20 6e 6f 74 20 72 65 name " is not re
da30: 61 64 61 62 6c 65 2e 20 44 65 6c 65 74 69 6e 67 adable. Deleting
da40: 20 67 65 6e 65 72 61 74 65 64 20 66 69 6c 65 2e generated file.
da50: 22 29 0a 09 09 09 28 64 65 6c 65 74 65 2d 66 69 ")....(delete-fi
da60: 6c 65 20 66 6e 61 6d 65 29 29 0a 20 20 20 20 20 le fname)).
da70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
da80: 20 23 66 29 29 0a 20 20 20 20 20 20 20 20 20 20 #f)).
da90: 20 20 20 20 20 20 23 66 29 29 29 29 0a 20 20 20 #f)))).
daa0: 20 3b 3b 20 28 63 6f 6d 6d 6f 6e 3a 66 61 75 78 ;; (common:faux
dab0: 2d 75 6e 6c 6f 63 6b 20 66 6e 61 6d 65 29 0a 20 -unlock fname).
dac0: 20 20 20 72 65 73 29 29 0a 20 20 0a 28 64 65 66 res)). .(def
dad0: 69 6e 65 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d ine (common:get-
dae0: 66 69 65 6c 64 73 20 63 66 67 64 61 74 29 0a 20 fields cfgdat).
daf0: 20 28 6c 65 74 20 28 28 66 69 65 6c 64 73 20 28 (let ((fields (
db00: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d
db10: 65 66 61 75 6c 74 20 63 66 67 64 61 74 20 22 66 efault cfgdat "f
db20: 69 65 6c 64 73 22 20 27 28 29 29 29 29 0a 20 20 ields" '()))).
db30: 20 20 28 6d 61 70 20 63 61 72 20 66 69 65 6c 64 (map car field
db40: 73 29 29 29 0a 0a 29 0a s)))..).