Artifact
21beeb7ec64ff9be72ec668e199e0543d14cf520:
0000: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
0010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0040: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 43 6f 70 79 ========.;; Copy
0050: 72 69 67 68 74 20 32 30 30 36 2d 32 30 31 32 2c right 2006-2012,
0060: 20 4d 61 74 74 68 65 77 20 57 65 6c 6c 61 6e 64 Matthew Welland
0070: 2e 0a 3b 3b 20 0a 3b 3b 20 54 68 69 73 20 66 69 ..;; .;; This fi
0080: 6c 65 20 69 73 20 70 61 72 74 20 6f 66 20 4d 65 le is part of Me
0090: 67 61 74 65 73 74 2e 0a 3b 3b 20 0a 3b 3b 20 20 gatest..;; .;;
00a0: 20 20 20 4d 65 67 61 74 65 73 74 20 69 73 20 66 Megatest is f
00b0: 72 65 65 20 73 6f 66 74 77 61 72 65 3a 20 79 6f ree software: yo
00c0: 75 20 63 61 6e 20 72 65 64 69 73 74 72 69 62 75 u can redistribu
00d0: 74 65 20 69 74 20 61 6e 64 2f 6f 72 20 6d 6f 64 te it and/or mod
00e0: 69 66 79 0a 3b 3b 20 20 20 20 20 69 74 20 75 6e ify.;; it un
00f0: 64 65 72 20 74 68 65 20 74 65 72 6d 73 20 6f 66 der the terms of
0100: 20 74 68 65 20 47 4e 55 20 47 65 6e 65 72 61 6c the GNU General
0110: 20 50 75 62 6c 69 63 20 4c 69 63 65 6e 73 65 20 Public License
0120: 61 73 20 70 75 62 6c 69 73 68 65 64 20 62 79 0a as published by.
0130: 3b 3b 20 20 20 20 20 74 68 65 20 46 72 65 65 20 ;; the Free
0140: 53 6f 66 74 77 61 72 65 20 46 6f 75 6e 64 61 74 Software Foundat
0150: 69 6f 6e 2c 20 65 69 74 68 65 72 20 76 65 72 73 ion, either vers
0160: 69 6f 6e 20 33 20 6f 66 20 74 68 65 20 4c 69 63 ion 3 of the Lic
0170: 65 6e 73 65 2c 20 6f 72 0a 3b 3b 20 20 20 20 20 ense, or.;;
0180: 28 61 74 20 79 6f 75 72 20 6f 70 74 69 6f 6e 29 (at your option)
0190: 20 61 6e 79 20 6c 61 74 65 72 20 76 65 72 73 69 any later versi
01a0: 6f 6e 2e 0a 3b 3b 20 0a 3b 3b 20 20 20 20 20 4d on..;; .;; M
01b0: 65 67 61 74 65 73 74 20 69 73 20 64 69 73 74 72 egatest is distr
01c0: 69 62 75 74 65 64 20 69 6e 20 74 68 65 20 68 6f ibuted in the ho
01d0: 70 65 20 74 68 61 74 20 69 74 20 77 69 6c 6c 20 pe that it will
01e0: 62 65 20 75 73 65 66 75 6c 2c 0a 3b 3b 20 20 20 be useful,.;;
01f0: 20 20 62 75 74 20 57 49 54 48 4f 55 54 20 41 4e but WITHOUT AN
0200: 59 20 57 41 52 52 41 4e 54 59 3b 20 77 69 74 68 Y WARRANTY; with
0210: 6f 75 74 20 65 76 65 6e 20 74 68 65 20 69 6d 70 out even the imp
0220: 6c 69 65 64 20 77 61 72 72 61 6e 74 79 20 6f 66 lied warranty of
0230: 0a 3b 3b 20 20 20 20 20 4d 45 52 43 48 41 4e 54 .;; MERCHANT
0240: 41 42 49 4c 49 54 59 20 6f 72 20 46 49 54 4e 45 ABILITY or FITNE
0250: 53 53 20 46 4f 52 20 41 20 50 41 52 54 49 43 55 SS FOR A PARTICU
0260: 4c 41 52 20 50 55 52 50 4f 53 45 2e 20 20 53 65 LAR PURPOSE. Se
0270: 65 20 74 68 65 0a 3b 3b 20 20 20 20 20 47 4e 55 e the.;; GNU
0280: 20 47 65 6e 65 72 61 6c 20 50 75 62 6c 69 63 20 General Public
0290: 4c 69 63 65 6e 73 65 20 66 6f 72 20 6d 6f 72 65 License for more
02a0: 20 64 65 74 61 69 6c 73 2e 0a 3b 3b 20 0a 3b 3b details..;; .;;
02b0: 20 20 20 20 20 59 6f 75 20 73 68 6f 75 6c 64 20 You should
02c0: 68 61 76 65 20 72 65 63 65 69 76 65 64 20 61 20 have received a
02d0: 63 6f 70 79 20 6f 66 20 74 68 65 20 47 4e 55 20 copy of the GNU
02e0: 47 65 6e 65 72 61 6c 20 50 75 62 6c 69 63 20 4c General Public L
02f0: 69 63 65 6e 73 65 0a 3b 3b 20 20 20 20 20 61 6c icense.;; al
0300: 6f 6e 67 20 77 69 74 68 20 4d 65 67 61 74 65 73 ong with Megates
0310: 74 2e 20 20 49 66 20 6e 6f 74 2c 20 73 65 65 20 t. If not, see
0320: 3c 68 74 74 70 3a 2f 2f 77 77 77 2e 67 6e 75 2e <http://www.gnu.
0330: 6f 72 67 2f 6c 69 63 65 6e 73 65 73 2f 3e 2e 0a org/licenses/>..
0340: 0a 3b 3b 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 3d 3d 3d 3d 3d 0a 0a 3b 3b 3d 3d 3d =========..;;===
0390: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03d0: 3d 3d 3d 0a 3b 3b 20 43 6f 6e 66 69 67 20 66 69 ===.;; Config fi
03e0: 6c 65 20 68 61 6e 64 6c 69 6e 67 0a 3b 3b 3d 3d le handling.;;==
03f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0400: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0410: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0420: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0430: 3d 3d 3d 3d 0a 0a 28 75 73 65 20 72 65 67 65 78 ====..(use regex
0440: 20 72 65 67 65 78 2d 63 61 73 65 20 6d 61 74 63 regex-case matc
0450: 68 61 62 6c 65 29 20 3b 3b 20 20 64 69 72 65 63 hable) ;; direc
0460: 74 6f 72 79 2d 75 74 69 6c 73 29 0a 28 64 65 63 tory-utils).(dec
0470: 6c 61 72 65 20 28 75 6e 69 74 20 63 6f 6e 66 69 lare (unit confi
0480: 67 66 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 gf)).(declare (u
0490: 73 65 73 20 70 72 6f 63 65 73 73 29 29 0a 28 64 ses process)).(d
04a0: 65 63 6c 61 72 65 20 28 75 73 65 73 20 65 6e 76 eclare (uses env
04b0: 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 )).(declare (use
04c0: 73 20 6b 65 79 73 29 29 0a 28 64 65 63 6c 61 72 s keys)).(declar
04d0: 65 20 28 75 73 65 73 20 64 65 62 75 67 70 72 69 e (uses debugpri
04e0: 6e 74 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 nt)).(declare (u
04f0: 73 65 73 20 6d 74 61 72 67 73 29 29 0a 28 64 65 ses mtargs)).(de
0500: 63 6c 61 72 65 20 28 75 73 65 73 20 6d 74 61 72 clare (uses mtar
0510: 67 73 2e 69 6d 70 6f 72 74 29 29 0a 28 64 65 63 gs.import)).(dec
0520: 6c 61 72 65 20 28 75 73 65 73 20 63 6f 6d 6d 6f lare (uses commo
0530: 6e 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 n)).(declare (us
0540: 65 73 20 63 6f 6d 6d 6f 6e 6d 6f 64 29 29 0a 28 es commonmod)).(
0550: 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 63 6f declare (uses co
0560: 6d 6d 6f 6e 6d 6f 64 2e 69 6d 70 6f 72 74 29 29 mmonmod.import))
0570: 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 .(declare (uses
0580: 64 62 66 69 6c 65 29 29 0a 28 64 65 63 6c 61 72 dbfile)).(declar
0590: 65 20 28 75 73 65 73 20 64 62 66 69 6c 65 2e 69 e (uses dbfile.i
05a0: 6d 70 6f 72 74 29 29 0a 28 64 65 63 6c 61 72 65 mport)).(declare
05b0: 20 28 75 73 65 73 20 64 62 6d 6f 64 29 29 0a 28 (uses dbmod)).(
05c0: 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 64 62 declare (uses db
05d0: 6d 6f 64 2e 69 6d 70 6f 72 74 29 29 0a 0a 28 69 mod.import))..(i
05e0: 6d 70 6f 72 74 20 63 6f 6d 6d 6f 6e 6d 6f 64 0a mport commonmod.
05f0: 09 28 70 72 65 66 69 78 20 6d 74 61 72 67 73 20 .(prefix mtargs
0600: 61 72 67 73 3a 29 0a 09 64 65 62 75 67 70 72 69 args:)..debugpri
0610: 6e 74 29 0a 0a 28 69 6e 63 6c 75 64 65 20 22 63 nt)..(include "c
0620: 6f 6d 6d 6f 6e 5f 72 65 63 6f 72 64 73 2e 73 63 ommon_records.sc
0630: 6d 22 29 0a 0a 3b 3b 20 72 65 74 75 72 6e 20 6c m")..;; return l
0640: 69 73 74 20 28 70 61 74 68 20 66 75 6c 6c 70 61 ist (path fullpa
0650: 74 68 20 63 6f 6e 66 69 67 6e 61 6d 65 29 0a 28 th configname).(
0660: 64 65 66 69 6e 65 20 28 66 69 6e 64 2d 63 6f 6e define (find-con
0670: 66 69 67 20 63 6f 6e 66 69 67 6e 61 6d 65 20 23 fig configname #
0680: 21 6b 65 79 20 28 74 6f 70 70 61 74 68 20 23 66 !key (toppath #f
0690: 29 29 0a 20 20 28 69 66 20 74 6f 70 70 61 74 68 )). (if toppath
06a0: 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 63 66 . (let ((cf
06b0: 6e 61 6d 65 20 28 63 6f 6e 63 20 74 6f 70 70 61 name (conc toppa
06c0: 74 68 20 22 2f 22 20 63 6f 6e 66 69 67 6e 61 6d th "/" confignam
06d0: 65 29 29 29 0a 09 28 69 66 20 28 63 6f 6d 6d 6f e)))..(if (commo
06e0: 6e 3a 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 63 n:file-exists? c
06f0: 66 6e 61 6d 65 29 0a 09 20 20 20 20 28 6c 69 73 fname).. (lis
0700: 74 20 74 6f 70 70 61 74 68 20 63 66 6e 61 6d 65 t toppath cfname
0710: 20 63 6f 6e 66 69 67 6e 61 6d 65 29 0a 09 20 20 configname)..
0720: 20 20 28 6c 69 73 74 20 23 66 20 20 20 20 20 20 (list #f
0730: 23 66 20 20 20 20 20 23 66 29 29 29 0a 20 20 20 #f #f))).
0740: 20 20 20 28 6c 65 74 2a 20 28 28 63 77 64 20 28 (let* ((cwd (
0750: 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 28 63 75 string-split (cu
0760: 72 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 rrent-directory)
0770: 20 22 2f 22 29 29 29 0a 09 28 6c 65 74 20 6c 6f "/")))..(let lo
0780: 6f 70 20 28 28 64 69 72 20 63 77 64 29 29 0a 09 op ((dir cwd))..
0790: 20 20 28 6c 65 74 2a 20 28 28 70 61 74 68 20 20 (let* ((path
07a0: 20 20 20 28 63 6f 6e 63 20 22 2f 22 20 28 73 74 (conc "/" (st
07b0: 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 ring-intersperse
07c0: 20 64 69 72 20 22 2f 22 29 29 29 0a 09 09 20 28 dir "/")))... (
07d0: 66 75 6c 6c 70 61 74 68 20 28 63 6f 6e 63 20 70 fullpath (conc p
07e0: 61 74 68 20 22 2f 22 20 63 6f 6e 66 69 67 6e 61 ath "/" configna
07f0: 6d 65 29 29 29 0a 09 20 20 20 20 28 69 66 20 28 me))).. (if (
0800: 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 common:file-exis
0810: 74 73 3f 20 66 75 6c 6c 70 61 74 68 29 0a 09 09 ts? fullpath)...
0820: 28 6c 69 73 74 20 70 61 74 68 20 66 75 6c 6c 70 (list path fullp
0830: 61 74 68 20 63 6f 6e 66 69 67 6e 61 6d 65 29 0a ath configname).
0840: 09 09 28 6c 65 74 20 28 28 72 65 6d 63 77 64 20 ..(let ((remcwd
0850: 28 74 61 6b 65 20 64 69 72 20 28 2d 20 28 6c 65 (take dir (- (le
0860: 6e 67 74 68 20 64 69 72 29 20 31 29 29 29 29 0a ngth dir) 1)))).
0870: 09 09 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 72 .. (if (null? r
0880: 65 6d 63 77 64 29 0a 09 09 20 20 20 20 20 20 28 emcwd)... (
0890: 6c 69 73 74 20 23 66 20 23 66 20 23 66 29 20 3b list #f #f #f) ;
08a0: 3b 20 20 23 66 20 23 66 29 20 0a 09 09 20 20 28 ; #f #f) ... (
08b0: 6c 6f 6f 70 20 72 65 6d 63 77 64 29 29 29 29 29 loop remcwd)))))
08c0: 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 ))))..(define (c
08d0: 6f 6e 66 69 67 66 3a 61 73 73 6f 63 2d 73 61 66 onfigf:assoc-saf
08e0: 65 2d 61 64 64 20 61 6c 69 73 74 20 6b 65 79 20 e-add alist key
08f0: 76 61 6c 20 23 21 6b 65 79 20 28 6d 65 74 61 64 val #!key (metad
0900: 61 74 61 20 23 66 29 29 0a 20 20 28 6c 65 74 20 ata #f)). (let
0910: 28 28 6e 65 77 61 6c 69 73 74 20 28 66 69 6c 74 ((newalist (filt
0920: 65 72 20 28 6c 61 6d 62 64 61 20 28 78 29 28 6e er (lambda (x)(n
0930: 6f 74 20 28 65 71 75 61 6c 3f 20 6b 65 79 20 28 ot (equal? key (
0940: 63 61 72 20 78 29 29 29 29 20 61 6c 69 73 74 29 car x)))) alist)
0950: 29 29 0a 20 20 20 20 28 61 70 70 65 6e 64 20 6e )). (append n
0960: 65 77 61 6c 69 73 74 20 28 6c 69 73 74 20 28 69 ewalist (list (i
0970: 66 20 6d 65 74 61 64 61 74 61 0a 09 09 09 20 20 f metadata....
0980: 20 20 20 20 20 28 6c 69 73 74 20 6b 65 79 20 76 (list key v
0990: 61 6c 20 6d 65 74 61 64 61 74 61 29 0a 09 09 09 al metadata)....
09a0: 20 20 20 20 20 20 20 28 6c 69 73 74 20 6b 65 79 (list key
09b0: 20 76 61 6c 29 29 29 29 29 29 0a 0a 3b 3b 20 74 val))))))..;; t
09c0: 68 69 73 20 69 73 20 75 73 65 64 20 69 6e 20 6d his is used in m
09d0: 65 67 61 74 65 73 74 71 61 2f 65 78 74 2e 73 63 egatestqa/ext.sc
09e0: 6d 2e 0a 3b 3b 20 72 65 6d 6f 76 65 20 69 74 20 m..;; remove it
09f0: 66 72 6f 6d 20 68 65 72 65 20 61 6e 64 20 74 68 from here and th
0a00: 65 72 65 20 62 79 20 31 32 2f 33 31 2f 32 31 0a ere by 12/31/21.
0a10: 3b 3b 20 28 64 65 66 69 6e 65 20 63 6f 6e 66 69 ;; (define confi
0a20: 67 3a 61 73 73 6f 63 2d 73 61 66 65 2d 61 64 64 g:assoc-safe-add
0a30: 20 63 6f 6e 66 69 67 66 3a 61 73 73 6f 63 2d 73 configf:assoc-s
0a40: 61 66 65 2d 61 64 64 29 0a 0a 28 64 65 66 69 6e afe-add)..(defin
0a50: 65 20 28 63 6f 6e 66 69 67 66 3a 73 65 63 74 69 e (configf:secti
0a60: 6f 6e 2d 76 61 72 2d 73 65 74 21 20 63 66 67 64 on-var-set! cfgd
0a70: 61 74 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 at section-name
0a80: 76 61 72 20 76 61 6c 75 65 20 23 21 6b 65 79 20 var value #!key
0a90: 28 6d 65 74 61 64 61 74 61 20 23 66 29 29 0a 20 (metadata #f)).
0aa0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 (hash-table-set
0ab0: 21 20 63 66 67 64 61 74 20 73 65 63 74 69 6f 6e ! cfgdat section
0ac0: 2d 6e 61 6d 65 0a 09 09 20 20 20 28 63 6f 6e 66 -name... (conf
0ad0: 69 67 66 3a 61 73 73 6f 63 2d 73 61 66 65 2d 61 igf:assoc-safe-a
0ae0: 64 64 0a 09 09 20 20 20 20 28 68 61 73 68 2d 74 dd... (hash-t
0af0: 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 able-ref/default
0b00: 20 63 66 67 64 61 74 20 73 65 63 74 69 6f 6e 2d cfgdat section-
0b10: 6e 61 6d 65 20 27 28 29 29 0a 09 09 20 20 20 20 name '())...
0b20: 76 61 72 20 76 61 6c 75 65 20 6d 65 74 61 64 61 var value metada
0b30: 74 61 3a 20 6d 65 74 61 64 61 74 61 29 29 29 0a ta: metadata))).
0b40: 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 .(define (config
0b50: 66 3a 65 76 61 6c 2d 73 74 72 69 6e 67 2d 69 6e f:eval-string-in
0b60: 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 73 74 72 -environment str
0b70: 29 0a 20 20 3b 3b 20 28 69 66 20 28 6f 72 20 28 ). ;; (if (or (
0b80: 73 74 72 69 6e 67 2d 6e 75 6c 6c 3f 20 73 74 72 string-null? str
0b90: 29 0a 20 20 3b 3b 09 20 20 28 65 71 75 61 6c 3f ). ;;. (equal?
0ba0: 20 22 21 22 20 28 73 75 62 73 74 72 69 6e 67 20 "!" (substring
0bb0: 73 74 72 20 30 20 31 29 29 29 20 3b 3b 20 6e 75 str 0 1))) ;; nu
0bc0: 6c 6c 20 73 74 72 69 6e 67 20 6f 72 20 73 74 61 ll string or sta
0bd0: 72 74 73 20 77 69 74 68 20 21 20 61 72 65 20 70 rts with ! are p
0be0: 72 65 73 65 72 76 65 64 20 62 75 74 20 4e 4f 54 reserved but NOT
0bf0: 20 73 65 74 20 69 6e 20 74 68 65 20 65 6e 76 69 set in the envi
0c00: 72 6f 6e 6d 65 6e 74 0a 20 20 20 20 20 20 73 74 ronment. st
0c10: 72 0a 20 20 20 20 20 20 28 68 61 6e 64 6c 65 2d r. (handle-
0c20: 65 78 63 65 70 74 69 6f 6e 73 0a 20 20 20 20 20 exceptions.
0c30: 20 20 65 78 6e 0a 20 20 20 20 20 20 20 28 62 65 exn. (be
0c40: 67 69 6e 0a 09 20 28 64 65 62 75 67 3a 70 72 69 gin.. (debug:pri
0c50: 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 nt-error 0 *defa
0c60: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 70 ult-log-port* "p
0c70: 72 6f 62 6c 65 6d 20 65 76 61 6c 75 61 74 69 6e roblem evaluatin
0c80: 67 20 5c 22 22 20 73 74 72 20 22 5c 22 20 69 6e g \"" str "\" in
0c90: 20 74 68 65 20 73 68 65 6c 6c 20 65 6e 76 69 72 the shell envir
0ca0: 6f 6e 6d 65 6e 74 2c 20 65 78 6e 3d 22 20 65 78 onment, exn=" ex
0cb0: 6e 29 0a 09 20 23 66 29 0a 20 20 20 20 20 20 20 n).. #f).
0cc0: 28 6c 65 74 20 28 28 63 6d 64 72 65 73 20 28 70 (let ((cmdres (p
0cd0: 72 6f 63 65 73 73 3a 63 6d 64 2d 72 75 6e 2d 3e rocess:cmd-run->
0ce0: 6c 69 73 74 20 28 63 6f 6e 63 20 22 65 63 68 6f list (conc "echo
0cf0: 20 22 20 73 74 72 29 29 29 29 0a 09 20 28 69 66 " str)))).. (if
0d00: 20 28 6e 75 6c 6c 3f 20 63 6d 64 72 65 73 29 20 (null? cmdres)
0d10: 22 22 0a 09 20 20 20 20 20 28 63 61 61 72 20 63 "".. (caar c
0d20: 6d 64 72 65 73 29 29 29 29 29 20 3b 3b 20 29 0a mdres))))) ;; ).
0d30: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
0d40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0d50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0d60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0d70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4d 61 6b =========.;; Mak
0d80: 65 20 74 68 65 20 72 65 67 65 78 70 27 73 20 6e e the regexp's n
0d90: 65 65 64 65 64 20 67 6c 6f 62 61 6c 6c 79 20 61 eeded globally a
0da0: 76 61 69 6c 61 62 6c 65 0a 3b 3b 3d 3d 3d 3d 3d vailable.;;=====
0db0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0dc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0dd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0de0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0df0: 3d 0a 0a 28 64 65 66 69 6e 65 20 63 6f 6e 66 69 =..(define confi
0e00: 67 66 3a 69 6e 63 6c 75 64 65 2d 72 78 20 28 72 gf:include-rx (r
0e10: 65 67 65 78 70 20 22 5e 5c 5c 5b 69 6e 63 6c 75 egexp "^\\[inclu
0e20: 64 65 5c 5c 73 2b 28 2e 2a 29 5c 5c 5d 5c 5c 73 de\\s+(.*)\\]\\s
0e30: 2a 24 22 29 29 0a 28 64 65 66 69 6e 65 20 63 6f *$")).(define co
0e40: 6e 66 69 67 66 3a 73 63 72 69 70 74 2d 72 78 20 nfigf:script-rx
0e50: 20 28 72 65 67 65 78 70 20 22 5e 5c 5c 5b 73 63 (regexp "^\\[sc
0e60: 72 69 70 74 69 6e 63 5c 5c 73 2b 28 5c 5c 53 2b riptinc\\s+(\\S+
0e70: 29 28 5b 5e 5c 5c 5d 5d 2a 29 5c 5c 5d 5c 5c 73 )([^\\]]*)\\]\\s
0e80: 2a 24 22 29 29 20 3b 3b 20 69 6e 63 6c 75 64 65 *$")) ;; include
0e90: 20 6f 75 74 70 75 74 20 66 72 6f 6d 20 61 20 73 output from a s
0ea0: 63 72 69 70 74 0a 28 64 65 66 69 6e 65 20 63 6f cript.(define co
0eb0: 6e 66 69 67 66 3a 73 65 63 74 69 6f 6e 2d 72 78 nfigf:section-rx
0ec0: 20 28 72 65 67 65 78 70 20 22 5e 5c 5c 5b 28 2e (regexp "^\\[(.
0ed0: 2a 29 5c 5c 5d 5c 5c 73 2a 24 22 29 29 0a 28 64 *)\\]\\s*$")).(d
0ee0: 65 66 69 6e 65 20 63 6f 6e 66 69 67 66 3a 62 6c efine configf:bl
0ef0: 61 6e 6b 2d 6c 2d 72 78 20 28 72 65 67 65 78 70 ank-l-rx (regexp
0f00: 20 22 5e 5c 5c 73 2a 24 22 29 29 0a 28 64 65 66 "^\\s*$")).(def
0f10: 69 6e 65 20 63 6f 6e 66 69 67 66 3a 6b 65 79 2d ine configf:key-
0f20: 73 79 73 2d 70 72 20 28 72 65 67 65 78 70 20 22 sys-pr (regexp "
0f30: 5e 28 5c 5c 53 2b 29 5c 5c 73 2b 5c 5c 5b 73 79 ^(\\S+)\\s+\\[sy
0f40: 73 74 65 6d 5c 5c 73 2b 28 5c 5c 53 2b 2e 2a 29 stem\\s+(\\S+.*)
0f50: 5c 5c 5d 5c 5c 73 2a 24 22 29 29 0a 28 64 65 66 \\]\\s*$")).(def
0f60: 69 6e 65 20 63 6f 6e 66 69 67 66 3a 6b 65 79 2d ine configf:key-
0f70: 76 61 6c 2d 70 72 20 28 72 65 67 65 78 70 20 22 val-pr (regexp "
0f80: 5e 28 5c 5c 53 2b 29 28 5c 5c 73 2b 28 2e 2a 29 ^(\\S+)(\\s+(.*)
0f90: 7c 28 29 29 24 22 29 29 0a 28 64 65 66 69 6e 65 |())$")).(define
0fa0: 20 63 6f 6e 66 69 67 66 3a 6b 65 79 2d 6e 6f 2d configf:key-no-
0fb0: 76 61 6c 20 28 72 65 67 65 78 70 20 22 5e 28 5c val (regexp "^(\
0fc0: 5c 53 2b 29 28 5c 5c 73 2a 29 24 22 29 29 0a 28 \S+)(\\s*)$")).(
0fd0: 64 65 66 69 6e 65 20 63 6f 6e 66 69 67 66 3a 63 define configf:c
0fe0: 6f 6d 6d 65 6e 74 2d 72 78 20 28 72 65 67 65 78 omment-rx (regex
0ff0: 70 20 22 5e 5c 5c 73 2a 23 2e 2a 22 29 29 0a 28 p "^\\s*#.*")).(
1000: 64 65 66 69 6e 65 20 63 6f 6e 66 69 67 66 3a 63 define configf:c
1010: 6f 6e 74 2d 6c 6e 2d 72 78 20 28 72 65 67 65 78 ont-ln-rx (regex
1020: 70 20 22 5e 28 5c 5c 73 2b 29 28 5c 5c 53 2b 2e p "^(\\s+)(\\S+.
1030: 2a 29 24 22 29 29 0a 28 64 65 66 69 6e 65 20 63 *)$")).(define c
1040: 6f 6e 66 69 67 66 3a 73 65 74 74 69 6e 67 73 20 onfigf:settings
1050: 20 20 28 72 65 67 65 78 70 20 22 5e 5c 5c 5b 63 (regexp "^\\[c
1060: 6f 6e 66 69 67 66 3a 73 65 74 74 69 6e 67 73 5c onfigf:settings\
1070: 5c 73 2b 28 5c 5c 53 2b 29 5c 5c 73 2b 28 5c 5c \s+(\\S+)\\s+(\\
1080: 53 2b 29 5d 5c 5c 73 2a 24 22 29 29 0a 0a 3b 3b S+)]\\s*$"))..;;
1090: 20 72 65 61 64 20 61 20 6c 69 6e 65 20 61 6e 64 read a line and
10a0: 20 70 72 6f 63 65 73 73 20 61 6e 79 20 23 7b 20 process any #{
10b0: 2e 2e 2e 20 7d 20 63 6f 6e 73 74 72 75 63 74 73 ... } constructs
10c0: 0a 0a 28 64 65 66 69 6e 65 20 63 6f 6e 66 69 67 ..(define config
10d0: 66 3a 76 61 72 2d 65 78 70 61 6e 64 2d 72 65 67 f:var-expand-reg
10e0: 65 78 20 28 72 65 67 65 78 70 20 22 5e 28 2e 2a ex (regexp "^(.*
10f0: 29 23 5c 5c 7b 28 73 63 68 65 6d 65 7c 73 79 73 )#\\{(scheme|sys
1100: 74 65 6d 7c 73 68 65 6c 6c 7c 67 65 74 65 6e 76 tem|shell|getenv
1110: 7c 67 65 74 7c 72 75 6e 63 6f 6e 66 69 67 73 2d |get|runconfigs-
1120: 67 65 74 7c 72 67 65 74 7c 73 63 6d 7c 73 68 7c get|rget|scm|sh|
1130: 72 70 7c 67 76 7c 67 7c 6d 74 72 61 68 29 5c 5c rp|gv|g|mtrah)\\
1140: 73 2b 28 5b 5e 5c 5c 7d 5c 5c 7b 5d 2a 29 5c 5c s+([^\\}\\{]*)\\
1150: 7d 28 2e 2a 29 22 29 29 0a 0a 28 64 65 66 69 6e }(.*)"))..(defin
1160: 65 20 28 63 6f 6e 66 69 67 66 3a 73 79 73 74 65 e (configf:syste
1170: 6d 20 68 74 20 63 6d 64 29 0a 20 20 28 73 79 73 m ht cmd). (sys
1180: 74 65 6d 20 63 6d 64 29 0a 20 20 29 0a 0a 28 64 tem cmd). )..(d
1190: 65 66 69 6e 65 20 63 6f 6e 66 69 67 66 3a 69 6d efine configf:im
11a0: 70 6f 72 74 73 20 22 28 69 6d 70 6f 72 74 20 63 ports "(import c
11b0: 6f 6d 6d 6f 6e 6d 6f 64 20 28 70 72 65 66 69 78 ommonmod (prefix
11c0: 20 6d 74 61 72 67 73 20 61 72 67 73 3a 29 29 22 mtargs args:))"
11d0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 )..(define (conf
11e0: 69 67 66 3a 70 72 6f 63 65 73 73 2d 6c 69 6e 65 igf:process-line
11f0: 20 6c 20 68 74 20 61 6c 6c 6f 77 2d 73 79 73 74 l ht allow-syst
1200: 65 6d 20 23 21 6b 65 79 20 28 6c 69 6e 65 6e 75 em #!key (linenu
1210: 6d 20 23 66 29 29 0a 20 20 28 6c 65 74 20 6c 6f m #f)). (let lo
1220: 6f 70 20 28 28 72 65 73 20 6c 29 29 0a 20 20 20 op ((res l)).
1230: 20 28 69 66 20 28 73 74 72 69 6e 67 3f 20 72 65 (if (string? re
1240: 73 29 0a 09 28 6c 65 74 20 28 28 6d 61 74 63 68 s)..(let ((match
1250: 64 61 74 20 28 73 74 72 69 6e 67 2d 73 65 61 72 dat (string-sear
1260: 63 68 20 63 6f 6e 66 69 67 66 3a 76 61 72 2d 65 ch configf:var-e
1270: 78 70 61 6e 64 2d 72 65 67 65 78 20 72 65 73 29 xpand-regex res)
1280: 29 29 0a 09 20 20 28 69 66 20 6d 61 74 63 68 64 )).. (if matchd
1290: 61 74 0a 09 20 20 20 20 20 20 28 6c 65 74 2a 20 at.. (let*
12a0: 28 28 70 72 65 73 74 72 20 20 28 6c 69 73 74 2d ((prestr (list-
12b0: 72 65 66 20 6d 61 74 63 68 64 61 74 20 31 29 29 ref matchdat 1))
12c0: 0a 09 09 20 20 20 20 20 28 63 6d 64 74 79 70 65 ... (cmdtype
12d0: 20 28 6c 69 73 74 2d 72 65 66 20 6d 61 74 63 68 (list-ref match
12e0: 64 61 74 20 32 29 29 20 3b 3b 20 65 76 61 6c 2c dat 2)) ;; eval,
12f0: 20 73 79 73 74 65 6d 2c 20 73 68 65 6c 6c 2c 20 system, shell,
1300: 67 65 74 65 6e 76 0a 09 09 20 20 20 20 20 28 63 getenv... (c
1310: 6d 64 20 20 20 20 20 28 6c 69 73 74 2d 72 65 66 md (list-ref
1320: 20 6d 61 74 63 68 64 61 74 20 33 29 29 0a 09 09 matchdat 3))...
1330: 20 20 20 20 20 28 70 6f 73 74 73 74 72 20 28 6c (poststr (l
1340: 69 73 74 2d 72 65 66 20 6d 61 74 63 68 64 61 74 ist-ref matchdat
1350: 20 34 29 29 0a 09 09 20 20 20 20 20 28 72 65 73 4))... (res
1360: 75 6c 74 20 20 23 66 29 0a 09 09 20 20 20 20 20 ult #f)...
1370: 28 73 74 61 72 74 2d 74 69 6d 65 20 28 63 75 72 (start-time (cur
1380: 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 0a 09 rent-seconds))..
1390: 09 20 20 20 20 20 28 63 6d 64 73 79 6d 20 20 28 . (cmdsym (
13a0: 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 63 string->symbol c
13b0: 6d 64 74 79 70 65 29 29 0a 09 09 20 20 20 20 20 mdtype))...
13c0: 28 66 75 6c 6c 63 6d 64 20 28 63 61 73 65 20 63 (fullcmd (case c
13d0: 6d 64 73 79 6d 0a 09 09 09 09 28 28 73 63 68 65 mdsym.....((sche
13e0: 6d 65 20 73 63 6d 29 20 28 63 6f 6e 63 20 22 28 me scm) (conc "(
13f0: 6c 61 6d 62 64 61 20 28 68 74 29 28 62 65 67 69 lambda (ht)(begi
1400: 6e 20 22 20 63 6f 6e 66 69 67 66 3a 69 6d 70 6f n " configf:impo
1410: 72 74 73 20 63 6d 64 20 22 29 29 22 29 29 0a 09 rts cmd "))"))..
1420: 09 09 09 28 28 73 79 73 74 65 6d 29 20 20 20 20 ...((system)
1430: 20 28 63 6f 6e 63 20 22 28 6c 61 6d 62 64 61 20 (conc "(lambda
1440: 28 68 74 29 28 63 6f 6e 66 69 67 66 3a 73 79 73 (ht)(configf:sys
1450: 74 65 6d 20 68 74 20 5c 22 22 20 63 6d 64 20 22 tem ht \"" cmd "
1460: 5c 22 29 29 22 29 29 0a 09 09 09 09 28 28 73 68 \"))")).....((sh
1470: 65 6c 6c 20 73 68 29 20 20 20 28 63 6f 6e 63 20 ell sh) (conc
1480: 22 28 6c 61 6d 62 64 61 20 28 68 74 29 28 73 74 "(lambda (ht)(st
1490: 72 69 6e 67 2d 74 72 61 6e 73 6c 61 74 65 20 28 ring-translate (
14a0: 73 68 65 6c 6c 20 5c 22 22 20 20 63 6d 64 20 22 shell \"" cmd "
14b0: 5c 22 29 20 5c 22 5c 6e 5c 22 20 5c 22 20 5c 22 \") \"\n\" \" \"
14c0: 29 29 22 29 29 0a 09 09 09 09 28 28 72 65 61 6c ))")).....((real
14d0: 70 61 74 68 20 72 70 29 28 63 6f 6e 63 20 22 28 path rp)(conc "(
14e0: 6c 61 6d 62 64 61 20 28 68 74 29 28 63 6f 6d 6d lambda (ht)(comm
14f0: 6f 6e 3a 6e 69 63 65 2d 70 61 74 68 20 5c 22 22 on:nice-path \""
1500: 20 63 6d 64 20 22 5c 22 29 29 22 29 29 0a 09 09 cmd "\"))"))...
1510: 09 09 28 28 67 65 74 65 6e 76 20 67 76 29 20 20 ..((getenv gv)
1520: 28 63 6f 6e 63 20 22 28 6c 61 6d 62 64 61 20 28 (conc "(lambda (
1530: 68 74 29 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d ht)(get-environm
1540: 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 5c 22 22 ent-variable \""
1550: 20 63 6d 64 20 22 5c 22 29 29 22 29 29 0a 09 09 cmd "\"))"))...
1560: 09 09 28 28 6d 74 72 61 68 29 20 20 20 20 20 20 ..((mtrah)
1570: 28 63 6f 6e 63 20 22 28 6c 61 6d 62 64 61 20 28 (conc "(lambda (
1580: 68 74 29 22 0a 20 20 20 20 20 20 20 20 20 20 20 ht)".
1590: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15b0: 20 20 20 20 20 20 20 20 20 22 20 20 20 20 28 6c " (l
15c0: 65 74 20 28 28 65 78 74 72 61 20 5c 22 22 20 63 et ((extra \"" c
15d0: 6d 64 20 22 5c 22 29 29 22 0a 09 09 09 09 09 09 md "\"))".......
15e0: 20 20 20 20 22 20 20 20 20 20 20 20 28 63 6f 6e " (con
15f0: 63 20 28 6f 72 20 2a 74 6f 70 70 61 74 68 2a 20 c (or *toppath*
1600: 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 (get-environment
1610: 2d 76 61 72 69 61 62 6c 65 20 5c 22 4d 54 5f 52 -variable \"MT_R
1620: 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 5c 22 29 29 UN_AREA_HOME\"))
1630: 22 0a 09 09 09 09 09 09 20 20 20 20 22 20 20 20 "....... "
1640: 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 73 (if (s
1650: 74 72 69 6e 67 2d 6e 75 6c 6c 3f 20 65 78 74 72 tring-null? extr
1660: 61 29 20 5c 22 5c 22 20 5c 22 2f 5c 22 29 22 0a a) \"\" \"/\")".
1670: 09 09 09 09 09 09 20 20 20 20 22 20 20 20 20 20 ...... "
1680: 20 20 20 20 20 20 20 20 65 78 74 72 61 29 29 29 extra)))
1690: 22 29 29 0a 09 09 09 09 28 28 67 65 74 20 67 29 ")).....((get g)
16a0: 20 20 20 0a 09 09 09 09 20 28 6d 61 74 63 68 20 ..... (match
16b0: 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 63 6d (string-split cm
16c0: 64 29 0a 09 09 09 09 09 28 28 73 65 63 74 20 76 d)......((sect v
16d0: 61 72 29 28 63 6f 6e 63 20 22 28 6c 61 6d 62 64 ar)(conc "(lambd
16e0: 61 20 28 68 74 29 28 63 6f 6e 66 69 67 66 3a 6c a (ht)(configf:l
16f0: 6f 6f 6b 75 70 20 68 74 20 5c 22 22 20 73 65 63 ookup ht \"" sec
1700: 74 20 22 5c 22 20 5c 22 22 20 76 61 72 20 22 5c t "\" \"" var "\
1710: 22 29 29 22 29 29 0a 09 09 09 09 09 28 65 6c 73 "))"))......(els
1720: 65 0a 09 09 09 09 09 20 28 64 65 62 75 67 3a 70 e...... (debug:p
1730: 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 rint-error 0 *de
1740: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
1750: 22 23 7b 67 65 74 20 2e 2e 2e 7d 20 75 73 65 64 "#{get ...} used
1760: 20 77 69 74 68 20 6f 6e 6c 79 20 6f 6e 65 20 70 with only one p
1770: 61 72 61 6d 65 74 65 72 2c 20 5c 22 22 20 63 6d arameter, \"" cm
1780: 64 20 22 5c 22 2c 20 74 77 6f 20 6e 65 65 64 65 d "\", two neede
1790: 64 2e 22 29 0a 09 09 09 09 09 20 22 28 6c 61 6d d.")...... "(lam
17a0: 62 64 61 20 28 68 74 29 20 23 66 29 22 29 29 29 bda (ht) #f)")))
17b0: 0a 09 09 09 09 28 28 72 75 6e 63 6f 6e 66 69 67 .....((runconfig
17c0: 73 2d 67 65 74 20 72 67 65 74 29 20 28 63 6f 6e s-get rget) (con
17d0: 63 20 22 28 6c 61 6d 62 64 61 20 28 68 74 29 28 c "(lambda (ht)(
17e0: 72 75 6e 63 6f 6e 66 69 67 73 2d 67 65 74 20 68 runconfigs-get h
17f0: 74 20 5c 22 22 20 63 6d 64 20 22 5c 22 29 29 22 t \"" cmd "\"))"
1800: 29 29 0a 09 09 09 09 3b 3b 20 28 28 72 67 65 74 )).....;; ((rget
1810: 29 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e ) (con
1820: 63 20 22 28 6c 61 6d 62 64 61 20 28 68 74 29 28 c "(lambda (ht)(
1830: 72 75 6e 63 6f 6e 66 69 67 73 2d 67 65 74 20 68 runconfigs-get h
1840: 74 20 5c 22 22 20 63 6d 64 20 22 5c 22 29 29 22 t \"" cmd "\"))"
1850: 29 29 0a 09 09 09 09 28 65 6c 73 65 20 22 28 6c )).....(else "(l
1860: 61 6d 62 64 61 20 28 68 74 29 28 70 72 69 6e 74 ambda (ht)(print
1870: 20 5c 22 45 52 52 4f 52 5c 22 29 20 5c 22 45 52 \"ERROR\") \"ER
1880: 52 4f 52 5c 22 29 22 29 29 29 29 0a 09 09 3b 3b ROR\")"))))...;;
1890: 20 28 70 72 69 6e 74 20 22 66 75 6c 6c 63 6d 64 (print "fullcmd
18a0: 3d 22 20 66 75 6c 6c 63 6d 64 29 0a 09 09 28 68 =" fullcmd)...(h
18b0: 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 andle-exceptions
18c0: 0a 09 09 20 65 78 6e 0a 09 09 20 28 62 65 67 69 ... exn... (begi
18d0: 6e 0a 09 09 20 20 20 28 64 65 62 75 67 3a 70 72 n... (debug:pr
18e0: 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c int 0 *default-l
18f0: 6f 67 2d 70 6f 72 74 2a 20 22 57 41 52 4e 49 4e og-port* "WARNIN
1900: 47 3a 20 66 61 69 6c 65 64 20 74 6f 20 70 72 6f G: failed to pro
1910: 63 65 73 73 20 63 6f 6e 66 69 67 20 69 6e 70 75 cess config inpu
1920: 74 20 5c 22 22 20 6c 20 22 5c 22 2c 20 65 78 6e t \"" l "\", exn
1930: 3d 22 20 65 78 6e 29 0a 09 09 20 20 20 28 64 65 =" exn)... (de
1940: 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 bug:print 0 *def
1950: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
1960: 20 6d 65 73 73 61 67 65 3a 20 22 20 28 28 63 6f message: " ((co
1970: 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 65 72 74 79 ndition-property
1980: 2d 61 63 63 65 73 73 6f 72 20 27 65 78 6e 20 27 -accessor 'exn '
1990: 6d 65 73 73 61 67 65 29 20 65 78 6e 29 29 0a 09 message) exn))..
19a0: 09 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 65 . ;; (print "e
19b0: 78 6e 3d 22 20 28 63 6f 6e 64 69 74 69 6f 6e 2d xn=" (condition-
19c0: 3e 6c 69 73 74 20 65 78 6e 29 29 0a 09 09 20 20 >list exn))...
19d0: 20 28 73 65 74 21 20 72 65 73 75 6c 74 20 28 63 (set! result (c
19e0: 6f 6e 63 20 22 23 7b 28 20 22 20 63 6d 64 74 79 onc "#{( " cmdty
19f0: 70 65 20 22 29 20 22 20 63 6d 64 20 22 7d 2c 20 pe ") " cmd "},
1a00: 66 75 6c 6c 20 65 78 70 61 6e 73 69 6f 6e 3a 20 full expansion:
1a10: 22 20 66 75 6c 6c 63 6d 64 29 29 29 0a 09 09 20 " fullcmd)))...
1a20: 28 69 66 20 28 6f 72 20 61 6c 6c 6f 77 2d 73 79 (if (or allow-sy
1a30: 73 74 65 6d 0a 09 09 09 20 28 6e 6f 74 20 28 6d stem.... (not (m
1a40: 65 6d 62 65 72 20 63 6d 64 74 79 70 65 20 27 28 ember cmdtype '(
1a50: 22 73 79 73 74 65 6d 22 20 22 73 68 65 6c 6c 22 "system" "shell"
1a60: 20 22 73 68 22 29 29 29 29 0a 09 09 20 20 20 20 "sh"))))...
1a70: 20 28 77 69 74 68 2d 69 6e 70 75 74 2d 66 72 6f (with-input-fro
1a80: 6d 2d 73 74 72 69 6e 67 20 66 75 6c 6c 63 6d 64 m-string fullcmd
1a90: 0a 09 09 20 20 20 20 20 20 20 28 6c 61 6d 62 64 ... (lambd
1aa0: 61 20 28 29 0a 09 09 09 20 28 73 65 74 21 20 72 a ().... (set! r
1ab0: 65 73 75 6c 74 20 28 28 65 76 61 6c 20 28 72 65 esult ((eval (re
1ac0: 61 64 29 29 20 68 74 29 29 29 29 0a 09 09 20 20 ad)) ht))))...
1ad0: 20 20 20 28 73 65 74 21 20 72 65 73 75 6c 74 20 (set! result
1ae0: 28 63 6f 6e 63 20 22 23 7b 28 22 20 63 6d 64 74 (conc "#{(" cmdt
1af0: 79 70 65 20 22 29 20 22 20 20 63 6d 64 20 22 7d ype ") " cmd "}
1b00: 22 29 29 29 29 0a 09 09 28 63 61 73 65 20 63 6d "))))...(case cm
1b10: 64 73 79 6d 0a 09 09 20 20 28 28 73 79 73 74 65 dsym... ((syste
1b20: 6d 20 73 68 65 6c 6c 20 73 63 68 65 6d 65 29 0a m shell scheme).
1b30: 09 09 20 20 20 28 6c 65 74 20 28 28 64 65 6c 74 .. (let ((delt
1b40: 61 20 28 2d 20 28 63 75 72 72 65 6e 74 2d 73 65 a (- (current-se
1b50: 63 6f 6e 64 73 29 20 73 74 61 72 74 2d 74 69 6d conds) start-tim
1b60: 65 29 29 29 0a 09 09 20 20 20 20 20 28 69 66 20 e)))... (if
1b70: 28 3e 20 64 65 6c 74 61 20 32 29 0a 09 09 09 20 (> delta 2)....
1b80: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
1b90: 6f 20 32 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 o 2 *default-log
1ba0: 2d 70 6f 72 74 2a 20 22 66 6f 72 20 6c 69 6e 65 -port* "for line
1bb0: 20 5c 22 22 20 6c 20 22 5c 22 5c 6e 20 63 6f 6d \"" l "\"\n com
1bc0: 6d 61 6e 64 3a 20 20 22 20 63 6d 64 20 22 20 74 mand: " cmd " t
1bd0: 6f 6f 6b 20 22 20 64 65 6c 74 61 20 22 20 73 65 ook " delta " se
1be0: 63 6f 6e 64 73 20 74 6f 20 72 75 6e 20 77 69 74 conds to run wit
1bf0: 68 20 6f 75 74 70 75 74 3a 5c 6e 20 20 20 22 20 h output:\n "
1c00: 72 65 73 75 6c 74 29 0a 09 09 09 20 28 64 65 62 result).... (deb
1c10: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 39 20 ug:print-info 9
1c20: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
1c30: 74 2a 20 22 66 6f 72 20 6c 69 6e 65 20 5c 22 22 t* "for line \""
1c40: 20 6c 20 22 5c 22 5c 6e 20 63 6f 6d 6d 61 6e 64 l "\"\n command
1c50: 3a 20 20 22 20 63 6d 64 20 22 20 74 6f 6f 6b 20 : " cmd " took
1c60: 22 20 64 65 6c 74 61 20 22 20 73 65 63 6f 6e 64 " delta " second
1c70: 73 20 74 6f 20 72 75 6e 20 77 69 74 68 20 6f 75 s to run with ou
1c80: 74 70 75 74 3a 5c 6e 20 20 20 22 20 72 65 73 75 tput:\n " resu
1c90: 6c 74 29 29 29 29 29 0a 09 09 28 6c 6f 6f 70 20 lt)))))...(loop
1ca0: 28 63 6f 6e 63 20 70 72 65 73 74 72 20 72 65 73 (conc prestr res
1cb0: 75 6c 74 20 70 6f 73 74 73 74 72 29 29 29 0a 09 ult poststr)))..
1cc0: 20 20 20 20 20 20 72 65 73 29 29 0a 09 72 65 73 res))..res
1cd0: 29 29 29 0a 0a 3b 3b 20 52 75 6e 20 61 20 73 68 )))..;; Run a sh
1ce0: 65 6c 6c 20 63 6f 6d 6d 61 6e 64 20 61 6e 64 20 ell command and
1cf0: 72 65 74 75 72 6e 20 74 68 65 20 6f 75 74 70 75 return the outpu
1d00: 74 20 61 73 20 61 20 73 74 72 69 6e 67 0a 28 64 t as a string.(d
1d10: 65 66 69 6e 65 20 28 73 68 65 6c 6c 20 63 6d 64 efine (shell cmd
1d20: 29 0a 20 20 28 6c 65 74 2a 20 28 28 6f 75 74 70 ). (let* ((outp
1d30: 75 74 20 28 70 72 6f 63 65 73 73 3a 63 6d 64 2d ut (process:cmd-
1d40: 72 75 6e 2d 3e 6c 69 73 74 20 63 6d 64 29 29 0a run->list cmd)).
1d50: 09 20 28 72 65 73 20 20 20 20 28 63 61 72 20 6f . (res (car o
1d60: 75 74 70 75 74 29 29 0a 09 20 28 73 74 61 74 75 utput)).. (statu
1d70: 73 20 28 63 61 64 72 20 6f 75 74 70 75 74 29 29 s (cadr output))
1d80: 29 0a 20 20 20 20 28 69 66 20 28 65 71 75 61 6c ). (if (equal
1d90: 3f 20 73 74 61 74 75 73 20 30 29 0a 09 28 6c 65 ? status 0)..(le
1da0: 74 20 28 28 6f 75 74 72 65 73 20 28 73 74 72 69 t ((outres (stri
1db0: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 0a ng-intersperse .
1dc0: 09 09 20 20 20 20 20 20 20 72 65 73 0a 09 09 20 .. res...
1dd0: 20 20 20 20 20 20 22 5c 6e 22 29 29 29 0a 09 20 "\n")))..
1de0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
1df0: 66 6f 20 34 20 2a 64 65 66 61 75 6c 74 2d 6c 6f fo 4 *default-lo
1e00: 67 2d 70 6f 72 74 2a 20 22 73 68 65 6c 6c 20 72 g-port* "shell r
1e10: 65 73 75 6c 74 3a 5c 6e 22 20 6f 75 74 72 65 73 esult:\n" outres
1e20: 29 0a 09 20 20 6f 75 74 72 65 73 29 0a 09 28 62 ).. outres)..(b
1e30: 65 67 69 6e 20 3b 3b 20 77 68 79 20 69 73 20 74 egin ;; why is t
1e40: 68 69 73 20 70 72 69 6e 74 69 6e 67 20 74 6f 20 his printing to
1e50: 65 72 72 6f 72 2d 70 6f 72 74 20 61 6e 64 20 6e error-port and n
1e60: 6f 74 20 75 73 69 6e 67 20 64 65 62 75 67 3a 70 ot using debug:p
1e70: 72 69 6e 74 3f 20 2d 6d 72 77 2d 0a 09 20 20 28 rint? -mrw-.. (
1e80: 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 70 with-output-to-p
1e90: 6f 72 74 20 28 63 75 72 72 65 6e 74 2d 65 72 72 ort (current-err
1ea0: 6f 72 2d 70 6f 72 74 29 0a 09 20 20 20 20 28 6c or-port).. (l
1eb0: 61 6d 62 64 61 20 28 29 0a 09 20 20 20 20 20 20 ambda ()..
1ec0: 28 70 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 22 (print "ERROR: "
1ed0: 20 63 6d 64 20 22 20 72 65 74 75 72 6e 65 64 20 cmd " returned
1ee0: 62 61 64 20 65 78 69 74 20 63 6f 64 65 20 22 20 bad exit code "
1ef0: 73 74 61 74 75 73 29 29 29 0a 09 20 20 22 22 29 status))).. "")
1f00: 29 29 29 0a 0a 3b 3b 20 74 68 69 73 20 77 61 73 )))..;; this was
1f10: 20 69 6e 6c 69 6e 65 20 62 75 74 20 49 27 6d 20 inline but I'm
1f20: 70 72 65 74 74 79 20 73 75 72 65 20 74 68 61 74 pretty sure that
1f30: 20 69 73 20 61 20 68 6f 6c 64 20 6f 76 65 72 20 is a hold over
1f40: 66 72 6f 6d 20 77 68 65 6e 20 69 74 20 77 61 73 from when it was
1f50: 20 2a 76 65 72 79 2a 20 73 69 6d 70 6c 65 20 2e *very* simple .
1f60: 2e 2e 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 63 ...;;.(define (c
1f70: 6f 6e 66 69 67 66 3a 72 65 61 64 2d 6c 69 6e 65 onfigf:read-line
1f80: 20 70 20 68 74 20 61 6c 6c 6f 77 2d 70 72 6f 63 p ht allow-proc
1f90: 65 73 73 69 6e 67 20 73 65 74 74 69 6e 67 73 29 essing settings)
1fa0: 0a 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 69 . (let loop ((i
1fb0: 6e 6c 20 28 72 65 61 64 2d 6c 69 6e 65 20 70 29 nl (read-line p)
1fc0: 29 29 0a 20 20 20 20 28 6c 65 74 20 28 28 63 6f )). (let ((co
1fd0: 6e 74 2d 6c 69 6e 65 20 28 61 6e 64 20 28 73 74 nt-line (and (st
1fe0: 72 69 6e 67 3f 20 69 6e 6c 29 0a 09 09 09 20 20 ring? inl)....
1ff0: 28 6e 6f 74 20 28 73 74 72 69 6e 67 2d 6e 75 6c (not (string-nul
2000: 6c 3f 20 69 6e 6c 29 29 0a 09 09 09 20 20 28 65 l? inl)).... (e
2010: 71 75 61 6c 3f 20 22 5c 5c 22 20 28 73 74 72 69 qual? "\\" (stri
2020: 6e 67 2d 74 61 6b 65 2d 72 69 67 68 74 20 69 6e ng-take-right in
2030: 6c 20 31 29 29 29 29 29 0a 20 20 20 20 20 20 28 l 1))))). (
2040: 69 66 20 63 6f 6e 74 2d 6c 69 6e 65 20 3b 3b 20 if cont-line ;;
2050: 6c 61 73 74 20 63 68 61 72 61 63 74 65 72 20 69 last character i
2060: 73 20 5c 20 0a 09 20 20 28 6c 65 74 20 28 28 6e s \ .. (let ((n
2070: 65 78 74 6c 20 28 72 65 61 64 2d 6c 69 6e 65 20 extl (read-line
2080: 70 29 29 29 0a 09 20 20 20 20 28 69 66 20 28 6e p))).. (if (n
2090: 6f 74 20 28 65 6f 66 2d 6f 62 6a 65 63 74 3f 20 ot (eof-object?
20a0: 6e 65 78 74 6c 29 29 0a 09 09 28 6c 6f 6f 70 20 nextl))...(loop
20b0: 28 73 74 72 69 6e 67 2d 61 70 70 65 6e 64 20 28 (string-append (
20c0: 69 66 20 63 6f 6e 74 2d 6c 69 6e 65 20 0a 09 09 if cont-line ...
20d0: 09 09 09 20 28 73 74 72 69 6e 67 2d 74 61 6b 65 ... (string-take
20e0: 20 69 6e 6c 20 28 2d 20 28 73 74 72 69 6e 67 2d inl (- (string-
20f0: 6c 65 6e 67 74 68 20 69 6e 6c 29 20 31 29 29 0a length inl) 1)).
2100: 09 09 09 09 09 20 69 6e 6c 29 0a 09 09 09 09 20 ..... inl).....
2110: 20 20 20 20 6e 65 78 74 6c 29 29 29 29 0a 09 20 nextl))))..
2120: 20 28 6c 65 74 20 28 28 72 65 73 20 28 63 61 73 (let ((res (cas
2130: 65 20 61 6c 6c 6f 77 2d 70 72 6f 63 65 73 73 69 e allow-processi
2140: 6e 67 20 3b 3b 20 69 66 20 28 61 6e 64 20 61 6c ng ;; if (and al
2150: 6c 6f 77 2d 70 72 6f 63 65 73 73 69 6e 67 20 0a low-processing .
2160: 09 09 20 20 20 20 20 20 20 3b 3b 09 20 20 20 28 .. ;;. (
2170: 6e 6f 74 20 28 65 71 3f 20 61 6c 6c 6f 77 2d 70 not (eq? allow-p
2180: 72 6f 63 65 73 73 69 6e 67 20 27 72 65 74 75 72 rocessing 'retur
2190: 6e 2d 73 74 72 69 6e 67 29 29 29 0a 09 09 20 20 n-string)))...
21a0: 20 20 20 20 20 28 28 23 74 20 23 66 29 0a 09 09 ((#t #f)...
21b0: 09 28 63 6f 6e 66 69 67 66 3a 70 72 6f 63 65 73 .(configf:proces
21c0: 73 2d 6c 69 6e 65 20 69 6e 6c 20 68 74 20 61 6c s-line inl ht al
21d0: 6c 6f 77 2d 70 72 6f 63 65 73 73 69 6e 67 29 29 low-processing))
21e0: 0a 09 09 20 20 20 20 20 20 20 28 28 72 65 74 75 ... ((retu
21f0: 72 6e 2d 73 74 72 69 6e 67 29 0a 09 09 09 69 6e rn-string)....in
2200: 6c 29 0a 09 09 20 20 20 20 20 20 20 28 65 6c 73 l)... (els
2210: 65 0a 09 09 09 28 63 6f 6e 66 69 67 66 3a 70 72 e....(configf:pr
2220: 6f 63 65 73 73 2d 6c 69 6e 65 20 69 6e 6c 20 68 ocess-line inl h
2230: 74 20 61 6c 6c 6f 77 2d 70 72 6f 63 65 73 73 69 t allow-processi
2240: 6e 67 29 29 29 29 29 0a 09 20 20 20 20 28 69 66 ng))))).. (if
2250: 20 28 61 6e 64 20 28 73 74 72 69 6e 67 3f 20 72 (and (string? r
2260: 65 73 29 20 20 3b 3b 20 6d 75 73 74 20 73 65 74 es) ;; must set
2270: 20 74 6f 20 22 6e 6f 22 20 74 6f 20 66 6f 72 63 to "no" to forc
2280: 65 20 4e 4f 54 20 74 72 69 6d 6d 69 6e 67 20 74 e NOT trimming t
2290: 72 61 69 6c 69 6e 67 20 73 70 61 63 65 73 0a 09 railing spaces..
22a0: 09 20 20 20 20 20 28 6e 6f 74 20 28 65 71 75 61 . (not (equa
22b0: 6c 3f 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 l? (hash-table-r
22c0: 65 66 2f 64 65 66 61 75 6c 74 20 73 65 74 74 69 ef/default setti
22d0: 6e 67 73 20 22 74 72 69 6d 2d 74 72 61 69 6c 69 ngs "trim-traili
22e0: 6e 67 2d 73 70 61 63 65 73 22 20 22 79 65 73 22 ng-spaces" "yes"
22f0: 29 20 22 6e 6f 22 29 29 29 0a 09 09 28 73 74 72 ) "no")))...(str
2300: 69 6e 67 2d 73 75 62 73 74 69 74 75 74 65 20 22 ing-substitute "
2310: 5c 5c 73 2b 24 22 20 22 22 20 72 65 73 29 0a 09 \\s+$" "" res)..
2320: 09 72 65 73 29 29 29 29 29 29 0a 0a 28 64 65 66 .res))))))..(def
2330: 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a 63 66 67 ine (configf:cfg
2340: 64 61 74 2d 3e 65 6e 76 2d 61 6c 69 73 74 20 73 dat->env-alist s
2350: 65 63 74 69 6f 6e 20 63 66 67 64 61 74 2d 68 74 ection cfgdat-ht
2360: 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 29 0a 20 allow-system).
2370: 20 28 66 69 6c 74 65 72 0a 20 20 20 28 6c 61 6d (filter. (lam
2380: 62 64 61 20 28 70 61 69 72 29 0a 20 20 20 20 20 bda (pair).
2390: 28 6c 65 74 2a 20 28 28 76 61 72 20 28 63 61 72 (let* ((var (car
23a0: 20 70 61 69 72 29 29 0a 20 20 20 20 20 20 20 20 pair)).
23b0: 20 20 20 20 28 76 61 6c 20 28 63 64 72 20 70 61 (val (cdr pa
23c0: 69 72 29 29 29 0a 20 20 20 20 20 20 20 28 63 6f ir))). (co
23d0: 6e 73 20 76 61 72 0a 20 20 20 20 20 20 20 20 20 ns var.
23e0: 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 (cond.
23f0: 20 20 20 20 20 20 20 20 28 28 61 6e 64 20 61 6c ((and al
2400: 6c 6f 77 2d 73 79 73 74 65 6d 20 28 70 72 6f 63 low-system (proc
2410: 65 64 75 72 65 3f 20 76 61 6c 29 29 20 3b 3b 20 edure? val)) ;;
2420: 69 66 20 77 65 20 64 65 63 69 64 65 64 20 74 6f if we decided to
2430: 20 75 73 65 20 73 6f 6d 65 74 68 69 6e 67 20 6f use something o
2440: 74 68 65 72 20 74 68 61 6e 20 23 74 20 6f 72 20 ther than #t or
2450: 23 66 20 66 6f 72 20 61 6c 6c 6f 77 2d 73 79 73 #f for allow-sys
2460: 74 65 6d 20 28 27 72 65 74 75 72 6e 2d 70 72 6f tem ('return-pro
2470: 63 73 20 6f 72 20 27 72 65 74 75 72 6e 2d 73 74 cs or 'return-st
2480: 72 69 6e 67 29 20 2c 20 74 68 69 73 20 6d 61 79 ring) , this may
2490: 20 62 65 63 6f 6d 65 20 70 72 6f 62 6c 65 6d 61 become problema
24a0: 74 69 63 0a 20 20 20 20 20 20 20 20 20 20 20 20 tic.
24b0: 20 20 20 28 76 61 6c 29 29 0a 20 20 20 20 20 20 (val)).
24c0: 20 20 20 20 20 20 20 20 28 28 70 72 6f 63 65 64 ((proced
24d0: 75 72 65 3f 20 76 61 6c 29 20 23 66 29 0a 20 20 ure? val) #f).
24e0: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 73 74 ((st
24f0: 72 69 6e 67 3f 20 76 61 6c 29 20 76 61 6c 29 0a ring? val) val).
2500: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 (e
2510: 6c 73 65 20 22 23 66 22 29 29 29 29 29 0a 20 20 lse "#f"))))).
2520: 20 28 61 70 70 65 6e 64 0a 20 20 20 20 28 68 61 (append. (ha
2530: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def
2540: 61 75 6c 74 20 63 66 67 64 61 74 2d 68 74 20 22 ault cfgdat-ht "
2550: 64 65 66 61 75 6c 74 22 20 27 28 29 29 0a 20 20 default" '()).
2560: 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 73 65 (if (equal? se
2570: 63 74 69 6f 6e 20 22 64 65 66 61 75 6c 74 22 29 ction "default")
2580: 20 27 28 29 20 28 68 61 73 68 2d 74 61 62 6c 65 '() (hash-table
2590: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 63 66 67 -ref/default cfg
25a0: 64 61 74 2d 68 74 20 73 65 63 74 69 6f 6e 20 27 dat-ht section '
25b0: 28 29 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 ())))))..(define
25c0: 20 28 63 61 6c 63 2d 61 6c 6c 6f 77 2d 73 79 73 (calc-allow-sys
25d0: 74 65 6d 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d tem allow-system
25e0: 20 73 65 63 74 69 6f 6e 20 73 65 63 74 69 6f 6e section section
25f0: 73 29 0a 20 20 28 69 66 20 73 65 63 74 69 6f 6e s). (if section
2600: 73 0a 20 20 20 20 20 20 28 61 6e 64 20 28 6f 72 s. (and (or
2610: 20 28 65 71 75 61 6c 3f 20 22 64 65 66 61 75 6c (equal? "defaul
2620: 74 22 20 73 65 63 74 69 6f 6e 29 0a 09 20 20 20 t" section)..
2630: 20 20 20 20 28 6d 65 6d 62 65 72 20 73 65 63 74 (member sect
2640: 69 6f 6e 20 73 65 63 74 69 6f 6e 73 29 29 0a 09 ion sections))..
2650: 20 20 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 29 allow-system)
2660: 20 3b 3b 20 61 63 63 6f 75 6e 74 20 66 6f 72 20 ;; account for
2670: 73 65 63 74 69 6f 6e 73 20 61 6e 64 20 72 65 74 sections and ret
2680: 75 72 6e 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d urn allow-system
2690: 20 61 73 20 69 74 20 6d 69 67 68 74 20 62 65 20 as it might be
26a0: 61 20 73 79 6d 62 6f 6c 20 73 75 63 68 20 61 73 a symbol such as
26b0: 20 72 65 74 75 72 6e 2d 73 74 72 69 6e 67 73 0a return-strings.
26c0: 20 20 20 20 20 20 61 6c 6c 6f 77 2d 73 79 73 74 allow-syst
26d0: 65 6d 29 29 0a 20 20 20 20 0a 3b 3b 20 67 69 76 em)). .;; giv
26e0: 65 6e 20 61 20 63 6f 6e 66 69 67 20 68 61 73 68 en a config hash
26f0: 20 61 6e 64 20 61 20 73 65 63 74 69 6f 6e 20 6e and a section n
2700: 61 6d 65 2c 20 61 70 70 6c 79 20 74 68 61 74 20 ame, apply that
2710: 73 65 63 74 69 6f 6e 20 74 6f 20 61 6c 6c 20 6d section to all m
2720: 61 74 63 68 69 6e 67 20 73 65 63 74 69 6f 6e 73 atching sections
2730: 20 28 75 73 69 6e 67 20 77 69 6c 64 63 61 72 64 (using wildcard
2740: 20 25 20 6f 72 20 72 65 67 65 78 20 69 66 20 2f % or regex if /
2750: 2e 2e 2e 2e 2f 29 0a 3b 3b 20 72 65 6d 6f 76 65 ..../).;; remove
2760: 20 74 68 65 20 73 65 63 74 69 6f 6e 20 77 68 65 the section whe
2770: 6e 20 64 6f 6e 65 20 73 6f 20 74 68 61 74 20 74 n done so that t
2780: 68 65 72 65 20 69 73 20 6e 6f 20 64 6f 77 6e 73 here is no downs
2790: 74 72 65 61 6d 20 63 6c 6f 62 62 65 72 69 6e 67 tream clobbering
27a0: 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e .;;.(define (con
27b0: 66 69 67 66 3a 61 70 70 6c 79 2d 77 69 6c 64 63 figf:apply-wildc
27c0: 61 72 64 73 20 68 74 20 73 65 63 74 69 6f 6e 2d ards ht section-
27d0: 6e 61 6d 65 29 0a 20 20 28 69 66 20 28 68 61 73 name). (if (has
27e0: 68 2d 74 61 62 6c 65 2d 65 78 69 73 74 73 3f 20 h-table-exists?
27f0: 68 74 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 29 ht section-name)
2800: 0a 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 76 . (let* ((v
2810: 61 72 73 20 20 28 68 61 73 68 2d 74 61 62 6c 65 ars (hash-table
2820: 2d 72 65 66 20 68 74 20 73 65 63 74 69 6f 6e 2d -ref ht section-
2830: 6e 61 6d 65 29 29 0a 09 20 20 20 20 20 28 72 78 name)).. (rx
2840: 73 74 72 20 28 69 66 20 28 73 74 72 69 6e 67 2d str (if (string-
2850: 63 6f 6e 74 61 69 6e 73 20 73 65 63 74 69 6f 6e contains section
2860: 2d 6e 61 6d 65 20 22 25 22 29 0a 09 09 09 28 73 -name "%")....(s
2870: 74 72 69 6e 67 2d 73 75 62 73 74 69 74 75 74 65 tring-substitute
2880: 20 28 72 65 67 65 78 70 20 22 25 22 29 20 22 2e (regexp "%") ".
2890: 2a 22 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 29 *" section-name)
28a0: 0a 09 09 09 28 73 74 72 69 6e 67 2d 73 75 62 73 ....(string-subs
28b0: 74 69 74 75 74 65 20 28 72 65 67 65 78 70 20 22 titute (regexp "
28c0: 5e 2f 28 2e 2a 29 2f 24 22 29 20 22 5c 5c 31 22 ^/(.*)/$") "\\1"
28d0: 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 29 29 29 section-name)))
28e0: 0a 09 20 20 20 20 20 28 72 78 20 20 20 20 28 72 .. (rx (r
28f0: 65 67 65 78 70 20 72 78 73 74 72 29 29 29 0a 09 egexp rxstr)))..
2900: 3b 3b 20 28 70 72 69 6e 74 20 22 5c 6e 73 65 63 ;; (print "\nsec
2910: 74 69 6f 6e 2d 6e 61 6d 65 3a 20 22 20 73 65 63 tion-name: " sec
2920: 74 69 6f 6e 2d 6e 61 6d 65 20 22 20 72 78 73 74 tion-name " rxst
2930: 72 3a 20 22 20 72 78 73 74 72 29 0a 20 20 20 20 r: " rxstr).
2940: 20 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 20 20 (for-each.
2950: 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 (lambda (
2960: 73 65 63 74 69 6f 6e 29 0a 09 20 20 20 28 69 66 section).. (if
2970: 20 73 65 63 74 69 6f 6e 0a 09 20 20 20 20 20 20 section..
2980: 20 28 6c 65 74 20 28 28 73 61 6d 65 2d 73 65 63 (let ((same-sec
2990: 74 69 6f 6e 20 28 73 74 72 69 6e 67 3d 3f 20 73 tion (string=? s
29a0: 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 73 65 63 74 ection-name sect
29b0: 69 6f 6e 29 29 0a 09 09 20 20 20 20 20 28 72 78 ion))... (rx
29c0: 2d 6d 61 74 63 68 20 20 20 20 20 28 73 74 72 69 -match (stri
29d0: 6e 67 2d 6d 61 74 63 68 20 72 78 20 73 65 63 74 ng-match rx sect
29e0: 69 6f 6e 29 29 29 0a 09 09 20 3b 3b 20 28 70 72 ion)))... ;; (pr
29f0: 69 6e 74 20 22 73 65 63 74 69 6f 6e 3a 20 22 20 int "section: "
2a00: 73 65 63 74 69 6f 6e 20 22 20 76 61 72 73 3a 20 section " vars:
2a10: 22 20 76 61 72 73 20 22 20 73 61 6d 65 2d 73 65 " vars " same-se
2a20: 63 74 69 6f 6e 3a 20 22 20 73 61 6d 65 2d 73 65 ction: " same-se
2a30: 63 74 69 6f 6e 20 22 20 72 78 2d 6d 61 74 63 68 ction " rx-match
2a40: 3a 20 22 20 72 78 2d 6d 61 74 63 68 29 0a 09 09 : " rx-match)...
2a50: 20 28 69 66 20 28 61 6e 64 20 28 6e 6f 74 20 73 (if (and (not s
2a60: 61 6d 65 2d 73 65 63 74 69 6f 6e 29 20 72 78 2d ame-section) rx-
2a70: 6d 61 74 63 68 29 0a 09 09 20 20 20 20 20 28 66 match)... (f
2a80: 6f 72 2d 65 61 63 68 0a 09 09 20 20 20 20 20 20 or-each...
2a90: 28 6c 61 6d 62 64 61 20 28 62 75 6e 64 6c 65 29 (lambda (bundle)
2aa0: 0a 09 09 09 3b 3b 20 28 70 72 69 6e 74 20 22 62 ....;; (print "b
2ab0: 75 6e 64 6c 65 3a 20 22 20 62 75 6e 64 6c 65 29 undle: " bundle)
2ac0: 0a 09 09 09 28 6c 65 74 20 28 28 6b 65 79 20 20 ....(let ((key
2ad0: 28 63 61 72 20 62 75 6e 64 6c 65 29 29 0a 09 09 (car bundle))...
2ae0: 09 20 20 20 20 20 20 28 76 61 6c 20 20 28 63 61 . (val (ca
2af0: 64 72 20 62 75 6e 64 6c 65 29 29 0a 09 09 09 20 dr bundle))....
2b00: 20 20 20 20 20 28 6d 65 74 61 20 28 69 66 20 28 (meta (if (
2b10: 3e 20 28 6c 65 6e 67 74 68 20 62 75 6e 64 6c 65 > (length bundle
2b20: 29 20 32 29 28 63 61 64 64 72 20 62 75 6e 64 6c ) 2)(caddr bundl
2b30: 65 29 20 23 66 29 29 29 0a 09 09 09 20 20 28 68 e) #f))).... (h
2b40: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 68 ash-table-set! h
2b50: 74 20 73 65 63 74 69 6f 6e 20 28 63 6f 6e 66 69 t section (confi
2b60: 67 66 3a 61 73 73 6f 63 2d 73 61 66 65 2d 61 64 gf:assoc-safe-ad
2b70: 64 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 d (hash-table-re
2b80: 66 20 68 74 20 73 65 63 74 69 6f 6e 29 20 6b 65 f ht section) ke
2b90: 79 20 76 61 6c 20 6d 65 74 61 64 61 74 61 3a 20 y val metadata:
2ba0: 6d 65 74 61 29 29 29 29 0a 09 09 20 20 20 20 20 meta))))...
2bb0: 20 76 61 72 73 29 29 29 29 29 0a 20 20 20 20 20 vars))))).
2bc0: 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (hash-table-
2bd0: 6b 65 79 73 20 68 74 29 29 29 29 0a 20 20 68 74 keys ht)))). ht
2be0: 29 0a 0a 3b 3b 20 72 65 61 64 20 61 20 63 6f 6e )..;; read a con
2bf0: 66 69 67 20 66 69 6c 65 2c 20 72 65 74 75 72 6e fig file, return
2c00: 73 20 68 61 73 68 20 74 61 62 6c 65 20 6f 66 20 s hash table of
2c10: 61 6c 69 73 74 73 0a 0a 3b 3b 20 72 65 61 64 20 alists..;; read
2c20: 61 20 63 6f 6e 66 69 67 20 66 69 6c 65 2c 20 72 a config file, r
2c30: 65 74 75 72 6e 73 20 68 61 73 68 20 74 61 62 6c eturns hash tabl
2c40: 65 20 6f 66 20 61 6c 69 73 74 73 0a 3b 3b 20 61 e of alists.;; a
2c50: 64 64 73 20 74 6f 20 68 74 20 69 66 20 67 69 76 dds to ht if giv
2c60: 65 6e 20 28 6d 75 73 74 20 62 65 20 23 66 20 6f en (must be #f o
2c70: 74 68 65 72 77 69 73 65 29 0a 3b 3b 20 61 6c 6c therwise).;; all
2c80: 6f 77 2d 73 79 73 74 65 6d 3a 0a 3b 3b 20 20 20 ow-system:.;;
2c90: 20 23 66 20 2d 20 64 6f 20 6e 6f 74 20 65 76 61 #f - do not eva
2ca0: 6c 75 61 74 65 20 5b 73 79 73 74 65 6d 0a 3b 3b luate [system.;;
2cb0: 20 20 20 20 23 74 20 2d 20 69 6d 6d 65 64 69 61 #t - immedia
2cc0: 74 65 6c 79 20 65 76 61 6c 75 61 74 65 20 5b 73 tely evaluate [s
2cd0: 79 73 74 65 6d 20 61 6e 64 20 73 74 6f 72 65 20 ystem and store
2ce0: 72 65 73 75 6c 74 20 61 73 20 73 74 72 69 6e 67 result as string
2cf0: 0a 3b 3b 20 20 20 20 27 72 65 74 75 72 6e 2d 70 .;; 'return-p
2d00: 72 6f 63 73 20 2d 2d 20 72 65 74 75 72 6e 20 61 rocs -- return a
2d10: 20 70 72 6f 63 20 74 61 6b 69 6e 67 20 68 74 20 proc taking ht
2d20: 61 73 20 61 6e 20 61 72 67 75 6d 65 6e 74 20 74 as an argument t
2d30: 68 61 74 20 6d 61 79 20 62 65 20 65 76 61 75 6c hat may be evaul
2d40: 61 74 65 64 20 61 74 20 73 6f 6d 65 20 66 75 74 ated at some fut
2d50: 75 72 65 20 74 69 6d 65 0a 3b 3b 20 20 20 20 27 ure time.;; '
2d60: 72 65 74 75 72 6e 2d 73 74 72 69 6e 67 20 2d 2d return-string --
2d70: 20 72 65 74 75 72 6e 20 61 20 73 74 72 69 6e 67 return a string
2d80: 20 72 65 70 72 65 73 65 6e 74 69 6e 67 20 61 20 representing a
2d90: 70 72 6f 63 20 74 61 6b 69 6e 67 20 68 74 20 61 proc taking ht a
2da0: 73 20 61 6e 20 61 72 67 75 6d 65 6e 74 20 74 68 s an argument th
2db0: 61 74 20 6d 61 79 20 62 65 20 65 76 61 75 6c 61 at may be evaula
2dc0: 74 65 64 20 61 74 20 73 6f 6d 65 20 66 75 74 75 ted at some futu
2dd0: 72 65 20 74 69 6d 65 0a 3b 3b 20 65 6e 76 69 6f re time.;; envio
2de0: 6e 2d 70 61 74 74 20 69 73 20 61 20 72 65 67 65 n-patt is a rege
2df0: 78 20 73 70 65 63 20 74 68 61 74 20 69 64 65 6e x spec that iden
2e00: 74 69 66 69 65 73 20 73 65 63 74 69 6f 6e 73 20 tifies sections
2e10: 74 68 61 74 20 77 69 6c 6c 20 62 65 20 65 76 61 that will be eva
2e20: 6c 27 64 0a 3b 3b 20 69 6e 20 74 68 65 20 65 6e l'd.;; in the en
2e30: 76 69 72 6f 6e 6d 65 6e 74 20 6f 6e 20 74 68 65 vironment on the
2e40: 20 66 6c 79 0a 3b 3b 20 73 65 63 74 69 6f 6e 73 fly.;; sections
2e50: 3a 20 23 66 20 3d 3e 20 67 65 74 20 61 6c 6c 2c : #f => get all,
2e60: 20 65 6c 73 65 20 6c 69 73 74 20 6f 66 20 73 65 else list of se
2e70: 63 74 69 6f 6e 73 20 74 6f 20 67 61 74 68 65 72 ctions to gather
2e80: 0a 3b 3b 20 70 6f 73 74 2d 73 65 63 74 69 6f 6e .;; post-section
2e90: 2d 70 72 6f 63 73 20 61 6c 69 73 74 20 6f 66 20 -procs alist of
2ea0: 73 65 63 74 69 6f 6e 2d 70 61 74 74 65 72 6e 20 section-pattern
2eb0: 3d 3e 20 70 72 6f 63 2c 20 77 68 65 72 65 3a 20 => proc, where:
2ec0: 28 70 72 6f 63 20 73 65 63 74 69 6f 6e 2d 6e 61 (proc section-na
2ed0: 6d 65 20 6e 65 78 74 2d 73 65 63 74 69 6f 6e 2d me next-section-
2ee0: 6e 61 6d 65 20 68 74 20 63 75 72 72 2d 70 61 74 name ht curr-pat
2ef0: 68 29 0a 3b 3b 20 61 70 70 6c 79 2d 77 69 6c 64 h).;; apply-wild
2f00: 63 61 72 64 73 3a 20 23 74 2f 23 66 20 2d 20 61 cards: #t/#f - a
2f10: 70 70 6c 79 20 76 61 72 73 20 66 72 6f 6d 20 74 pply vars from t
2f20: 61 72 67 65 74 73 20 77 69 74 68 20 25 20 77 69 argets with % wi
2f30: 6c 64 63 61 72 64 73 20 74 6f 20 61 6c 6c 20 6d ldcards to all m
2f40: 61 74 63 68 69 6e 67 20 73 65 63 74 69 6f 6e 73 atching sections
2f50: 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 72 65 61 .;;.(define (rea
2f60: 64 2d 63 6f 6e 66 69 67 20 70 61 74 68 20 68 74 d-config path ht
2f70: 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 23 21 allow-system #!
2f80: 6b 65 79 20 28 65 6e 76 69 72 6f 6e 2d 70 61 74 key (environ-pat
2f90: 74 20 23 66 29 20 20 20 20 20 20 20 20 20 20 20 t #f)
2fa0: 20 28 63 75 72 72 2d 73 65 63 74 69 6f 6e 20 23 (curr-section #
2fb0: 66 29 20 20 20 0a 09 09 20 20 20 20 20 28 73 65 f) ... (se
2fc0: 63 74 69 6f 6e 73 20 23 66 29 20 20 20 20 20 20 ctions #f)
2fd0: 20 20 20 20 20 20 20 20 28 73 65 74 74 69 6e 67 (setting
2fe0: 73 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 s (make-hash-tab
2ff0: 6c 65 29 29 20 28 6b 65 65 70 2d 66 69 6c 65 6e le)) (keep-filen
3000: 61 6d 65 73 20 23 66 29 0a 09 09 20 20 20 20 20 ames #f)...
3010: 28 70 6f 73 74 2d 73 65 63 74 69 6f 6e 2d 70 72 (post-section-pr
3020: 6f 63 73 20 27 28 29 29 20 20 20 28 61 70 70 6c ocs '()) (appl
3030: 79 2d 77 69 6c 64 63 61 72 64 73 20 23 74 29 20 y-wildcards #t)
3040: 29 0a 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 ). (debug:print
3050: 20 39 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 9 *default-log-
3060: 70 6f 72 74 2a 20 22 53 54 41 52 54 3a 20 22 20 port* "START: "
3070: 70 61 74 68 29 0a 3b 3b 20 28 69 66 20 2a 63 6f path).;; (if *co
3080: 6e 66 69 67 64 61 74 2a 0a 3b 3b 20 20 20 20 20 nfigdat*.;;
3090: 28 63 6f 6d 6d 6f 6e 3a 73 61 76 65 2d 70 6b 74 (common:save-pkt
30a0: 20 60 28 28 61 63 74 69 6f 6e 20 2e 20 72 65 61 `((action . rea
30b0: 64 2d 63 6f 6e 66 69 67 29 0a 3b 3b 20 20 20 20 d-config).;;
30c0: 20 20 20 09 09 20 28 66 20 20 20 20 20 20 2e 20 .. (f .
30d0: 2c 28 63 6f 6e 64 20 28 28 73 74 72 69 6e 67 3f ,(cond ((string?
30e0: 20 70 61 74 68 29 20 70 61 74 68 29 0a 3b 3b 20 path) path).;;
30f0: 20 20 20 20 20 20 09 09 09 09 20 20 28 28 70 6f .... ((po
3100: 72 74 3f 20 20 20 70 61 74 68 29 20 22 70 6f 72 rt? path) "por
3110: 74 22 29 0a 3b 3b 20 20 20 20 20 20 20 09 09 09 t").;; ...
3120: 09 20 20 28 65 6c 73 65 20 28 63 6f 6e 63 20 70 . (else (conc p
3130: 61 74 68 29 29 29 29 0a 3b 3b 20 20 20 20 20 20 ath)))).;;
3140: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3150: 20 20 28 54 20 20 20 20 20 20 2e 20 63 6f 6e 66 (T . conf
3160: 69 67 66 29 29 0a 3b 3b 20 20 20 20 20 20 20 09 igf)).;; .
3170: 20 20 20 20 20 20 20 2a 63 6f 6e 66 69 67 64 61 *configda
3180: 74 2a 20 23 74 20 61 64 64 2d 6f 6e 6c 79 3a 20 t* #t add-only:
3190: 23 74 29 29 0a 20 20 28 69 66 20 28 61 6e 64 20 #t)). (if (and
31a0: 28 6e 6f 74 20 28 70 6f 72 74 3f 20 70 61 74 68 (not (port? path
31b0: 29 29 0a 09 20 20 20 28 6e 6f 74 20 28 63 6f 6d )).. (not (com
31c0: 6d 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 74 73 3f mon:file-exists?
31d0: 20 70 61 74 68 29 29 29 20 3b 3b 20 66 6f 72 20 path))) ;; for
31e0: 63 61 73 65 20 77 68 65 72 65 20 77 65 20 61 72 case where we ar
31f0: 65 20 68 61 6e 64 65 64 20 61 20 70 6f 72 74 0a e handed a port.
3200: 20 20 20 20 20 20 28 62 65 67 69 6e 20 0a 09 28 (begin ..(
3210: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
3220: 20 31 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 1 *default-log-
3230: 70 6f 72 74 2a 20 22 72 65 61 64 2d 63 6f 6e 66 port* "read-conf
3240: 69 67 20 2d 20 66 69 6c 65 20 6e 6f 74 20 66 6f ig - file not fo
3250: 75 6e 64 20 22 20 70 61 74 68 20 22 20 63 75 72 und " path " cur
3260: 72 65 6e 74 20 70 61 74 68 3a 20 22 20 28 63 75 rent path: " (cu
3270: 72 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 rrent-directory)
3280: 29 0a 09 3b 3b 20 57 41 52 4e 49 4e 47 3a 20 54 )..;; WARNING: T
3290: 68 69 73 20 69 73 20 61 20 72 69 73 6b 79 20 63 his is a risky c
32a0: 68 61 6e 67 65 20 62 75 74 20 72 65 61 6c 6c 79 hange but really
32b0: 2c 20 77 65 20 73 68 6f 75 6c 64 20 6e 6f 74 20 , we should not
32c0: 72 65 74 75 72 6e 20 61 6e 20 65 6d 70 74 79 20 return an empty
32d0: 68 61 73 68 20 74 61 62 6c 65 20 69 66 20 6e 6f hash table if no
32e0: 20 66 69 6c 65 20 72 65 61 64 3f 0a 09 23 66 29 file read?..#f)
32f0: 20 3b 3b 20 28 69 66 20 28 6e 6f 74 20 68 74 29 ;; (if (not ht)
3300: 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 (make-hash-table
3310: 29 20 68 74 29 29 0a 20 20 20 20 20 20 28 6c 65 ) ht)). (le
3320: 74 20 28 28 69 6e 70 20 20 20 20 20 20 20 20 28 t ((inp (
3330: 69 66 20 28 73 74 72 69 6e 67 3f 20 70 61 74 68 if (string? path
3340: 29 0a 09 09 09 20 20 20 20 28 6f 70 65 6e 2d 69 ).... (open-i
3350: 6e 70 75 74 2d 66 69 6c 65 20 70 61 74 68 29 0a nput-file path).
3360: 09 09 09 20 20 20 20 20 20 70 61 74 68 29 29 20 ... path))
3370: 3b 3b 20 77 65 20 63 61 6e 20 62 65 20 68 61 6e ;; we can be han
3380: 64 65 64 20 61 20 70 6f 72 74 0a 09 20 20 20 20 ded a port..
3390: 28 72 65 73 20 20 20 20 20 20 20 20 28 69 66 20 (res (if
33a0: 28 6e 6f 74 20 68 74 29 28 6d 61 6b 65 2d 68 61 (not ht)(make-ha
33b0: 73 68 2d 74 61 62 6c 65 29 20 68 74 29 29 0a 09 sh-table) ht))..
33c0: 20 20 20 20 28 6d 65 74 61 70 61 74 68 20 20 20 (metapath
33d0: 28 69 66 20 28 6f 72 20 28 64 65 62 75 67 3a 64 (if (or (debug:d
33e0: 65 62 75 67 2d 6d 6f 64 65 20 39 29 0a 09 09 09 ebug-mode 9)....
33f0: 09 6b 65 65 70 2d 66 69 6c 65 6e 61 6d 65 73 29 .keep-filenames)
3400: 0a 09 09 09 20 20 20 20 70 61 74 68 20 23 66 29 .... path #f)
3410: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 70 ). (p
3420: 72 6f 63 65 73 73 2d 77 69 6c 64 63 61 72 64 73 rocess-wildcards
3430: 20 20 28 6c 61 6d 62 64 61 20 28 72 65 73 20 63 (lambda (res c
3440: 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 urr-section-name
3450: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
3460: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3470: 20 20 20 20 28 69 66 20 28 61 6e 64 20 61 70 70 (if (and app
3480: 6c 79 2d 77 69 6c 64 63 61 72 64 73 0a 20 20 20 ly-wildcards.
3490: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
34a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
34b0: 20 20 20 20 20 20 20 20 28 6f 72 20 28 73 74 72 (or (str
34c0: 69 6e 67 2d 63 6f 6e 74 61 69 6e 73 20 63 75 72 ing-contains cur
34d0: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 22 r-section-name "
34e0: 25 22 29 20 20 20 3b 3b 20 77 69 6c 64 63 61 72 %") ;; wildcar
34f0: 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 d.
3500: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3510: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3520: 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 22 (string-match "
3530: 2f 2e 2a 2f 22 20 63 75 72 72 2d 73 65 63 74 69 /.*/" curr-secti
3540: 6f 6e 2d 6e 61 6d 65 29 29 29 20 3b 3b 20 72 65 on-name))) ;; re
3550: 67 65 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 gex.
3560: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3570: 20 20 20 20 20 20 20 20 20 20 28 62 65 67 69 6e (begin
3580: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3590: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
35a0: 20 20 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 (config
35b0: 66 3a 61 70 70 6c 79 2d 77 69 6c 64 63 61 72 64 f:apply-wildcard
35c0: 73 20 72 65 73 20 63 75 72 72 2d 73 65 63 74 69 s res curr-secti
35d0: 6f 6e 2d 6e 61 6d 65 29 0a 20 20 20 20 20 20 20 on-name).
35e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
35f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3600: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 64 65 6c (hash-table-del
3610: 65 74 65 21 20 72 65 73 20 63 75 72 72 2d 73 65 ete! res curr-se
3620: 63 74 69 6f 6e 2d 6e 61 6d 65 29 29 29 29 29 29 ction-name))))))
3630: 20 20 3b 3b 20 4e 4f 54 45 3a 20 69 66 20 74 68 ;; NOTE: if th
3640: 65 20 73 65 63 74 69 6f 6e 20 69 73 20 61 20 77 e section is a w
3650: 69 6c 64 20 63 61 72 64 20 69 74 20 77 69 6c 6c ild card it will
3660: 20 62 65 20 52 45 4d 4f 56 45 44 20 66 72 6f 6d be REMOVED from
3670: 20 72 65 73 20 0a 09 28 6c 65 74 20 6c 6f 6f 70 res ..(let loop
3680: 20 28 28 69 6e 6c 20 20 20 20 20 20 20 20 20 20 ((inl
3690: 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 72 65 (configf:re
36a0: 61 64 2d 6c 69 6e 65 20 69 6e 70 20 72 65 73 20 ad-line inp res
36b0: 28 63 61 6c 63 2d 61 6c 6c 6f 77 2d 73 79 73 74 (calc-allow-syst
36c0: 65 6d 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 em allow-system
36d0: 63 75 72 72 2d 73 65 63 74 69 6f 6e 20 73 65 63 curr-section sec
36e0: 74 69 6f 6e 73 29 20 73 65 74 74 69 6e 67 73 29 tions) settings)
36f0: 29 20 3b 3b 20 28 72 65 61 64 2d 6c 69 6e 65 20 ) ;; (read-line
3700: 69 6e 70 29 29 0a 09 09 20 20 20 28 63 75 72 72 inp))... (curr
3710: 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 28 69 -section-name (i
3720: 66 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 20 63 f curr-section c
3730: 75 72 72 2d 73 65 63 74 69 6f 6e 20 22 64 65 66 urr-section "def
3740: 61 75 6c 74 22 29 29 0a 09 09 20 20 20 28 76 61 ault"))... (va
3750: 72 2d 66 6c 61 67 20 23 66 29 3b 3b 20 74 75 72 r-flag #f);; tur
3760: 6e 20 6f 6e 20 66 6f 72 20 6b 65 79 2d 76 61 72 n on for key-var
3770: 2d 70 72 20 61 6e 64 20 63 6f 6e 74 2d 6c 6e 2d -pr and cont-ln-
3780: 72 78 2c 20 74 75 72 6e 20 6f 66 66 20 65 6c 73 rx, turn off els
3790: 65 77 68 65 72 65 0a 09 09 20 20 20 28 6c 65 61 ewhere... (lea
37a0: 64 20 20 20 20 20 23 66 29 29 0a 09 20 20 28 64 d #f)).. (d
37b0: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
37c0: 38 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 8 *default-log-p
37d0: 6f 72 74 2a 20 22 63 75 72 72 2d 73 65 63 74 69 ort* "curr-secti
37e0: 6f 6e 2d 6e 61 6d 65 3a 20 22 20 63 75 72 72 2d on-name: " curr-
37f0: 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 22 20 76 section-name " v
3800: 61 72 2d 66 6c 61 67 3a 20 22 20 76 61 72 2d 66 ar-flag: " var-f
3810: 6c 61 67 20 22 5c 6e 20 20 20 69 6e 6c 3a 20 5c lag "\n inl: \
3820: 22 22 20 69 6e 6c 20 22 5c 22 22 29 0a 09 20 20 "" inl "\"")..
3830: 28 69 66 20 28 65 6f 66 2d 6f 62 6a 65 63 74 3f (if (eof-object?
3840: 20 69 6e 6c 29 20 0a 09 20 20 20 20 20 20 28 62 inl) .. (b
3850: 65 67 69 6e 0a 20 20 20 20 20 20 20 20 20 20 20 egin.
3860: 20 20 20 20 20 3b 3b 20 70 72 6f 63 65 73 73 20 ;; process
3870: 6c 61 73 74 20 73 65 63 74 69 6f 6e 20 66 6f 72 last section for
3880: 20 77 69 6c 64 63 61 72 64 73 0a 20 20 20 20 20 wildcards.
3890: 20 20 20 20 20 20 20 20 20 20 20 28 70 72 6f 63 (proc
38a0: 65 73 73 2d 77 69 6c 64 63 61 72 64 73 20 72 65 ess-wildcards re
38b0: 73 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e s curr-section-n
38c0: 61 6d 65 29 0a 09 09 28 69 66 20 28 73 74 72 69 ame)...(if (stri
38d0: 6e 67 3f 20 70 61 74 68 29 20 3b 3b 20 77 65 20 ng? path) ;; we
38e0: 72 65 63 65 69 76 65 64 20 61 20 70 61 74 68 2c received a path,
38f0: 20 6e 6f 74 20 61 20 70 6f 72 74 2c 20 74 68 75 not a port, thu
3900: 73 20 77 65 20 61 72 65 20 72 65 73 70 6f 6e 73 s we are respons
3910: 69 62 6c 65 20 66 6f 72 20 63 6c 6f 73 69 6e 67 ible for closing
3920: 20 69 74 2e 0a 09 09 20 20 20 20 28 63 6c 6f 73 it.... (clos
3930: 65 2d 69 6e 70 75 74 2d 70 6f 72 74 20 69 6e 70 e-input-port inp
3940: 29 29 0a 09 09 28 69 66 20 28 6c 69 73 74 3f 20 ))...(if (list?
3950: 73 65 63 74 69 6f 6e 73 29 20 3b 3b 20 64 65 6c sections) ;; del
3960: 65 74 65 20 61 6c 6c 20 73 65 63 74 69 6f 6e 73 ete all sections
3970: 20 65 78 63 65 70 74 20 67 69 76 65 6e 20 77 68 except given wh
3980: 65 6e 20 73 65 63 74 69 6f 6e 73 20 69 73 20 70 en sections is p
3990: 72 6f 76 69 64 65 64 0a 09 09 20 20 20 20 28 66 rovided... (f
39a0: 6f 72 2d 65 61 63 68 0a 09 09 20 20 20 20 20 28 or-each... (
39b0: 6c 61 6d 62 64 61 20 28 73 65 63 74 69 6f 6e 29 lambda (section)
39c0: 0a 09 09 20 20 20 20 20 20 20 28 69 66 20 28 6e ... (if (n
39d0: 6f 74 20 28 6d 65 6d 62 65 72 20 73 65 63 74 69 ot (member secti
39e0: 6f 6e 20 73 65 63 74 69 6f 6e 73 29 29 0a 09 09 on sections))...
39f0: 09 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d . (hash-table-
3a00: 64 65 6c 65 74 65 21 20 72 65 73 20 73 65 63 74 delete! res sect
3a10: 69 6f 6e 29 29 29 20 3b 3b 20 77 65 20 61 72 65 ion))) ;; we are
3a20: 20 75 73 69 6e 67 20 22 22 20 61 73 20 61 20 64 using "" as a d
3a30: 75 6d 70 69 6e 67 20 67 72 6f 75 6e 64 20 61 6e umping ground an
3a40: 64 20 6d 75 73 74 20 72 65 6d 6f 76 65 20 69 74 d must remove it
3a50: 20 62 65 66 6f 72 65 20 72 65 74 75 72 6e 69 6e before returnin
3a60: 67 20 74 68 65 20 68 74 0a 09 09 20 20 20 20 20 g the ht...
3a70: 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 (hash-table-keys
3a80: 20 72 65 73 29 29 29 0a 09 09 28 64 65 62 75 67 res)))...(debug
3a90: 3a 70 72 69 6e 74 20 39 20 2a 64 65 66 61 75 6c :print 9 *defaul
3aa0: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 45 4e 44 t-log-port* "END
3ab0: 3a 20 22 20 70 61 74 68 29 0a 20 20 20 20 20 20 : " path).
3ac0: 20 20 20 20 20 20 20 20 20 20 72 65 73 0a 20 20 res.
3ad0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 29 20 )
3ae0: 3b 3b 20 72 65 74 76 61 6c 0a 09 20 20 20 20 20 ;; retval..
3af0: 20 28 72 65 67 65 78 2d 63 61 73 65 20 0a 09 20 (regex-case ..
3b00: 20 20 20 20 20 20 69 6e 6c 20 0a 09 20 20 20 20 inl ..
3b10: 20 20 20 28 63 6f 6e 66 69 67 66 3a 63 6f 6d 6d (configf:comm
3b20: 65 6e 74 2d 72 78 20 5f 20 20 20 20 20 20 20 20 ent-rx _
3b30: 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 20 (loop
3b40: 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d 6c 69 (configf:read-li
3b50: 6e 65 20 69 6e 70 20 72 65 73 20 28 63 61 6c 63 ne inp res (calc
3b60: 2d 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 61 6c -allow-system al
3b70: 6c 6f 77 2d 73 79 73 74 65 6d 20 63 75 72 72 2d low-system curr-
3b80: 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 73 65 63 section-name sec
3b90: 74 69 6f 6e 73 29 20 73 65 74 74 69 6e 67 73 29 tions) settings)
3ba0: 0a 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 20 20 20 20
3bc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3bd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 63 75 72 cur
3be0: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 r-section-name #
3bf0: 66 20 23 66 29 29 0a 20 20 20 20 20 20 20 20 20 f #f)).
3c00: 20 20 20 20 20 20 0a 09 20 20 20 20 20 20 20 28 .. (
3c10: 63 6f 6e 66 69 67 66 3a 62 6c 61 6e 6b 2d 6c 2d configf:blank-l-
3c20: 72 78 20 5f 20 20 20 20 20 20 20 20 20 20 20 20 rx _
3c30: 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 6f 6e (loop (con
3c40: 66 69 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 figf:read-line i
3c50: 6e 70 20 72 65 73 20 28 63 61 6c 63 2d 61 6c 6c np res (calc-all
3c60: 6f 77 2d 73 79 73 74 65 6d 20 61 6c 6c 6f 77 2d ow-system allow-
3c70: 73 79 73 74 65 6d 20 63 75 72 72 2d 73 65 63 74 system curr-sect
3c80: 69 6f 6e 2d 6e 61 6d 65 20 73 65 63 74 69 6f 6e ion-name section
3c90: 73 29 20 73 65 74 74 69 6e 67 73 29 0a 20 20 20 s) settings).
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 20 20 20 20 20 20 20 20 20 20 20 20 20
3cd0: 20 20 20 20 20 20 20 20 20 63 75 72 72 2d 73 65 curr-se
3ce0: 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 66 ction-name #f #f
3cf0: 29 29 0a 09 20 20 20 20 20 20 20 28 63 6f 6e 66 )).. (conf
3d00: 69 67 66 3a 73 65 74 74 69 6e 67 73 20 20 20 28 igf:settings (
3d10: 20 78 20 73 65 74 74 69 6e 67 20 76 61 6c 20 20 x setting val
3d20: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
3d30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3d40: 20 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 (begin.
3d50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3d60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3d70: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 (hash-table-set
3d80: 21 20 73 65 74 74 69 6e 67 73 20 73 65 74 74 69 ! settings setti
3d90: 6e 67 20 76 61 6c 29 0a 20 20 20 20 20 20 20 20 ng val).
3da0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3db0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 6f (lo
3dc0: 6f 70 20 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 op (configf:read
3dd0: 2d 6c 69 6e 65 20 69 6e 70 20 72 65 73 20 28 63 -line inp res (c
3de0: 61 6c 63 2d 61 6c 6c 6f 77 2d 73 79 73 74 65 6d alc-allow-system
3df0: 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 63 75 allow-system cu
3e00: 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 rr-section-name
3e10: 73 65 63 74 69 6f 6e 73 29 20 73 65 74 74 69 6e sections) settin
3e20: 67 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 gs).
3e30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3e40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 63 c
3e50: 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 urr-section-name
3e60: 20 23 66 20 23 66 29 29 29 0a 20 20 20 20 20 20 #f #f))).
3e70: 20 20 20 20 20 20 20 20 20 0a 09 20 20 20 20 20 ..
3e80: 20 20 28 63 6f 6e 66 69 67 66 3a 69 6e 63 6c 75 (configf:inclu
3e90: 64 65 2d 72 78 20 28 20 78 20 69 6e 63 6c 75 64 de-rx ( x includ
3ea0: 65 2d 66 69 6c 65 20 29 0a 20 20 20 20 20 20 20 e-file ).
3eb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3ec0: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 (let
3ed0: 2a 20 28 28 63 75 72 72 2d 63 6f 6e 66 2d 64 69 * ((curr-conf-di
3ee0: 72 20 28 70 61 74 68 6e 61 6d 65 2d 64 69 72 65 r (pathname-dire
3ef0: 63 74 6f 72 79 20 70 61 74 68 29 29 0a 20 20 20 ctory path)).
3f00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3f10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3f20: 20 20 20 20 20 20 20 28 66 75 6c 6c 2d 63 6f 6e (full-con
3f30: 66 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 28 f (if (and (
3f40: 61 62 73 6f 6c 75 74 65 2d 70 61 74 68 6e 61 6d absolute-pathnam
3f50: 65 3f 20 69 6e 63 6c 75 64 65 2d 66 69 6c 65 29 e? include-file)
3f60: 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 69 (file-exists? i
3f70: 6e 63 6c 75 64 65 2d 66 69 6c 65 29 29 0a 20 20 nclude-file)).
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: 20 20 20 20 20 20 20 20 20 20 20 69 6e 63 6c 75 inclu
3fc0: 64 65 2d 66 69 6c 65 0a 20 20 20 20 20 20 20 20 de-file.
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 20 20 20 20 20 20
4000: 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 6e 69 63 (common:nic
4010: 65 2d 70 61 74 68 20 0a 20 20 20 20 20 20 20 20 e-path .
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 20 20 20 20 20
4050: 20 20 20 20 20 20 28 63 6f 6e 63 20 28 69 66 20 (conc (if
4060: 63 75 72 72 2d 63 6f 6e 66 2d 64 69 72 0a 20 20 curr-conf-dir.
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 20 20 20 20 20
40b0: 20 20 20 20 20 20 63 75 72 72 2d 63 6f 6e 66 2d curr-conf-
40c0: 64 69 72 0a 20 20 20 20 20 20 20 20 20 20 20 20 dir.
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 20 20 20 20 20 20 20 20 20 20 20 22 2e 22 29 ".")
4110: 0a 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 20 20 20 20 20 20
4150: 20 20 20 20 20 22 2f 22 20 69 6e 63 6c 75 64 65 "/" include
4160: 2d 66 69 6c 65 29 29 29 29 29 0a 09 09 09 09 20 -file))))).....
4170: 20 20 20 20 28 6c 65 74 20 28 28 61 6c 6c 2d 6d (let ((all-m
4180: 61 74 63 68 65 73 20 28 73 6f 72 74 20 28 68 61 atches (sort (ha
4190: 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 20 ndle-exceptions
41a0: 65 78 6e 0a 09 09 09 09 09 09 09 09 28 62 65 67 exn.........(beg
41b0: 69 6e 0a 09 09 09 09 09 09 09 09 20 28 64 65 62 in......... (deb
41c0: 75 67 3a 70 72 69 6e 74 20 27 28 32 20 39 29 20 ug:print '(2 9)
41d0: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
41e0: 74 2a 20 22 67 6c 6f 62 20 6f 66 20 22 20 66 75 t* "glob of " fu
41f0: 6c 6c 2d 63 6f 6e 66 20 22 20 67 61 76 65 20 6e ll-conf " gave n
4200: 6f 20 6d 61 74 63 68 2e 20 2c 20 65 78 6e 3d 22 o match. , exn="
4210: 20 65 78 6e 29 0a 09 09 09 09 09 09 09 09 20 28 exn)......... (
4220: 6c 69 73 74 29 29 0a 09 09 09 09 09 09 09 09 28 list)).........(
4230: 67 6c 6f 62 20 66 75 6c 6c 2d 63 6f 6e 66 29 29 glob full-conf))
4240: 20 73 74 72 69 6e 67 3c 3d 3f 29 29 29 0a 09 09 string<=?)))...
4250: 09 09 20 20 20 20 20 20 20 28 69 66 20 28 6e 75 .. (if (nu
4260: 6c 6c 3f 20 61 6c 6c 2d 6d 61 74 63 68 65 73 29 ll? all-matches)
4270: 0a 09 09 09 09 09 20 20 20 28 62 65 67 69 6e 0a ...... (begin.
4280: 09 09 09 09 09 20 20 20 20 20 28 64 65 62 75 67 ..... (debug
4290: 3a 70 72 69 6e 74 20 27 28 32 20 39 29 20 23 66 :print '(2 9) #f
42a0: 20 22 49 4e 46 4f 3a 20 69 6e 63 6c 75 64 65 20 "INFO: include
42b0: 66 69 6c 65 28 73 29 20 6d 61 74 63 68 69 6e 67 file(s) matching
42c0: 20 22 20 69 6e 63 6c 75 64 65 2d 66 69 6c 65 20 " include-file
42d0: 22 20 6e 6f 74 20 66 6f 75 6e 64 20 28 63 61 6c " not found (cal
42e0: 6c 65 64 20 66 72 6f 6d 20 22 20 70 61 74 68 20 led from " path
42f0: 22 29 22 29 0a 09 09 09 09 09 20 20 20 20 20 28 ")")...... (
4300: 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 2a 64 debug:print 2 *d
4310: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
4320: 20 22 20 20 20 20 20 20 20 20 22 20 66 75 6c 6c " " full
4330: 2d 63 6f 6e 66 29 29 0a 09 09 09 09 09 20 20 20 -conf))......
4340: 28 66 6f 72 2d 65 61 63 68 0a 09 09 09 09 09 20 (for-each......
4350: 20 20 20 28 6c 61 6d 62 64 61 20 28 66 70 61 74 (lambda (fpat
4360: 68 29 0a 09 09 09 09 09 20 20 20 20 20 20 3b 3b h)...... ;;
4370: 20 28 70 75 73 68 2d 64 69 72 65 63 74 6f 72 79 (push-directory
4380: 20 63 6f 6e 66 2d 64 69 72 29 0a 09 09 09 09 09 conf-dir)......
4390: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
43a0: 6e 74 20 39 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 9 *default-lo
43b0: 67 2d 70 6f 72 74 2a 20 22 49 6e 63 6c 75 64 69 g-port* "Includi
43c0: 6e 67 3a 20 22 20 66 75 6c 6c 2d 63 6f 6e 66 29 ng: " full-conf)
43d0: 0a 09 09 09 09 09 20 20 20 20 20 20 28 72 65 61 ...... (rea
43e0: 64 2d 63 6f 6e 66 69 67 20 66 70 61 74 68 20 72 d-config fpath r
43f0: 65 73 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 es allow-system
4400: 65 6e 76 69 72 6f 6e 2d 70 61 74 74 3a 20 65 6e environ-patt: en
4410: 76 69 72 6f 6e 2d 70 61 74 74 0a 09 09 09 09 09 viron-patt......
4420: 09 09 20 20 20 63 75 72 72 2d 73 65 63 74 69 6f .. curr-sectio
4430: 6e 3a 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d n: curr-section-
4440: 6e 61 6d 65 20 73 65 63 74 69 6f 6e 73 3a 20 73 name sections: s
4450: 65 63 74 69 6f 6e 73 20 73 65 74 74 69 6e 67 73 ections settings
4460: 3a 20 73 65 74 74 69 6e 67 73 0a 09 09 09 09 09 : settings......
4470: 09 09 20 20 20 6b 65 65 70 2d 66 69 6c 65 6e 61 .. keep-filena
4480: 6d 65 73 3a 20 6b 65 65 70 2d 66 69 6c 65 6e 61 mes: keep-filena
4490: 6d 65 73 29 29 0a 09 09 09 09 09 20 20 20 20 61 mes))...... a
44a0: 6c 6c 2d 6d 61 74 63 68 65 73 29 29 0a 09 09 09 ll-matches))....
44b0: 09 20 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 . (loop (c
44c0: 6f 6e 66 69 67 66 3a 72 65 61 64 2d 6c 69 6e 65 onfigf:read-line
44d0: 20 69 6e 70 20 72 65 73 20 28 63 61 6c 63 2d 61 inp res (calc-a
44e0: 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 61 6c 6c 6f llow-system allo
44f0: 77 2d 73 79 73 74 65 6d 20 63 75 72 72 2d 73 65 w-system curr-se
4500: 63 74 69 6f 6e 2d 6e 61 6d 65 20 73 65 63 74 69 ction-name secti
4510: 6f 6e 73 29 20 73 65 74 74 69 6e 67 73 29 0a 09 ons) settings)..
4520: 09 09 09 09 20 20 20 20 20 63 75 72 72 2d 73 65 .... curr-se
4530: 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 66 ction-name #f #f
4540: 29 29 29 29 0a 09 20 20 20 20 20 20 20 28 63 6f )))).. (co
4550: 6e 66 69 67 66 3a 73 63 72 69 70 74 2d 72 78 20 nfigf:script-rx
4560: 28 20 78 20 69 6e 63 6c 75 64 65 2d 73 63 72 69 ( x include-scri
4570: 70 74 20 70 61 72 61 6d 73 29 3b 3b 20 68 61 6e pt params);; han
4580: 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 20 dle-exceptions.
4590: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
45a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
45b0: 20 3b 3b 20 20 20 20 65 78 6e 0a 20 20 20 20 20 ;; exn.
45c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
45d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 ;;
45e0: 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 (begin.
45f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4600: 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 20 ;;
4610: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
4620: 20 27 28 30 20 32 20 39 29 20 23 66 20 22 49 4e '(0 2 9) #f "IN
4630: 46 4f 3a 20 69 6e 63 6c 75 64 65 20 66 72 6f 6d FO: include from
4640: 20 73 63 72 69 70 74 20 22 20 69 6e 63 6c 75 64 script " includ
4650: 65 2d 73 63 72 69 70 74 20 22 20 66 61 69 6c 65 e-script " faile
4660: 64 2e 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 d.").
4670: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4680: 20 20 20 20 20 20 20 3b 3b 20 20 20 20 20 20 28 ;; (
4690: 6c 6f 6f 70 20 28 63 6f 6e 66 69 67 66 3a 72 65 loop (configf:re
46a0: 61 64 2d 6c 69 6e 65 20 69 6e 70 20 72 65 73 20 ad-line inp res
46b0: 28 63 61 6c 63 2d 61 6c 6c 6f 77 2d 73 79 73 74 (calc-allow-syst
46c0: 65 6d 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 em allow-system
46d0: 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d curr-section-nam
46e0: 65 20 73 65 63 74 69 6f 6e 73 29 20 73 65 74 74 e sections) sett
46f0: 69 6e 67 73 29 20 63 75 72 72 2d 73 65 63 74 69 ings) curr-secti
4700: 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 66 29 29 0a on-name #f #f)).
4710: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4720: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4730: 20 20 28 69 66 20 28 61 6e 64 20 28 63 6f 6d 6d (if (and (comm
4740: 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 on:file-exists?
4750: 69 6e 63 6c 75 64 65 2d 73 63 72 69 70 74 29 28 include-script)(
4760: 66 69 6c 65 2d 65 78 65 63 75 74 65 2d 61 63 63 file-execute-acc
4770: 65 73 73 3f 20 69 6e 63 6c 75 64 65 2d 73 63 72 ess? include-scr
4780: 69 70 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 ipt)).
4790: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
47a0: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 (let
47b0: 2a 20 28 28 6c 6f 63 61 6c 2d 61 6c 6c 6f 77 2d * ((local-allow-
47c0: 73 79 73 74 65 6d 20 20 28 63 61 6c 63 2d 61 6c system (calc-al
47d0: 6c 6f 77 2d 73 79 73 74 65 6d 20 61 6c 6c 6f 77 low-system allow
47e0: 2d 73 79 73 74 65 6d 20 63 75 72 72 2d 73 65 63 -system curr-sec
47f0: 74 69 6f 6e 2d 6e 61 6d 65 20 73 65 63 74 69 6f tion-name sectio
4800: 6e 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ns)).
4810: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4820: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4830: 20 20 28 65 6e 76 2d 64 65 6c 74 61 20 20 28 63 (env-delta (c
4840: 6f 6e 66 69 67 66 3a 63 66 67 64 61 74 2d 3e 65 onfigf:cfgdat->e
4850: 6e 76 2d 61 6c 69 73 74 20 63 75 72 72 2d 73 65 nv-alist curr-se
4860: 63 74 69 6f 6e 2d 6e 61 6d 65 20 72 65 73 20 6c ction-name res l
4870: 6f 63 61 6c 2d 61 6c 6c 6f 77 2d 73 79 73 74 65 ocal-allow-syste
4880: 6d 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 m)).
4890: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
48a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
48b0: 20 28 6e 65 77 2d 69 6e 70 2d 70 6f 72 74 0a 20 (new-inp-port.
48c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
48d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
48e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f (co
48f0: 6d 6d 6f 6e 3a 77 69 74 68 2d 65 6e 76 2d 76 61 mmon:with-env-va
4900: 72 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 rs.
4910: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4920: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4930: 20 20 65 6e 76 2d 64 65 6c 74 61 0a 20 20 20 20 env-delta.
4940: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
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 28 6c 61 6d 62 (lamb
4970: 64 61 20 28 29 0a 20 20 20 20 20 20 20 20 20 20 da ().
4980: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
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 28 6f 70 65 6e 2d 69 6e 70 (open-inp
49b0: 75 74 2d 70 69 70 65 20 28 63 6f 6e 63 20 69 6e ut-pipe (conc in
49c0: 63 6c 75 64 65 2d 73 63 72 69 70 74 20 22 20 22 clude-script " "
49d0: 20 70 61 72 61 6d 73 29 29 29 29 29 29 0a 20 20 params)))))).
49e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
49f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4a00: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
4a10: 6e 74 20 27 28 32 20 39 29 20 2a 64 65 66 61 75 nt '(2 9) *defau
4a20: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 49 6e lt-log-port* "In
4a30: 63 6c 75 64 69 6e 67 20 66 72 6f 6d 20 73 63 72 cluding from scr
4a40: 69 70 74 20 6f 75 74 70 75 74 3a 20 22 20 69 6e ipt output: " in
4a50: 63 6c 75 64 65 2d 73 63 72 69 70 74 29 0a 20 20 clude-script).
4a60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4a70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4a80: 20 20 20 20 20 20 3b 3b 20 20 28 70 72 69 6e 74 ;; (print
4a90: 20 22 57 65 20 67 6f 74 20 68 65 72 65 2c 20 63 "We got here, c
4aa0: 61 6c 6c 69 6e 67 20 72 65 61 64 2d 63 6f 6e 66 alling read-conf
4ab0: 69 67 20 6e 65 78 74 2e 20 50 6f 72 74 20 69 73 ig next. Port is
4ac0: 3a 20 22 20 6e 65 77 2d 69 6e 70 2d 70 6f 72 74 : " new-inp-port
4ad0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
4ae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4af0: 20 20 20 20 20 20 20 20 20 20 28 72 65 61 64 2d (read-
4b00: 63 6f 6e 66 69 67 20 6e 65 77 2d 69 6e 70 2d 70 config new-inp-p
4b10: 6f 72 74 20 72 65 73 20 61 6c 6c 6f 77 2d 73 79 ort res allow-sy
4b20: 73 74 65 6d 20 65 6e 76 69 72 6f 6e 2d 70 61 74 stem environ-pat
4b30: 74 3a 20 65 6e 76 69 72 6f 6e 2d 70 61 74 74 20 t: environ-patt
4b40: 63 75 72 72 2d 73 65 63 74 69 6f 6e 3a 20 63 75 curr-section: cu
4b50: 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 rr-section-name
4b60: 73 65 63 74 69 6f 6e 73 3a 20 73 65 63 74 69 6f sections: sectio
4b70: 6e 73 20 73 65 74 74 69 6e 67 73 3a 20 73 65 74 ns settings: set
4b80: 74 69 6e 67 73 20 6b 65 65 70 2d 66 69 6c 65 6e tings keep-filen
4b90: 61 6d 65 73 3a 20 6b 65 65 70 2d 66 69 6c 65 6e ames: keep-filen
4ba0: 61 6d 65 73 29 0a 20 20 20 20 20 20 20 20 20 20 ames).
4bb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4bc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
4bd0: 6c 6f 73 65 2d 69 6e 70 75 74 2d 70 6f 72 74 20 lose-input-port
4be0: 6e 65 77 2d 69 6e 70 2d 70 6f 72 74 29 0a 20 20 new-inp-port).
4bf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4c00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4c10: 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 6f 6e (loop (con
4c20: 66 69 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 figf:read-line i
4c30: 6e 70 20 72 65 73 20 28 63 61 6c 63 2d 61 6c 6c np res (calc-all
4c40: 6f 77 2d 73 79 73 74 65 6d 20 61 6c 6c 6f 77 2d ow-system allow-
4c50: 73 79 73 74 65 6d 20 63 75 72 72 2d 73 65 63 74 system curr-sect
4c60: 69 6f 6e 2d 6e 61 6d 65 20 73 65 63 74 69 6f 6e ion-name section
4c70: 73 29 20 73 65 74 74 69 6e 67 73 29 20 63 75 72 s) settings) cur
4c80: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 r-section-name #
4c90: 66 20 23 66 29 29 0a 20 20 20 20 20 20 20 20 20 f #f)).
4ca0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4cb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 62 65 (be
4cc0: 67 69 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 gin.
4cd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4ce0: 20 20 20 20 20 20 20 20 20 20 20 20 28 64 65 62 (deb
4cf0: 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 ug:print 0 *defa
4d00: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 53 ult-log-port* "S
4d10: 63 72 69 70 74 20 6e 6f 74 20 66 6f 75 6e 64 20 cript not found
4d20: 6f 72 20 6e 6f 74 20 65 78 65 63 74 75 74 61 62 or not exectutab
4d30: 6c 65 3a 20 22 20 69 6e 63 6c 75 64 65 2d 73 63 le: " include-sc
4d40: 72 69 70 74 29 0a 20 20 20 20 20 20 20 20 20 20 ript).
4d50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4d60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
4d70: 6f 6f 70 20 28 63 6f 6e 66 69 67 66 3a 72 65 61 oop (configf:rea
4d80: 64 2d 6c 69 6e 65 20 69 6e 70 20 72 65 73 20 28 d-line inp res (
4d90: 63 61 6c 63 2d 61 6c 6c 6f 77 2d 73 79 73 74 65 calc-allow-syste
4da0: 6d 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 63 m allow-system c
4db0: 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 urr-section-name
4dc0: 20 73 65 63 74 69 6f 6e 73 29 20 73 65 74 74 69 sections) setti
4dd0: 6e 67 73 29 20 63 75 72 72 2d 73 65 63 74 69 6f ngs) curr-sectio
4de0: 6e 2d 6e 61 6d 65 20 23 66 20 23 66 29 29 29 0a n-name #f #f))).
4df0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4e00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4e10: 20 20 29 20 3b 3b 20 29 0a 09 20 20 20 20 20 20 ) ;; )..
4e20: 20 28 63 6f 6e 66 69 67 66 3a 73 65 63 74 69 6f (configf:sectio
4e30: 6e 2d 72 78 20 28 20 78 20 73 65 63 74 69 6f 6e n-rx ( x section
4e40: 2d 6e 61 6d 65 20 29 0a 20 20 20 20 20 20 20 20 -name ).
4e50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4e60: 20 20 20 20 20 20 20 20 20 20 20 28 62 65 67 69 (begi
4e70: 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 n.
4e80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4e90: 20 20 20 20 20 20 20 3b 3b 20 63 61 6c 6c 20 70 ;; call p
4ea0: 6f 73 74 2d 73 65 63 74 69 6f 6e 2d 70 72 6f 63 ost-section-proc
4eb0: 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 s.
4ec0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4ed0: 20 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 (for-each
4ee0: 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4ef0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4f00: 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 (lambda
4f10: 28 64 61 74 29 0a 20 20 20 20 20 20 20 20 20 20 (dat).
4f20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4f30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
4f40: 65 74 20 28 28 70 61 74 74 20 28 63 61 72 20 64 et ((patt (car d
4f50: 61 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 at)).
4f60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4f70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4f80: 20 20 20 28 70 72 6f 63 20 28 63 64 72 20 64 61 (proc (cdr da
4f90: 74 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 t))).
4fa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4fb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
4fc0: 69 66 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 if (string-match
4fd0: 20 70 61 74 74 20 63 75 72 72 2d 73 65 63 74 69 patt curr-secti
4fe0: 6f 6e 2d 6e 61 6d 65 29 0a 20 20 20 20 20 20 20 on-name).
4ff0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5000: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5010: 20 20 20 20 20 20 20 28 70 72 6f 63 20 63 75 72 (proc cur
5020: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 73 r-section-name s
5030: 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 72 65 73 20 ection-name res
5040: 70 61 74 68 29 29 29 29 0a 20 20 20 20 20 20 20 path)))).
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 20 20 20 20 20 20 20 70 p
5070: 6f 73 74 2d 73 65 63 74 69 6f 6e 2d 70 72 6f 63 ost-section-proc
5080: 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 s).
5090: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
50a0: 20 20 20 20 20 20 20 20 3b 3b 20 61 66 74 65 72 ;; after
50b0: 20 67 61 74 68 65 72 69 6e 67 20 74 68 65 20 76 gathering the v
50c0: 61 72 73 20 66 6f 72 20 61 20 73 65 63 74 69 6f ars for a sectio
50d0: 6e 20 61 6e 64 20 69 66 20 61 70 70 6c 79 2d 77 n and if apply-w
50e0: 69 6c 64 63 61 72 64 73 20 69 73 20 74 72 75 65 ildcards is true
50f0: 20 61 6e 64 20 69 66 20 74 68 65 72 65 20 69 73 and if there is
5100: 20 61 20 77 69 6c 64 63 61 72 64 20 69 6e 20 74 a wildcard in t
5110: 68 65 20 73 65 63 74 69 6f 6e 20 6e 61 6d 65 20 he section name
5120: 70 72 6f 63 65 73 73 20 77 69 6c 64 63 61 72 64 process wildcard
5130: 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 s.
5140: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5150: 20 20 20 20 20 20 20 3b 3b 20 4e 4f 54 45 3a 20 ;; NOTE:
5160: 77 65 20 61 72 65 20 70 72 6f 63 65 73 73 69 6e we are processin
5170: 67 20 74 68 65 20 63 75 72 72 2d 73 65 63 74 69 g the curr-secti
5180: 6f 6e 2d 6e 61 6d 65 2c 20 4e 4f 54 20 73 65 63 on-name, NOT sec
5190: 74 69 6f 6e 2d 6e 61 6d 65 2e 0a 20 20 20 20 20 tion-name..
51a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
51b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
51c0: 28 70 72 6f 63 65 73 73 2d 77 69 6c 64 63 61 72 (process-wildcar
51d0: 64 73 20 72 65 73 20 63 75 72 72 2d 73 65 63 74 ds res curr-sect
51e0: 69 6f 6e 2d 6e 61 6d 65 29 0a 20 20 20 20 20 20 ion-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 28 (
5210: 69 66 20 28 6e 6f 74 20 28 68 61 73 68 2d 74 61 if (not (hash-ta
5220: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default
5230: 72 65 73 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 res section-name
5240: 20 23 66 29 29 28 68 61 73 68 2d 74 61 62 6c 65 #f))(hash-table
5250: 2d 73 65 74 21 20 72 65 73 20 73 65 63 74 69 6f -set! res sectio
5260: 6e 2d 6e 61 6d 65 20 27 28 29 29 29 20 3b 3b 20 n-name '())) ;;
5270: 65 6e 73 75 72 65 20 74 68 61 74 20 6d 65 72 65 ensure that mere
5280: 20 6d 65 6e 74 69 6f 6e 20 6f 66 20 61 20 73 65 mention of a se
5290: 63 74 69 6f 6e 20 69 73 20 6e 6f 74 20 6c 6f 73 ction is not los
52a0: 74 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 t.
52b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
52c0: 20 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 6f (loop (co
52d0: 6e 66 69 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 nfigf:read-line
52e0: 69 6e 70 20 72 65 73 20 28 63 61 6c 63 2d 61 6c inp res (calc-al
52f0: 6c 6f 77 2d 73 79 73 74 65 6d 20 61 6c 6c 6f 77 low-system allow
5300: 2d 73 79 73 74 65 6d 20 63 75 72 72 2d 73 65 63 -system curr-sec
5310: 74 69 6f 6e 2d 6e 61 6d 65 20 73 65 63 74 69 6f tion-name sectio
5320: 6e 73 29 20 73 65 74 74 69 6e 67 73 29 0a 20 20 ns) settings).
5330: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5340: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5350: 20 20 20 20 20 20 20 20 20 3b 3b 20 69 66 20 77 ;; if w
5360: 65 20 68 61 76 65 20 74 68 65 20 73 65 63 74 69 e have the secti
5370: 6f 6e 73 20 6c 69 73 74 20 74 68 65 6e 20 66 6f ons list then fo
5380: 72 63 65 20 61 6c 6c 20 73 65 74 74 69 6e 67 73 rce all settings
5390: 20 69 6e 74 6f 20 22 22 20 61 6e 64 20 64 65 6c into "" and del
53a0: 65 74 65 20 69 74 20 6c 61 74 65 72 3f 0a 20 20 ete it later?.
53b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
53c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
53d0: 20 20 20 20 20 20 20 20 20 3b 3b 20 28 69 66 20 ;; (if
53e0: 28 6f 72 20 28 6e 6f 74 20 73 65 63 74 69 6f 6e (or (not section
53f0: 73 29 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 s) .
5400: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5410: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
5420: 3b 09 20 20 20 20 20 20 28 6d 65 6d 62 65 72 20 ;. (member
5430: 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 73 65 63 section-name sec
5440: 74 69 6f 6e 73 29 29 0a 20 20 20 20 20 20 20 20 tions)).
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 3b 3b 09 20 20 73 65 63 74 69 6f 6e 2d ;;. section-
5480: 6e 61 6d 65 20 22 22 29 20 3b 3b 20 73 74 69 63 name "") ;; stic
5490: 6b 20 65 76 65 72 79 74 68 69 6e 67 20 69 6e 74 k everything int
54a0: 6f 20 22 22 2e 20 4e 4f 50 45 3a 20 57 65 20 6e o "". NOPE: We n
54b0: 65 65 64 20 6e 65 77 20 73 74 72 61 74 65 67 79 eed new strategy
54c0: 2e 20 50 75 74 20 73 74 75 66 66 20 69 6e 20 63 . Put stuff in c
54d0: 6f 72 72 65 63 74 20 73 65 63 74 69 6f 6e 73 20 orrect sections
54e0: 61 6e 64 20 74 68 65 6e 20 64 65 6c 65 74 65 20 and then delete
54f0: 61 6c 6c 20 73 65 63 74 69 6f 6e 73 20 6c 61 74 all sections lat
5500: 65 72 2e 0a 20 20 20 20 20 20 20 20 20 20 20 20 er..
5510: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5520: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 s
5530: 65 63 74 69 6f 6e 2d 6e 61 6d 65 0a 20 20 20 20 ection-name.
5540: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5550: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5560: 20 20 20 20 20 20 20 23 66 20 23 66 29 29 29 0a #f #f))).
5570: 09 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 66 . (configf
5580: 3a 6b 65 79 2d 73 79 73 2d 70 72 20 28 20 78 20 :key-sys-pr ( x
5590: 6b 65 79 20 63 6d 64 20 20 20 20 20 20 29 0a 20 key cmd ).
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 28 69 66 20 28 63 61 6c 63 2d 61 6c 6c 6f (if (calc-allo
55d0: 77 2d 73 79 73 74 65 6d 20 61 6c 6c 6f 77 2d 73 w-system allow-s
55e0: 79 73 74 65 6d 20 63 75 72 72 2d 73 65 63 74 69 ystem curr-secti
55f0: 6f 6e 2d 6e 61 6d 65 20 73 65 63 74 69 6f 6e 73 on-name sections
5600: 29 0a 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 20 20
5620: 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 (let ((
5630: 61 6c 69 73 74 20 20 20 20 28 68 61 73 68 2d 74 alist (hash-t
5640: 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 able-ref/default
5650: 20 72 65 73 20 63 75 72 72 2d 73 65 63 74 69 6f res curr-sectio
5660: 6e 2d 6e 61 6d 65 20 27 28 29 29 29 0a 20 20 20 n-name '())).
5670: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5680: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5690: 20 20 20 20 20 20 20 20 20 20 28 76 61 6c 2d 70 (val-p
56a0: 72 6f 63 20 28 6c 61 6d 62 64 61 20 28 29 0a 20 roc (lambda ().
56b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
56c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
56d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
56e0: 20 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 (let* ((
56f0: 73 74 61 72 74 2d 74 69 6d 65 20 28 63 75 72 72 start-time (curr
5700: 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 0a 20 20 ent-seconds)).
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 20 20 20 20 20 20 20 20 20 20 28 6c (l
5750: 6f 63 61 6c 2d 61 6c 6c 6f 77 2d 73 79 73 74 65 ocal-allow-syste
5760: 6d 20 20 28 63 61 6c 63 2d 61 6c 6c 6f 77 2d 73 m (calc-allow-s
5770: 79 73 74 65 6d 20 61 6c 6c 6f 77 2d 73 79 73 74 ystem allow-syst
5780: 65 6d 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d em curr-section-
5790: 6e 61 6d 65 20 73 65 63 74 69 6f 6e 73 29 29 0a name sections)).
57a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
57b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
57c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
57d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
57e0: 28 65 6e 76 2d 64 65 6c 74 61 20 20 28 63 6f 6e (env-delta (con
57f0: 66 69 67 66 3a 63 66 67 64 61 74 2d 3e 65 6e 76 figf:cfgdat->env
5800: 2d 61 6c 69 73 74 20 63 75 72 72 2d 73 65 63 74 -alist curr-sect
5810: 69 6f 6e 2d 6e 61 6d 65 20 72 65 73 20 6c 6f 63 ion-name res loc
5820: 61 6c 2d 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 29 al-allow-system)
5830: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
5840: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5850: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5860: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5870: 20 20 28 63 6d 64 72 65 73 20 20 20 20 20 28 70 (cmdres (p
5880: 72 6f 63 65 73 73 3a 63 6d 64 2d 72 75 6e 2d 3e rocess:cmd-run->
5890: 6c 69 73 74 20 63 6d 64 20 64 65 6c 74 61 2d 65 list cmd delta-e
58a0: 6e 76 2d 61 6c 69 73 74 2d 6f 72 2d 68 61 73 68 nv-alist-or-hash
58b0: 2d 74 61 62 6c 65 3a 20 65 6e 76 2d 64 65 6c 74 -table: env-delt
58c0: 61 29 29 20 3b 3b 20 42 42 3a 20 68 65 72 65 20 a)) ;; BB: here
58d0: 69 73 20 77 68 65 72 65 20 5b 73 79 73 74 65 6d is where [system
58e0: 20 69 73 20 65 78 65 63 27 64 2e 20 20 6e 65 65 is exec'd. nee
58f0: 64 73 20 74 6f 20 68 61 76 65 20 65 6e 76 20 66 ds to have env f
5900: 72 6f 6d 20 6f 74 68 65 72 20 76 61 72 73 21 0a rom other vars!.
5910: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5920: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5930: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5940: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5950: 28 64 65 6c 74 61 20 20 20 20 20 20 28 2d 20 28 (delta (- (
5960: 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 current-seconds)
5970: 20 73 74 61 72 74 2d 74 69 6d 65 29 29 0a 20 20 start-time)).
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 20 20 20 20
59b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 (s
59c0: 74 61 74 75 73 20 20 20 20 20 28 63 61 64 72 20 tatus (cadr
59d0: 63 6d 64 72 65 73 29 29 0a 20 20 20 20 20 20 20 cmdres)).
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 28 72 65 73 20 20 20 (res
5a20: 20 20 20 20 20 28 63 61 72 20 20 63 6d 64 72 65 (car cmdre
5a30: 73 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 s))).
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: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
5a80: 6f 20 34 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 o 4 *default-log
5a90: 2d 70 6f 72 74 2a 20 22 22 20 69 6e 6c 20 22 5c -port* "" inl "\
5aa0: 6e 20 3d 3e 20 22 20 28 73 74 72 69 6e 67 2d 69 n => " (string-i
5ab0: 6e 74 65 72 73 70 65 72 73 65 20 72 65 73 20 22 ntersperse res "
5ac0: 5c 6e 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 \n")).
5ad0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5ae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5af0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5b00: 20 28 69 66 20 28 6e 6f 74 20 28 65 71 3f 20 73 (if (not (eq? s
5b10: 74 61 74 75 73 20 30 29 29 0a 20 20 20 20 20 20 tatus 0)).
5b20: 20 20 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 28 62 65 67 69 6e 0a (begin.
5b60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5b70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
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 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 (debug:print-er
5bb0: 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c ror 0 *default-l
5bc0: 6f 67 2d 70 6f 72 74 2a 20 22 70 72 6f 62 6c 65 og-port* "proble
5bd0: 6d 20 77 69 74 68 20 22 20 69 6e 6c 20 22 2c 20 m with " inl ",
5be0: 72 65 74 75 72 6e 20 63 6f 64 65 20 22 20 73 74 return code " st
5bf0: 61 74 75 73 0a 20 20 20 20 20 20 20 20 20 20 20 atus.
5c00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5c10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5c20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5c30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5c40: 20 20 20 20 20 20 20 20 20 22 20 6f 75 74 70 75 " outpu
5c50: 74 3a 20 22 20 63 6d 64 72 65 73 29 29 29 0a 20 t: " cmdres))).
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 28 69 66 20 28 3e (if (>
5ca0: 20 64 65 6c 74 61 20 32 29 0a 20 20 20 20 20 20 delta 2).
5cb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5cc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5cd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5ce0: 20 20 20 20 20 20 20 20 20 28 64 65 62 75 67 3a (debug:
5cf0: 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 print-info 0 *de
5d00: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
5d10: 22 66 6f 72 20 6c 69 6e 65 20 5c 22 22 20 69 6e "for line \"" in
5d20: 6c 20 22 5c 22 5c 6e 20 20 63 6f 6d 6d 61 6e 64 l "\"\n command
5d30: 3a 20 22 20 63 6d 64 20 22 20 74 6f 6f 6b 20 22 : " cmd " took "
5d40: 20 64 65 6c 74 61 20 22 20 73 65 63 6f 6e 64 73 delta " seconds
5d50: 20 74 6f 20 72 75 6e 20 77 69 74 68 20 6f 75 74 to run with out
5d60: 70 75 74 3a 5c 6e 20 20 20 22 20 72 65 73 29 0a put:\n " res).
5d70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5d80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5d90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5da0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
5db0: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
5dc0: 20 39 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 9 *default-log-
5dd0: 70 6f 72 74 2a 20 22 66 6f 72 20 6c 69 6e 65 20 port* "for line
5de0: 5c 22 22 20 69 6e 6c 20 22 5c 22 5c 6e 20 20 63 \"" inl "\"\n c
5df0: 6f 6d 6d 61 6e 64 3a 20 22 20 63 6d 64 20 22 20 ommand: " cmd "
5e00: 74 6f 6f 6b 20 22 20 64 65 6c 74 61 20 22 20 73 took " delta " s
5e10: 65 63 6f 6e 64 73 20 74 6f 20 72 75 6e 20 77 69 econds to run wi
5e20: 74 68 20 6f 75 74 70 75 74 3a 5c 6e 20 20 20 22 th output:\n "
5e30: 20 72 65 73 29 29 0a 20 20 20 20 20 20 20 20 20 res)).
5e40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5e50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5e60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5e70: 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 72 65 73 (if (null? res
5e80: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
5e90: 20 20 20 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 22 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 "".
5ed0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5ee0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5ef0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5f00: 20 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 (string-inter
5f10: 73 70 65 72 73 65 20 72 65 73 20 22 20 22 29 29 sperse res " "))
5f20: 29 29 29 29 0a 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 28 68 (h
5f50: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 72 ash-table-set! r
5f60: 65 73 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d es curr-section-
5f70: 6e 61 6d 65 20 0a 20 20 20 20 20 20 20 20 20 20 name .
5f80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5f90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5fa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5fb0: 28 63 6f 6e 66 69 67 66 3a 61 73 73 6f 63 2d 73 (configf:assoc-s
5fc0: 61 66 65 2d 61 64 64 20 61 6c 69 73 74 0a 20 20 afe-add alist.
5fd0: 20 20 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 20 20 20 20
6010: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6b k
6020: 65 79 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 ey .
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 28 63 61 73 65 20 28 63 61 6c 63 (case (calc
6080: 2d 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 61 6c -allow-system al
6090: 6c 6f 77 2d 73 79 73 74 65 6d 20 63 75 72 72 2d low-system curr-
60a0: 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 73 65 63 section-name sec
60b0: 74 69 6f 6e 73 29 0a 20 20 20 20 20 20 20 20 20 tions).
60c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
60d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
60e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
60f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6100: 20 20 20 20 20 20 20 20 20 20 28 28 72 65 74 75 ((retu
6110: 72 6e 2d 70 72 6f 63 73 29 20 76 61 6c 2d 70 72 rn-procs) val-pr
6120: 6f 63 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 oc).
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 20 20 20 20 20 20 20 20 20 20
6170: 20 20 20 20 20 20 20 28 28 72 65 74 75 72 6e 2d ((return-
6180: 73 74 72 69 6e 67 29 20 63 6d 64 29 0a 20 20 20 string) cmd).
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 20 20 20 20 20 20 20 20 20 20 20 20 20
61e0: 28 65 6c 73 65 20 28 76 61 6c 2d 70 72 6f 63 29 (else (val-proc)
61f0: 29 29 0a 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 20 20 20 20
6240: 20 20 20 20 6d 65 74 61 64 61 74 61 3a 20 6d 65 metadata: me
6250: 74 61 70 61 74 68 29 29 0a 20 20 20 20 20 20 20 tapath)).
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 28 6c 6f 6f 70 20 28 63 6f 6e 66 69 67 66 (loop (configf
6290: 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 20 72 :read-line inp r
62a0: 65 73 20 28 63 61 6c 63 2d 61 6c 6c 6f 77 2d 73 es (calc-allow-s
62b0: 79 73 74 65 6d 20 61 6c 6c 6f 77 2d 73 79 73 74 ystem allow-syst
62c0: 65 6d 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d em curr-section-
62d0: 6e 61 6d 65 20 73 65 63 74 69 6f 6e 73 29 20 73 name sections) s
62e0: 65 74 74 69 6e 67 73 29 20 63 75 72 72 2d 73 65 ettings) curr-se
62f0: 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 66 ction-name #f #f
6300: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
6310: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6320: 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 20 (loop
6330: 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d 6c 69 (configf:read-li
6340: 6e 65 20 69 6e 70 20 72 65 73 0a 20 20 20 20 20 ne inp res.
6350: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6360: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
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 28 63 61 6c 63 (calc
6390: 2d 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 61 6c -allow-system al
63a0: 6c 6f 77 2d 73 79 73 74 65 6d 20 63 75 72 72 2d low-system curr-
63b0: 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 73 65 63 section-name sec
63c0: 74 69 6f 6e 73 29 0a 20 20 20 20 20 20 20 20 20 tions).
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 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6400: 20 20 20 20 20 20 20 73 65 74 74 69 6e 67 73 29 settings)
6410: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
6420: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6430: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 63 75 cu
6440: 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 rr-section-name
6450: 23 66 20 23 66 29 29 29 0a 20 20 20 20 20 20 20 #f #f))).
6460: 20 20 20 20 20 20 20 20 0a 09 20 20 20 20 20 20 ..
6470: 20 28 63 6f 6e 66 69 67 66 3a 6b 65 79 2d 6e 6f (configf:key-no
6480: 2d 76 61 6c 20 28 20 78 20 6b 65 79 20 76 61 6c -val ( x key val
6490: 29 0a 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: 20 20 20 20 20 28 6c 65 74 2a 20 28 28 61 6c 69 (let* ((ali
64c0: 73 74 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 st (hash-table
64d0: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 72 65 73 -ref/default res
64e0: 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 curr-section-na
64f0: 6d 65 20 27 28 29 29 29 0a 20 20 20 20 20 20 20 me '())).
6500: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6510: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6520: 20 20 20 28 66 76 61 6c 20 20 20 20 28 6f 72 20 (fval (or
6530: 28 69 66 20 28 73 74 72 69 6e 67 3f 20 76 61 6c (if (string? val
6540: 29 20 76 61 6c 20 23 66 29 20 22 22 29 29 29 20 ) val #f) "")))
6550: 3b 3b 20 66 76 61 6c 20 73 68 6f 75 6c 64 20 62 ;; fval should b
6560: 65 20 65 69 74 68 65 72 20 22 22 20 6f 72 20 22 e either "" or "
6570: 20 22 20 28 6f 6e 65 20 6f 72 20 6d 6f 72 65 20 " (one or more
6580: 73 70 61 63 65 73 29 0a 20 20 20 20 20 20 20 20 spaces).
6590: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
65a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 64 65 (de
65b0: 62 75 67 3a 70 72 69 6e 74 20 31 30 20 2a 64 65 bug:print 10 *de
65c0: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
65d0: 22 20 20 20 73 65 74 74 69 6e 67 3a 20 5b 22 20 " setting: ["
65e0: 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d curr-section-nam
65f0: 65 20 22 5d 20 22 20 6b 65 79 20 22 20 3d 20 23 e "] " key " = #
6600: 74 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 t").
6610: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6620: 20 20 20 20 20 20 20 20 20 28 73 61 66 65 2d 73 (safe-s
6630: 65 74 65 6e 76 20 6b 65 79 20 66 76 61 6c 29 0a etenv key fval).
6640: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6650: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6660: 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 (hash-table
6670: 2d 73 65 74 21 20 72 65 73 20 63 75 72 72 2d 73 -set! res curr-s
6680: 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 0a 20 20 20 ection-name .
6690: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
66a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
66b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
66c0: 20 20 20 28 63 6f 6e 66 69 67 66 3a 61 73 73 6f (configf:asso
66d0: 63 2d 73 61 66 65 2d 61 64 64 20 61 6c 69 73 74 c-safe-add alist
66e0: 20 6b 65 79 20 66 76 61 6c 20 6d 65 74 61 64 61 key fval metada
66f0: 74 61 3a 20 6d 65 74 61 70 61 74 68 29 29 0a 20 ta: metapath)).
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 28 6c 6f 6f 70 20 28 63 6f 6e 66 69 (loop (confi
6730: 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 gf:read-line inp
6740: 20 72 65 73 0a 20 20 20 20 20 20 20 20 20 20 20 res.
6750: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6760: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6770: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6780: 20 20 20 28 63 61 6c 63 2d 61 6c 6c 6f 77 2d 73 (calc-allow-s
6790: 79 73 74 65 6d 20 61 6c 6c 6f 77 2d 73 79 73 74 ystem allow-syst
67a0: 65 6d 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d em curr-section-
67b0: 6e 61 6d 65 20 73 65 63 74 69 6f 6e 73 29 0a 20 name sections).
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 20 20 20 20 20 20 20 20 73 65 74 set
6800: 74 69 6e 67 73 29 0a 20 20 20 20 20 20 20 20 20 tings).
6810: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6820: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6830: 20 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e curr-section-n
6840: 61 6d 65 20 6b 65 79 20 23 66 29 29 29 0a 20 20 ame key #f))).
6850: 20 20 20 20 20 20 20 20 20 20 20 20 20 0a 09 20 ..
6860: 20 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 6b (configf:k
6870: 65 79 2d 76 61 6c 2d 70 72 20 28 20 78 20 6b 65 ey-val-pr ( x ke
6880: 79 20 75 6e 6b 31 20 76 61 6c 20 75 6e 6b 32 20 y unk1 val unk2
6890: 29 0a 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 20
68b0: 20 20 20 20 20 28 6c 65 74 2a 20 28 28 61 6c 69 (let* ((ali
68c0: 73 74 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 st (hash-table
68d0: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 72 65 73 -ref/default res
68e0: 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 curr-section-na
68f0: 6d 65 20 27 28 29 29 29 0a 20 20 20 20 20 20 20 me '())).
6900: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6910: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6920: 20 20 20 28 65 6e 76 61 72 20 20 20 28 61 6e 64 (envar (and
6930: 20 65 6e 76 69 72 6f 6e 2d 70 61 74 74 0a 09 09 environ-patt...
6940: 09 09 09 09 09 28 73 74 72 69 6e 67 2d 73 65 61 .....(string-sea
6950: 72 63 68 20 28 72 65 67 65 78 70 20 65 6e 76 69 rch (regexp envi
6960: 72 6f 6e 2d 70 61 74 74 29 20 63 75 72 72 2d 73 ron-patt) curr-s
6970: 65 63 74 69 6f 6e 2d 6e 61 6d 65 29 20 3b 3b 20 ection-name) ;;
6980: 64 6f 65 73 20 74 68 65 20 73 65 63 74 69 6f 6e does the section
6990: 20 6d 61 74 63 68 20 74 68 65 20 65 6e 76 69 6f match the envio
69a0: 6e 70 61 74 74 3f 0a 09 09 09 09 09 09 09 28 61 npatt?........(a
69b0: 6e 64 20 28 6e 6f 74 20 28 73 74 72 69 6e 67 2d nd (not (string-
69c0: 6e 75 6c 6c 3f 20 6b 65 79 29 29 0a 09 09 09 09 null? key)).....
69d0: 09 09 09 20 20 20 20 20 28 6e 6f 74 20 28 65 71 ... (not (eq
69e0: 75 61 6c 3f 20 22 21 22 20 28 73 75 62 73 74 72 ual? "!" (substr
69f0: 69 6e 67 20 6b 65 79 20 30 20 31 29 29 29 29 20 ing key 0 1))))
6a00: 3b 3b 20 21 20 61 73 20 6c 65 61 64 69 6e 67 20 ;; ! as leading
6a10: 63 68 61 72 61 63 74 65 72 20 69 73 20 61 20 73 character is a s
6a20: 69 67 6e 61 74 75 72 65 20 74 6f 20 4e 4f 54 20 ignature to NOT
6a30: 65 78 70 6f 72 74 20 74 6f 20 74 68 65 20 65 6e export to the en
6a40: 76 69 72 6f 6e 6d 65 6e 74 0a 09 09 09 09 09 09 vironment.......
6a50: 09 3b 3b 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 .;; (string-matc
6a60: 68 20 22 5e 2e 2a 3a 2e 2a 3a 2e 2a 24 22 20 6b h "^.*:.*:.*$" k
6a70: 65 79 29 20 3b 3b 20 3b 3b 20 73 6f 6d 65 74 68 ey) ;; ;; someth
6a80: 69 6e 67 3a 73 6f 6d 65 74 68 69 6e 67 3a 73 6f ing:something:so
6a90: 6d 65 74 68 69 6e 67 20 72 65 73 65 72 76 65 64 mething reserved
6aa0: 20 66 6f 72 20 74 72 69 67 67 65 72 73 20 69 6e for triggers in
6ab0: 20 72 75 6e 63 6f 6e 66 69 67 73 0a 09 09 09 09 runconfigs.....
6ac0: 09 09 09 29 29 20 0a 20 20 20 20 20 20 20 20 20 ...)) .
6ad0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6ae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6af0: 20 28 72 65 61 6c 76 61 6c 20 28 69 66 20 65 6e (realval (if en
6b00: 76 61 72 0a 20 20 20 20 20 20 20 20 20 20 20 20 var.
6b10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6b20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6b30: 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 66 (conf
6b40: 69 67 66 3a 65 76 61 6c 2d 73 74 72 69 6e 67 2d igf:eval-string-
6b50: 69 6e 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 76 in-environment v
6b60: 61 6c 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 al).
6b70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6b80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6b90: 20 20 20 20 20 20 20 20 20 20 20 76 61 6c 29 29 val))
6ba0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
6bb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6bc0: 20 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 (debug:pr
6bd0: 69 6e 74 2d 69 6e 66 6f 20 36 20 2a 64 65 66 61 int-info 6 *defa
6be0: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 72 ult-log-port* "r
6bf0: 65 61 64 2d 63 6f 6e 66 69 67 20 65 6e 76 20 73 ead-config env s
6c00: 65 74 74 69 6e 67 2c 20 65 6e 76 61 72 3a 20 22 etting, envar: "
6c10: 20 65 6e 76 61 72 20 22 20 72 65 61 6c 76 61 6c envar " realval
6c20: 3a 20 22 20 72 65 61 6c 76 61 6c 20 22 20 76 61 : " realval " va
6c30: 6c 3a 20 22 20 76 61 6c 20 22 20 6b 65 79 3a 20 l: " val " key:
6c40: 22 20 6b 65 79 20 22 20 63 75 72 72 2d 73 65 63 " key " curr-sec
6c50: 74 69 6f 6e 2d 6e 61 6d 65 3a 20 22 20 63 75 72 tion-name: " cur
6c60: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 29 0a r-section-name).
6c70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6c80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6c90: 20 20 20 20 20 28 69 66 20 65 6e 76 61 72 20 28 (if envar (
6ca0: 73 61 66 65 2d 73 65 74 65 6e 76 20 6b 65 79 20 safe-setenv key
6cb0: 72 65 61 6c 76 61 6c 29 29 0a 20 20 20 20 20 20 realval)).
6cc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6cd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
6ce0: 64 65 62 75 67 3a 70 72 69 6e 74 20 31 30 20 2a debug:print 10 *
6cf0: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
6d00: 2a 20 22 20 20 20 73 65 74 74 69 6e 67 3a 20 5b * " setting: [
6d10: 22 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e " curr-section-n
6d20: 61 6d 65 20 22 5d 20 22 20 6b 65 79 20 22 20 3d ame "] " key " =
6d30: 20 22 20 76 61 6c 29 0a 20 20 20 20 20 20 20 20 " val).
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 28 68 61 (ha
6d60: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 72 65 sh-table-set! re
6d70: 73 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e s curr-section-n
6d80: 61 6d 65 20 0a 20 20 20 20 20 20 20 20 20 20 20 ame .
6d90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6da0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6db0: 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 66 (conf
6dc0: 69 67 66 3a 61 73 73 6f 63 2d 73 61 66 65 2d 61 igf:assoc-safe-a
6dd0: 64 64 20 61 6c 69 73 74 20 6b 65 79 20 72 65 61 dd alist key rea
6de0: 6c 76 61 6c 20 6d 65 74 61 64 61 74 61 3a 20 6d lval metadata: m
6df0: 65 74 61 70 61 74 68 29 29 0a 20 20 20 20 20 20 etapath)).
6e00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6e10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
6e20: 6c 6f 6f 70 20 28 63 6f 6e 66 69 67 66 3a 72 65 loop (configf:re
6e30: 61 64 2d 6c 69 6e 65 20 69 6e 70 20 72 65 73 0a ad-line inp res.
6e40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6e50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6e60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6e70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
6e80: 61 6c 63 2d 61 6c 6c 6f 77 2d 73 79 73 74 65 6d alc-allow-system
6e90: 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 63 75 allow-system cu
6ea0: 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 rr-section-name
6eb0: 73 65 63 74 69 6f 6e 73 29 20 73 65 74 74 69 6e sections) settin
6ec0: 67 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 gs).
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 63 c
6ef0: 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 urr-section-name
6f00: 20 6b 65 79 20 23 66 29 29 29 0a 09 20 20 20 20 key #f)))..
6f10: 20 20 20 3b 3b 20 69 66 20 61 20 63 6f 6e 74 69 ;; if a conti
6f20: 6e 75 65 64 20 6c 69 6e 65 0a 09 20 20 20 20 20 nued line..
6f30: 20 20 28 63 6f 6e 66 69 67 66 3a 63 6f 6e 74 2d (configf:cont-
6f40: 6c 6e 2d 72 78 20 28 20 78 20 77 68 73 70 20 76 ln-rx ( x whsp v
6f50: 61 6c 20 20 20 20 20 29 0a 20 20 20 20 20 20 20 al ).
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 28 6c 65 74 (let
6f80: 20 28 28 61 6c 69 73 74 20 28 68 61 73 68 2d 74 ((alist (hash-t
6f90: 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 able-ref/default
6fa0: 20 72 65 73 20 63 75 72 72 2d 73 65 63 74 69 6f res curr-sectio
6fb0: 6e 2d 6e 61 6d 65 20 27 28 29 29 29 29 0a 20 20 n-name '()))).
6fc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6fd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6fe0: 20 20 20 28 69 66 20 76 61 72 2d 66 6c 61 67 20 (if var-flag
6ff0: 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 69 ;; i
7000: 66 20 73 65 74 20 74 6f 20 61 20 73 74 72 69 6e f set to a strin
7010: 67 20 74 68 65 6e 20 77 65 20 68 61 76 65 20 61 g then we have a
7020: 20 63 6f 6e 74 69 6e 75 65 64 20 76 61 72 0a 20 continued var.
7030: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7040: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7050: 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 6e (let ((n
7060: 65 77 76 61 6c 20 28 63 6f 6e 63 20 0a 20 20 20 ewval (conc .
7070: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7080: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7090: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
70a0: 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 6c 6f (configf:lo
70b0: 6f 6b 75 70 20 72 65 73 20 63 75 72 72 2d 73 65 okup res curr-se
70c0: 63 74 69 6f 6e 2d 6e 61 6d 65 20 76 61 72 2d 66 ction-name var-f
70d0: 6c 61 67 29 20 22 5c 6e 22 0a 20 20 20 20 20 20 lag) "\n".
70e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
70f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7100: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7110: 20 20 3b 3b 20 74 72 69 6d 20 6c 65 61 64 20 66 ;; trim lead f
7120: 72 6f 6d 20 74 68 65 20 69 6e 63 6f 6d 69 6e 67 rom the incoming
7130: 20 77 68 73 70 20 74 6f 20 73 75 70 70 6f 72 74 whsp to support
7140: 20 73 6f 6d 65 20 69 6e 64 65 6e 74 69 6e 67 2e some indenting.
7150: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
7160: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
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 28 69 66 20 6c 65 61 (if lea
7190: 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 d.
71a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
71b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
71c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 (s
71d0: 74 72 69 6e 67 2d 73 75 62 73 74 69 74 75 74 65 tring-substitute
71e0: 20 28 72 65 67 65 78 70 20 6c 65 61 64 29 20 22 (regexp lead) "
71f0: 22 20 77 68 73 70 29 0a 20 20 20 20 20 20 20 20 " whsp).
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 20 20 20 20 20 20 20
7220: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7230: 20 20 20 20 22 22 29 0a 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 20 20
7260: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7270: 76 61 6c 29 29 29 0a 20 20 20 20 20 20 20 20 20 val))).
7280: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7290: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
72a0: 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 76 61 6c ;; (print "val
72b0: 3a 20 22 20 76 61 6c 20 22 5c 6e 6e 65 77 76 61 : " val "\nnewva
72c0: 6c 3a 20 5c 22 22 20 6e 65 77 76 61 6c 20 22 5c l: \"" newval "\
72d0: 22 5c 6e 76 61 72 66 6c 61 67 3a 20 22 20 76 61 "\nvarflag: " va
72e0: 72 2d 66 6c 61 67 29 0a 20 20 20 20 20 20 20 20 r-flag).
72f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7300: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7310: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 (hash-table-s
7320: 65 74 21 20 72 65 73 20 63 75 72 72 2d 73 65 63 et! res curr-sec
7330: 74 69 6f 6e 2d 6e 61 6d 65 20 0a 20 20 20 20 20 tion-name .
7340: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7350: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7360: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7370: 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a (configf:
7380: 61 73 73 6f 63 2d 73 61 66 65 2d 61 64 64 20 61 assoc-safe-add a
7390: 6c 69 73 74 20 76 61 72 2d 66 6c 61 67 20 6e 65 list var-flag ne
73a0: 77 76 61 6c 20 6d 65 74 61 64 61 74 61 3a 20 6d wval metadata: m
73b0: 65 74 61 70 61 74 68 29 29 0a 20 20 20 20 20 20 etapath)).
73c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
73d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
73e0: 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 6f 6e 66 (loop (conf
73f0: 69 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e igf:read-line in
7400: 70 20 72 65 73 20 28 63 61 6c 63 2d 61 6c 6c 6f p res (calc-allo
7410: 77 2d 73 79 73 74 65 6d 20 61 6c 6c 6f 77 2d 73 w-system allow-s
7420: 79 73 74 65 6d 20 63 75 72 72 2d 73 65 63 74 69 ystem curr-secti
7430: 6f 6e 2d 6e 61 6d 65 20 73 65 63 74 69 6f 6e 73 on-name sections
7440: 29 20 73 65 74 74 69 6e 67 73 29 20 63 75 72 72 ) settings) curr
7450: 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 76 61 -section-name va
7460: 72 2d 66 6c 61 67 20 28 69 66 20 6c 65 61 64 20 r-flag (if lead
7470: 6c 65 61 64 20 77 68 73 70 29 29 29 0a 20 20 20 lead whsp))).
7480: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7490: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
74a0: 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 6f 6e (loop (con
74b0: 66 69 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 figf:read-line i
74c0: 6e 70 20 72 65 73 20 28 63 61 6c 63 2d 61 6c 6c np res (calc-all
74d0: 6f 77 2d 73 79 73 74 65 6d 20 61 6c 6c 6f 77 2d ow-system allow-
74e0: 73 79 73 74 65 6d 20 63 75 72 72 2d 73 65 63 74 system curr-sect
74f0: 69 6f 6e 2d 6e 61 6d 65 20 73 65 63 74 69 6f 6e ion-name section
7500: 73 29 20 73 65 74 74 69 6e 67 73 29 20 63 75 72 s) settings) cur
7510: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 r-section-name #
7520: 66 20 23 66 29 29 29 29 0a 09 20 20 20 20 20 20 f #f))))..
7530: 20 28 65 6c 73 65 20 28 64 65 62 75 67 3a 70 72 (else (debug:pr
7540: 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 int-error 0 *def
7550: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
7560: 70 72 6f 62 6c 65 6d 20 70 61 72 73 69 6e 67 20 problem parsing
7570: 22 20 70 61 74 68 20 22 2c 5c 6e 20 20 20 5c 22 " path ",\n \"
7580: 22 20 69 6e 6c 20 22 5c 22 22 29 0a 09 09 20 20 " inl "\"")...
7590: 20 20 20 28 73 65 74 21 20 76 61 72 2d 66 6c 61 (set! var-fla
75a0: 67 20 23 66 29 0a 09 09 20 20 20 20 20 28 6c 6f g #f)... (lo
75b0: 6f 70 20 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 op (configf:read
75c0: 2d 6c 69 6e 65 20 69 6e 70 20 72 65 73 20 28 63 -line inp res (c
75d0: 61 6c 63 2d 61 6c 6c 6f 77 2d 73 79 73 74 65 6d alc-allow-system
75e0: 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 63 75 allow-system cu
75f0: 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 rr-section-name
7600: 73 65 63 74 69 6f 6e 73 29 20 73 65 74 74 69 6e sections) settin
7610: 67 73 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e gs) curr-section
7620: 2d 6e 61 6d 65 20 23 66 20 23 66 29 29 29 29 0a -name #f #f)))).
7630: 20 20 20 20 20 20 20 20 20 20 29 20 3b 3b 20 65 ) ;; e
7640: 6e 64 20 6c 6f 6f 70 0a 20 20 20 20 20 20 20 20 nd loop.
7650: 29 29 29 0a 20 20 0a 3b 3b 20 70 61 74 68 65 6e ))). .;; pathen
7660: 76 76 61 72 20 77 69 6c 6c 20 73 65 74 20 74 68 vvar will set th
7670: 65 20 6e 61 6d 65 64 20 76 61 72 20 74 6f 20 74 e named var to t
7680: 68 65 20 70 61 74 68 20 6f 66 20 74 68 65 20 63 he path of the c
7690: 6f 6e 66 69 67 0a 28 64 65 66 69 6e 65 20 28 66 onfig.(define (f
76a0: 69 6e 64 2d 61 6e 64 2d 72 65 61 64 2d 63 6f 6e ind-and-read-con
76b0: 66 69 67 20 66 6e 61 6d 65 20 23 21 6b 65 79 20 fig fname #!key
76c0: 28 65 6e 76 69 72 6f 6e 2d 70 61 74 74 20 23 66 (environ-patt #f
76d0: 29 28 67 69 76 65 6e 2d 74 6f 70 70 61 74 68 20 )(given-toppath
76e0: 23 66 29 28 70 61 74 68 65 6e 76 76 61 72 20 23 #f)(pathenvvar #
76f0: 66 29 29 0a 20 20 28 6c 65 74 2a 20 28 28 63 75 f)). (let* ((cu
7700: 72 72 2d 64 69 72 20 20 20 28 63 75 72 72 65 6e rr-dir (curren
7710: 74 2d 64 69 72 65 63 74 6f 72 79 29 29 0a 20 20 t-directory)).
7720: 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 69 6e (configin
7730: 66 6f 20 28 66 69 6e 64 2d 63 6f 6e 66 69 67 20 fo (find-config
7740: 66 6e 61 6d 65 20 74 6f 70 70 61 74 68 3a 20 67 fname toppath: g
7750: 69 76 65 6e 2d 74 6f 70 70 61 74 68 29 29 0a 09 iven-toppath))..
7760: 20 28 74 6f 70 70 61 74 68 20 20 20 20 28 63 61 (toppath (ca
7770: 72 20 63 6f 6e 66 69 67 69 6e 66 6f 29 29 0a 09 r configinfo))..
7780: 20 28 63 6f 6e 66 69 67 66 69 6c 65 20 28 63 61 (configfile (ca
7790: 64 72 20 63 6f 6e 66 69 67 69 6e 66 6f 29 29 0a dr configinfo)).
77a0: 09 20 28 73 65 74 2d 66 69 65 6c 64 73 20 28 6c . (set-fields (l
77b0: 61 6d 62 64 61 20 28 63 75 72 72 2d 73 65 63 74 ambda (curr-sect
77c0: 69 6f 6e 20 6e 65 78 74 2d 73 65 63 74 69 6f 6e ion next-section
77d0: 20 68 74 20 70 61 74 68 29 0a 09 09 20 20 20 20 ht path)...
77e0: 20 20 20 28 6c 65 74 20 28 28 66 69 65 6c 64 2d (let ((field-
77f0: 6e 61 6d 65 73 20 28 69 66 20 68 74 20 28 63 6f names (if ht (co
7800: 6d 6d 6f 6e 3a 67 65 74 2d 66 69 65 6c 64 73 20 mmon:get-fields
7810: 68 74 29 20 27 28 29 29 29 0a 09 09 09 20 20 20 ht) '()))....
7820: 20 20 28 74 61 72 67 65 74 20 20 20 20 20 20 28 (target (
7830: 6f 72 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 54 or (getenv "MT_T
7840: 41 52 47 45 54 22 29 28 61 72 67 73 3a 67 65 74 ARGET")(args:get
7850: 2d 61 72 67 20 22 2d 72 65 71 74 61 72 67 22 29 -arg "-reqtarg")
7860: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
7870: 74 61 72 67 65 74 22 29 29 29 29 0a 09 09 09 20 target"))))....
7880: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
7890: 6f 20 39 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 o 9 *default-log
78a0: 2d 70 6f 72 74 2a 20 22 73 65 74 2d 66 69 65 6c -port* "set-fiel
78b0: 64 73 20 77 69 74 68 20 66 69 65 6c 64 2d 6e 61 ds with field-na
78c0: 6d 65 73 3d 22 20 66 69 65 6c 64 2d 6e 61 6d 65 mes=" field-name
78d0: 73 20 22 20 74 61 72 67 65 74 3d 22 20 74 61 72 s " target=" tar
78e0: 67 65 74 20 22 20 63 75 72 72 2d 73 65 63 74 69 get " curr-secti
78f0: 6f 6e 3d 22 20 63 75 72 72 2d 73 65 63 74 69 6f on=" curr-sectio
7900: 6e 20 22 20 6e 65 78 74 2d 73 65 63 74 69 6f 6e n " next-section
7910: 3d 22 20 6e 65 78 74 2d 73 65 63 74 69 6f 6e 20 =" next-section
7920: 22 20 70 61 74 68 3d 22 20 70 61 74 68 20 22 20 " path=" path "
7930: 68 74 3d 22 20 68 74 29 0a 09 09 09 20 28 69 66 ht=" ht).... (if
7940: 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 66 69 65 (not (null? fie
7950: 6c 64 2d 6e 61 6d 65 73 29 29 28 6b 65 79 73 3a ld-names))(keys:
7960: 74 61 72 67 65 74 2d 73 65 74 2d 61 72 67 73 20 target-set-args
7970: 66 69 65 6c 64 2d 6e 61 6d 65 73 20 74 61 72 67 field-names targ
7980: 65 74 20 23 66 29 29 29 29 29 29 0a 20 20 20 20 et #f)))))).
7990: 28 69 66 20 74 6f 70 70 61 74 68 20 28 63 68 61 (if toppath (cha
79a0: 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 74 6f nge-directory to
79b0: 70 70 61 74 68 29 29 20 0a 20 20 20 20 28 69 66 ppath)) . (if
79c0: 20 28 61 6e 64 20 74 6f 70 70 61 74 68 20 70 61 (and toppath pa
79d0: 74 68 65 6e 76 76 61 72 29 28 73 65 74 65 6e 76 thenvvar)(setenv
79e0: 20 70 61 74 68 65 6e 76 76 61 72 20 74 6f 70 70 pathenvvar topp
79f0: 61 74 68 29 29 0a 20 20 20 20 28 6c 65 74 20 28 ath)). (let (
7a00: 28 63 6f 6e 66 69 67 64 61 74 20 20 28 69 66 20 (configdat (if
7a10: 63 6f 6e 66 69 67 66 69 6c 65 20 0a 09 09 09 20 configfile ....
7a20: 20 28 72 65 61 64 2d 63 6f 6e 66 69 67 20 63 6f (read-config co
7a30: 6e 66 69 67 66 69 6c 65 20 23 66 20 23 74 20 65 nfigfile #f #t e
7a40: 6e 76 69 72 6f 6e 2d 70 61 74 74 3a 20 65 6e 76 nviron-patt: env
7a50: 69 72 6f 6e 2d 70 61 74 74 20 70 6f 73 74 2d 73 iron-patt post-s
7a60: 65 63 74 69 6f 6e 2d 70 72 6f 63 73 3a 20 28 6c ection-procs: (l
7a70: 69 73 74 20 28 63 6f 6e 73 20 22 5e 66 69 65 6c ist (cons "^fiel
7a80: 64 73 24 22 20 73 65 74 2d 66 69 65 6c 64 73 29 ds$" set-fields)
7a90: 29 20 23 66 29 29 29 29 0a 20 20 20 20 20 20 28 ) #f)))). (
7aa0: 69 66 20 74 6f 70 70 61 74 68 20 28 63 68 61 6e if toppath (chan
7ab0: 67 65 2d 64 69 72 65 63 74 6f 72 79 20 63 75 72 ge-directory cur
7ac0: 72 2d 64 69 72 29 29 0a 20 20 20 20 20 20 28 6c r-dir)). (l
7ad0: 69 73 74 20 63 6f 6e 66 69 67 64 61 74 20 74 6f ist configdat to
7ae0: 70 70 61 74 68 20 63 6f 6e 66 69 67 66 69 6c 65 ppath configfile
7af0: 20 66 6e 61 6d 65 29 29 29 29 0a 0a 28 64 65 66 fname))))..(def
7b00: 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f ine (configf:loo
7b10: 6b 75 70 20 63 66 67 64 61 74 20 73 65 63 74 69 kup cfgdat secti
7b20: 6f 6e 20 76 61 72 29 0a 20 20 28 69 66 20 28 68 on var). (if (h
7b30: 61 73 68 2d 74 61 62 6c 65 3f 20 63 66 67 64 61 ash-table? cfgda
7b40: 74 29 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 t). (let ((
7b50: 73 65 63 74 64 61 74 20 28 68 61 73 68 2d 74 61 sectdat (hash-ta
7b60: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default
7b70: 63 66 67 64 61 74 20 73 65 63 74 69 6f 6e 20 27 cfgdat section '
7b80: 28 29 29 29 29 0a 09 28 69 66 20 28 6e 75 6c 6c ())))..(if (null
7b90: 3f 20 73 65 63 74 64 61 74 29 0a 09 20 20 20 20 ? sectdat)..
7ba0: 23 66 0a 09 20 20 20 20 28 6c 65 74 20 28 28 6d #f.. (let ((m
7bb0: 61 74 63 68 20 28 61 73 73 6f 63 20 76 61 72 20 atch (assoc var
7bc0: 73 65 63 74 64 61 74 29 29 29 0a 09 20 20 20 20 sectdat)))..
7bd0: 20 20 28 69 66 20 6d 61 74 63 68 20 3b 3b 20 28 (if match ;; (
7be0: 61 6e 64 20 6d 61 74 63 68 20 28 6c 69 73 74 3f and match (list?
7bf0: 20 6d 61 74 63 68 29 28 3e 20 28 6c 65 6e 67 74 match)(> (lengt
7c00: 68 20 6d 61 74 63 68 29 20 31 29 29 0a 09 09 20 h match) 1))...
7c10: 20 28 63 61 64 72 20 6d 61 74 63 68 29 0a 09 09 (cadr match)...
7c20: 20 20 23 66 29 29 0a 09 20 20 20 20 29 29 0a 20 #f)).. )).
7c30: 20 20 20 20 20 23 66 29 29 0a 0a 3b 3b 20 75 73 #f))..;; us
7c40: 65 20 74 6f 20 68 61 76 65 20 64 65 66 69 6e 69 e to have defini
7c50: 74 69 76 65 20 73 65 74 74 69 6e 67 3a 0a 3b 3b tive setting:.;;
7c60: 20 20 5b 66 6f 6f 5d 0a 3b 3b 20 20 76 61 72 20 [foo].;; var
7c70: 79 65 73 0a 3b 3b 0a 3b 3b 20 20 28 63 6f 6e 66 yes.;;.;; (conf
7c80: 69 67 66 3a 76 61 72 2d 69 73 3f 20 63 66 67 64 igf:var-is? cfgd
7c90: 61 74 20 22 66 6f 6f 22 20 22 76 61 72 22 20 22 at "foo" "var" "
7ca0: 79 65 73 22 29 20 3d 3e 20 23 74 0a 3b 3b 0a 28 yes") => #t.;;.(
7cb0: 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a define (configf:
7cc0: 76 61 72 2d 69 73 3f 20 63 66 67 64 61 74 20 73 var-is? cfgdat s
7cd0: 65 63 74 69 6f 6e 20 76 61 72 20 65 78 70 65 63 ection var expec
7ce0: 74 65 64 2d 76 61 6c 29 0a 20 20 28 65 71 75 61 ted-val). (equa
7cf0: 6c 3f 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b l? (configf:look
7d00: 75 70 20 63 66 67 64 61 74 20 73 65 63 74 69 6f up cfgdat sectio
7d10: 6e 20 76 61 72 29 20 65 78 70 65 63 74 65 64 2d n var) expected-
7d20: 76 61 6c 29 29 0a 0a 3b 3b 20 72 65 64 65 66 69 val))..;; redefi
7d30: 6e 65 73 0a 28 64 65 66 69 6e 65 20 63 6f 6e 66 nes.(define conf
7d40: 69 67 2d 6c 6f 6f 6b 75 70 20 63 6f 6e 66 69 67 ig-lookup config
7d50: 66 3a 6c 6f 6f 6b 75 70 29 0a 28 64 65 66 69 6e f:lookup).(defin
7d60: 65 20 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d 66 e configf:read-f
7d70: 69 6c 65 20 72 65 61 64 2d 63 6f 6e 66 69 67 29 ile read-config)
7d80: 0a 0a 3b 3b 20 73 61 66 65 6c 79 20 6c 6f 6f 6b ..;; safely look
7d90: 20 75 70 20 61 20 76 61 6c 75 65 20 74 68 61 74 up a value that
7da0: 20 69 73 20 65 78 70 65 63 74 65 64 20 74 6f 20 is expected to
7db0: 62 65 20 61 20 6e 75 6d 62 65 72 2c 20 72 65 74 be a number, ret
7dc0: 75 72 6e 0a 3b 3b 20 61 20 64 65 66 61 75 6c 74 urn.;; a default
7dd0: 20 28 23 66 20 75 6e 6c 65 73 73 20 70 72 6f 76 (#f unless prov
7de0: 69 64 65 64 29 0a 3b 3b 0a 28 64 65 66 69 6e 65 ided).;;.(define
7df0: 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 (configf:lookup
7e00: 2d 6e 75 6d 62 65 72 20 63 66 67 64 61 74 20 73 -number cfgdat s
7e10: 65 63 74 69 6f 6e 20 76 61 72 6e 61 6d 65 20 23 ection varname #
7e20: 21 6b 65 79 20 28 64 65 66 61 75 6c 74 20 23 66 !key (default #f
7e30: 29 29 0a 20 20 28 6c 65 74 2a 20 28 28 76 61 6c )). (let* ((val
7e40: 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 (configf:lookup
7e50: 20 63 66 67 64 61 74 20 73 65 63 74 69 6f 6e 20 cfgdat section
7e60: 76 61 72 6e 61 6d 65 29 29 0a 20 20 20 20 20 20 varname)).
7e70: 20 20 20 28 72 65 73 20 28 69 66 20 76 61 6c 0a (res (if val.
7e80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7e90: 20 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 (string->numbe
7ea0: 72 20 28 73 74 72 69 6e 67 2d 73 75 62 73 74 69 r (string-substi
7eb0: 74 75 74 65 20 22 5c 5c 73 2b 22 20 22 22 20 76 tute "\\s+" "" v
7ec0: 61 6c 20 23 74 29 29 0a 20 20 20 20 20 20 20 20 al #t)).
7ed0: 20 20 20 20 20 20 20 20 20 20 23 66 29 29 29 0a #f))).
7ee0: 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 28 (cond. (
7ef0: 72 65 73 20 20 72 65 73 29 0a 20 20 20 20 20 28 res res). (
7f00: 76 61 6c 20 20 28 64 65 62 75 67 3a 70 72 69 6e val (debug:prin
7f10: 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 0 *default-log
7f20: 2d 70 6f 72 74 2a 20 22 45 52 52 4f 52 3a 20 6e -port* "ERROR: n
7f30: 6f 20 6e 75 6d 62 65 72 20 66 6f 75 6e 64 20 66 o number found f
7f40: 6f 72 20 5b 22 20 73 65 63 74 69 6f 6e 20 22 5d or [" section "]
7f50: 2c 20 22 20 76 61 72 6e 61 6d 65 20 22 2c 20 67 , " varname ", g
7f60: 6f 74 3a 20 22 20 76 61 6c 29 29 0a 20 20 20 20 ot: " val)).
7f70: 20 28 65 6c 73 65 20 64 65 66 61 75 6c 74 29 29 (else default))
7f80: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e ))..(define (con
7f90: 66 69 67 66 3a 73 65 63 74 69 6f 6e 2d 76 61 72 figf:section-var
7fa0: 73 20 63 66 67 64 61 74 20 73 65 63 74 69 6f 6e s cfgdat section
7fb0: 29 0a 20 20 28 6c 65 74 20 28 28 73 65 63 74 64 ). (let ((sectd
7fc0: 61 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 at (hash-table-r
7fd0: 65 66 2f 64 65 66 61 75 6c 74 20 63 66 67 64 61 ef/default cfgda
7fe0: 74 20 73 65 63 74 69 6f 6e 20 27 28 29 29 29 29 t section '())))
7ff0: 0a 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 . (if (null?
8000: 73 65 63 74 64 61 74 29 0a 09 27 28 29 0a 09 28 sectdat)..'()..(
8010: 6d 61 70 20 63 61 72 20 73 65 63 74 64 61 74 29 map car sectdat)
8020: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f )))..(define (co
8030: 6e 66 69 67 66 3a 67 65 74 2d 73 65 63 74 69 6f nfigf:get-sectio
8040: 6e 20 63 66 67 64 61 74 20 73 65 63 74 69 6f 6e n cfgdat section
8050: 29 0a 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d ). (hash-table-
8060: 72 65 66 2f 64 65 66 61 75 6c 74 20 63 66 67 64 ref/default cfgd
8070: 61 74 20 73 65 63 74 69 6f 6e 20 27 28 29 29 29 at section '()))
8080: 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 ..(define (confi
8090: 67 66 3a 73 65 74 2d 73 65 63 74 69 6f 6e 2d 76 gf:set-section-v
80a0: 61 72 20 63 66 67 64 61 74 20 73 65 63 74 69 6f ar cfgdat sectio
80b0: 6e 20 76 61 72 20 76 61 6c 29 0a 20 20 28 6c 65 n var val). (le
80c0: 74 20 28 28 73 65 63 74 64 61 74 20 28 63 6f 6e t ((sectdat (con
80d0: 66 69 67 66 3a 67 65 74 2d 73 65 63 74 69 6f 6e figf:get-section
80e0: 20 63 66 67 64 61 74 20 73 65 63 74 69 6f 6e 29 cfgdat section)
80f0: 29 29 0a 20 20 20 20 28 68 61 73 68 2d 74 61 62 )). (hash-tab
8100: 6c 65 2d 73 65 74 21 20 63 66 67 64 61 74 20 73 le-set! cfgdat s
8110: 65 63 74 69 6f 6e 0a 20 20 20 20 20 20 20 20 20 ection.
8120: 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e (con
8130: 66 69 67 66 3a 61 73 73 6f 63 2d 73 61 66 65 2d figf:assoc-safe-
8140: 61 64 64 20 73 65 63 74 64 61 74 20 76 61 72 20 add sectdat var
8150: 76 61 6c 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d val))))..;;=====
8160: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 3b 3b 28 61 70 70 65 6e 64 20 28 66 69 6c =.;;(append (fil
81b0: 74 65 72 20 28 6c 61 6d 62 64 61 20 28 78 29 28 ter (lambda (x)(
81c0: 6e 6f 74 20 28 61 73 73 6f 63 20 76 61 72 20 73 not (assoc var s
81d0: 65 63 74 64 61 74 29 29 29 20 73 65 63 74 64 61 ectdat))) sectda
81e0: 74 29 0a 3b 3b 09 20 20 20 20 28 6c 69 73 74 20 t).;;. (list
81f0: 76 61 72 20 76 61 6c 29 29 29 29 0a 0a 28 64 65 var val))))..(de
8200: 66 69 6e 65 20 28 73 65 74 75 70 29 0a 20 20 28 fine (setup). (
8210: 6c 65 74 2a 20 28 28 63 6f 6e 66 69 67 66 20 28 let* ((configf (
8220: 66 69 6e 64 2d 63 6f 6e 66 69 67 20 22 6d 65 67 find-config "meg
8230: 61 74 65 73 74 2e 63 6f 6e 66 69 67 22 29 29 0a atest.config")).
8240: 09 20 28 63 6f 6e 66 69 67 20 20 28 69 66 20 63 . (config (if c
8250: 6f 6e 66 69 67 66 20 28 72 65 61 64 2d 63 6f 6e onfigf (read-con
8260: 66 69 67 20 63 6f 6e 66 69 67 66 20 23 66 20 23 fig configf #f #
8270: 74 29 20 23 66 29 29 29 0a 20 20 20 20 28 69 66 t) #f))). (if
8280: 20 63 6f 6e 66 69 67 0a 09 28 73 65 74 65 6e 76 config..(setenv
8290: 20 22 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 22 "RUN_AREA_HOME"
82a0: 20 28 70 61 74 68 6e 61 6d 65 2d 64 69 72 65 63 (pathname-direc
82b0: 74 6f 72 79 20 63 6f 6e 66 69 67 66 29 29 29 0a tory configf))).
82c0: 20 20 20 20 63 6f 6e 66 69 67 29 29 0a 0a 3b 3b config))..;;
82d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
82e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
82f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8300: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8310: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4e 6f 6e 20 64 65 ======.;; Non de
8320: 73 74 72 75 63 74 69 76 65 20 77 72 69 74 69 6e structive writin
8330: 67 20 6f 66 20 63 6f 6e 66 69 67 20 66 69 6c 65 g of config file
8340: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
8350: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8360: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8370: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8380: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 =========..(defi
8390: 6e 65 20 28 63 6f 6e 66 69 67 66 3a 63 6f 6d 70 ne (configf:comp
83a0: 72 65 73 73 2d 6d 75 6c 74 69 2d 6c 69 6e 65 73 ress-multi-lines
83b0: 20 66 64 61 74 29 0a 20 20 3b 3b 20 73 74 65 70 fdat). ;; step
83c0: 20 31 2e 35 20 2d 20 63 6f 6d 70 72 65 73 73 20 1.5 - compress
83d0: 61 6e 79 20 63 6f 6e 74 69 6e 75 65 64 20 6c 69 any continued li
83e0: 6e 65 73 0a 20 20 28 69 66 20 28 6e 75 6c 6c 3f nes. (if (null?
83f0: 20 66 64 61 74 29 20 66 64 61 74 0a 09 28 6c 65 fdat) fdat..(le
8400: 74 20 6c 6f 6f 70 20 28 28 68 65 64 20 28 63 61 t loop ((hed (ca
8410: 72 20 66 64 61 74 29 29 0a 09 09 20 20 20 28 74 r fdat))... (t
8420: 61 6c 20 28 63 64 72 20 66 64 61 74 29 29 0a 09 al (cdr fdat))..
8430: 09 20 20 20 28 63 75 72 20 22 22 29 0a 09 09 20 . (cur "")...
8440: 20 20 28 6c 65 64 20 23 66 29 0a 09 09 20 20 20 (led #f)...
8450: 28 72 65 73 20 27 28 29 29 29 0a 09 20 20 3b 3b (res '())).. ;;
8460: 20 41 4c 4c 20 57 48 49 54 45 53 50 41 43 45 20 ALL WHITESPACE
8470: 4c 45 41 44 49 4e 47 20 4c 49 4e 45 53 20 41 52 LEADING LINES AR
8480: 45 20 54 41 43 4b 45 44 20 4f 4e 21 21 0a 09 20 E TACKED ON!!..
8490: 20 3b 3b 20 20 31 2e 20 72 65 6d 6f 76 65 20 6c ;; 1. remove l
84a0: 65 64 20 77 68 69 74 65 73 70 61 63 65 0a 09 20 ed whitespace..
84b0: 20 3b 3b 20 20 32 2e 20 74 61 63 6b 20 6f 6e 20 ;; 2. tack on
84c0: 74 6f 20 68 65 64 20 77 69 74 68 20 22 5c 6e 22 to hed with "\n"
84d0: 0a 09 20 20 28 6c 65 74 20 28 28 6d 61 74 63 68 .. (let ((match
84e0: 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 63 (string-match c
84f0: 6f 6e 66 69 67 66 3a 63 6f 6e 74 2d 6c 6e 2d 72 onfigf:cont-ln-r
8500: 78 20 68 65 64 29 29 29 0a 09 20 20 20 20 28 69 x hed))).. (i
8510: 66 20 6d 61 74 63 68 20 3b 3b 20 62 6c 61 73 74 f match ;; blast
8520: 21 20 68 61 76 65 20 74 6f 20 64 65 61 6c 20 77 ! have to deal w
8530: 69 74 68 20 61 20 6d 75 6c 74 69 6c 69 6e 65 0a ith a multiline.
8540: 09 09 28 6c 65 74 2a 20 28 28 6c 65 61 64 20 28 ..(let* ((lead (
8550: 63 61 64 72 20 6d 61 74 63 68 29 29 0a 09 09 20 cadr match))...
8560: 20 20 20 20 20 20 28 6c 76 61 6c 20 28 63 61 64 (lval (cad
8570: 64 72 20 6d 61 74 63 68 29 29 0a 09 09 20 20 20 dr match))...
8580: 20 20 20 20 28 6e 65 77 6c 20 28 63 6f 6e 63 20 (newl (conc
8590: 63 75 72 20 22 5c 6e 22 20 6c 76 61 6c 29 29 29 cur "\n" lval)))
85a0: 0a 09 09 20 20 28 69 66 20 28 6e 6f 74 20 6c 65 ... (if (not le
85b0: 64 29 28 73 65 74 21 20 6c 65 64 20 6c 65 61 64 d)(set! led lead
85c0: 29 29 0a 09 09 20 20 28 69 66 20 28 6e 75 6c 6c ))... (if (null
85d0: 3f 20 74 61 6c 29 20 0a 09 09 20 20 20 20 20 20 ? tal) ...
85e0: 28 73 65 74 21 20 66 64 61 74 20 28 61 70 70 65 (set! fdat (appe
85f0: 6e 64 20 66 64 61 74 20 28 6c 69 73 74 20 6e 65 nd fdat (list ne
8600: 77 6c 29 29 29 0a 09 09 20 20 20 20 20 20 28 6c wl)))... (l
8610: 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 28 63 64 oop (car tal)(cd
8620: 72 20 74 61 6c 29 20 6e 65 77 6c 20 6c 65 64 20 r tal) newl led
8630: 72 65 73 29 29 29 20 3b 3b 20 4e 42 2f 2f 20 6e res))) ;; NB// n
8640: 6f 74 20 74 61 63 6b 69 6e 67 20 6e 65 77 6c 20 ot tacking newl
8650: 6f 6e 74 6f 20 72 65 73 0a 09 09 28 6c 65 74 20 onto res...(let
8660: 28 28 6e 65 77 72 65 73 20 28 69 66 20 6c 65 64 ((newres (if led
8670: 20 0a 09 09 09 09 20 20 28 61 70 70 65 6e 64 20 ..... (append
8680: 72 65 73 20 28 6c 69 73 74 20 63 75 72 20 68 65 res (list cur he
8690: 64 29 29 0a 09 09 09 09 20 20 28 61 70 70 65 6e d))..... (appen
86a0: 64 20 72 65 73 20 28 6c 69 73 74 20 68 65 64 29 d res (list hed)
86b0: 29 29 29 29 0a 09 09 20 20 3b 3b 20 70 72 65 76 ))))... ;; prev
86c0: 20 77 61 73 20 61 20 6d 75 6c 74 69 6c 69 6e 65 was a multiline
86d0: 0a 09 09 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 ... (if (null?
86e0: 74 61 6c 29 0a 09 09 20 20 20 20 20 20 6e 65 77 tal)... new
86f0: 72 65 73 0a 09 09 20 20 20 20 20 20 28 6c 6f 6f res... (loo
8700: 70 20 28 63 61 72 20 74 61 6c 29 28 63 64 72 20 p (car tal)(cdr
8710: 74 61 6c 29 20 22 22 20 23 66 20 6e 65 77 72 65 tal) "" #f newre
8720: 73 29 29 29 29 29 29 29 29 0a 0a 3b 3b 20 6e 6f s))))))))..;; no
8730: 74 65 3a 20 49 27 6d 20 63 68 65 61 74 69 6e 67 te: I'm cheating
8740: 20 61 20 6c 69 74 74 6c 65 20 68 65 72 65 2e 20 a little here.
8750: 49 20 6d 65 72 65 6c 79 20 72 65 70 6c 61 63 65 I merely replace
8760: 20 22 5c 6e 22 20 77 69 74 68 20 22 5c 6e 20 20 "\n" with "\n
8770: 20 20 20 20 20 20 20 22 0a 28 64 65 66 69 6e 65 ".(define
8780: 20 28 63 6f 6e 66 69 67 66 3a 65 78 70 61 6e 64 (configf:expand
8790: 2d 6d 75 6c 74 69 2d 6c 69 6e 65 73 20 66 64 61 -multi-lines fda
87a0: 74 29 0a 20 20 3b 3b 20 73 74 65 70 20 31 2e 35 t). ;; step 1.5
87b0: 20 2d 20 63 6f 6d 70 72 65 73 73 20 61 6e 79 20 - compress any
87c0: 63 6f 6e 74 69 6e 75 65 64 20 6c 69 6e 65 73 0a continued lines.
87d0: 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 66 64 61 (if (null? fda
87e0: 74 29 20 66 64 61 74 0a 20 20 20 20 20 20 28 6c t) fdat. (l
87f0: 65 74 20 6c 6f 6f 70 20 28 28 68 65 64 20 28 63 et loop ((hed (c
8800: 61 72 20 66 64 61 74 29 29 0a 09 09 20 28 74 61 ar fdat))... (ta
8810: 6c 20 28 63 64 72 20 66 64 61 74 29 29 0a 09 09 l (cdr fdat))...
8820: 20 28 72 65 73 20 27 28 29 29 29 0a 09 28 6c 65 (res '()))..(le
8830: 74 20 28 28 6e 65 77 72 65 73 20 28 61 70 70 65 t ((newres (appe
8840: 6e 64 20 72 65 73 20 28 6c 69 73 74 20 28 73 74 nd res (list (st
8850: 72 69 6e 67 2d 73 75 62 73 74 69 74 75 74 65 20 ring-substitute
8860: 28 72 65 67 65 78 70 20 22 5c 6e 22 29 20 22 5c (regexp "\n") "\
8870: 6e 20 20 20 20 20 20 20 20 20 22 20 68 65 64 20 n " hed
8880: 23 74 29 29 29 29 29 0a 09 20 20 28 69 66 20 28 #t))))).. (if (
8890: 6e 75 6c 6c 3f 20 74 61 6c 29 0a 09 20 20 20 20 null? tal)..
88a0: 20 20 6e 65 77 72 65 73 0a 09 20 20 20 20 20 20 newres..
88b0: 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 28 (loop (car tal)(
88c0: 63 64 72 20 74 61 6c 29 20 6e 65 77 72 65 73 29 cdr tal) newres)
88d0: 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 )))))..(define (
88e0: 63 6f 6e 66 69 67 66 3a 66 69 6c 65 2d 3e 6c 69 configf:file->li
88f0: 73 74 20 66 6e 61 6d 65 29 0a 20 20 28 69 66 20 st fname). (if
8900: 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 69 (common:file-exi
8910: 73 74 73 3f 20 66 6e 61 6d 65 29 0a 20 20 20 20 sts? fname).
8920: 20 20 28 6c 65 74 20 28 28 69 6e 70 20 28 6f 70 (let ((inp (op
8930: 65 6e 2d 69 6e 70 75 74 2d 66 69 6c 65 20 66 6e en-input-file fn
8940: 61 6d 65 29 29 29 0a 09 28 6c 65 74 20 6c 6f 6f ame)))..(let loo
8950: 70 20 28 28 69 6e 6c 20 28 72 65 61 64 2d 6c 69 p ((inl (read-li
8960: 6e 65 20 69 6e 70 29 29 0a 09 09 20 20 20 28 72 ne inp))... (r
8970: 65 73 20 27 28 29 29 29 0a 09 20 20 28 69 66 20 es '())).. (if
8980: 28 65 6f 66 2d 6f 62 6a 65 63 74 3f 20 69 6e 6c (eof-object? inl
8990: 29 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a ).. (begin.
89a0: 09 09 28 63 6c 6f 73 65 2d 69 6e 70 75 74 2d 70 ..(close-input-p
89b0: 6f 72 74 20 69 6e 70 29 0a 09 09 28 72 65 76 65 ort inp)...(reve
89c0: 72 73 65 20 72 65 73 29 29 0a 09 20 20 20 20 20 rse res))..
89d0: 20 28 6c 6f 6f 70 20 28 72 65 61 64 2d 6c 69 6e (loop (read-lin
89e0: 65 20 69 6e 70 29 28 63 6f 6e 73 20 69 6e 6c 20 e inp)(cons inl
89f0: 72 65 73 29 29 29 29 29 0a 20 20 20 20 20 20 27 res))))). '
8a00: 28 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d ()))..;;========
8a10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8a20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8a30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8a40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
8a50: 3b 20 57 72 69 74 65 20 61 20 63 6f 6e 66 69 67 ; Write a config
8a60: 0a 3b 3b 20 20 20 30 2e 20 47 69 76 65 6e 20 61 .;; 0. Given a
8a70: 20 72 65 66 65 72 65 72 65 6e 63 65 20 64 61 74 refererence dat
8a80: 61 20 73 74 72 75 63 74 75 72 65 20 22 69 6e 64 a structure "ind
8a90: 61 74 22 0a 3b 3b 20 20 20 31 2e 20 4f 70 65 6e at".;; 1. Open
8aa0: 20 74 68 65 20 6f 75 74 70 75 74 20 66 69 6c 65 the output file
8ab0: 20 61 6e 64 20 72 65 61 64 20 69 74 20 69 6e 74 and read it int
8ac0: 6f 20 61 20 6c 69 73 74 0a 3b 3b 20 20 20 32 2e o a list.;; 2.
8ad0: 20 46 6c 61 74 74 65 6e 20 61 6e 79 20 6d 75 6c Flatten any mul
8ae0: 74 69 6c 69 6e 65 20 65 6e 74 72 69 65 73 0a 3b tiline entries.;
8af0: 3b 20 20 20 33 2e 20 4d 6f 64 69 66 79 20 76 61 ; 3. Modify va
8b00: 6c 75 65 73 20 70 65 72 20 63 6f 6e 74 65 6e 74 lues per content
8b10: 73 20 6f 66 20 22 69 6e 64 61 74 22 20 61 6e 64 s of "indat" and
8b20: 20 72 65 6d 6f 76 65 20 61 62 73 65 6e 74 20 76 remove absent v
8b30: 61 6c 75 65 73 0a 3b 3b 20 20 20 34 2e 20 41 70 alues.;; 4. Ap
8b40: 70 65 6e 64 20 6e 65 77 20 76 61 6c 75 65 73 20 pend new values
8b50: 74 6f 20 74 68 65 20 73 65 63 74 69 6f 6e 20 28 to the section (
8b60: 69 6d 6d 65 64 69 61 74 65 6c 79 20 61 66 74 65 immediately afte
8b70: 72 20 6c 61 73 74 20 6c 65 67 69 74 20 65 6e 74 r last legit ent
8b80: 72 79 29 0a 3b 3b 20 20 20 35 2e 20 57 72 69 74 ry).;; 5. Writ
8b90: 65 20 6f 75 74 20 74 68 65 20 6e 65 77 20 6c 69 e out the new li
8ba0: 73 74 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d st .;;==========
8bb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8bc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8bd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8be0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 ============..(d
8bf0: 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a 77 efine (configf:w
8c00: 72 69 74 65 2d 63 6f 6e 66 69 67 20 69 6e 64 61 rite-config inda
8c10: 74 20 66 6e 61 6d 65 20 23 21 6b 65 79 20 28 72 t fname #!key (r
8c20: 65 71 75 69 72 65 64 2d 73 65 63 74 69 6f 6e 73 equired-sections
8c30: 20 27 28 29 29 29 0a 20 20 28 6c 65 74 2a 20 28 '())). (let* (
8c40: 3b 3b 20 73 74 65 70 20 31 3a 20 4f 70 65 6e 20 ;; step 1: Open
8c50: 74 68 65 20 6f 75 74 70 75 74 20 66 69 6c 65 20 the output file
8c60: 61 6e 64 20 72 65 61 64 20 69 74 20 69 6e 74 6f and read it into
8c70: 20 61 20 6c 69 73 74 0a 09 20 28 66 64 61 74 20 a list.. (fdat
8c80: 20 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 66 (configf:f
8c90: 69 6c 65 2d 3e 6c 69 73 74 20 66 6e 61 6d 65 29 ile->list fname)
8ca0: 29 0a 09 20 28 72 65 66 64 61 74 20 20 28 6d 61 ).. (refdat (ma
8cb0: 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a ke-hash-table)).
8cc0: 09 20 28 73 65 63 68 61 73 68 20 28 6d 61 6b 65 . (sechash (make
8cd0: 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 20 3b 3b -hash-table)) ;;
8ce0: 20 63 75 72 72 65 6e 74 20 73 65 63 74 69 6f 6e current section
8cf0: 20 68 61 73 68 2c 20 69 6e 69 74 20 77 69 74 68 hash, init with
8d00: 20 68 61 73 68 20 66 6f 72 20 22 64 65 66 61 75 hash for "defau
8d10: 6c 74 22 20 73 65 63 74 69 6f 6e 0a 09 20 28 6e lt" section.. (n
8d20: 65 77 20 20 20 20 20 23 66 29 20 3b 3b 20 70 75 ew #f) ;; pu
8d30: 74 20 74 68 65 20 6c 69 6e 65 20 74 6f 20 62 65 t the line to be
8d40: 20 75 73 65 64 20 69 6e 20 6e 65 77 2c 20 69 66 used in new, if
8d50: 20 69 74 20 69 73 20 74 6f 20 62 65 20 64 65 6c it is to be del
8d60: 65 74 65 64 20 74 68 65 20 73 65 74 20 6e 65 77 eted the set new
8d70: 20 74 6f 20 23 66 0a 09 20 28 73 65 63 6e 61 6d to #f.. (secnam
8d80: 65 20 23 66 29 29 0a 0a 20 20 20 20 3b 3b 20 73 e #f)).. ;; s
8d90: 74 65 70 20 32 3a 20 46 6c 61 74 74 65 6e 20 6d tep 2: Flatten m
8da0: 75 6c 74 69 6c 69 6e 65 20 65 6e 74 72 69 65 73 ultiline entries
8db0: 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6e . (if (not (n
8dc0: 75 6c 6c 3f 20 66 64 61 74 29 29 28 73 65 74 21 ull? fdat))(set!
8dd0: 20 66 64 61 74 20 28 63 6f 6e 66 69 67 66 3a 63 fdat (configf:c
8de0: 6f 6d 70 72 65 73 73 2d 6d 75 6c 74 69 2d 6c 69 ompress-multi-li
8df0: 6e 65 73 20 66 64 61 74 29 29 29 0a 0a 20 20 20 nes fdat)))..
8e00: 20 3b 3b 20 73 74 65 70 20 33 3a 20 4d 6f 64 69 ;; step 3: Modi
8e10: 66 79 20 76 61 6c 75 65 73 20 70 65 72 20 63 6f fy values per co
8e20: 6e 74 65 6e 74 73 20 6f 66 20 22 69 6e 64 61 74 ntents of "indat
8e30: 22 20 61 6e 64 20 72 65 6d 6f 76 65 20 61 62 73 " and remove abs
8e40: 65 6e 74 20 76 61 6c 75 65 73 0a 20 20 20 20 28 ent values. (
8e50: 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 66 if (not (null? f
8e60: 64 61 74 29 29 0a 09 28 6c 65 74 20 6c 6f 6f 70 dat))..(let loop
8e70: 20 28 28 68 65 64 20 20 28 63 61 72 20 66 64 61 ((hed (car fda
8e80: 74 29 29 0a 09 09 20 20 20 28 74 61 6c 20 20 28 t))... (tal (
8e90: 63 61 64 72 20 66 64 61 74 29 29 0a 09 09 20 20 cadr fdat))...
8ea0: 20 28 72 65 73 20 20 27 28 29 29 0a 09 09 20 20 (res '())...
8eb0: 20 28 6c 6e 75 6d 20 30 29 29 0a 09 20 20 28 72 (lnum 0)).. (r
8ec0: 65 67 65 78 2d 63 61 73 65 20 0a 09 20 20 20 68 egex-case .. h
8ed0: 65 64 0a 09 20 20 20 28 63 6f 6e 66 69 67 66 3a ed.. (configf:
8ee0: 63 6f 6d 6d 65 6e 74 2d 72 78 20 5f 20 20 20 20 comment-rx _
8ef0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 (s
8f00: 65 74 21 20 72 65 73 20 28 61 70 70 65 6e 64 20 et! res (append
8f10: 72 65 73 20 28 6c 69 73 74 20 68 65 64 29 29 29 res (list hed)))
8f20: 29 20 3b 3b 20 28 6c 6f 6f 70 20 28 72 65 61 64 ) ;; (loop (read
8f30: 2d 6c 69 6e 65 20 69 6e 70 29 20 63 75 72 72 2d -line inp) curr-
8f40: 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 section-name #f
8f50: 23 66 29 29 0a 09 20 20 20 28 63 6f 6e 66 69 67 #f)).. (config
8f60: 66 3a 62 6c 61 6e 6b 2d 6c 2d 72 78 20 5f 20 20 f:blank-l-rx _
8f70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8f80: 28 73 65 74 21 20 72 65 73 20 28 61 70 70 65 6e (set! res (appen
8f90: 64 20 72 65 73 20 28 6c 69 73 74 20 68 65 64 29 d res (list hed)
8fa0: 29 29 29 20 3b 3b 20 28 6c 6f 6f 70 20 28 72 65 ))) ;; (loop (re
8fb0: 61 64 2d 6c 69 6e 65 20 69 6e 70 29 20 63 75 72 ad-line inp) cur
8fc0: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 r-section-name #
8fd0: 66 20 23 66 29 29 0a 09 20 20 20 28 63 6f 6e 66 f #f)).. (conf
8fe0: 69 67 66 3a 73 65 63 74 69 6f 6e 2d 72 78 20 28 igf:section-rx (
8ff0: 20 78 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 x section-name
9000: 29 20 28 6c 65 74 20 28 28 73 65 63 74 69 6f 6e ) (let ((section
9010: 2d 68 61 73 68 20 28 68 61 73 68 2d 74 61 62 6c -hash (hash-tabl
9020: 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 72 65 e-ref/default re
9030: 66 64 61 74 20 73 65 63 74 69 6f 6e 2d 6e 61 6d fdat section-nam
9040: 65 20 23 66 29 29 29 0a 09 09 09 09 09 20 20 20 e #f)))......
9050: 20 28 69 66 20 28 6e 6f 74 20 73 65 63 74 69 6f (if (not sectio
9060: 6e 2d 68 61 73 68 29 0a 09 09 09 09 09 09 28 6c n-hash).......(l
9070: 65 74 20 28 28 6e 65 77 68 61 73 68 20 28 6d 61 et ((newhash (ma
9080: 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 29 ke-hash-table)))
9090: 0a 09 09 09 09 09 09 20 20 28 68 61 73 68 2d 74 ....... (hash-t
90a0: 61 62 6c 65 2d 73 65 74 21 20 72 65 66 64 61 74 able-set! refdat
90b0: 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 6e 65 section-name ne
90c0: 77 68 61 73 68 29 20 3b 3b 20 77 61 73 20 72 65 whash) ;; was re
90d0: 66 68 61 73 68 20 2d 20 6e 6f 74 20 73 75 72 65 fhash - not sure
90e0: 20 74 68 61 74 20 72 65 66 64 61 74 20 69 73 20 that refdat is
90f0: 63 6f 72 72 65 63 74 20 68 65 72 65 0a 09 09 09 correct here....
9100: 09 09 09 20 20 28 73 65 74 21 20 73 65 63 68 61 ... (set! secha
9110: 73 68 20 6e 65 77 68 61 73 68 29 29 0a 09 09 09 sh newhash))....
9120: 09 09 09 28 73 65 74 21 20 73 65 63 68 61 73 68 ...(set! sechash
9130: 20 73 65 63 74 69 6f 6e 2d 68 61 73 68 29 29 0a section-hash)).
9140: 09 09 09 09 09 20 20 20 20 28 73 65 74 21 20 6e ..... (set! n
9150: 65 77 20 68 65 64 29 20 3b 3b 20 77 69 6c 6c 20 ew hed) ;; will
9160: 61 70 70 65 6e 64 20 74 68 69 73 20 61 74 20 74 append this at t
9170: 68 65 20 62 6f 74 74 6f 6d 20 6f 66 20 74 68 65 he bottom of the
9180: 20 6c 6f 6f 70 0a 09 09 09 09 09 20 20 20 20 28 loop...... (
9190: 73 65 74 21 20 73 65 63 6e 61 6d 65 20 73 65 63 set! secname sec
91a0: 74 69 6f 6e 2d 6e 61 6d 65 29 0a 09 09 09 09 09 tion-name)......
91b0: 20 20 20 20 29 29 0a 09 20 20 20 3b 3b 20 4e 6f )).. ;; No
91c0: 20 6e 65 65 64 20 74 6f 20 70 72 6f 63 65 73 73 need to process
91d0: 20 6b 65 79 20 63 6d 64 2c 20 6c 65 74 20 69 74 key cmd, let it
91e0: 20 66 61 6c 6c 20 74 68 6f 75 67 68 20 74 6f 20 fall though to
91f0: 6b 65 79 20 76 61 6c 0a 09 20 20 20 28 63 6f 6e key val.. (con
9200: 66 69 67 66 3a 6b 65 79 2d 76 61 6c 2d 70 72 20 figf:key-val-pr
9210: 28 20 78 20 6b 65 79 20 76 61 6c 20 20 20 20 20 ( x key val
9220: 20 29 0a 09 09 20 20 20 20 20 20 20 28 6c 65 74 )... (let
9230: 20 28 28 6e 65 77 76 61 6c 20 28 63 6f 6e 66 69 ((newval (confi
9240: 67 66 3a 6c 6f 6f 6b 75 70 20 69 6e 64 61 74 20 gf:lookup indat
9250: 73 65 63 6e 61 6d 65 20 6b 65 79 29 29 29 20 3b secname key))) ;
9260: 3b 20 77 61 73 20 73 65 63 2c 20 62 75 67 20 6f ; was sec, bug o
9270: 72 20 63 6f 72 72 65 63 74 3f 0a 09 09 09 20 3b r correct?.... ;
9280: 3b 20 63 61 6e 20 68 61 6e 64 6c 65 20 6e 65 77 ; can handle new
9290: 76 61 6c 20 3d 3d 20 23 66 20 68 65 72 65 20 3d val == #f here =
92a0: 3e 20 74 68 61 74 20 6d 65 61 6e 73 20 6b 65 79 > that means key
92b0: 20 69 73 20 72 65 6d 6f 76 65 64 0a 09 09 09 20 is removed....
92c0: 28 63 6f 6e 64 20 0a 09 09 09 20 20 28 28 65 71 (cond .... ((eq
92d0: 75 61 6c 3f 20 6e 65 77 76 61 6c 20 76 61 6c 29 ual? newval val)
92e0: 0a 09 09 09 20 20 20 28 73 65 74 21 20 72 65 73 .... (set! res
92f0: 20 28 61 70 70 65 6e 64 20 72 65 73 20 28 6c 69 (append res (li
9300: 73 74 20 68 65 64 29 29 29 29 0a 09 09 09 20 20 st hed))))....
9310: 28 28 6e 6f 74 20 6e 65 77 76 61 6c 29 20 3b 3b ((not newval) ;;
9320: 20 6b 65 79 20 68 61 73 20 62 65 65 6e 20 72 65 key has been re
9330: 6d 6f 76 65 64 0a 09 09 09 20 20 20 28 73 65 74 moved.... (set
9340: 21 20 6e 65 77 20 23 66 29 29 0a 09 09 09 20 20 ! new #f))....
9350: 28 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 6e 65 ((not (equal? ne
9360: 77 76 61 6c 20 76 61 6c 29 29 0a 09 09 09 20 20 wval val))....
9370: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 (hash-table-s
9380: 65 74 21 20 73 65 63 68 61 73 68 20 6b 65 79 20 et! sechash key
9390: 6e 65 77 76 61 6c 29 0a 09 09 09 20 20 20 20 20 newval)....
93a0: 28 73 65 74 21 20 6e 65 77 20 28 63 6f 6e 63 20 (set! new (conc
93b0: 6b 65 79 20 22 20 22 20 6e 65 77 76 61 6c 29 29 key " " newval))
93c0: 29 0a 09 09 09 20 20 28 65 6c 73 65 0a 09 09 09 ).... (else....
93d0: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d (debug:print-
93e0: 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 error 0 *default
93f0: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 70 72 6f 62 -log-port* "prob
9400: 6c 65 6d 20 70 61 72 73 69 6e 67 20 6c 69 6e 65 lem parsing line
9410: 20 6e 75 6d 62 65 72 20 22 20 6c 6e 75 6d 20 22 number " lnum "
9420: 5c 22 22 20 68 65 64 20 22 5c 22 22 29 29 29 29 \"" hed "\""))))
9430: 29 0a 09 20 20 20 28 65 6c 73 65 0a 09 20 20 20 ).. (else..
9440: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 (debug:print-er
9450: 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c ror 0 *default-l
9460: 6f 67 2d 70 6f 72 74 2a 20 22 50 72 6f 62 6c 65 og-port* "Proble
9470: 6d 20 70 61 72 73 69 6e 67 20 6c 69 6e 65 20 6e m parsing line n
9480: 75 6d 20 22 20 6c 6e 75 6d 20 22 20 3a 5c 6e 20 um " lnum " :\n
9490: 20 20 22 20 68 65 64 20 29 29 29 0a 09 20 20 28 " hed ))).. (
94a0: 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 74 if (not (null? t
94b0: 61 6c 29 29 0a 09 20 20 20 20 20 20 28 6c 6f 6f al)).. (loo
94c0: 70 20 28 63 61 72 20 74 61 6c 29 28 63 64 72 20 p (car tal)(cdr
94d0: 74 61 6c 29 28 69 66 20 6e 65 77 20 28 61 70 70 tal)(if new (app
94e0: 65 6e 64 20 72 65 73 20 28 6c 69 73 74 20 6e 65 end res (list ne
94f0: 77 29 29 20 72 65 73 29 28 2b 20 6c 6e 75 6d 20 w)) res)(+ lnum
9500: 31 29 29 29 0a 09 20 20 3b 3b 20 64 72 6f 70 20 1))).. ;; drop
9510: 74 6f 20 68 65 72 65 20 77 68 65 6e 20 64 6f 6e to here when don
9520: 65 20 70 72 6f 63 65 73 73 69 6e 67 2c 20 72 65 e processing, re
9530: 73 20 63 6f 6e 74 61 69 6e 73 20 6d 6f 64 69 66 s contains modif
9540: 69 65 64 20 6c 69 73 74 20 6f 66 20 6c 69 6e 65 ied list of line
9550: 73 0a 09 20 20 28 73 65 74 21 20 66 64 61 74 20 s.. (set! fdat
9560: 72 65 73 29 29 29 0a 0a 20 20 20 20 3b 3b 20 73 res))).. ;; s
9570: 74 65 70 20 34 3a 20 41 70 70 65 6e 64 20 6e 65 tep 4: Append ne
9580: 77 20 76 61 6c 75 65 73 20 74 6f 20 74 68 65 20 w values to the
9590: 73 65 63 74 69 6f 6e 0a 20 20 20 20 28 66 6f 72 section. (for
95a0: 2d 65 61 63 68 20 0a 20 20 20 20 20 28 6c 61 6d -each . (lam
95b0: 62 64 61 20 28 73 65 63 74 69 6f 6e 29 0a 20 20 bda (section).
95c0: 20 20 20 20 20 28 6c 65 74 20 28 28 73 64 61 74 (let ((sdat
95d0: 20 20 20 27 28 29 29 20 3b 3b 20 61 70 70 65 6e '()) ;; appen
95e0: 64 20 6e 65 65 64 65 64 20 62 69 74 73 20 68 65 d needed bits he
95f0: 72 65 0a 09 20 20 20 20 20 28 73 76 61 72 73 20 re.. (svars
9600: 20 28 63 6f 6e 66 69 67 66 3a 73 65 63 74 69 6f (configf:sectio
9610: 6e 2d 76 61 72 73 20 69 6e 64 61 74 20 73 65 63 n-vars indat sec
9620: 74 69 6f 6e 29 29 29 0a 09 20 28 66 6f 72 2d 65 tion))).. (for-e
9630: 61 63 68 20 0a 09 20 20 28 6c 61 6d 62 64 61 20 ach .. (lambda
9640: 28 76 61 72 29 0a 09 20 20 20 20 28 6c 65 74 20 (var).. (let
9650: 28 28 76 61 6c 20 28 63 6f 6e 66 69 67 66 3a 6c ((val (configf:l
9660: 6f 6f 6b 75 70 20 72 65 66 64 61 74 20 73 65 63 ookup refdat sec
9670: 74 69 6f 6e 20 76 61 72 29 29 29 0a 09 20 20 20 tion var)))..
9680: 20 20 20 28 69 66 20 28 6e 6f 74 20 76 61 6c 29 (if (not val)
9690: 20 3b 3b 20 74 68 69 73 20 6f 6e 65 20 69 73 20 ;; this one is
96a0: 6e 65 77 0a 09 09 20 20 28 62 65 67 69 6e 0a 09 new... (begin..
96b0: 09 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 . (if (null?
96c0: 73 64 61 74 29 28 73 65 74 21 20 73 64 61 74 20 sdat)(set! sdat
96d0: 28 6c 69 73 74 20 28 63 6f 6e 63 20 22 5b 22 20 (list (conc "["
96e0: 73 65 63 74 69 6f 6e 20 22 5d 22 29 29 29 29 0a section "]")))).
96f0: 09 09 20 20 20 20 28 73 65 74 21 20 73 64 61 74 .. (set! sdat
9700: 20 28 61 70 70 65 6e 64 20 73 64 61 74 20 28 6c (append sdat (l
9710: 69 73 74 20 28 63 6f 6e 63 20 76 61 72 20 22 20 ist (conc var "
9720: 22 20 76 61 6c 29 29 29 29 29 29 29 29 0a 09 20 " val))))))))..
9730: 20 73 76 61 72 73 29 0a 09 20 28 73 65 74 21 20 svars).. (set!
9740: 66 64 61 74 20 28 61 70 70 65 6e 64 20 66 64 61 fdat (append fda
9750: 74 20 73 64 61 74 29 29 29 29 0a 20 20 20 20 20 t sdat)))).
9760: 28 64 65 6c 65 74 65 2d 64 75 70 6c 69 63 61 74 (delete-duplicat
9770: 65 73 20 28 61 70 70 65 6e 64 20 72 65 71 75 69 es (append requi
9780: 72 65 64 2d 73 65 63 74 69 6f 6e 73 20 28 68 61 red-sections (ha
9790: 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 69 6e sh-table-keys in
97a0: 64 61 74 29 29 29 29 0a 0a 20 20 20 20 3b 3b 20 dat)))).. ;;
97b0: 73 74 65 70 20 35 3a 20 57 72 69 74 65 20 6f 75 step 5: Write ou
97c0: 74 20 6e 65 77 20 66 69 6c 65 0a 20 20 20 20 28 t new file. (
97d0: 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 with-output-to-f
97e0: 69 6c 65 20 66 6e 61 6d 65 20 0a 20 20 20 20 20 ile fname .
97f0: 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 28 66 6f (lambda ()..(fo
9800: 72 2d 65 61 63 68 20 0a 09 20 28 6c 61 6d 62 64 r-each .. (lambd
9810: 61 20 28 6c 69 6e 65 29 0a 09 20 20 20 28 70 72 a (line).. (pr
9820: 69 6e 74 20 6c 69 6e 65 29 29 0a 09 20 28 63 6f int line)).. (co
9830: 6e 66 69 67 66 3a 65 78 70 61 6e 64 2d 6d 75 6c nfigf:expand-mul
9840: 74 69 2d 6c 69 6e 65 73 20 66 64 61 74 29 29 29 ti-lines fdat)))
9850: 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
9860: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9870: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9880: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9890: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
98a0: 20 72 65 66 64 62 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d refdb.;;=======
98b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
98c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
98d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
98e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
98f0: 0a 3b 3b 20 72 65 61 64 73 20 61 20 72 65 66 64 .;; reads a refd
9900: 62 20 69 6e 74 6f 20 61 6e 20 61 73 73 6f 63 20 b into an assoc
9910: 61 72 72 61 79 20 6f 66 20 61 73 73 6f 63 20 61 array of assoc a
9920: 72 72 61 79 73 0a 3b 3b 20 20 20 72 65 74 75 72 rrays.;; retur
9930: 6e 73 20 28 6c 69 73 74 20 64 61 74 20 6d 73 67 ns (list dat msg
9940: 29 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 ).(define (confi
9950: 67 66 3a 72 65 61 64 2d 72 65 66 64 62 20 72 65 gf:read-refdb re
9960: 66 64 62 2d 70 61 74 68 29 0a 20 20 28 6c 65 74 fdb-path). (let
9970: 20 28 28 73 68 65 65 74 73 2d 66 69 6c 65 20 20 ((sheets-file
9980: 28 63 6f 6e 63 20 72 65 66 64 62 2d 70 61 74 68 (conc refdb-path
9990: 20 22 2f 73 68 65 65 74 2d 6e 61 6d 65 73 2e 63 "/sheet-names.c
99a0: 66 67 22 29 29 29 0a 20 20 20 20 28 69 66 20 28 fg"))). (if (
99b0: 6e 6f 74 20 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 not (common:file
99c0: 2d 65 78 69 73 74 73 3f 20 73 68 65 65 74 73 2d -exists? sheets-
99d0: 66 69 6c 65 29 29 0a 09 28 6c 69 73 74 20 23 66 file))..(list #f
99e0: 20 28 63 6f 6e 63 20 22 45 52 52 4f 52 3a 20 6e (conc "ERROR: n
99f0: 6f 20 72 65 66 64 62 20 66 6f 75 6e 64 20 61 74 o refdb found at
9a00: 20 22 20 72 65 66 64 62 2d 70 61 74 68 29 29 0a " refdb-path)).
9a10: 09 28 69 66 20 28 6e 6f 74 20 28 66 69 6c 65 2d .(if (not (file-
9a20: 72 65 61 64 2d 61 63 63 65 73 73 3f 20 73 68 65 read-access? she
9a30: 65 74 73 2d 66 69 6c 65 29 29 0a 09 20 20 20 20 ets-file))..
9a40: 28 6c 69 73 74 20 23 66 20 28 63 6f 6e 63 20 22 (list #f (conc "
9a50: 45 52 52 4f 52 3a 20 72 65 66 64 62 20 66 69 6c ERROR: refdb fil
9a60: 65 20 6e 6f 74 20 72 65 61 64 61 62 6c 65 20 61 e not readable a
9a70: 74 20 22 20 72 65 66 64 62 2d 70 61 74 68 29 29 t " refdb-path))
9a80: 0a 09 20 20 20 20 28 6c 65 74 2a 20 28 28 73 68 .. (let* ((sh
9a90: 65 65 74 73 20 28 77 69 74 68 2d 69 6e 70 75 74 eets (with-input
9aa0: 2d 66 72 6f 6d 2d 66 69 6c 65 20 73 68 65 65 74 -from-file sheet
9ab0: 73 2d 66 69 6c 65 0a 09 09 09 20 20 20 20 20 28 s-file.... (
9ac0: 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 20 20 20 lambda ()....
9ad0: 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 (let loop ((
9ae0: 69 6e 6c 20 28 72 65 61 64 2d 6c 69 6e 65 29 29 inl (read-line))
9af0: 0a 09 09 09 09 09 20 20 28 72 65 73 20 27 28 29 ...... (res '()
9b00: 29 29 0a 09 09 09 09 20 28 69 66 20 28 65 6f 66 ))..... (if (eof
9b10: 2d 6f 62 6a 65 63 74 3f 20 69 6e 6c 29 0a 09 09 -object? inl)...
9b20: 09 09 20 20 20 20 20 28 72 65 76 65 72 73 65 20 .. (reverse
9b30: 72 65 73 29 0a 09 09 09 09 20 20 20 20 20 28 6c res)..... (l
9b40: 6f 6f 70 20 28 72 65 61 64 2d 6c 69 6e 65 29 28 oop (read-line)(
9b50: 63 6f 6e 73 20 69 6e 6c 20 72 65 73 29 29 29 29 cons inl res))))
9b60: 29 29 29 0a 09 09 20 20 20 28 64 61 74 61 20 20 )))... (data
9b70: 20 27 28 29 29 29 0a 09 20 20 20 20 20 20 28 66 '())).. (f
9b80: 6f 72 2d 65 61 63 68 20 0a 09 20 20 20 20 20 20 or-each ..
9b90: 20 28 6c 61 6d 62 64 61 20 28 73 68 65 65 74 2d (lambda (sheet-
9ba0: 6e 61 6d 65 29 0a 09 09 20 28 6c 65 74 2a 20 28 name)... (let* (
9bb0: 28 64 61 74 2d 70 61 74 68 20 20 28 63 6f 6e 63 (dat-path (conc
9bc0: 20 72 65 66 64 62 2d 70 61 74 68 20 22 2f 22 20 refdb-path "/"
9bd0: 73 68 65 65 74 2d 6e 61 6d 65 20 22 2e 64 61 74 sheet-name ".dat
9be0: 22 29 29 0a 09 09 09 28 72 65 66 2d 64 61 74 20 "))....(ref-dat
9bf0: 20 20 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d (configf:read-
9c00: 66 69 6c 65 20 64 61 74 2d 70 61 74 68 20 23 66 file dat-path #f
9c10: 20 23 74 29 29 0a 09 09 09 28 72 65 66 2d 61 73 #t))....(ref-as
9c20: 73 6f 63 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 soc (map (lambda
9c30: 20 28 6b 65 79 29 0a 09 09 09 09 09 20 20 28 6c (key)...... (l
9c40: 69 73 74 20 6b 65 79 20 28 68 61 73 68 2d 74 61 ist key (hash-ta
9c50: 62 6c 65 2d 72 65 66 20 72 65 66 2d 64 61 74 20 ble-ref ref-dat
9c60: 6b 65 79 29 29 29 0a 09 09 09 09 09 28 68 61 73 key)))......(has
9c70: 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 72 65 66 h-table-keys ref
9c80: 2d 64 61 74 29 29 29 29 0a 09 09 09 09 20 20 20 -dat)))).....
9c90: 3b 3b 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 3e ;; (hash-table->
9ca0: 61 6c 69 73 74 20 72 65 66 2d 64 61 74 29 29 29 alist ref-dat)))
9cb0: 0a 09 09 20 20 20 3b 3b 20 28 73 65 74 21 20 64 ... ;; (set! d
9cc0: 61 74 61 20 28 61 70 70 65 6e 64 20 64 61 74 61 ata (append data
9cd0: 20 28 6c 69 73 74 20 28 6c 69 73 74 20 73 68 65 (list (list she
9ce0: 65 74 2d 6e 61 6d 65 20 72 65 66 2d 61 73 73 6f et-name ref-asso
9cf0: 63 29 29 29 29 29 29 0a 09 09 20 20 20 28 73 65 c))))))... (se
9d00: 74 21 20 64 61 74 61 20 28 63 6f 6e 73 20 28 6c t! data (cons (l
9d10: 69 73 74 20 73 68 65 65 74 2d 6e 61 6d 65 20 72 ist sheet-name r
9d20: 65 66 2d 61 73 73 6f 63 29 20 64 61 74 61 29 29 ef-assoc) data))
9d30: 29 29 0a 09 20 20 20 20 20 20 20 73 68 65 65 74 )).. sheet
9d40: 73 29 0a 09 20 20 20 20 20 20 28 6c 69 73 74 20 s).. (list
9d50: 64 61 74 61 20 22 4e 4f 20 45 52 52 4f 52 53 22 data "NO ERRORS"
9d60: 29 29 29 29 29 29 0a 0a 3b 3b 20 6d 61 70 20 6f ))))))..;; map o
9d70: 76 65 72 20 61 6c 6c 20 70 61 69 72 73 20 69 6e ver all pairs in
9d80: 20 61 20 74 68 72 65 65 20 6c 65 76 65 6c 20 68 a three level h
9d90: 69 65 72 61 72 63 68 69 61 6c 20 61 6c 69 73 74 ierarchial alist
9da0: 20 61 6e 64 20 61 70 70 6c 79 20 61 20 66 75 6e and apply a fun
9db0: 63 74 69 6f 6e 20 74 6f 20 74 68 65 20 6b 65 79 ction to the key
9dc0: 73 2f 76 61 6c 0a 3b 3b 0a 28 64 65 66 69 6e 65 s/val.;;.(define
9dd0: 20 28 63 6f 6e 66 69 67 66 3a 6d 61 70 2d 61 6c (configf:map-al
9de0: 6c 2d 68 69 65 72 2d 61 6c 69 73 74 20 64 61 74 l-hier-alist dat
9df0: 61 20 70 72 6f 63 20 23 21 6b 65 79 20 28 69 6e a proc #!key (in
9e00: 69 74 70 72 6f 63 31 20 23 66 29 28 69 6e 69 74 itproc1 #f)(init
9e10: 70 72 6f 63 32 20 23 66 29 28 69 6e 69 74 70 72 proc2 #f)(initpr
9e20: 6f 63 33 20 23 66 29 29 0a 20 20 28 66 6f 72 2d oc3 #f)). (for-
9e30: 65 61 63 68 20 0a 20 20 20 28 6c 61 6d 62 64 61 each . (lambda
9e40: 20 28 73 68 65 65 74 6e 61 6d 65 29 0a 20 20 20 (sheetname).
9e50: 20 20 28 6c 65 74 2a 20 28 28 73 68 65 65 74 74 (let* ((sheett
9e60: 6d 70 20 20 28 61 73 73 6f 63 20 73 68 65 65 74 mp (assoc sheet
9e70: 6e 61 6d 65 20 64 61 74 61 29 29 0a 09 20 20 20 name data))..
9e80: 20 28 73 68 65 65 74 64 61 74 20 20 28 69 66 20 (sheetdat (if
9e90: 73 68 65 65 74 74 6d 70 20 28 63 61 64 72 20 73 sheettmp (cadr s
9ea0: 68 65 65 74 74 6d 70 29 20 27 28 29 29 29 29 0a heettmp) '()))).
9eb0: 20 20 20 20 20 20 20 28 69 66 20 69 6e 69 74 70 (if initp
9ec0: 72 6f 63 31 20 28 69 6e 69 74 70 72 6f 63 31 20 roc1 (initproc1
9ed0: 73 68 65 65 74 6e 61 6d 65 29 29 0a 20 20 20 20 sheetname)).
9ee0: 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 28 (for-each ..(
9ef0: 6c 61 6d 62 64 61 20 28 73 65 63 74 69 6f 6e 6e lambda (sectionn
9f00: 61 6d 65 29 0a 09 20 20 28 6c 65 74 2a 20 28 28 ame).. (let* ((
9f10: 73 65 63 74 69 6f 6e 74 6d 70 20 20 28 61 73 73 sectiontmp (ass
9f20: 6f 63 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20 73 oc sectionname s
9f30: 68 65 65 74 64 61 74 29 29 0a 09 09 20 28 73 65 heetdat))... (se
9f40: 63 74 69 6f 6e 64 61 74 20 20 28 69 66 20 73 65 ctiondat (if se
9f50: 63 74 69 6f 6e 74 6d 70 20 28 63 61 64 72 20 73 ctiontmp (cadr s
9f60: 65 63 74 69 6f 6e 74 6d 70 29 20 27 28 29 29 29 ectiontmp) '()))
9f70: 29 0a 09 20 20 20 20 28 69 66 20 69 6e 69 74 70 ).. (if initp
9f80: 72 6f 63 32 20 28 69 6e 69 74 70 72 6f 63 32 20 roc2 (initproc2
9f90: 73 68 65 65 74 6e 61 6d 65 20 73 65 63 74 69 6f sheetname sectio
9fa0: 6e 6e 61 6d 65 29 29 0a 09 20 20 20 20 28 66 6f nname)).. (fo
9fb0: 72 2d 65 61 63 68 0a 09 20 20 20 20 20 28 6c 61 r-each.. (la
9fc0: 6d 62 64 61 20 28 76 61 72 6e 61 6d 65 29 0a 09 mbda (varname)..
9fd0: 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 76 (let* ((v
9fe0: 61 6c 74 6d 70 20 28 61 73 73 6f 63 20 76 61 72 altmp (assoc var
9ff0: 6e 61 6d 65 20 73 65 63 74 69 6f 6e 64 61 74 29 name sectiondat)
a000: 29 0a 09 09 20 20 20 20 20 20 28 76 61 6c 20 20 )... (val
a010: 20 20 28 69 66 20 76 61 6c 74 6d 70 20 28 63 61 (if valtmp (ca
a020: 64 72 20 76 61 6c 74 6d 70 29 20 22 22 29 29 29 dr valtmp) "")))
a030: 0a 09 09 20 28 70 72 6f 63 20 73 68 65 65 74 6e ... (proc sheetn
a040: 61 6d 65 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20 ame sectionname
a050: 76 61 72 6e 61 6d 65 20 76 61 6c 29 29 29 0a 09 varname val)))..
a060: 20 20 20 20 20 28 6d 61 70 20 63 61 72 20 73 65 (map car se
a070: 63 74 69 6f 6e 64 61 74 29 29 29 29 0a 09 28 6d ctiondat))))..(m
a080: 61 70 20 63 61 72 20 73 68 65 65 74 64 61 74 29 ap car sheetdat)
a090: 29 29 29 0a 20 20 20 28 6d 61 70 20 63 61 72 20 ))). (map car
a0a0: 64 61 74 61 29 29 0a 20 20 64 61 74 61 29 0a 0a data)). data)..
a0b0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
a0c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a0d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a0e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a0f0: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 20 43 20 4f ========.;; C O
a100: 20 4e 20 46 20 49 20 47 20 20 20 54 20 4f 20 2f N F I G T O /
a110: 20 46 20 52 20 4f 20 4d 20 20 20 41 20 4c 20 49 F R O M A L I
a120: 20 53 20 54 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d S T.;;=========
a130: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a140: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a150: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a160: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 =============..(
a170: 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a define (configf:
a180: 63 6f 6e 66 69 67 2d 3e 61 6c 69 73 74 20 63 66 config->alist cf
a190: 67 64 61 74 29 0a 20 20 28 68 61 73 68 2d 74 61 gdat). (hash-ta
a1a0: 62 6c 65 2d 3e 61 6c 69 73 74 20 63 66 67 64 61 ble->alist cfgda
a1b0: 74 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f t))..(define (co
a1c0: 6e 66 69 67 66 3a 61 6c 69 73 74 2d 3e 63 6f 6e nfigf:alist->con
a1d0: 66 69 67 20 61 64 61 74 29 0a 20 20 28 6c 65 74 fig adat). (let
a1e0: 20 28 28 68 74 20 28 6d 61 6b 65 2d 68 61 73 68 ((ht (make-hash
a1f0: 2d 74 61 62 6c 65 29 29 29 0a 20 20 20 20 28 66 -table))). (f
a200: 6f 72 2d 65 61 63 68 0a 20 20 20 20 20 28 6c 61 or-each. (la
a210: 6d 62 64 61 20 28 73 65 63 74 69 6f 6e 29 0a 20 mbda (section).
a220: 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c (hash-tabl
a230: 65 2d 73 65 74 21 20 68 74 20 28 63 61 72 20 73 e-set! ht (car s
a240: 65 63 74 69 6f 6e 29 28 63 64 72 20 73 65 63 74 ection)(cdr sect
a250: 69 6f 6e 29 29 29 0a 20 20 20 20 20 61 64 61 74 ion))). adat
a260: 29 0a 20 20 20 20 68 74 29 29 0a 0a 3b 3b 20 69 ). ht))..;; i
a270: 66 20 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 f .(define (conf
a280: 69 67 66 3a 72 65 61 64 2d 61 6c 69 73 74 20 66 igf:read-alist f
a290: 6e 61 6d 65 29 0a 20 20 28 68 61 6e 64 6c 65 2d name). (handle-
a2a0: 65 78 63 65 70 74 69 6f 6e 73 0a 20 20 20 20 20 exceptions.
a2b0: 20 65 78 6e 0a 20 20 20 20 28 62 65 67 69 6e 0a exn. (begin.
a2c0: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
a2d0: 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 0 *default-lo
a2e0: 67 2d 70 6f 72 74 2a 20 22 72 65 61 64 20 6f 66 g-port* "read of
a2f0: 20 61 6c 69 73 74 20 22 20 66 6e 61 6d 65 20 22 alist " fname "
a300: 20 66 61 69 6c 65 64 2e 20 65 78 6e 3d 22 20 65 failed. exn=" e
a310: 78 6e 29 0a 20 20 20 20 20 20 23 66 29 0a 20 20 xn). #f).
a320: 20 20 28 63 6f 6e 66 69 67 66 3a 61 6c 69 73 74 (configf:alist
a330: 2d 3e 63 6f 6e 66 69 67 0a 20 20 20 20 20 28 77 ->config. (w
a340: 69 74 68 2d 69 6e 70 75 74 2d 66 72 6f 6d 2d 66 ith-input-from-f
a350: 69 6c 65 20 66 6e 61 6d 65 20 72 65 61 64 29 29 ile fname read))
a360: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e ))..(define (con
a370: 66 69 67 66 3a 77 72 69 74 65 2d 61 6c 69 73 74 figf:write-alist
a380: 20 63 64 61 74 20 66 6e 61 6d 65 29 0a 20 20 28 cdat fname). (
a390: 69 66 20 28 6e 6f 74 20 28 63 6f 6d 6d 6f 6e 3a if (not (common:
a3a0: 66 61 75 78 2d 6c 6f 63 6b 20 66 6e 61 6d 65 29 faux-lock fname)
a3b0: 29 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 ). (debug:p
a3c0: 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d rint 0 *default-
a3d0: 6c 6f 67 2d 70 6f 72 74 2a 20 22 49 4e 46 4f 3a log-port* "INFO:
a3e0: 20 43 6f 75 6c 64 20 6e 6f 74 20 67 65 74 20 6c Could not get l
a3f0: 6f 63 6b 20 6f 6e 20 22 20 66 6e 61 6d 65 29 29 ock on " fname))
a400: 0a 20 20 28 6c 65 74 2a 20 28 28 64 61 74 20 20 . (let* ((dat
a410: 28 63 6f 6e 66 69 67 66 3a 63 6f 6e 66 69 67 2d (configf:config-
a420: 3e 61 6c 69 73 74 20 63 64 61 74 29 29 0a 20 20 >alist cdat)).
a430: 20 20 20 20 20 20 20 28 72 65 73 0a 20 20 20 20 (res.
a440: 20 20 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 (begin.
a450: 20 20 20 20 20 20 20 20 20 28 77 69 74 68 2d 6f (with-o
a460: 75 74 70 75 74 2d 74 6f 2d 66 69 6c 65 20 66 6e utput-to-file fn
a470: 61 6d 65 20 3b 3b 20 66 69 72 73 74 20 77 72 69 ame ;; first wri
a480: 74 65 20 6f 75 74 20 74 68 65 20 66 69 6c 65 0a te out the file.
a490: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
a4a0: 61 6d 62 64 61 20 28 29 0a 20 20 20 20 20 20 20 ambda ().
a4b0: 20 20 20 20 20 20 20 20 20 28 70 70 20 64 61 74 (pp dat
a4c0: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
a4d0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 . (if
a4e0: 20 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 (common:file-ex
a4f0: 69 73 74 73 3f 20 66 6e 61 6d 65 29 20 20 20 3b ists? fname) ;
a500: 3b 20 6e 6f 77 20 76 65 72 69 66 79 20 69 74 20 ; now verify it
a510: 69 73 20 72 65 61 64 61 62 6c 65 0a 20 20 20 20 is readable.
a520: 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 (if
a530: 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d 61 6c (configf:read-al
a540: 69 73 74 20 66 6e 61 6d 65 29 0a 20 20 20 20 20 ist fname).
a550: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 23 #
a560: 74 20 3b 3b 20 64 61 74 61 20 69 73 20 67 6f 6f t ;; data is goo
a570: 64 2e 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 d..
a580: 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a 20 20 (begin.
a590: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a5a0: 20 20 20 20 28 68 61 6e 64 6c 65 2d 65 78 63 65 (handle-exce
a5b0: 70 74 69 6f 6e 73 0a 09 09 09 20 20 65 78 6e 0a ptions.... exn.
a5c0: 09 09 09 28 62 65 67 69 6e 0a 09 09 09 20 20 28 ...(begin.... (
a5d0: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
a5e0: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
a5f0: 20 22 64 65 6c 65 74 69 6e 67 20 22 20 66 6e 61 "deleting " fna
a600: 6d 65 20 22 20 66 61 69 6c 65 64 2c 20 65 78 6e me " failed, exn
a610: 3d 22 20 65 78 6e 29 0a 09 09 09 20 20 23 66 29 =" exn).... #f)
a620: 0a 09 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 ....(debug:print
a630: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
a640: 70 6f 72 74 2a 20 22 57 41 52 4e 49 4e 47 3a 20 port* "WARNING:
a650: 63 6f 6e 74 65 6e 74 20 22 20 64 61 74 20 22 20 content " dat "
a660: 66 6f 72 20 63 61 63 68 65 20 22 20 66 6e 61 6d for cache " fnam
a670: 65 20 22 20 69 73 20 6e 6f 74 20 72 65 61 64 61 e " is not reada
a680: 62 6c 65 2e 20 44 65 6c 65 74 69 6e 67 20 67 65 ble. Deleting ge
a690: 6e 65 72 61 74 65 64 20 66 69 6c 65 2e 22 29 0a nerated file.").
a6a0: 09 09 09 28 64 65 6c 65 74 65 2d 66 69 6c 65 20 ...(delete-file
a6b0: 66 6e 61 6d 65 29 29 0a 20 20 20 20 20 20 20 20 fname)).
a6c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 23 66 #f
a6d0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
a6e0: 20 20 20 23 66 29 29 29 29 0a 20 20 20 20 28 63 #f)))). (c
a6f0: 6f 6d 6d 6f 6e 3a 66 61 75 78 2d 75 6e 6c 6f 63 ommon:faux-unloc
a700: 6b 20 66 6e 61 6d 65 29 0a 20 20 20 20 72 65 73 k fname). res
a710: 29 29 0a 20 20 0a 3b 3b 20 63 6f 6e 76 65 72 74 )). .;; convert
a720: 20 68 69 65 72 61 72 63 68 69 61 6c 20 6c 69 73 hierarchial lis
a730: 74 20 74 6f 20 69 6e 69 20 66 6f 72 6d 61 74 0a t to ini format.
a740: 3b 3b 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 ;;.(define (conf
a750: 69 67 66 3a 63 6f 6e 66 69 67 2d 3e 69 6e 69 20 igf:config->ini
a760: 64 61 74 61 29 0a 20 20 28 6d 61 70 20 0a 20 20 data). (map .
a770: 20 28 6c 61 6d 62 64 61 20 28 73 65 63 74 69 6f (lambda (sectio
a780: 6e 29 0a 20 20 20 20 20 28 6c 65 74 20 28 28 73 n). (let ((s
a790: 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 28 63 61 72 ection-name (car
a7a0: 20 73 65 63 74 69 6f 6e 29 29 0a 09 20 20 20 28 section)).. (
a7b0: 73 65 63 74 69 6f 6e 2d 64 61 74 20 20 28 63 64 section-dat (cd
a7c0: 72 20 73 65 63 74 69 6f 6e 29 29 29 0a 20 20 20 r section))).
a7d0: 20 20 20 20 28 70 72 69 6e 74 20 22 5c 6e 5b 22 (print "\n["
a7e0: 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 22 5d section-name "]
a7f0: 22 29 0a 20 20 20 20 20 20 20 28 6d 61 70 20 28 "). (map (
a800: 6c 61 6d 62 64 61 20 28 64 61 74 2d 70 61 69 72 lambda (dat-pair
a810: 29 0a 09 20 20 20 20 20 20 28 6c 65 74 2a 20 28 ).. (let* (
a820: 28 76 61 72 20 28 63 61 72 20 64 61 74 2d 70 61 (var (car dat-pa
a830: 69 72 29 29 0a 09 09 20 20 20 20 20 28 76 61 6c ir))... (val
a840: 20 28 63 61 64 72 20 64 61 74 2d 70 61 69 72 29 (cadr dat-pair)
a850: 29 0a 09 09 20 20 20 20 20 28 66 6e 61 6d 65 20 )... (fname
a860: 28 69 66 20 28 3e 20 28 6c 65 6e 67 74 68 20 64 (if (> (length d
a870: 61 74 2d 70 61 69 72 29 20 32 29 28 63 61 64 64 at-pair) 2)(cadd
a880: 72 20 64 61 74 2d 70 61 69 72 29 20 23 66 29 29 r dat-pair) #f))
a890: 29 0a 09 09 28 69 66 20 66 6e 61 6d 65 20 28 70 )...(if fname (p
a8a0: 72 69 6e 74 20 22 23 20 22 20 76 61 72 20 22 3d rint "# " var "=
a8b0: 3e 22 20 66 6e 61 6d 65 29 29 0a 09 09 28 70 72 >" fname))...(pr
a8c0: 69 6e 74 20 76 61 72 20 22 20 22 20 76 61 6c 29 int var " " val)
a8d0: 29 29 0a 09 20 20 20 20 73 65 63 74 69 6f 6e 2d )).. section-
a8e0: 64 61 74 29 29 29 20 3b 3b 20 20 20 20 20 20 20 dat))) ;;
a8f0: 28 70 72 69 6e 74 20 22 73 65 63 74 69 6f 6e 2d (print "section-
a900: 64 61 74 3a 20 22 20 73 65 63 74 69 6f 6e 2d 64 dat: " section-d
a910: 61 74 29 29 0a 20 20 20 28 68 61 73 68 2d 74 61 at)). (hash-ta
a920: 62 6c 65 2d 3e 61 6c 69 73 74 20 64 61 74 61 29 ble->alist data)
a930: 29 29 0a )).