Artifact
7cf9abed09e83dac73b5953e74031e096d845331:
0000: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
0010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0040: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 43 6f 70 79 ========.;; Copy
0050: 72 69 67 68 74 20 32 30 30 36 2d 32 30 31 32 2c right 2006-2012,
0060: 20 4d 61 74 74 68 65 77 20 57 65 6c 6c 61 6e 64 Matthew Welland
0070: 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68 69 73 20 70 ..;; .;; This p
0080: 72 6f 67 72 61 6d 20 69 73 20 6d 61 64 65 20 61 rogram is made a
0090: 76 61 69 6c 61 62 6c 65 20 75 6e 64 65 72 20 74 vailable under t
00a0: 68 65 20 47 4e 55 20 47 50 4c 20 76 65 72 73 69 he GNU GPL versi
00b0: 6f 6e 20 32 2e 30 20 6f 72 0a 3b 3b 20 20 67 72 on 2.0 or.;; gr
00c0: 65 61 74 65 72 2e 20 53 65 65 20 74 68 65 20 61 eater. See the a
00d0: 63 63 6f 6d 70 61 6e 79 69 6e 67 20 66 69 6c 65 ccompanying file
00e0: 20 43 4f 50 59 49 4e 47 20 66 6f 72 20 64 65 74 COPYING for det
00f0: 61 69 6c 73 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68 ails..;; .;; Th
0100: 69 73 20 70 72 6f 67 72 61 6d 20 69 73 20 64 69 is program is di
0110: 73 74 72 69 62 75 74 65 64 20 57 49 54 48 4f 55 stributed WITHOU
0120: 54 20 41 4e 59 20 57 41 52 52 41 4e 54 59 3b 20 T ANY WARRANTY;
0130: 77 69 74 68 6f 75 74 20 65 76 65 6e 20 74 68 65 without even the
0140: 0a 3b 3b 20 20 69 6d 70 6c 69 65 64 20 77 61 72 .;; implied war
0150: 72 61 6e 74 79 20 6f 66 20 4d 45 52 43 48 41 4e ranty of MERCHAN
0160: 54 41 42 49 4c 49 54 59 20 6f 72 20 46 49 54 4e TABILITY or FITN
0170: 45 53 53 20 46 4f 52 20 41 20 50 41 52 54 49 43 ESS FOR A PARTIC
0180: 55 4c 41 52 0a 3b 3b 20 20 50 55 52 50 4f 53 45 ULAR.;; PURPOSE
0190: 2e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
01a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 3d 3d ==========..;;==
01e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0200: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0210: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0220: 3d 3d 3d 3d 0a 3b 3b 20 43 6f 6e 66 69 67 20 66 ====.;; Config f
0230: 69 6c 65 20 68 61 6e 64 6c 69 6e 67 0a 3b 3b 3d ile handling.;;=
0240: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0250: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0260: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0270: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0280: 3d 3d 3d 3d 3d 0a 0a 28 75 73 65 20 72 65 67 65 =====..(use rege
0290: 78 20 72 65 67 65 78 2d 63 61 73 65 29 20 3b 3b x regex-case) ;;
02a0: 20 20 64 69 72 65 63 74 6f 72 79 2d 75 74 69 6c directory-util
02b0: 73 29 0a 28 64 65 63 6c 61 72 65 20 28 75 6e 69 s).(declare (uni
02c0: 74 20 63 6f 6e 66 69 67 66 29 29 0a 28 64 65 63 t configf)).(dec
02d0: 6c 61 72 65 20 28 75 73 65 73 20 70 72 6f 63 65 lare (uses proce
02e0: 73 73 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 ss)).(declare (u
02f0: 73 65 73 20 65 6e 76 29 29 0a 0a 28 69 6e 63 6c ses env))..(incl
0300: 75 64 65 20 22 63 6f 6d 6d 6f 6e 5f 72 65 63 6f ude "common_reco
0310: 72 64 73 2e 73 63 6d 22 29 0a 0a 3b 3b 20 72 65 rds.scm")..;; re
0320: 74 75 72 6e 20 6c 69 73 74 20 28 70 61 74 68 20 turn list (path
0330: 66 75 6c 6c 70 61 74 68 20 63 6f 6e 66 69 67 6e fullpath confign
0340: 61 6d 65 29 0a 28 64 65 66 69 6e 65 20 28 66 69 ame).(define (fi
0350: 6e 64 2d 63 6f 6e 66 69 67 20 63 6f 6e 66 69 67 nd-config config
0360: 6e 61 6d 65 20 23 21 6b 65 79 20 28 74 6f 70 70 name #!key (topp
0370: 61 74 68 20 23 66 29 29 0a 20 20 28 69 66 20 74 ath #f)). (if t
0380: 6f 70 70 61 74 68 0a 20 20 20 20 20 20 28 6c 65 oppath. (le
0390: 74 20 28 28 63 66 6e 61 6d 65 20 28 63 6f 6e 63 t ((cfname (conc
03a0: 20 74 6f 70 70 61 74 68 20 22 2f 22 20 63 6f 6e toppath "/" con
03b0: 66 69 67 6e 61 6d 65 29 29 29 0a 09 28 69 66 20 figname)))..(if
03c0: 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 63 66 (file-exists? cf
03d0: 6e 61 6d 65 29 0a 09 20 20 20 20 28 6c 69 73 74 name).. (list
03e0: 20 74 6f 70 70 61 74 68 20 63 66 6e 61 6d 65 20 toppath cfname
03f0: 63 6f 6e 66 69 67 6e 61 6d 65 29 0a 09 20 20 20 configname)..
0400: 20 28 6c 69 73 74 20 23 66 20 20 20 20 20 20 23 (list #f #
0410: 66 20 20 20 20 20 23 66 29 29 29 0a 20 20 20 20 f #f))).
0420: 20 20 28 6c 65 74 2a 20 28 28 63 77 64 20 28 73 (let* ((cwd (s
0430: 74 72 69 6e 67 2d 73 70 6c 69 74 20 28 63 75 72 tring-split (cur
0440: 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 20 rent-directory)
0450: 22 2f 22 29 29 29 0a 09 28 6c 65 74 20 6c 6f 6f "/")))..(let loo
0460: 70 20 28 28 64 69 72 20 63 77 64 29 29 0a 09 20 p ((dir cwd))..
0470: 20 28 6c 65 74 2a 20 28 28 70 61 74 68 20 20 20 (let* ((path
0480: 20 20 28 63 6f 6e 63 20 22 2f 22 20 28 73 74 72 (conc "/" (str
0490: 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 ing-intersperse
04a0: 64 69 72 20 22 2f 22 29 29 29 0a 09 09 20 28 66 dir "/")))... (f
04b0: 75 6c 6c 70 61 74 68 20 28 63 6f 6e 63 20 70 61 ullpath (conc pa
04c0: 74 68 20 22 2f 22 20 63 6f 6e 66 69 67 6e 61 6d th "/" confignam
04d0: 65 29 29 29 0a 09 20 20 20 20 28 69 66 20 28 66 e))).. (if (f
04e0: 69 6c 65 2d 65 78 69 73 74 73 3f 20 66 75 6c 6c ile-exists? full
04f0: 70 61 74 68 29 0a 09 09 28 6c 69 73 74 20 70 61 path)...(list pa
0500: 74 68 20 66 75 6c 6c 70 61 74 68 20 63 6f 6e 66 th fullpath conf
0510: 69 67 6e 61 6d 65 29 0a 09 09 28 6c 65 74 20 28 igname)...(let (
0520: 28 72 65 6d 63 77 64 20 28 74 61 6b 65 20 64 69 (remcwd (take di
0530: 72 20 28 2d 20 28 6c 65 6e 67 74 68 20 64 69 72 r (- (length dir
0540: 29 20 31 29 29 29 29 0a 09 09 20 20 28 69 66 20 ) 1))))... (if
0550: 28 6e 75 6c 6c 3f 20 72 65 6d 63 77 64 29 0a 09 (null? remcwd)..
0560: 09 20 20 20 20 20 20 28 6c 69 73 74 20 23 66 20 . (list #f
0570: 23 66 20 23 66 29 20 3b 3b 20 20 23 66 20 23 66 #f #f) ;; #f #f
0580: 29 20 0a 09 09 20 20 28 6c 6f 6f 70 20 72 65 6d ) ... (loop rem
0590: 63 77 64 29 29 29 29 29 29 29 29 29 0a 0a 28 64 cwd)))))))))..(d
05a0: 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 3a 61 73 efine (config:as
05b0: 73 6f 63 2d 73 61 66 65 2d 61 64 64 20 61 6c 69 soc-safe-add ali
05c0: 73 74 20 6b 65 79 20 76 61 6c 20 23 21 6b 65 79 st key val #!key
05d0: 20 28 6d 65 74 61 64 61 74 61 20 23 66 29 29 0a (metadata #f)).
05e0: 20 20 28 6c 65 74 20 28 28 6e 65 77 61 6c 69 73 (let ((newalis
05f0: 74 20 28 66 69 6c 74 65 72 20 28 6c 61 6d 62 64 t (filter (lambd
0600: 61 20 28 78 29 28 6e 6f 74 20 28 65 71 75 61 6c a (x)(not (equal
0610: 3f 20 6b 65 79 20 28 63 61 72 20 78 29 29 29 29 ? key (car x))))
0620: 20 61 6c 69 73 74 29 29 29 0a 20 20 20 20 28 61 alist))). (a
0630: 70 70 65 6e 64 20 6e 65 77 61 6c 69 73 74 20 28 ppend newalist (
0640: 6c 69 73 74 20 28 69 66 20 6d 65 74 61 64 61 74 list (if metadat
0650: 61 0a 09 09 09 20 20 20 20 20 20 20 28 6c 69 73 a.... (lis
0660: 74 20 6b 65 79 20 76 61 6c 20 6d 65 74 61 64 61 t key val metada
0670: 74 61 29 0a 09 09 09 20 20 20 20 20 20 20 28 6c ta).... (l
0680: 69 73 74 20 6b 65 79 20 76 61 6c 29 29 29 29 29 ist key val)))))
0690: 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 )..(define (conf
06a0: 69 67 3a 65 76 61 6c 2d 73 74 72 69 6e 67 2d 69 ig:eval-string-i
06b0: 6e 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 73 74 n-environment st
06c0: 72 29 0a 20 20 28 68 61 6e 64 6c 65 2d 65 78 63 r). (handle-exc
06d0: 65 70 74 69 6f 6e 73 0a 20 20 20 65 78 6e 0a 20 eptions. exn.
06e0: 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 28 64 (begin. (d
06f0: 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 ebug:print-error
0700: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
0710: 70 6f 72 74 2a 20 22 70 72 6f 62 6c 65 6d 20 65 port* "problem e
0720: 76 61 6c 75 61 74 69 6e 67 20 5c 22 22 20 73 74 valuating \"" st
0730: 72 20 22 5c 22 20 69 6e 20 74 68 65 20 73 68 65 r "\" in the she
0740: 6c 6c 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 22 29 ll environment")
0750: 0a 20 20 20 20 20 23 66 29 0a 20 20 20 28 6c 65 . #f). (le
0760: 74 20 28 28 63 6d 64 72 65 73 20 28 70 72 6f 63 t ((cmdres (proc
0770: 65 73 73 3a 63 6d 64 2d 72 75 6e 2d 3e 6c 69 73 ess:cmd-run->lis
0780: 74 20 28 63 6f 6e 63 20 22 65 63 68 6f 20 22 20 t (conc "echo "
0790: 73 74 72 29 29 29 29 0a 20 20 20 20 20 28 69 66 str)))). (if
07a0: 20 28 6e 75 6c 6c 3f 20 63 6d 64 72 65 73 29 20 (null? cmdres)
07b0: 22 22 0a 09 20 28 63 61 61 72 20 63 6d 64 72 65 "".. (caar cmdre
07c0: 73 29 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d s)))))..;;======
07d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
07e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
07f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0800: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0810: 0a 3b 3b 20 4d 61 6b 65 20 74 68 65 20 72 65 67 .;; Make the reg
0820: 65 78 70 27 73 20 6e 65 65 64 65 64 20 67 6c 6f exp's needed glo
0830: 62 61 6c 6c 79 20 61 76 61 69 6c 61 62 6c 65 0a bally available.
0840: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
0850: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0860: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0870: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0880: 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e ========..(defin
0890: 65 20 63 6f 6e 66 69 67 66 3a 69 6e 63 6c 75 64 e configf:includ
08a0: 65 2d 72 78 20 28 72 65 67 65 78 70 20 22 5e 5c e-rx (regexp "^\
08b0: 5c 5b 69 6e 63 6c 75 64 65 5c 5c 73 2b 28 2e 2a \[include\\s+(.*
08c0: 29 5c 5c 5d 5c 5c 73 2a 24 22 29 29 0a 28 64 65 )\\]\\s*$")).(de
08d0: 66 69 6e 65 20 63 6f 6e 66 69 67 66 3a 73 63 72 fine configf:scr
08e0: 69 70 74 2d 72 78 20 20 28 72 65 67 65 78 70 20 ipt-rx (regexp
08f0: 22 5e 5c 5c 5b 73 63 72 69 70 74 69 6e 63 5c 5c "^\\[scriptinc\\
0900: 73 2b 28 2e 2a 29 5c 5c 5d 5c 5c 73 2a 24 22 29 s+(.*)\\]\\s*$")
0910: 29 20 3b 3b 20 69 6e 63 6c 75 64 65 20 6f 75 74 ) ;; include out
0920: 70 75 74 20 66 72 6f 6d 20 61 20 73 63 72 69 70 put from a scrip
0930: 74 0a 28 64 65 66 69 6e 65 20 63 6f 6e 66 69 67 t.(define config
0940: 66 3a 73 65 63 74 69 6f 6e 2d 72 78 20 28 72 65 f:section-rx (re
0950: 67 65 78 70 20 22 5e 5c 5c 5b 28 2e 2a 29 5c 5c gexp "^\\[(.*)\\
0960: 5d 5c 5c 73 2a 24 22 29 29 0a 28 64 65 66 69 6e ]\\s*$")).(defin
0970: 65 20 63 6f 6e 66 69 67 66 3a 62 6c 61 6e 6b 2d e configf:blank-
0980: 6c 2d 72 78 20 28 72 65 67 65 78 70 20 22 5e 5c l-rx (regexp "^\
0990: 5c 73 2a 24 22 29 29 0a 28 64 65 66 69 6e 65 20 \s*$")).(define
09a0: 63 6f 6e 66 69 67 66 3a 6b 65 79 2d 73 79 73 2d configf:key-sys-
09b0: 70 72 20 28 72 65 67 65 78 70 20 22 5e 28 5c 5c pr (regexp "^(\\
09c0: 53 2b 29 5c 5c 73 2b 5c 5c 5b 73 79 73 74 65 6d S+)\\s+\\[system
09d0: 5c 5c 73 2b 28 5c 5c 53 2b 2e 2a 29 5c 5c 5d 5c \\s+(\\S+.*)\\]\
09e0: 5c 73 2a 24 22 29 29 0a 28 64 65 66 69 6e 65 20 \s*$")).(define
09f0: 63 6f 6e 66 69 67 66 3a 6b 65 79 2d 76 61 6c 2d configf:key-val-
0a00: 70 72 20 28 72 65 67 65 78 70 20 22 5e 28 5c 5c pr (regexp "^(\\
0a10: 53 2b 29 28 5c 5c 73 2b 28 2e 2a 29 7c 28 29 29 S+)(\\s+(.*)|())
0a20: 24 22 29 29 0a 28 64 65 66 69 6e 65 20 63 6f 6e $")).(define con
0a30: 66 69 67 66 3a 6b 65 79 2d 6e 6f 2d 76 61 6c 20 figf:key-no-val
0a40: 28 72 65 67 65 78 70 20 22 5e 28 5c 5c 53 2b 29 (regexp "^(\\S+)
0a50: 28 5c 5c 73 2a 29 24 22 29 29 0a 28 64 65 66 69 (\\s*)$")).(defi
0a60: 6e 65 20 63 6f 6e 66 69 67 66 3a 63 6f 6d 6d 65 ne configf:comme
0a70: 6e 74 2d 72 78 20 28 72 65 67 65 78 70 20 22 5e nt-rx (regexp "^
0a80: 5c 5c 73 2a 23 2e 2a 22 29 29 0a 28 64 65 66 69 \\s*#.*")).(defi
0a90: 6e 65 20 63 6f 6e 66 69 67 66 3a 63 6f 6e 74 2d ne configf:cont-
0aa0: 6c 6e 2d 72 78 20 28 72 65 67 65 78 70 20 22 5e ln-rx (regexp "^
0ab0: 28 5c 5c 73 2b 29 28 5c 5c 53 2b 2e 2a 29 24 22 (\\s+)(\\S+.*)$"
0ac0: 29 29 0a 28 64 65 66 69 6e 65 20 63 6f 6e 66 69 )).(define confi
0ad0: 67 66 3a 73 65 74 74 69 6e 67 73 20 20 20 28 72 gf:settings (r
0ae0: 65 67 65 78 70 20 22 5e 5c 5c 5b 63 6f 6e 66 69 egexp "^\\[confi
0af0: 67 66 3a 73 65 74 74 69 6e 67 73 5c 5c 73 2b 28 gf:settings\\s+(
0b00: 5c 5c 53 2b 29 5c 5c 73 2b 28 5c 5c 53 2b 29 5d \\S+)\\s+(\\S+)]
0b10: 5c 5c 73 2a 24 22 29 29 0a 0a 3b 3b 20 72 65 61 \\s*$"))..;; rea
0b20: 64 20 61 20 6c 69 6e 65 20 61 6e 64 20 70 72 6f d a line and pro
0b30: 63 65 73 73 20 61 6e 79 20 23 7b 20 2e 2e 2e 20 cess any #{ ...
0b40: 7d 20 63 6f 6e 73 74 72 75 63 74 73 0a 0a 28 64 } constructs..(d
0b50: 65 66 69 6e 65 20 63 6f 6e 66 69 67 66 3a 76 61 efine configf:va
0b60: 72 2d 65 78 70 61 6e 64 2d 72 65 67 65 78 20 28 r-expand-regex (
0b70: 72 65 67 65 78 70 20 22 5e 28 2e 2a 29 23 5c 5c regexp "^(.*)#\\
0b80: 7b 28 73 63 68 65 6d 65 7c 73 79 73 74 65 6d 7c {(scheme|system|
0b90: 73 68 65 6c 6c 7c 67 65 74 65 6e 76 7c 67 65 74 shell|getenv|get
0ba0: 7c 72 75 6e 63 6f 6e 66 69 67 73 2d 67 65 74 7c |runconfigs-get|
0bb0: 72 67 65 74 7c 73 63 6d 7c 73 68 7c 72 70 7c 67 rget|scm|sh|rp|g
0bc0: 76 7c 67 7c 6d 74 72 61 68 29 5c 5c 73 2b 28 5b v|g|mtrah)\\s+([
0bd0: 5e 5c 5c 7d 5c 5c 7b 5d 2a 29 5c 5c 7d 28 2e 2a ^\\}\\{]*)\\}(.*
0be0: 29 22 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 )"))..(define (c
0bf0: 6f 6e 66 69 67 66 3a 70 72 6f 63 65 73 73 2d 6c onfigf:process-l
0c00: 69 6e 65 20 6c 20 68 74 20 61 6c 6c 6f 77 2d 73 ine l ht allow-s
0c10: 79 73 74 65 6d 20 23 21 6b 65 79 20 28 6c 69 6e ystem #!key (lin
0c20: 65 6e 75 6d 20 23 66 29 29 0a 20 20 28 6c 65 74 enum #f)). (let
0c30: 20 6c 6f 6f 70 20 28 28 72 65 73 20 6c 29 29 0a loop ((res l)).
0c40: 20 20 20 20 28 69 66 20 28 73 74 72 69 6e 67 3f (if (string?
0c50: 20 72 65 73 29 0a 09 28 6c 65 74 20 28 28 6d 61 res)..(let ((ma
0c60: 74 63 68 64 61 74 20 28 73 74 72 69 6e 67 2d 73 tchdat (string-s
0c70: 65 61 72 63 68 20 63 6f 6e 66 69 67 66 3a 76 61 earch configf:va
0c80: 72 2d 65 78 70 61 6e 64 2d 72 65 67 65 78 20 72 r-expand-regex r
0c90: 65 73 29 29 29 0a 09 20 20 28 69 66 20 6d 61 74 es))).. (if mat
0ca0: 63 68 64 61 74 0a 09 20 20 20 20 20 20 28 6c 65 chdat.. (le
0cb0: 74 2a 20 28 28 70 72 65 73 74 72 20 20 28 6c 69 t* ((prestr (li
0cc0: 73 74 2d 72 65 66 20 6d 61 74 63 68 64 61 74 20 st-ref matchdat
0cd0: 31 29 29 0a 09 09 20 20 20 20 20 28 63 6d 64 74 1))... (cmdt
0ce0: 79 70 65 20 28 6c 69 73 74 2d 72 65 66 20 6d 61 ype (list-ref ma
0cf0: 74 63 68 64 61 74 20 32 29 29 20 3b 3b 20 65 76 tchdat 2)) ;; ev
0d00: 61 6c 2c 20 73 79 73 74 65 6d 2c 20 73 68 65 6c al, system, shel
0d10: 6c 2c 20 67 65 74 65 6e 76 0a 09 09 20 20 20 20 l, getenv...
0d20: 20 28 63 6d 64 20 20 20 20 20 28 6c 69 73 74 2d (cmd (list-
0d30: 72 65 66 20 6d 61 74 63 68 64 61 74 20 33 29 29 ref matchdat 3))
0d40: 0a 09 09 20 20 20 20 20 28 70 6f 73 74 73 74 72 ... (poststr
0d50: 20 28 6c 69 73 74 2d 72 65 66 20 6d 61 74 63 68 (list-ref match
0d60: 64 61 74 20 34 29 29 0a 09 09 20 20 20 20 20 28 dat 4))... (
0d70: 72 65 73 75 6c 74 20 20 23 66 29 0a 09 09 20 20 result #f)...
0d80: 20 20 20 28 73 74 61 72 74 2d 74 69 6d 65 20 28 (start-time (
0d90: 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 current-seconds)
0da0: 29 0a 09 09 20 20 20 20 20 28 63 6d 64 73 79 6d )... (cmdsym
0db0: 20 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f (string->symbo
0dc0: 6c 20 63 6d 64 74 79 70 65 29 29 0a 09 09 20 20 l cmdtype))...
0dd0: 20 20 20 28 66 75 6c 6c 63 6d 64 20 28 63 61 73 (fullcmd (cas
0de0: 65 20 63 6d 64 73 79 6d 0a 09 09 09 09 28 28 73 e cmdsym.....((s
0df0: 63 68 65 6d 65 20 73 63 6d 29 20 28 63 6f 6e 63 cheme scm) (conc
0e00: 20 22 28 6c 61 6d 62 64 61 20 28 68 74 29 22 20 "(lambda (ht)"
0e10: 63 6d 64 20 22 29 22 29 29 0a 09 09 09 09 28 28 cmd ")")).....((
0e20: 73 79 73 74 65 6d 29 20 20 20 20 20 28 63 6f 6e system) (con
0e30: 63 20 22 28 6c 61 6d 62 64 61 20 28 68 74 29 28 c "(lambda (ht)(
0e40: 73 79 73 74 65 6d 20 5c 22 22 20 63 6d 64 20 22 system \"" cmd "
0e50: 5c 22 29 29 22 29 29 0a 09 09 09 09 28 28 73 68 \"))")).....((sh
0e60: 65 6c 6c 20 73 68 29 20 20 20 28 63 6f 6e 63 20 ell sh) (conc
0e70: 22 28 6c 61 6d 62 64 61 20 28 68 74 29 28 73 74 "(lambda (ht)(st
0e80: 72 69 6e 67 2d 74 72 61 6e 73 6c 61 74 65 20 28 ring-translate (
0e90: 73 68 65 6c 6c 20 5c 22 22 20 20 63 6d 64 20 22 shell \"" cmd "
0ea0: 5c 22 29 20 5c 22 5c 6e 5c 22 20 5c 22 20 5c 22 \") \"\n\" \" \"
0eb0: 29 29 22 29 29 0a 09 09 09 09 28 28 72 65 61 6c ))")).....((real
0ec0: 70 61 74 68 20 72 70 29 28 63 6f 6e 63 20 22 28 path rp)(conc "(
0ed0: 6c 61 6d 62 64 61 20 28 68 74 29 28 63 6f 6d 6d lambda (ht)(comm
0ee0: 6f 6e 3a 6e 69 63 65 2d 70 61 74 68 20 5c 22 22 on:nice-path \""
0ef0: 20 63 6d 64 20 22 5c 22 29 29 22 29 29 0a 09 09 cmd "\"))"))...
0f00: 09 09 28 28 67 65 74 65 6e 76 20 67 76 29 20 20 ..((getenv gv)
0f10: 28 63 6f 6e 63 20 22 28 6c 61 6d 62 64 61 20 28 (conc "(lambda (
0f20: 68 74 29 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d ht)(get-environm
0f30: 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 5c 22 22 ent-variable \""
0f40: 20 63 6d 64 20 22 5c 22 29 29 22 29 29 0a 09 09 cmd "\"))"))...
0f50: 09 09 28 28 6d 74 72 61 68 29 20 20 20 20 20 20 ..((mtrah)
0f60: 28 63 6f 6e 63 20 22 28 6c 61 6d 62 64 61 20 28 (conc "(lambda (
0f70: 68 74 29 22 0a 20 20 20 20 20 20 20 20 20 20 20 ht)".
0f80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0f90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0fa0: 20 20 20 20 20 20 20 20 20 22 20 20 20 20 28 6c " (l
0fb0: 65 74 20 28 28 65 78 74 72 61 20 5c 22 22 20 63 et ((extra \"" c
0fc0: 6d 64 20 22 5c 22 29 29 22 0a 09 09 09 09 09 09 md "\"))".......
0fd0: 20 20 20 20 22 20 20 20 20 20 20 20 28 63 6f 6e " (con
0fe0: 63 20 28 6f 72 20 2a 74 6f 70 70 61 74 68 2a 20 c (or *toppath*
0ff0: 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 (get-environment
1000: 2d 76 61 72 69 61 62 6c 65 20 5c 22 4d 54 5f 52 -variable \"MT_R
1010: 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 5c 22 29 29 UN_AREA_HOME\"))
1020: 22 0a 09 09 09 09 09 09 20 20 20 20 22 20 20 20 "....... "
1030: 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 73 (if (s
1040: 74 72 69 6e 67 2d 6e 75 6c 6c 3f 20 65 78 74 72 tring-null? extr
1050: 61 29 20 5c 22 5c 22 20 5c 22 2f 5c 22 29 22 0a a) \"\" \"/\")".
1060: 09 09 09 09 09 09 20 20 20 20 22 20 20 20 20 20 ...... "
1070: 20 20 20 20 20 20 20 20 65 78 74 72 61 29 29 29 extra)))
1080: 22 29 29 0a 09 09 09 09 28 28 67 65 74 20 67 29 ")).....((get g)
1090: 20 20 20 0a 09 09 09 09 20 28 6c 65 74 2a 20 28 ..... (let* (
10a0: 28 70 61 72 74 73 20 28 73 74 72 69 6e 67 2d 73 (parts (string-s
10b0: 70 6c 69 74 20 63 6d 64 29 29 0a 09 09 09 09 09 plit cmd))......
10c0: 28 73 65 63 74 20 20 28 63 61 72 20 70 61 72 74 (sect (car part
10d0: 73 29 29 0a 09 09 09 09 09 28 76 61 72 20 20 20 s))......(var
10e0: 28 63 61 64 72 20 70 61 72 74 73 29 29 29 0a 09 (cadr parts)))..
10f0: 09 09 09 20 20 20 28 63 6f 6e 63 20 22 28 6c 61 ... (conc "(la
1100: 6d 62 64 61 20 28 68 74 29 28 63 6f 6e 66 69 67 mbda (ht)(config
1110: 2d 6c 6f 6f 6b 75 70 20 68 74 20 5c 22 22 20 73 -lookup ht \"" s
1120: 65 63 74 20 22 5c 22 20 5c 22 22 20 76 61 72 20 ect "\" \"" var
1130: 22 5c 22 29 29 22 29 29 29 0a 09 09 09 09 28 28 "\"))"))).....((
1140: 72 75 6e 63 6f 6e 66 69 67 73 2d 67 65 74 20 72 runconfigs-get r
1150: 67 65 74 29 20 28 63 6f 6e 63 20 22 28 6c 61 6d get) (conc "(lam
1160: 62 64 61 20 28 68 74 29 28 72 75 6e 63 6f 6e 66 bda (ht)(runconf
1170: 69 67 73 2d 67 65 74 20 68 74 20 5c 22 22 20 63 igs-get ht \"" c
1180: 6d 64 20 22 5c 22 29 29 22 29 29 0a 09 09 09 09 md "\"))")).....
1190: 3b 3b 20 28 28 72 67 65 74 29 20 20 20 20 20 20 ;; ((rget)
11a0: 20 20 20 20 20 28 63 6f 6e 63 20 22 28 6c 61 6d (conc "(lam
11b0: 62 64 61 20 28 68 74 29 28 72 75 6e 63 6f 6e 66 bda (ht)(runconf
11c0: 69 67 73 2d 67 65 74 20 68 74 20 5c 22 22 20 63 igs-get ht \"" c
11d0: 6d 64 20 22 5c 22 29 29 22 29 29 0a 09 09 09 09 md "\"))")).....
11e0: 28 65 6c 73 65 20 22 28 6c 61 6d 62 64 61 20 28 (else "(lambda (
11f0: 68 74 29 28 70 72 69 6e 74 20 5c 22 45 52 52 4f ht)(print \"ERRO
1200: 52 5c 22 29 20 5c 22 45 52 52 4f 52 5c 22 29 22 R\") \"ERROR\")"
1210: 29 29 29 29 0a 09 09 3b 3b 20 28 70 72 69 6e 74 ))))...;; (print
1220: 20 22 66 75 6c 6c 63 6d 64 3d 22 20 66 75 6c 6c "fullcmd=" full
1230: 63 6d 64 29 0a 09 09 28 68 61 6e 64 6c 65 2d 65 cmd)...(handle-e
1240: 78 63 65 70 74 69 6f 6e 73 0a 09 09 20 65 78 6e xceptions... exn
1250: 0a 09 09 20 28 62 65 67 69 6e 0a 09 09 20 20 20 ... (begin...
1260: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a (debug:print 0 *
1270: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
1280: 2a 20 22 57 41 52 4e 49 4e 47 3a 20 66 61 69 6c * "WARNING: fail
1290: 65 64 20 74 6f 20 70 72 6f 63 65 73 73 20 63 6f ed to process co
12a0: 6e 66 69 67 20 69 6e 70 75 74 20 5c 22 22 20 6c nfig input \"" l
12b0: 20 22 5c 22 22 29 0a 09 09 20 20 20 28 64 65 62 "\"")... (deb
12c0: 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 ug:print 0 *defa
12d0: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 20 ult-log-port* "
12e0: 6d 65 73 73 61 67 65 3a 20 22 20 28 28 63 6f 6e message: " ((con
12f0: 64 69 74 69 6f 6e 2d 70 72 6f 70 65 72 74 79 2d dition-property-
1300: 61 63 63 65 73 73 6f 72 20 27 65 78 6e 20 27 6d accessor 'exn 'm
1310: 65 73 73 61 67 65 29 20 65 78 6e 29 29 0a 09 09 essage) exn))...
1320: 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 65 78 ;; (print "ex
1330: 6e 3d 22 20 28 63 6f 6e 64 69 74 69 6f 6e 2d 3e n=" (condition->
1340: 6c 69 73 74 20 65 78 6e 29 29 0a 09 09 20 20 20 list exn))...
1350: 28 73 65 74 21 20 72 65 73 75 6c 74 20 28 63 6f (set! result (co
1360: 6e 63 20 22 23 7b 28 20 22 20 63 6d 64 74 79 70 nc "#{( " cmdtyp
1370: 65 20 22 29 20 22 20 63 6d 64 20 22 7d 2c 20 66 e ") " cmd "}, f
1380: 75 6c 6c 20 65 78 70 61 6e 73 69 6f 6e 3a 20 22 ull expansion: "
1390: 20 66 75 6c 6c 63 6d 64 29 29 29 0a 09 09 20 28 fullcmd)))... (
13a0: 69 66 20 28 6f 72 20 61 6c 6c 6f 77 2d 73 79 73 if (or allow-sys
13b0: 74 65 6d 0a 09 09 09 20 28 6e 6f 74 20 28 6d 65 tem.... (not (me
13c0: 6d 62 65 72 20 63 6d 64 74 79 70 65 20 27 28 22 mber cmdtype '("
13d0: 73 79 73 74 65 6d 22 20 22 73 68 65 6c 6c 22 20 system" "shell"
13e0: 22 73 68 22 29 29 29 29 0a 09 09 20 20 20 20 20 "sh"))))...
13f0: 28 77 69 74 68 2d 69 6e 70 75 74 2d 66 72 6f 6d (with-input-from
1400: 2d 73 74 72 69 6e 67 20 66 75 6c 6c 63 6d 64 0a -string fullcmd.
1410: 09 09 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 .. (lambda
1420: 20 28 29 0a 09 09 09 20 28 73 65 74 21 20 72 65 ().... (set! re
1430: 73 75 6c 74 20 28 28 65 76 61 6c 20 28 72 65 61 sult ((eval (rea
1440: 64 29 29 20 68 74 29 29 29 29 0a 09 09 20 20 20 d)) ht))))...
1450: 20 20 28 73 65 74 21 20 72 65 73 75 6c 74 20 28 (set! result (
1460: 63 6f 6e 63 20 22 23 7b 28 22 20 63 6d 64 74 79 conc "#{(" cmdty
1470: 70 65 20 22 29 20 22 20 20 63 6d 64 20 22 7d 22 pe ") " cmd "}"
1480: 29 29 29 29 0a 09 09 28 63 61 73 65 20 63 6d 64 ))))...(case cmd
1490: 73 79 6d 0a 09 09 20 20 28 28 73 79 73 74 65 6d sym... ((system
14a0: 20 73 68 65 6c 6c 20 73 63 68 65 6d 65 29 0a 09 shell scheme)..
14b0: 09 20 20 20 28 6c 65 74 20 28 28 64 65 6c 74 61 . (let ((delta
14c0: 20 28 2d 20 28 63 75 72 72 65 6e 74 2d 73 65 63 (- (current-sec
14d0: 6f 6e 64 73 29 20 73 74 61 72 74 2d 74 69 6d 65 onds) start-time
14e0: 29 29 29 0a 09 09 20 20 20 20 20 28 69 66 20 28 )))... (if (
14f0: 3e 20 64 65 6c 74 61 20 32 29 0a 09 09 09 20 28 > delta 2).... (
1500: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
1510: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
1520: 70 6f 72 74 2a 20 22 66 6f 72 20 6c 69 6e 65 20 port* "for line
1530: 5c 22 22 20 6c 20 22 5c 22 5c 6e 20 63 6f 6d 6d \"" l "\"\n comm
1540: 61 6e 64 3a 20 20 22 20 63 6d 64 20 22 20 74 6f and: " cmd " to
1550: 6f 6b 20 22 20 64 65 6c 74 61 20 22 20 73 65 63 ok " delta " sec
1560: 6f 6e 64 73 20 74 6f 20 72 75 6e 20 77 69 74 68 onds to run with
1570: 20 6f 75 74 70 75 74 3a 5c 6e 20 20 20 22 20 72 output:\n " r
1580: 65 73 75 6c 74 29 0a 09 09 09 20 28 64 65 62 75 esult).... (debu
1590: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 39 20 2a g:print-info 9 *
15a0: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
15b0: 2a 20 22 66 6f 72 20 6c 69 6e 65 20 5c 22 22 20 * "for line \""
15c0: 6c 20 22 5c 22 5c 6e 20 63 6f 6d 6d 61 6e 64 3a l "\"\n command:
15d0: 20 20 22 20 63 6d 64 20 22 20 74 6f 6f 6b 20 22 " cmd " took "
15e0: 20 64 65 6c 74 61 20 22 20 73 65 63 6f 6e 64 73 delta " seconds
15f0: 20 74 6f 20 72 75 6e 20 77 69 74 68 20 6f 75 74 to run with out
1600: 70 75 74 3a 5c 6e 20 20 20 22 20 72 65 73 75 6c put:\n " resul
1610: 74 29 29 29 29 29 0a 09 09 28 6c 6f 6f 70 20 28 t)))))...(loop (
1620: 63 6f 6e 63 20 70 72 65 73 74 72 20 72 65 73 75 conc prestr resu
1630: 6c 74 20 70 6f 73 74 73 74 72 29 29 29 0a 09 20 lt poststr)))..
1640: 20 20 20 20 20 72 65 73 29 29 0a 09 72 65 73 29 res))..res)
1650: 29 29 0a 0a 3b 3b 20 52 75 6e 20 61 20 73 68 65 ))..;; Run a she
1660: 6c 6c 20 63 6f 6d 6d 61 6e 64 20 61 6e 64 20 72 ll command and r
1670: 65 74 75 72 6e 20 74 68 65 20 6f 75 74 70 75 74 eturn the output
1680: 20 61 73 20 61 20 73 74 72 69 6e 67 0a 28 64 65 as a string.(de
1690: 66 69 6e 65 20 28 73 68 65 6c 6c 20 63 6d 64 29 fine (shell cmd)
16a0: 0a 20 20 28 6c 65 74 2a 20 28 28 6f 75 74 70 75 . (let* ((outpu
16b0: 74 20 28 70 72 6f 63 65 73 73 3a 63 6d 64 2d 72 t (process:cmd-r
16c0: 75 6e 2d 3e 6c 69 73 74 20 63 6d 64 29 29 0a 09 un->list cmd))..
16d0: 20 28 72 65 73 20 20 20 20 28 63 61 72 20 6f 75 (res (car ou
16e0: 74 70 75 74 29 29 0a 09 20 28 73 74 61 74 75 73 tput)).. (status
16f0: 20 28 63 61 64 72 20 6f 75 74 70 75 74 29 29 29 (cadr output)))
1700: 0a 20 20 20 20 28 69 66 20 28 65 71 75 61 6c 3f . (if (equal?
1710: 20 73 74 61 74 75 73 20 30 29 0a 09 28 6c 65 74 status 0)..(let
1720: 20 28 28 6f 75 74 72 65 73 20 28 73 74 72 69 6e ((outres (strin
1730: 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 0a 09 g-intersperse ..
1740: 09 20 20 20 20 20 20 20 72 65 73 0a 09 09 20 20 . res...
1750: 20 20 20 20 20 22 5c 6e 22 29 29 29 0a 09 20 20 "\n")))..
1760: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
1770: 6f 20 34 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 o 4 *default-log
1780: 2d 70 6f 72 74 2a 20 22 73 68 65 6c 6c 20 72 65 -port* "shell re
1790: 73 75 6c 74 3a 5c 6e 22 20 6f 75 74 72 65 73 29 sult:\n" outres)
17a0: 0a 09 20 20 6f 75 74 72 65 73 29 0a 09 28 62 65 .. outres)..(be
17b0: 67 69 6e 0a 09 20 20 28 77 69 74 68 2d 6f 75 74 gin.. (with-out
17c0: 70 75 74 2d 74 6f 2d 70 6f 72 74 20 28 63 75 72 put-to-port (cur
17d0: 72 65 6e 74 2d 65 72 72 6f 72 2d 70 6f 72 74 29 rent-error-port)
17e0: 0a 09 20 20 20 20 28 6c 61 6d 62 64 61 20 28 29 .. (lambda ()
17f0: 0a 09 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 .. (print "
1800: 45 52 52 4f 52 3a 20 22 20 63 6d 64 20 22 20 72 ERROR: " cmd " r
1810: 65 74 75 72 6e 65 64 20 62 61 64 20 65 78 69 74 eturned bad exit
1820: 20 63 6f 64 65 20 22 20 73 74 61 74 75 73 29 29 code " status))
1830: 29 0a 09 20 20 22 22 29 29 29 29 0a 0a 3b 3b 20 ).. ""))))..;;
1840: 74 68 69 73 20 77 61 73 20 69 6e 6c 69 6e 65 20 this was inline
1850: 62 75 74 20 49 27 6d 20 70 72 65 74 74 79 20 73 but I'm pretty s
1860: 75 72 65 20 74 68 61 74 20 69 73 20 61 20 68 6f ure that is a ho
1870: 6c 64 20 6f 76 65 72 20 66 72 6f 6d 20 77 68 65 ld over from whe
1880: 6e 20 69 74 20 77 61 73 20 2a 76 65 72 79 2a 20 n it was *very*
1890: 73 69 6d 70 6c 65 20 2e 2e 2e 0a 3b 3b 0a 28 64 simple ....;;.(d
18a0: 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a 72 efine (configf:r
18b0: 65 61 64 2d 6c 69 6e 65 20 70 20 68 74 20 61 6c ead-line p ht al
18c0: 6c 6f 77 2d 70 72 6f 63 65 73 73 69 6e 67 20 73 low-processing s
18d0: 65 74 74 69 6e 67 73 29 0a 20 20 28 6c 65 74 20 ettings). (let
18e0: 6c 6f 6f 70 20 28 28 69 6e 6c 20 28 72 65 61 64 loop ((inl (read
18f0: 2d 6c 69 6e 65 20 70 29 29 29 0a 20 20 20 20 28 -line p))). (
1900: 6c 65 74 20 28 28 63 6f 6e 74 2d 6c 69 6e 65 20 let ((cont-line
1910: 28 61 6e 64 20 28 73 74 72 69 6e 67 3f 20 69 6e (and (string? in
1920: 6c 29 0a 09 09 09 20 20 28 6e 6f 74 20 28 73 74 l).... (not (st
1930: 72 69 6e 67 2d 6e 75 6c 6c 3f 20 69 6e 6c 29 29 ring-null? inl))
1940: 0a 09 09 09 20 20 28 65 71 75 61 6c 3f 20 22 5c .... (equal? "\
1950: 5c 22 20 28 73 74 72 69 6e 67 2d 74 61 6b 65 2d \" (string-take-
1960: 72 69 67 68 74 20 69 6e 6c 20 31 29 29 29 29 29 right inl 1)))))
1970: 0a 20 20 20 20 20 20 28 69 66 20 63 6f 6e 74 2d . (if cont-
1980: 6c 69 6e 65 20 3b 3b 20 6c 61 73 74 20 63 68 61 line ;; last cha
1990: 72 61 63 74 65 72 20 69 73 20 5c 20 0a 09 20 20 racter is \ ..
19a0: 28 6c 65 74 20 28 28 6e 65 78 74 6c 20 28 72 65 (let ((nextl (re
19b0: 61 64 2d 6c 69 6e 65 20 70 29 29 29 0a 09 20 20 ad-line p)))..
19c0: 20 20 28 69 66 20 28 6e 6f 74 20 28 65 6f 66 2d (if (not (eof-
19d0: 6f 62 6a 65 63 74 3f 20 6e 65 78 74 6c 29 29 0a object? nextl)).
19e0: 09 09 28 6c 6f 6f 70 20 28 73 74 72 69 6e 67 2d ..(loop (string-
19f0: 61 70 70 65 6e 64 20 28 69 66 20 63 6f 6e 74 2d append (if cont-
1a00: 6c 69 6e 65 20 0a 09 09 09 09 09 20 28 73 74 72 line ...... (str
1a10: 69 6e 67 2d 74 61 6b 65 20 69 6e 6c 20 28 2d 20 ing-take inl (-
1a20: 28 73 74 72 69 6e 67 2d 6c 65 6e 67 74 68 20 69 (string-length i
1a30: 6e 6c 29 20 31 29 29 0a 09 09 09 09 09 20 69 6e nl) 1))...... in
1a40: 6c 29 0a 09 09 09 09 20 20 20 20 20 6e 65 78 74 l)..... next
1a50: 6c 29 29 29 29 0a 09 20 20 28 6c 65 74 20 28 28 l)))).. (let ((
1a60: 72 65 73 20 28 63 61 73 65 20 61 6c 6c 6f 77 2d res (case allow-
1a70: 70 72 6f 63 65 73 73 69 6e 67 20 3b 3b 20 69 66 processing ;; if
1a80: 20 28 61 6e 64 20 61 6c 6c 6f 77 2d 70 72 6f 63 (and allow-proc
1a90: 65 73 73 69 6e 67 20 0a 09 09 20 20 20 20 20 20 essing ...
1aa0: 20 3b 3b 09 20 20 20 28 6e 6f 74 20 28 65 71 3f ;;. (not (eq?
1ab0: 20 61 6c 6c 6f 77 2d 70 72 6f 63 65 73 73 69 6e allow-processin
1ac0: 67 20 27 72 65 74 75 72 6e 2d 73 74 72 69 6e 67 g 'return-string
1ad0: 29 29 29 0a 09 09 20 20 20 20 20 20 20 28 28 23 )))... ((#
1ae0: 74 20 23 66 29 0a 09 09 09 28 63 6f 6e 66 69 67 t #f)....(config
1af0: 66 3a 70 72 6f 63 65 73 73 2d 6c 69 6e 65 20 69 f:process-line i
1b00: 6e 6c 20 68 74 20 61 6c 6c 6f 77 2d 70 72 6f 63 nl ht allow-proc
1b10: 65 73 73 69 6e 67 29 29 0a 09 09 20 20 20 20 20 essing))...
1b20: 20 20 28 28 72 65 74 75 72 6e 2d 73 74 72 69 6e ((return-strin
1b30: 67 29 0a 09 09 09 69 6e 6c 29 0a 09 09 20 20 20 g)....inl)...
1b40: 20 20 20 20 28 65 6c 73 65 0a 09 09 09 28 63 6f (else....(co
1b50: 6e 66 69 67 66 3a 70 72 6f 63 65 73 73 2d 6c 69 nfigf:process-li
1b60: 6e 65 20 69 6e 6c 20 68 74 20 61 6c 6c 6f 77 2d ne inl ht allow-
1b70: 70 72 6f 63 65 73 73 69 6e 67 29 29 29 29 29 0a processing))))).
1b80: 09 20 20 20 20 28 69 66 20 28 61 6e 64 20 28 73 . (if (and (s
1b90: 74 72 69 6e 67 3f 20 72 65 73 29 0a 09 09 20 20 tring? res)...
1ba0: 20 20 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 (not (equal?
1bb0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/
1bc0: 64 65 66 61 75 6c 74 20 73 65 74 74 69 6e 67 73 default settings
1bd0: 20 22 74 72 69 6d 2d 74 72 61 69 6c 69 6e 67 2d "trim-trailing-
1be0: 73 70 61 63 65 73 22 20 22 6e 6f 22 29 20 22 6e spaces" "no") "n
1bf0: 6f 22 29 29 29 0a 09 09 28 73 74 72 69 6e 67 2d o")))...(string-
1c00: 73 75 62 73 74 69 74 75 74 65 20 22 5c 5c 73 2b substitute "\\s+
1c10: 24 22 20 22 22 20 72 65 73 29 0a 09 09 72 65 73 $" "" res)...res
1c20: 29 29 29 29 29 29 0a 20 20 0a 28 64 65 66 69 6e )))))). .(defin
1c30: 65 20 28 63 61 6c 63 2d 61 6c 6c 6f 77 2d 73 79 e (calc-allow-sy
1c40: 73 74 65 6d 20 61 6c 6c 6f 77 2d 73 79 73 74 65 stem allow-syste
1c50: 6d 20 73 65 63 74 69 6f 6e 20 73 65 63 74 69 6f m section sectio
1c60: 6e 73 29 0a 20 20 28 69 66 20 73 65 63 74 69 6f ns). (if sectio
1c70: 6e 73 0a 20 20 20 20 20 20 28 61 6e 64 20 28 6f ns. (and (o
1c80: 72 20 28 65 71 75 61 6c 3f 20 22 64 65 66 61 75 r (equal? "defau
1c90: 6c 74 22 20 73 65 63 74 69 6f 6e 29 0a 09 20 20 lt" section)..
1ca0: 20 20 20 20 20 28 6d 65 6d 62 65 72 20 73 65 63 (member sec
1cb0: 74 69 6f 6e 20 73 65 63 74 69 6f 6e 73 29 29 0a tion sections)).
1cc0: 09 20 20 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d . allow-system
1cd0: 29 20 3b 3b 20 61 63 63 6f 75 6e 74 20 66 6f 72 ) ;; account for
1ce0: 20 73 65 63 74 69 6f 6e 73 20 61 6e 64 20 72 65 sections and re
1cf0: 74 75 72 6e 20 61 6c 6c 6f 77 2d 73 79 73 74 65 turn allow-syste
1d00: 6d 20 61 73 20 69 74 20 6d 69 67 68 74 20 62 65 m as it might be
1d10: 20 61 20 73 79 6d 62 6f 6c 20 73 75 63 68 20 61 a symbol such a
1d20: 73 20 72 65 74 75 72 6e 2d 73 74 72 69 6e 67 73 s return-strings
1d30: 0a 20 20 20 20 20 20 61 6c 6c 6f 77 2d 73 79 73 . allow-sys
1d40: 74 65 6d 29 29 0a 20 20 20 20 0a 3b 3b 20 67 69 tem)). .;; gi
1d50: 76 65 6e 20 61 20 63 6f 6e 66 69 67 20 68 61 73 ven a config has
1d60: 68 20 61 6e 64 20 61 20 73 65 63 74 69 6f 6e 20 h and a section
1d70: 6e 61 6d 65 2c 20 61 70 70 6c 79 20 74 68 61 74 name, apply that
1d80: 20 73 65 63 74 69 6f 6e 20 74 6f 20 61 6c 6c 20 section to all
1d90: 6d 61 74 63 68 69 6e 67 20 73 65 63 74 69 6f 6e matching section
1da0: 73 20 28 75 73 69 6e 67 20 77 69 6c 64 63 61 72 s (using wildcar
1db0: 64 20 25 20 6f 72 20 72 65 67 65 78 20 69 66 20 d % or regex if
1dc0: 2f 2e 2e 2e 2e 2f 29 0a 3b 3b 20 72 65 6d 6f 76 /..../).;; remov
1dd0: 65 20 74 68 65 20 73 65 63 74 69 6f 6e 20 77 68 e the section wh
1de0: 65 6e 20 64 6f 6e 65 20 73 6f 20 74 68 61 74 20 en done so that
1df0: 74 68 65 72 65 20 69 73 20 6e 6f 20 64 6f 77 6e there is no down
1e00: 73 74 72 65 61 6d 20 63 6c 6f 62 62 65 72 69 6e stream clobberin
1e10: 67 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 63 6f g.;;.(define (co
1e20: 6e 66 69 67 66 3a 61 70 70 6c 79 2d 77 69 6c 64 nfigf:apply-wild
1e30: 63 61 72 64 73 20 68 74 20 73 65 63 74 69 6f 6e cards ht section
1e40: 2d 6e 61 6d 65 29 0a 20 20 28 69 66 20 28 68 61 -name). (if (ha
1e50: 73 68 2d 74 61 62 6c 65 2d 65 78 69 73 74 73 3f sh-table-exists?
1e60: 20 68 74 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 ht section-name
1e70: 29 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 76 ). (let ((v
1e80: 61 72 73 20 28 68 61 73 68 2d 74 61 62 6c 65 2d ars (hash-table-
1e90: 72 65 66 20 68 74 20 73 65 63 74 69 6f 6e 2d 6e ref ht section-n
1ea0: 61 6d 65 29 29 0a 20 20 20 20 20 20 20 20 20 20 ame)).
1eb0: 20 20 28 72 78 20 20 20 28 72 65 67 65 78 70 20 (rx (regexp
1ec0: 28 69 66 20 28 73 74 72 69 6e 67 2d 63 6f 6e 74 (if (string-cont
1ed0: 61 69 6e 73 20 73 65 63 74 69 6f 6e 2d 6e 61 6d ains section-nam
1ee0: 65 20 22 25 22 29 0a 20 20 20 20 20 20 20 20 20 e "%").
1ef0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f00: 20 20 20 20 20 28 73 74 72 69 6e 67 2d 73 75 62 (string-sub
1f10: 73 74 69 74 75 74 65 20 73 65 63 74 69 6f 6e 2d stitute section-
1f20: 6e 61 6d 65 20 22 25 22 20 22 2e 2a 22 29 0a 20 name "%" ".*").
1f30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f40: 20 20 20 20 20 20 20 20 20 20 20 20 20 73 65 63 sec
1f50: 74 69 6f 6e 2d 6e 61 6d 65 29 29 29 29 0a 20 20 tion-name)))).
1f60: 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 0a (for-each.
1f70: 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 (lambda
1f80: 20 28 73 65 63 74 69 6f 6e 29 0a 20 20 20 20 20 (section).
1f90: 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 73 (if (and s
1fa0: 65 63 74 69 6f 6e 2d 6e 61 6d 65 0a 20 20 20 20 ection-name.
1fb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1fc0: 73 65 63 74 69 6f 6e 20 0a 20 20 20 20 20 20 20 section .
1fd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6e 6f (no
1fe0: 74 20 28 73 74 72 69 6e 67 3d 3f 20 73 65 63 74 t (string=? sect
1ff0: 69 6f 6e 2d 6e 61 6d 65 20 73 65 63 74 69 6f 6e ion-name section
2000: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
2010: 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d 6d (string-m
2020: 61 74 63 68 20 72 78 20 73 65 63 74 69 6f 6e 29 atch rx section)
2030: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
2040: 20 28 66 6f 72 2d 65 61 63 68 0a 20 20 20 20 20 (for-each.
2050: 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 (lamb
2060: 64 61 20 28 62 75 6e 64 6c 65 29 0a 20 20 20 20 da (bundle).
2070: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
2080: 65 74 20 28 28 6b 65 79 20 20 28 63 61 72 20 62 et ((key (car b
2090: 75 6e 64 6c 65 29 29 0a 20 20 20 20 20 20 20 20 undle)).
20a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
20b0: 28 76 61 6c 20 20 28 63 61 64 72 20 62 75 6e 64 (val (cadr bund
20c0: 6c 65 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 le)).
20d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6d 65 (me
20e0: 74 61 20 28 69 66 20 28 3e 20 28 6c 65 6e 67 74 ta (if (> (lengt
20f0: 68 20 62 75 6e 64 6c 65 29 20 32 29 28 63 61 64 h bundle) 2)(cad
2100: 64 72 20 62 75 6e 64 6c 65 29 20 23 66 29 29 29 dr bundle) #f)))
2110: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2120: 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 (hash-table
2130: 2d 73 65 74 21 20 68 74 20 73 65 63 74 69 6f 6e -set! ht section
2140: 20 28 63 6f 6e 66 69 67 3a 61 73 73 6f 63 2d 73 (config:assoc-s
2150: 61 66 65 2d 61 64 64 20 28 68 61 73 68 2d 74 61 afe-add (hash-ta
2160: 62 6c 65 2d 72 65 66 20 68 74 20 73 65 63 74 69 ble-ref ht secti
2170: 6f 6e 29 20 6b 65 79 20 76 61 6c 20 6d 65 74 61 on) key val meta
2180: 64 61 74 61 3a 20 6d 65 74 61 29 29 29 29 0a 20 data: meta)))).
2190: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 76 v
21a0: 61 72 73 29 29 29 0a 20 20 20 20 20 20 20 20 20 ars))).
21b0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 (hash-table-keys
21c0: 20 68 74 29 29 29 29 0a 20 20 68 74 29 0a 0a 3b ht)))). ht)..;
21d0: 3b 20 72 65 61 64 20 61 20 63 6f 6e 66 69 67 20 ; read a config
21e0: 66 69 6c 65 2c 20 72 65 74 75 72 6e 73 20 68 61 file, returns ha
21f0: 73 68 20 74 61 62 6c 65 20 6f 66 20 61 6c 69 73 sh table of alis
2200: 74 73 0a 0a 3b 3b 20 72 65 61 64 20 61 20 63 6f ts..;; read a co
2210: 6e 66 69 67 20 66 69 6c 65 2c 20 72 65 74 75 72 nfig file, retur
2220: 6e 73 20 68 61 73 68 20 74 61 62 6c 65 20 6f 66 ns hash table of
2230: 20 61 6c 69 73 74 73 0a 3b 3b 20 61 64 64 73 20 alists.;; adds
2240: 74 6f 20 68 74 20 69 66 20 67 69 76 65 6e 20 28 to ht if given (
2250: 6d 75 73 74 20 62 65 20 23 66 20 6f 74 68 65 72 must be #f other
2260: 77 69 73 65 29 0a 3b 3b 20 65 6e 76 69 6f 6e 2d wise).;; envion-
2270: 70 61 74 74 20 69 73 20 61 20 72 65 67 65 78 20 patt is a regex
2280: 73 70 65 63 20 74 68 61 74 20 69 64 65 6e 74 69 spec that identi
2290: 66 69 65 73 20 73 65 63 74 69 6f 6e 73 20 74 68 fies sections th
22a0: 61 74 20 77 69 6c 6c 20 62 65 20 65 76 61 6c 27 at will be eval'
22b0: 64 0a 3b 3b 20 69 6e 20 74 68 65 20 65 6e 76 69 d.;; in the envi
22c0: 72 6f 6e 6d 65 6e 74 20 6f 6e 20 74 68 65 20 66 ronment on the f
22d0: 6c 79 0a 3b 3b 20 73 65 63 74 69 6f 6e 73 3a 20 ly.;; sections:
22e0: 23 66 20 3d 3e 20 67 65 74 20 61 6c 6c 2c 20 65 #f => get all, e
22f0: 6c 73 65 20 6c 69 73 74 20 6f 66 20 73 65 63 74 lse list of sect
2300: 69 6f 6e 73 20 74 6f 20 67 61 74 68 65 72 0a 3b ions to gather.;
2310: 3b 20 70 6f 73 74 2d 73 65 63 74 69 6f 6e 2d 70 ; post-section-p
2320: 72 6f 63 73 20 61 6c 69 73 74 20 6f 66 20 73 65 rocs alist of se
2330: 63 74 69 6f 6e 2d 70 61 74 74 65 72 6e 20 3d 3e ction-pattern =>
2340: 20 70 72 6f 63 2c 20 77 68 65 72 65 3a 20 28 70 proc, where: (p
2350: 72 6f 63 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 roc section-name
2360: 20 6e 65 78 74 2d 73 65 63 74 69 6f 6e 2d 6e 61 next-section-na
2370: 6d 65 20 68 74 20 63 75 72 72 2d 70 61 74 68 29 me ht curr-path)
2380: 0a 3b 3b 20 61 70 70 6c 79 2d 77 69 6c 64 63 61 .;; apply-wildca
2390: 72 64 73 3a 20 23 74 2f 23 66 20 2d 20 61 70 70 rds: #t/#f - app
23a0: 6c 79 20 76 61 72 73 20 66 72 6f 6d 20 74 61 72 ly vars from tar
23b0: 67 65 74 73 20 77 69 74 68 20 25 20 77 69 6c 64 gets with % wild
23c0: 63 61 72 64 73 20 74 6f 20 61 6c 6c 20 6d 61 74 cards to all mat
23d0: 63 68 69 6e 67 20 73 65 63 74 69 6f 6e 73 0a 3b ching sections.;
23e0: 3b 0a 28 64 65 66 69 6e 65 20 28 72 65 61 64 2d ;.(define (read-
23f0: 63 6f 6e 66 69 67 20 70 61 74 68 20 68 74 20 61 config path ht a
2400: 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 23 21 6b 65 llow-system #!ke
2410: 79 20 28 65 6e 76 69 72 6f 6e 2d 70 61 74 74 20 y (environ-patt
2420: 23 66 29 28 63 75 72 72 2d 73 65 63 74 69 6f 6e #f)(curr-section
2430: 20 23 66 29 28 73 65 63 74 69 6f 6e 73 20 23 66 #f)(sections #f
2440: 29 28 73 65 74 74 69 6e 67 73 20 28 6d 61 6b 65 )(settings (make
2450: 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 28 6b 65 -hash-table))(ke
2460: 65 70 2d 66 69 6c 65 6e 61 6d 65 73 20 23 66 29 ep-filenames #f)
2470: 28 70 6f 73 74 2d 73 65 63 74 69 6f 6e 2d 70 72 (post-section-pr
2480: 6f 63 73 20 27 28 29 29 28 61 70 70 6c 79 2d 77 ocs '())(apply-w
2490: 69 6c 64 63 61 72 64 73 20 23 74 29 29 0a 20 20 ildcards #t)).
24a0: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
24b0: 6f 20 35 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 o 5 *default-log
24c0: 2d 70 6f 72 74 2a 20 22 72 65 61 64 2d 63 6f 6e -port* "read-con
24d0: 66 69 67 20 22 20 70 61 74 68 20 22 20 61 6c 6c fig " path " all
24e0: 6f 77 2d 73 79 73 74 65 6d 20 22 20 61 6c 6c 6f ow-system " allo
24f0: 77 2d 73 79 73 74 65 6d 20 22 20 65 6e 76 69 72 w-system " envir
2500: 6f 6e 2d 70 61 74 74 20 22 20 65 6e 76 69 72 6f on-patt " enviro
2510: 6e 2d 70 61 74 74 20 22 20 63 75 72 72 2d 73 65 n-patt " curr-se
2520: 63 74 69 6f 6e 3a 20 22 20 63 75 72 72 2d 73 65 ction: " curr-se
2530: 63 74 69 6f 6e 20 22 20 73 65 63 74 69 6f 6e 73 ction " sections
2540: 3a 20 22 20 73 65 63 74 69 6f 6e 73 20 22 20 70 : " sections " p
2550: 77 64 3a 20 22 20 28 63 75 72 72 65 6e 74 2d 64 wd: " (current-d
2560: 69 72 65 63 74 6f 72 79 29 29 0a 20 20 28 64 65 irectory)). (de
2570: 62 75 67 3a 70 72 69 6e 74 20 39 20 2a 64 65 66 bug:print 9 *def
2580: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
2590: 53 54 41 52 54 3a 20 22 20 70 61 74 68 29 0a 20 START: " path).
25a0: 20 28 69 66 20 28 61 6e 64 20 28 6e 6f 74 20 28 (if (and (not (
25b0: 70 6f 72 74 3f 20 70 61 74 68 29 29 0a 09 20 20 port? path))..
25c0: 20 28 6e 6f 74 20 28 66 69 6c 65 2d 65 78 69 73 (not (file-exis
25d0: 74 73 3f 20 70 61 74 68 29 29 29 20 3b 3b 20 66 ts? path))) ;; f
25e0: 6f 72 20 63 61 73 65 20 77 68 65 72 65 20 77 65 or case where we
25f0: 20 61 72 65 20 68 61 6e 64 65 64 20 61 20 70 6f are handed a po
2600: 72 74 0a 20 20 20 20 20 20 28 62 65 67 69 6e 20 rt. (begin
2610: 0a 09 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 ..(debug:print-i
2620: 6e 66 6f 20 31 20 2a 64 65 66 61 75 6c 74 2d 6c nfo 1 *default-l
2630: 6f 67 2d 70 6f 72 74 2a 20 22 72 65 61 64 2d 63 og-port* "read-c
2640: 6f 6e 66 69 67 20 2d 20 66 69 6c 65 20 6e 6f 74 onfig - file not
2650: 20 66 6f 75 6e 64 20 22 20 70 61 74 68 20 22 20 found " path "
2660: 63 75 72 72 65 6e 74 20 70 61 74 68 3a 20 22 20 current path: "
2670: 28 63 75 72 72 65 6e 74 2d 64 69 72 65 63 74 6f (current-directo
2680: 72 79 29 29 0a 09 3b 3b 20 57 41 52 4e 49 4e 47 ry))..;; WARNING
2690: 3a 20 54 68 69 73 20 69 73 20 61 20 72 69 73 6b : This is a risk
26a0: 79 20 63 68 61 6e 67 65 20 62 75 74 20 72 65 61 y change but rea
26b0: 6c 6c 79 2c 20 77 65 20 73 68 6f 75 6c 64 20 6e lly, we should n
26c0: 6f 74 20 72 65 74 75 72 6e 20 61 6e 20 65 6d 70 ot return an emp
26d0: 74 79 20 68 61 73 68 20 74 61 62 6c 65 20 69 66 ty hash table if
26e0: 20 6e 6f 20 66 69 6c 65 20 72 65 61 64 3f 0a 09 no file read?..
26f0: 23 66 29 20 3b 3b 20 28 69 66 20 28 6e 6f 74 20 #f) ;; (if (not
2700: 68 74 29 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 ht)(make-hash-ta
2710: 62 6c 65 29 20 68 74 29 29 0a 20 20 20 20 20 20 ble) ht)).
2720: 28 6c 65 74 20 28 28 69 6e 70 20 20 20 20 20 20 (let ((inp
2730: 20 20 28 69 66 20 28 73 74 72 69 6e 67 3f 20 70 (if (string? p
2740: 61 74 68 29 0a 09 09 09 20 20 20 20 28 6f 70 65 ath).... (ope
2750: 6e 2d 69 6e 70 75 74 2d 66 69 6c 65 20 70 61 74 n-input-file pat
2760: 68 29 0a 09 09 09 20 20 20 20 20 20 70 61 74 68 h).... path
2770: 29 29 20 3b 3b 20 77 65 20 63 61 6e 20 62 65 20 )) ;; we can be
2780: 68 61 6e 64 65 64 20 61 20 70 6f 72 74 0a 09 20 handed a port..
2790: 20 20 20 28 72 65 73 20 20 20 20 20 20 20 20 28 (res (
27a0: 69 66 20 28 6e 6f 74 20 68 74 29 28 6d 61 6b 65 if (not ht)(make
27b0: 2d 68 61 73 68 2d 74 61 62 6c 65 29 20 68 74 29 -hash-table) ht)
27c0: 29 0a 09 20 20 20 20 28 6d 65 74 61 70 61 74 68 ).. (metapath
27d0: 20 20 20 28 69 66 20 28 6f 72 20 28 64 65 62 75 (if (or (debu
27e0: 67 3a 64 65 62 75 67 2d 6d 6f 64 65 20 39 29 0a g:debug-mode 9).
27f0: 09 09 09 09 6b 65 65 70 2d 66 69 6c 65 6e 61 6d ....keep-filenam
2800: 65 73 29 0a 09 09 09 20 20 20 20 70 61 74 68 20 es).... path
2810: 23 66 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 #f)).
2820: 20 28 70 72 6f 63 65 73 73 2d 77 69 6c 64 63 61 (process-wildca
2830: 72 64 73 20 20 28 6c 61 6d 62 64 61 20 28 72 65 rds (lambda (re
2840: 73 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e s curr-section-n
2850: 61 6d 65 29 0a 20 20 20 20 20 20 20 20 20 20 20 ame).
2860: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2870: 20 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 (if (and
2880: 61 70 70 6c 79 2d 77 69 6c 64 63 61 72 64 73 0a apply-wildcards.
2890: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
28a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
28b0: 20 20 20 20 20 20 20 20 20 20 20 28 6f 72 20 28 (or (
28c0: 73 74 72 69 6e 67 2d 63 6f 6e 74 61 69 6e 73 20 string-contains
28d0: 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d curr-section-nam
28e0: 65 20 22 25 22 29 20 20 20 3b 3b 20 77 69 6c 64 e "%") ;; wild
28f0: 63 61 72 64 0a 20 20 20 20 20 20 20 20 20 20 20 card.
2900: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2910: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2920: 20 20 20 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 (string-matc
2930: 68 20 22 2f 2e 2a 2f 22 20 63 75 72 72 2d 73 65 h "/.*/" curr-se
2940: 63 74 69 6f 6e 2d 6e 61 6d 65 29 29 29 20 3b 3b ction-name))) ;;
2950: 20 72 65 67 65 78 0a 20 20 20 20 20 20 20 20 20 regex.
2960: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2970: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 62 65 (be
2980: 67 69 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 gin.
2990: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
29a0: 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e (con
29b0: 66 69 67 66 3a 61 70 70 6c 79 2d 77 69 6c 64 63 figf:apply-wildc
29c0: 61 72 64 73 20 72 65 73 20 63 75 72 72 2d 73 65 ards res curr-se
29d0: 63 74 69 6f 6e 2d 6e 61 6d 65 29 0a 20 20 20 20 ction-name).
29e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
29f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2a00: 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (hash-table-
2a10: 64 65 6c 65 74 65 21 20 72 65 73 20 63 75 72 72 delete! res curr
2a20: 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 29 29 29 -section-name)))
2a30: 29 29 29 20 20 3b 3b 20 4e 4f 54 45 3a 20 69 66 ))) ;; NOTE: if
2a40: 20 74 68 65 20 73 65 63 74 69 6f 6e 20 69 73 20 the section is
2a50: 61 20 77 69 6c 64 20 63 61 72 64 20 69 74 20 77 a wild card it w
2a60: 69 6c 6c 20 62 65 20 52 45 4d 4f 56 45 44 20 66 ill be REMOVED f
2a70: 72 6f 6d 20 72 65 73 20 0a 09 28 6c 65 74 20 6c rom res ..(let l
2a80: 6f 6f 70 20 28 28 69 6e 6c 20 20 20 20 20 20 20 oop ((inl
2a90: 20 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 66 (configf
2aa0: 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 20 72 :read-line inp r
2ab0: 65 73 20 28 63 61 6c 63 2d 61 6c 6c 6f 77 2d 73 es (calc-allow-s
2ac0: 79 73 74 65 6d 20 61 6c 6c 6f 77 2d 73 79 73 74 ystem allow-syst
2ad0: 65 6d 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 20 em curr-section
2ae0: 73 65 63 74 69 6f 6e 73 29 20 73 65 74 74 69 6e sections) settin
2af0: 67 73 29 29 20 3b 3b 20 28 72 65 61 64 2d 6c 69 gs)) ;; (read-li
2b00: 6e 65 20 69 6e 70 29 29 0a 09 09 20 20 20 28 63 ne inp))... (c
2b10: 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 urr-section-name
2b20: 20 28 69 66 20 63 75 72 72 2d 73 65 63 74 69 6f (if curr-sectio
2b30: 6e 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 20 22 n curr-section "
2b40: 64 65 66 61 75 6c 74 22 29 29 0a 09 09 20 20 20 default"))...
2b50: 28 76 61 72 2d 66 6c 61 67 20 23 66 29 3b 3b 20 (var-flag #f);;
2b60: 74 75 72 6e 20 6f 6e 20 66 6f 72 20 6b 65 79 2d turn on for key-
2b70: 76 61 72 2d 70 72 20 61 6e 64 20 63 6f 6e 74 2d var-pr and cont-
2b80: 6c 6e 2d 72 78 2c 20 74 75 72 6e 20 6f 66 66 20 ln-rx, turn off
2b90: 65 6c 73 65 77 68 65 72 65 0a 09 09 20 20 20 28 elsewhere... (
2ba0: 6c 65 61 64 20 20 20 20 20 23 66 29 29 0a 09 20 lead #f))..
2bb0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
2bc0: 66 6f 20 38 20 2a 64 65 66 61 75 6c 74 2d 6c 6f fo 8 *default-lo
2bd0: 67 2d 70 6f 72 74 2a 20 22 63 75 72 72 2d 73 65 g-port* "curr-se
2be0: 63 74 69 6f 6e 2d 6e 61 6d 65 3a 20 22 20 63 75 ction-name: " cu
2bf0: 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 rr-section-name
2c00: 22 20 76 61 72 2d 66 6c 61 67 3a 20 22 20 76 61 " var-flag: " va
2c10: 72 2d 66 6c 61 67 20 22 5c 6e 20 20 20 69 6e 6c r-flag "\n inl
2c20: 3a 20 5c 22 22 20 69 6e 6c 20 22 5c 22 22 29 0a : \"" inl "\"").
2c30: 09 20 20 28 69 66 20 28 65 6f 66 2d 6f 62 6a 65 . (if (eof-obje
2c40: 63 74 3f 20 69 6e 6c 29 20 0a 09 20 20 20 20 20 ct? inl) ..
2c50: 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 (begin.
2c60: 20 20 20 20 20 20 20 20 3b 3b 20 70 72 6f 63 65 ;; proce
2c70: 73 73 20 6c 61 73 74 20 73 65 63 74 69 6f 6e 20 ss last section
2c80: 66 6f 72 20 77 69 6c 64 63 61 72 64 73 0a 20 20 for wildcards.
2c90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 70 (p
2ca0: 72 6f 63 65 73 73 2d 77 69 6c 64 63 61 72 64 73 rocess-wildcards
2cb0: 20 72 65 73 20 63 75 72 72 2d 73 65 63 74 69 6f res curr-sectio
2cc0: 6e 2d 6e 61 6d 65 29 0a 09 09 28 69 66 20 28 73 n-name)...(if (s
2cd0: 74 72 69 6e 67 3f 20 70 61 74 68 29 20 3b 3b 20 tring? path) ;;
2ce0: 77 65 20 72 65 63 65 69 76 65 64 20 61 20 70 61 we received a pa
2cf0: 74 68 2c 20 6e 6f 74 20 61 20 70 6f 72 74 2c 20 th, not a port,
2d00: 74 68 75 73 20 77 65 20 61 72 65 20 72 65 73 70 thus we are resp
2d10: 6f 6e 73 69 62 6c 65 20 66 6f 72 20 63 6c 6f 73 onsible for clos
2d20: 69 6e 67 20 69 74 2e 0a 09 09 20 20 20 20 28 63 ing it.... (c
2d30: 6c 6f 73 65 2d 69 6e 70 75 74 2d 70 6f 72 74 20 lose-input-port
2d40: 69 6e 70 29 29 0a 09 09 28 68 61 73 68 2d 74 61 inp))...(hash-ta
2d50: 62 6c 65 2d 64 65 6c 65 74 65 21 20 72 65 73 20 ble-delete! res
2d60: 22 22 29 20 3b 3b 20 77 65 20 61 72 65 20 75 73 "") ;; we are us
2d70: 69 6e 67 20 22 22 20 61 73 20 61 20 64 75 6d 70 ing "" as a dump
2d80: 69 6e 67 20 67 72 6f 75 6e 64 20 61 6e 64 20 6d ing ground and m
2d90: 75 73 74 20 72 65 6d 6f 76 65 20 69 74 20 62 65 ust remove it be
2da0: 66 6f 72 65 20 72 65 74 75 72 6e 69 6e 67 20 74 fore returning t
2db0: 68 65 20 68 74 0a 09 09 28 64 65 62 75 67 3a 70 he ht...(debug:p
2dc0: 72 69 6e 74 20 39 20 2a 64 65 66 61 75 6c 74 2d rint 9 *default-
2dd0: 6c 6f 67 2d 70 6f 72 74 2a 20 22 45 4e 44 3a 20 log-port* "END:
2de0: 22 20 70 61 74 68 29 0a 09 09 72 65 73 29 0a 09 " path)...res)..
2df0: 20 20 20 20 20 20 28 72 65 67 65 78 2d 63 61 73 (regex-cas
2e00: 65 20 0a 09 20 20 20 20 20 20 20 69 6e 6c 20 0a e .. inl .
2e10: 09 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 66 . (configf
2e20: 3a 63 6f 6d 6d 65 6e 74 2d 72 78 20 5f 20 20 20 :comment-rx _
2e30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
2e40: 6c 6f 6f 70 20 28 63 6f 6e 66 69 67 66 3a 72 65 loop (configf:re
2e50: 61 64 2d 6c 69 6e 65 20 69 6e 70 20 72 65 73 20 ad-line inp res
2e60: 28 63 61 6c 63 2d 61 6c 6c 6f 77 2d 73 79 73 74 (calc-allow-syst
2e70: 65 6d 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 em allow-system
2e80: 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d curr-section-nam
2e90: 65 20 73 65 63 74 69 6f 6e 73 29 20 73 65 74 74 e sections) sett
2ea0: 69 6e 67 73 29 20 63 75 72 72 2d 73 65 63 74 69 ings) curr-secti
2eb0: 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 66 29 29 0a on-name #f #f)).
2ec0: 09 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 66 . (configf
2ed0: 3a 62 6c 61 6e 6b 2d 6c 2d 72 78 20 5f 20 20 20 :blank-l-rx _
2ee0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
2ef0: 6c 6f 6f 70 20 28 63 6f 6e 66 69 67 66 3a 72 65 loop (configf:re
2f00: 61 64 2d 6c 69 6e 65 20 69 6e 70 20 72 65 73 20 ad-line inp res
2f10: 28 63 61 6c 63 2d 61 6c 6c 6f 77 2d 73 79 73 74 (calc-allow-syst
2f20: 65 6d 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 em allow-system
2f30: 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d curr-section-nam
2f40: 65 20 73 65 63 74 69 6f 6e 73 29 20 73 65 74 74 e sections) sett
2f50: 69 6e 67 73 29 20 63 75 72 72 2d 73 65 63 74 69 ings) curr-secti
2f60: 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 66 29 29 0a on-name #f #f)).
2f70: 09 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 66 . (configf
2f80: 3a 73 65 74 74 69 6e 67 73 20 20 20 28 20 78 20 :settings ( x
2f90: 73 65 74 74 69 6e 67 20 76 61 6c 20 20 29 20 28 setting val ) (
2fa0: 62 65 67 69 6e 0a 09 09 09 09 09 09 09 28 68 61 begin........(ha
2fb0: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 73 65 sh-table-set! se
2fc0: 74 74 69 6e 67 73 20 73 65 74 74 69 6e 67 20 76 ttings setting v
2fd0: 61 6c 29 0a 09 09 09 09 09 09 09 28 6c 6f 6f 70 al)........(loop
2fe0: 20 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d 6c (configf:read-l
2ff0: 69 6e 65 20 69 6e 70 20 72 65 73 20 28 63 61 6c ine inp res (cal
3000: 63 2d 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 61 c-allow-system a
3010: 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 63 75 72 72 llow-system curr
3020: 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 73 65 -section-name se
3030: 63 74 69 6f 6e 73 29 20 73 65 74 74 69 6e 67 73 ctions) settings
3040: 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e ) curr-section-n
3050: 61 6d 65 20 23 66 20 23 66 29 29 29 0a 09 20 20 ame #f #f)))..
3060: 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 69 6e (configf:in
3070: 63 6c 75 64 65 2d 72 78 20 28 20 78 20 69 6e 63 clude-rx ( x inc
3080: 6c 75 64 65 2d 66 69 6c 65 20 29 20 28 6c 65 74 lude-file ) (let
3090: 2a 20 28 28 63 75 72 72 2d 63 6f 6e 66 2d 64 69 * ((curr-conf-di
30a0: 72 20 28 70 61 74 68 6e 61 6d 65 2d 64 69 72 65 r (pathname-dire
30b0: 63 74 6f 72 79 20 70 61 74 68 29 29 0a 09 09 09 ctory path))....
30c0: 09 09 09 09 20 20 20 20 20 28 66 75 6c 6c 2d 63 .... (full-c
30d0: 6f 6e 66 20 20 20 20 20 28 69 66 20 28 61 62 73 onf (if (abs
30e0: 6f 6c 75 74 65 2d 70 61 74 68 6e 61 6d 65 3f 20 olute-pathname?
30f0: 69 6e 63 6c 75 64 65 2d 66 69 6c 65 29 0a 09 09 include-file)...
3100: 09 09 09 09 09 09 09 09 69 6e 63 6c 75 64 65 2d ........include-
3110: 66 69 6c 65 0a 09 09 09 09 09 09 09 09 09 09 28 file...........(
3120: 63 6f 6d 6d 6f 6e 3a 6e 69 63 65 2d 70 61 74 68 common:nice-path
3130: 20 0a 09 09 09 09 09 09 09 09 09 09 20 28 63 6f ........... (co
3140: 6e 63 20 28 69 66 20 63 75 72 72 2d 63 6f 6e 66 nc (if curr-conf
3150: 2d 64 69 72 0a 09 09 09 09 09 09 09 09 09 09 09 -dir............
3160: 20 20 20 63 75 72 72 2d 63 6f 6e 66 2d 64 69 72 curr-conf-dir
3170: 0a 09 09 09 09 09 09 09 09 09 09 09 20 20 20 22 ............ "
3180: 2e 22 29 0a 09 09 09 09 09 09 09 09 09 09 20 20 .")...........
3190: 20 20 20 20 20 22 2f 22 20 69 6e 63 6c 75 64 65 "/" include
31a0: 2d 66 69 6c 65 29 29 29 29 29 0a 09 09 09 09 09 -file)))))......
31b0: 09 09 28 69 66 20 28 66 69 6c 65 2d 65 78 69 73 ..(if (file-exis
31c0: 74 73 3f 20 66 75 6c 6c 2d 63 6f 6e 66 29 0a 09 ts? full-conf)..
31d0: 09 09 09 09 09 09 20 20 20 20 28 62 65 67 69 6e ...... (begin
31e0: 0a 09 09 09 09 09 09 09 20 20 20 20 20 20 3b 3b ........ ;;
31f0: 20 28 70 75 73 68 2d 64 69 72 65 63 74 6f 72 79 (push-directory
3200: 20 63 6f 6e 66 2d 64 69 72 29 0a 09 09 09 09 09 conf-dir)......
3210: 09 09 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 .. (debug:p
3220: 72 69 6e 74 20 39 20 2a 64 65 66 61 75 6c 74 2d rint 9 *default-
3230: 6c 6f 67 2d 70 6f 72 74 2a 20 22 49 6e 63 6c 75 log-port* "Inclu
3240: 64 69 6e 67 3a 20 22 20 66 75 6c 6c 2d 63 6f 6e ding: " full-con
3250: 66 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 20 f)........
3260: 28 72 65 61 64 2d 63 6f 6e 66 69 67 20 66 75 6c (read-config ful
3270: 6c 2d 63 6f 6e 66 20 72 65 73 20 61 6c 6c 6f 77 l-conf res allow
3280: 2d 73 79 73 74 65 6d 20 65 6e 76 69 72 6f 6e 2d -system environ-
3290: 70 61 74 74 3a 20 65 6e 76 69 72 6f 6e 2d 70 61 patt: environ-pa
32a0: 74 74 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 3a tt curr-section:
32b0: 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 curr-section-na
32c0: 6d 65 20 73 65 63 74 69 6f 6e 73 3a 20 73 65 63 me sections: sec
32d0: 74 69 6f 6e 73 20 73 65 74 74 69 6e 67 73 3a 20 tions settings:
32e0: 73 65 74 74 69 6e 67 73 20 6b 65 65 70 2d 66 69 settings keep-fi
32f0: 6c 65 6e 61 6d 65 73 3a 20 6b 65 65 70 2d 66 69 lenames: keep-fi
3300: 6c 65 6e 61 6d 65 73 29 0a 09 09 09 09 09 09 09 lenames)........
3310: 20 20 20 20 20 20 3b 3b 20 28 70 6f 70 2d 64 69 ;; (pop-di
3320: 72 65 63 74 6f 72 79 29 0a 09 09 09 09 09 09 09 rectory)........
3330: 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 6f 6e (loop (con
3340: 66 69 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 figf:read-line i
3350: 6e 70 20 72 65 73 20 28 63 61 6c 63 2d 61 6c 6c np res (calc-all
3360: 6f 77 2d 73 79 73 74 65 6d 20 61 6c 6c 6f 77 2d ow-system allow-
3370: 73 79 73 74 65 6d 20 63 75 72 72 2d 73 65 63 74 system curr-sect
3380: 69 6f 6e 2d 6e 61 6d 65 20 73 65 63 74 69 6f 6e ion-name section
3390: 73 29 20 73 65 74 74 69 6e 67 73 29 20 63 75 72 s) settings) cur
33a0: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 r-section-name #
33b0: 66 20 23 66 29 29 0a 09 09 09 09 09 09 09 20 20 f #f))........
33c0: 20 20 28 62 65 67 69 6e 0a 09 09 09 09 09 09 09 (begin........
33d0: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
33e0: 6e 74 20 27 28 32 20 39 29 20 23 66 20 22 49 4e nt '(2 9) #f "IN
33f0: 46 4f 3a 20 69 6e 63 6c 75 64 65 20 66 69 6c 65 FO: include file
3400: 20 22 20 69 6e 63 6c 75 64 65 2d 66 69 6c 65 20 " include-file
3410: 22 20 6e 6f 74 20 66 6f 75 6e 64 20 28 63 61 6c " not found (cal
3420: 6c 65 64 20 66 72 6f 6d 20 22 20 70 61 74 68 20 led from " path
3430: 22 29 22 29 0a 09 09 09 09 09 09 09 20 20 20 20 ")")........
3440: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 (debug:print 2
3450: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
3460: 72 74 2a 20 22 20 20 20 20 20 20 20 20 22 20 66 rt* " " f
3470: 75 6c 6c 2d 63 6f 6e 66 29 0a 09 09 09 09 09 09 ull-conf).......
3480: 09 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 6f . (loop (co
3490: 6e 66 69 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 nfigf:read-line
34a0: 69 6e 70 20 72 65 73 20 28 63 61 6c 63 2d 61 6c inp res (calc-al
34b0: 6c 6f 77 2d 73 79 73 74 65 6d 20 61 6c 6c 6f 77 low-system allow
34c0: 2d 73 79 73 74 65 6d 20 63 75 72 72 2d 73 65 63 -system curr-sec
34d0: 74 69 6f 6e 2d 6e 61 6d 65 20 73 65 63 74 69 6f tion-name sectio
34e0: 6e 73 29 20 73 65 74 74 69 6e 67 73 29 20 63 75 ns) settings) cu
34f0: 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 rr-section-name
3500: 23 66 20 23 66 29 29 29 29 29 0a 09 20 20 20 20 #f #f)))))..
3510: 20 20 20 28 63 6f 6e 66 69 67 66 3a 73 63 72 69 (configf:scri
3520: 70 74 2d 72 78 20 28 20 78 20 69 6e 63 6c 75 64 pt-rx ( x includ
3530: 65 2d 73 63 72 69 70 74 20 29 3b 3b 20 68 61 6e e-script );; han
3540: 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 dle-exceptions..
3550: 09 09 09 09 09 20 20 20 20 20 20 3b 3b 20 20 20 ..... ;;
3560: 20 65 78 6e 0a 09 09 09 09 09 09 20 20 20 20 20 exn.......
3570: 20 3b 3b 20 20 20 20 28 62 65 67 69 6e 0a 09 09 ;; (begin...
3580: 09 09 09 09 20 20 20 20 20 20 3b 3b 20 20 20 20 .... ;;
3590: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 27 (debug:print '
35a0: 28 30 20 32 20 39 29 20 23 66 20 22 49 4e 46 4f (0 2 9) #f "INFO
35b0: 3a 20 69 6e 63 6c 75 64 65 20 66 72 6f 6d 20 73 : include from s
35c0: 63 72 69 70 74 20 22 20 69 6e 63 6c 75 64 65 2d cript " include-
35d0: 73 63 72 69 70 74 20 22 20 66 61 69 6c 65 64 2e script " failed.
35e0: 22 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 3b ")....... ;
35f0: 3b 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 6f ; (loop (co
3600: 6e 66 69 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 nfigf:read-line
3610: 69 6e 70 20 72 65 73 20 28 63 61 6c 63 2d 61 6c inp res (calc-al
3620: 6c 6f 77 2d 73 79 73 74 65 6d 20 61 6c 6c 6f 77 low-system allow
3630: 2d 73 79 73 74 65 6d 20 63 75 72 72 2d 73 65 63 -system curr-sec
3640: 74 69 6f 6e 2d 6e 61 6d 65 20 73 65 63 74 69 6f tion-name sectio
3650: 6e 73 29 20 73 65 74 74 69 6e 67 73 29 20 63 75 ns) settings) cu
3660: 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 rr-section-name
3670: 23 66 20 23 66 29 29 0a 09 09 09 09 09 09 09 20 #f #f))........
3680: 28 69 66 20 28 61 6e 64 20 28 66 69 6c 65 2d 65 (if (and (file-e
3690: 78 69 73 74 73 3f 20 69 6e 63 6c 75 64 65 2d 73 xists? include-s
36a0: 63 72 69 70 74 29 28 66 69 6c 65 2d 65 78 65 63 cript)(file-exec
36b0: 75 74 65 2d 61 63 63 65 73 73 3f 20 69 6e 63 6c ute-access? incl
36c0: 75 64 65 2d 73 63 72 69 70 74 29 29 0a 09 09 09 ude-script))....
36d0: 09 09 09 09 20 20 20 20 20 28 6c 65 74 2a 20 28 .... (let* (
36e0: 28 6e 65 77 2d 69 6e 70 2d 70 6f 72 74 20 28 6f (new-inp-port (o
36f0: 70 65 6e 2d 69 6e 70 75 74 2d 70 69 70 65 20 69 pen-input-pipe i
3700: 6e 63 6c 75 64 65 2d 73 63 72 69 70 74 29 29 29 nclude-script)))
3710: 0a 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 ........ (
3720: 64 65 62 75 67 3a 70 72 69 6e 74 20 27 28 32 20 debug:print '(2
3730: 39 29 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 9) *default-log-
3740: 70 6f 72 74 2a 20 22 49 6e 63 6c 75 64 69 6e 67 port* "Including
3750: 20 66 72 6f 6d 20 73 63 72 69 70 74 20 6f 75 74 from script out
3760: 70 75 74 3a 20 22 20 69 6e 63 6c 75 64 65 2d 73 put: " include-s
3770: 63 72 69 70 74 29 0a 09 09 09 09 09 09 09 20 20 cript)........
3780: 20 20 20 20 3b 3b 20 20 28 70 72 69 6e 74 20 22 ;; (print "
3790: 57 65 20 67 6f 74 20 68 65 72 65 2c 20 63 61 6c We got here, cal
37a0: 6c 69 6e 67 20 72 65 61 64 2d 63 6f 6e 66 69 67 ling read-config
37b0: 20 6e 65 78 74 2e 20 50 6f 72 74 20 69 73 3a 20 next. Port is:
37c0: 22 20 6e 65 77 2d 69 6e 70 2d 70 6f 72 74 29 0a " new-inp-port).
37d0: 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 72 ....... (r
37e0: 65 61 64 2d 63 6f 6e 66 69 67 20 6e 65 77 2d 69 ead-config new-i
37f0: 6e 70 2d 70 6f 72 74 20 72 65 73 20 61 6c 6c 6f np-port res allo
3800: 77 2d 73 79 73 74 65 6d 20 65 6e 76 69 72 6f 6e w-system environ
3810: 2d 70 61 74 74 3a 20 65 6e 76 69 72 6f 6e 2d 70 -patt: environ-p
3820: 61 74 74 20 63 75 72 72 2d 73 65 63 74 69 6f 6e att curr-section
3830: 3a 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e : curr-section-n
3840: 61 6d 65 20 73 65 63 74 69 6f 6e 73 3a 20 73 65 ame sections: se
3850: 63 74 69 6f 6e 73 20 73 65 74 74 69 6e 67 73 3a ctions settings:
3860: 20 73 65 74 74 69 6e 67 73 20 6b 65 65 70 2d 66 settings keep-f
3870: 69 6c 65 6e 61 6d 65 73 3a 20 6b 65 65 70 2d 66 ilenames: keep-f
3880: 69 6c 65 6e 61 6d 65 73 29 0a 09 09 09 09 09 09 ilenames).......
3890: 09 20 20 20 20 20 20 20 28 63 6c 6f 73 65 2d 69 . (close-i
38a0: 6e 70 75 74 2d 70 6f 72 74 20 6e 65 77 2d 69 6e nput-port new-in
38b0: 70 2d 70 6f 72 74 29 0a 09 09 09 09 09 09 09 20 p-port)........
38c0: 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 6f 6e (loop (con
38d0: 66 69 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 figf:read-line i
38e0: 6e 70 20 72 65 73 20 28 63 61 6c 63 2d 61 6c 6c np res (calc-all
38f0: 6f 77 2d 73 79 73 74 65 6d 20 61 6c 6c 6f 77 2d ow-system allow-
3900: 73 79 73 74 65 6d 20 63 75 72 72 2d 73 65 63 74 system curr-sect
3910: 69 6f 6e 2d 6e 61 6d 65 20 73 65 63 74 69 6f 6e ion-name section
3920: 73 29 20 73 65 74 74 69 6e 67 73 29 20 63 75 72 s) settings) cur
3930: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 r-section-name #
3940: 66 20 23 66 29 29 0a 09 09 09 09 09 09 09 20 20 f #f))........
3950: 20 20 20 28 62 65 67 69 6e 0a 09 09 09 09 09 09 (begin.......
3960: 09 20 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 . (debug:p
3970: 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d rint 0 *default-
3980: 6c 6f 67 2d 70 6f 72 74 2a 20 22 53 63 72 69 70 log-port* "Scrip
3990: 74 20 6e 6f 74 20 66 6f 75 6e 64 20 6f 72 20 6e t not found or n
39a0: 6f 74 20 65 78 65 63 74 75 74 61 62 6c 65 3a 20 ot exectutable:
39b0: 22 20 69 6e 63 6c 75 64 65 2d 73 63 72 69 70 74 " include-script
39c0: 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 20 20 )........
39d0: 28 6c 6f 6f 70 20 28 63 6f 6e 66 69 67 66 3a 72 (loop (configf:r
39e0: 65 61 64 2d 6c 69 6e 65 20 69 6e 70 20 72 65 73 ead-line inp res
39f0: 20 28 63 61 6c 63 2d 61 6c 6c 6f 77 2d 73 79 73 (calc-allow-sys
3a00: 74 65 6d 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d tem allow-system
3a10: 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 curr-section-na
3a20: 6d 65 20 73 65 63 74 69 6f 6e 73 29 20 73 65 74 me sections) set
3a30: 74 69 6e 67 73 29 20 63 75 72 72 2d 73 65 63 74 tings) curr-sect
3a40: 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 66 29 29 ion-name #f #f))
3a50: 29 0a 09 09 09 09 09 09 09 20 29 20 3b 3b 20 29 )........ ) ;; )
3a60: 0a 09 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 .. (config
3a70: 66 3a 73 65 63 74 69 6f 6e 2d 72 78 20 28 20 78 f:section-rx ( x
3a80: 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 29 20 section-name )
3a90: 28 62 65 67 69 6e 0a 09 09 09 09 09 09 09 3b 3b (begin........;;
3aa0: 20 63 61 6c 6c 20 70 6f 73 74 2d 73 65 63 74 69 call post-secti
3ab0: 6f 6e 2d 70 72 6f 63 73 0a 09 09 09 09 09 09 09 on-procs........
3ac0: 28 66 6f 72 2d 65 61 63 68 20 0a 09 09 09 09 09 (for-each ......
3ad0: 09 09 20 28 6c 61 6d 62 64 61 20 28 64 61 74 29 .. (lambda (dat)
3ae0: 0a 09 09 09 09 09 09 09 20 20 20 28 6c 65 74 20 ........ (let
3af0: 28 28 70 61 74 74 20 28 63 61 72 20 64 61 74 29 ((patt (car dat)
3b00: 29 0a 09 09 09 09 09 09 09 09 20 28 70 72 6f 63 )......... (proc
3b10: 20 28 63 64 72 20 64 61 74 29 29 29 0a 09 09 09 (cdr dat)))....
3b20: 09 09 09 09 20 20 20 20 20 28 69 66 20 28 73 74 .... (if (st
3b30: 72 69 6e 67 2d 6d 61 74 63 68 20 70 61 74 74 20 ring-match patt
3b40: 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d curr-section-nam
3b50: 65 29 0a 09 09 09 09 09 09 09 09 20 28 70 72 6f e)......... (pro
3b60: 63 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e c curr-section-n
3b70: 61 6d 65 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 ame section-name
3b80: 20 72 65 73 20 70 61 74 68 29 29 29 29 0a 09 09 res path))))...
3b90: 09 09 09 09 09 20 70 6f 73 74 2d 73 65 63 74 69 ..... post-secti
3ba0: 6f 6e 2d 70 72 6f 63 73 29 0a 20 20 20 20 20 20 on-procs).
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 20 20 20
3be0: 20 20 3b 3b 20 61 66 74 65 72 20 67 61 74 68 65 ;; after gathe
3bf0: 72 69 6e 67 20 74 68 65 20 76 61 72 73 20 66 6f ring the vars fo
3c00: 72 20 61 20 73 65 63 74 69 6f 6e 20 61 6e 64 20 r a section and
3c10: 69 66 20 61 70 70 6c 79 2d 77 69 6c 64 63 61 72 if apply-wildcar
3c20: 64 73 20 69 73 20 74 72 75 65 20 61 6e 64 20 69 ds is true and i
3c30: 66 20 74 68 65 72 65 20 69 73 20 61 20 77 69 6c f there is a wil
3c40: 64 63 61 72 64 20 69 6e 20 74 68 65 20 73 65 63 dcard in the sec
3c50: 74 69 6f 6e 20 6e 61 6d 65 20 70 72 6f 63 65 73 tion name proces
3c60: 73 20 77 69 6c 64 63 61 72 64 73 0a 20 20 20 20 s wildcards.
3c70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3c80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3c90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3ca0: 20 20 20 20 3b 3b 20 4e 4f 54 45 3a 20 77 65 20 ;; NOTE: we
3cb0: 61 72 65 20 70 72 6f 63 65 73 73 69 6e 67 20 74 are processing t
3cc0: 68 65 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d he curr-section-
3cd0: 6e 61 6d 65 2c 20 4e 4f 54 20 73 65 63 74 69 6f name, NOT sectio
3ce0: 6e 2d 6e 61 6d 65 2e 0a 20 20 20 20 20 20 20 20 n-name..
3cf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3d00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3d10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3d20: 28 70 72 6f 63 65 73 73 2d 77 69 6c 64 63 61 72 (process-wildcar
3d30: 64 73 20 72 65 73 20 63 75 72 72 2d 73 65 63 74 ds res curr-sect
3d40: 69 6f 6e 2d 6e 61 6d 65 29 0a 09 09 09 09 09 09 ion-name).......
3d50: 09 28 6c 6f 6f 70 20 28 63 6f 6e 66 69 67 66 3a .(loop (configf:
3d60: 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 20 72 65 read-line inp re
3d70: 73 20 28 63 61 6c 63 2d 61 6c 6c 6f 77 2d 73 79 s (calc-allow-sy
3d80: 73 74 65 6d 20 61 6c 6c 6f 77 2d 73 79 73 74 65 stem allow-syste
3d90: 6d 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e m curr-section-n
3da0: 61 6d 65 20 73 65 63 74 69 6f 6e 73 29 20 73 65 ame sections) se
3db0: 74 74 69 6e 67 73 29 0a 09 09 09 09 09 09 09 20 ttings)........
3dc0: 20 20 20 20 20 3b 3b 20 69 66 20 77 65 20 68 61 ;; if we ha
3dd0: 76 65 20 74 68 65 20 73 65 63 74 69 6f 6e 73 20 ve the sections
3de0: 6c 69 73 74 20 74 68 65 6e 20 66 6f 72 63 65 20 list then force
3df0: 61 6c 6c 20 73 65 74 74 69 6e 67 73 20 69 6e 74 all settings int
3e00: 6f 20 22 22 20 61 6e 64 20 64 65 6c 65 74 65 20 o "" and delete
3e10: 69 74 20 6c 61 74 65 72 3f 0a 09 09 09 09 09 09 it later?.......
3e20: 09 20 20 20 20 20 20 28 69 66 20 28 6f 72 20 28 . (if (or (
3e30: 6e 6f 74 20 73 65 63 74 69 6f 6e 73 29 20 0a 09 not sections) ..
3e40: 09 09 09 09 09 09 09 20 20 20 20 20 20 28 6d 65 ....... (me
3e50: 6d 62 65 72 20 73 65 63 74 69 6f 6e 2d 6e 61 6d mber section-nam
3e60: 65 20 73 65 63 74 69 6f 6e 73 29 29 0a 09 09 09 e sections))....
3e70: 09 09 09 09 09 20 20 73 65 63 74 69 6f 6e 2d 6e ..... section-n
3e80: 61 6d 65 20 22 22 29 20 3b 3b 20 73 74 69 63 6b ame "") ;; stick
3e90: 20 65 76 65 72 79 74 68 69 6e 67 20 69 6e 74 6f everything into
3ea0: 20 22 22 0a 09 09 09 09 09 09 09 20 20 20 20 20 ""........
3eb0: 20 23 66 20 23 66 29 29 29 0a 09 20 20 20 20 20 #f #f)))..
3ec0: 20 20 28 63 6f 6e 66 69 67 66 3a 6b 65 79 2d 73 (configf:key-s
3ed0: 79 73 2d 70 72 20 28 20 78 20 6b 65 79 20 63 6d ys-pr ( x key cm
3ee0: 64 20 20 20 20 20 20 29 20 28 69 66 20 28 63 61 d ) (if (ca
3ef0: 6c 63 2d 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 lc-allow-system
3f00: 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 63 75 72 allow-system cur
3f10: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 73 r-section-name s
3f20: 65 63 74 69 6f 6e 73 29 0a 09 09 09 09 09 09 09 ections)........
3f30: 20 20 28 6c 65 74 20 28 28 61 6c 69 73 74 20 20 (let ((alist
3f40: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 (hash-table-re
3f50: 66 2f 64 65 66 61 75 6c 74 20 72 65 73 20 63 75 f/default res cu
3f60: 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 rr-section-name
3f70: 27 28 29 29 29 0a 09 09 09 09 09 09 09 09 28 76 '())).........(v
3f80: 61 6c 2d 70 72 6f 63 20 28 6c 61 6d 62 64 61 20 al-proc (lambda
3f90: 28 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 ()..........
3fa0: 28 6c 65 74 2a 20 28 28 73 74 61 72 74 2d 74 69 (let* ((start-ti
3fb0: 6d 65 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f me (current-seco
3fc0: 6e 64 73 29 29 0a 09 09 09 09 09 09 09 09 09 09 nds))...........
3fd0: 20 20 20 28 63 6d 64 72 65 73 20 20 20 20 20 28 (cmdres (
3fe0: 70 72 6f 63 65 73 73 3a 63 6d 64 2d 72 75 6e 2d process:cmd-run-
3ff0: 3e 6c 69 73 74 20 63 6d 64 29 29 0a 09 09 09 09 >list cmd)).....
4000: 09 09 09 09 09 09 20 20 20 28 64 65 6c 74 61 20 ...... (delta
4010: 20 20 20 20 20 28 2d 20 28 63 75 72 72 65 6e 74 (- (current
4020: 2d 73 65 63 6f 6e 64 73 29 20 73 74 61 72 74 2d -seconds) start-
4030: 74 69 6d 65 29 29 0a 09 09 09 09 09 09 09 09 09 time))..........
4040: 09 20 20 20 28 73 74 61 74 75 73 20 20 20 20 20 . (status
4050: 28 63 61 64 72 20 63 6d 64 72 65 73 29 29 0a 09 (cadr cmdres))..
4060: 09 09 09 09 09 09 09 09 09 20 20 20 28 72 65 73 ......... (res
4070: 20 20 20 20 20 20 20 20 28 63 61 72 20 20 63 6d (car cm
4080: 64 72 65 73 29 29 29 0a 09 09 09 09 09 09 09 09 dres))).........
4090: 09 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
40a0: 69 6e 74 2d 69 6e 66 6f 20 34 20 2a 64 65 66 61 int-info 4 *defa
40b0: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 22 ult-log-port* ""
40c0: 20 69 6e 6c 20 22 5c 6e 20 3d 3e 20 22 20 28 73 inl "\n => " (s
40d0: 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 tring-interspers
40e0: 65 20 72 65 73 20 22 5c 6e 22 29 29 0a 09 09 09 e res "\n"))....
40f0: 09 09 09 09 09 09 20 20 20 20 20 20 28 69 66 20 ...... (if
4100: 28 6e 6f 74 20 28 65 71 3f 20 73 74 61 74 75 73 (not (eq? status
4110: 20 30 29 29 0a 09 09 09 09 09 09 09 09 09 09 20 0))...........
4120: 20 28 62 65 67 69 6e 0a 09 09 09 09 09 09 09 09 (begin.........
4130: 09 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 .. (debug:pri
4140: 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 nt-error 0 *defa
4150: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 70 ult-log-port* "p
4160: 72 6f 62 6c 65 6d 20 77 69 74 68 20 22 20 69 6e roblem with " in
4170: 6c 20 22 2c 20 72 65 74 75 72 6e 20 63 6f 64 65 l ", return code
4180: 20 22 20 73 74 61 74 75 73 0a 09 09 09 09 09 09 " status.......
4190: 09 09 09 09 09 09 20 22 20 6f 75 74 70 75 74 3a ...... " output:
41a0: 20 22 20 63 6d 64 72 65 73 29 29 29 0a 09 09 09 " cmdres)))....
41b0: 09 09 09 09 09 09 20 20 20 20 20 20 28 69 66 20 ...... (if
41c0: 28 3e 20 64 65 6c 74 61 20 32 29 0a 09 09 09 09 (> delta 2).....
41d0: 09 09 09 09 09 09 20 20 28 64 65 62 75 67 3a 70 ...... (debug:p
41e0: 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 rint-info 0 *def
41f0: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
4200: 66 6f 72 20 6c 69 6e 65 20 5c 22 22 20 69 6e 6c for line \"" inl
4210: 20 22 5c 22 5c 6e 20 20 63 6f 6d 6d 61 6e 64 3a "\"\n command:
4220: 20 22 20 63 6d 64 20 22 20 74 6f 6f 6b 20 22 20 " cmd " took "
4230: 64 65 6c 74 61 20 22 20 73 65 63 6f 6e 64 73 20 delta " seconds
4240: 74 6f 20 72 75 6e 20 77 69 74 68 20 6f 75 74 70 to run with outp
4250: 75 74 3a 5c 6e 20 20 20 22 20 72 65 73 29 0a 09 ut:\n " res)..
4260: 09 09 09 09 09 09 09 09 09 20 20 28 64 65 62 75 ......... (debu
4270: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 39 20 2a g:print-info 9 *
4280: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
4290: 2a 20 22 66 6f 72 20 6c 69 6e 65 20 5c 22 22 20 * "for line \""
42a0: 69 6e 6c 20 22 5c 22 5c 6e 20 20 63 6f 6d 6d 61 inl "\"\n comma
42b0: 6e 64 3a 20 22 20 63 6d 64 20 22 20 74 6f 6f 6b nd: " cmd " took
42c0: 20 22 20 64 65 6c 74 61 20 22 20 73 65 63 6f 6e " delta " secon
42d0: 64 73 20 74 6f 20 72 75 6e 20 77 69 74 68 20 6f ds to run with o
42e0: 75 74 70 75 74 3a 5c 6e 20 20 20 22 20 72 65 73 utput:\n " res
42f0: 29 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 ))..........
4300: 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 72 65 73 (if (null? res
4310: 29 0a 09 09 09 09 09 09 09 09 09 09 20 20 22 22 )........... ""
4320: 0a 09 09 09 09 09 09 09 09 09 09 20 20 28 73 74 ........... (st
4330: 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 ring-intersperse
4340: 20 72 65 73 20 22 20 22 29 29 29 29 29 29 0a 09 res " "))))))..
4350: 09 09 09 09 09 09 20 20 20 20 28 68 61 73 68 2d ...... (hash-
4360: 74 61 62 6c 65 2d 73 65 74 21 20 72 65 73 20 63 table-set! res c
4370: 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 urr-section-name
4380: 20 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 20 ..........
4390: 28 63 6f 6e 66 69 67 3a 61 73 73 6f 63 2d 73 61 (config:assoc-sa
43a0: 66 65 2d 61 64 64 20 61 6c 69 73 74 0a 09 09 09 fe-add alist....
43b0: 09 09 09 09 09 09 20 20 20 09 09 09 20 20 20 20 ...... ...
43c0: 6b 65 79 20 0a 09 09 09 09 09 09 09 09 09 09 09 key ............
43d0: 09 20 20 20 20 28 63 61 73 65 20 28 63 61 6c 63 . (case (calc
43e0: 2d 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 61 6c -allow-system al
43f0: 6c 6f 77 2d 73 79 73 74 65 6d 20 63 75 72 72 2d low-system curr-
4400: 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 73 65 63 section-name sec
4410: 74 69 6f 6e 73 29 0a 09 09 09 09 09 09 09 09 09 tions)..........
4420: 09 09 09 20 20 20 20 20 20 28 28 72 65 74 75 72 ... ((retur
4430: 6e 2d 70 72 6f 63 73 29 20 76 61 6c 2d 70 72 6f n-procs) val-pro
4440: 63 29 0a 09 09 09 09 09 09 09 09 09 09 09 09 20 c).............
4450: 20 20 20 20 20 28 28 72 65 74 75 72 6e 2d 73 74 ((return-st
4460: 72 69 6e 67 29 20 63 6d 64 29 0a 09 09 09 09 09 ring) cmd)......
4470: 09 09 09 09 09 09 09 20 20 20 20 20 20 28 65 6c ....... (el
4480: 73 65 20 28 76 61 6c 2d 70 72 6f 63 29 29 29 0a se (val-proc))).
4490: 09 09 09 09 09 09 09 09 09 09 09 09 20 20 20 20 ............
44a0: 6d 65 74 61 64 61 74 61 3a 20 6d 65 74 61 70 61 metadata: metapa
44b0: 74 68 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 th))........
44c0: 28 6c 6f 6f 70 20 28 63 6f 6e 66 69 67 66 3a 72 (loop (configf:r
44d0: 65 61 64 2d 6c 69 6e 65 20 69 6e 70 20 72 65 73 ead-line inp res
44e0: 20 28 63 61 6c 63 2d 61 6c 6c 6f 77 2d 73 79 73 (calc-allow-sys
44f0: 74 65 6d 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d tem allow-system
4500: 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 curr-section-na
4510: 6d 65 20 73 65 63 74 69 6f 6e 73 29 20 73 65 74 me sections) set
4520: 74 69 6e 67 73 29 20 63 75 72 72 2d 73 65 63 74 tings) curr-sect
4530: 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 66 29 29 ion-name #f #f))
4540: 0a 09 09 09 09 09 09 09 20 20 28 6c 6f 6f 70 20 ........ (loop
4550: 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d 6c 69 (configf:read-li
4560: 6e 65 20 69 6e 70 20 72 65 73 20 28 63 61 6c 63 ne inp res (calc
4570: 2d 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 61 6c -allow-system al
4580: 6c 6f 77 2d 73 79 73 74 65 6d 20 63 75 72 72 2d low-system curr-
4590: 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 73 65 63 section-name sec
45a0: 74 69 6f 6e 73 29 20 73 65 74 74 69 6e 67 73 29 tions) settings)
45b0: 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 curr-section-na
45c0: 6d 65 20 23 66 20 23 66 29 29 29 0a 09 20 20 20 me #f #f)))..
45d0: 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 6b 65 79 (configf:key
45e0: 2d 6e 6f 2d 76 61 6c 20 28 20 78 20 6b 65 79 20 -no-val ( x key
45f0: 76 61 6c 29 20 20 20 20 20 20 20 20 20 20 20 20 val)
4600: 28 6c 65 74 2a 20 28 28 61 6c 69 73 74 20 20 20 (let* ((alist
4610: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/
4620: 64 65 66 61 75 6c 74 20 72 65 73 20 63 75 72 72 default res curr
4630: 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 27 28 -section-name '(
4640: 29 29 29 0a 09 09 09 09 09 09 09 09 20 20 28 66 )))......... (f
4650: 76 61 6c 20 20 20 20 28 6f 72 20 28 69 66 20 28 val (or (if (
4660: 73 74 72 69 6e 67 3f 20 76 61 6c 29 20 76 61 6c string? val) val
4670: 20 23 66 29 20 22 22 29 29 29 20 3b 3b 20 66 76 #f) ""))) ;; fv
4680: 61 6c 20 73 68 6f 75 6c 64 20 62 65 20 65 69 74 al should be eit
4690: 68 65 72 20 22 22 20 6f 72 20 22 20 22 20 28 6f her "" or " " (o
46a0: 6e 65 20 6f 72 20 6d 6f 72 65 20 73 70 61 63 65 ne or more space
46b0: 73 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 28 s)........ (
46c0: 64 65 62 75 67 3a 70 72 69 6e 74 20 31 30 20 2a debug:print 10 *
46d0: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
46e0: 2a 20 22 20 20 20 73 65 74 74 69 6e 67 3a 20 5b * " setting: [
46f0: 22 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e " curr-section-n
4700: 61 6d 65 20 22 5d 20 22 20 6b 65 79 20 22 20 3d ame "] " key " =
4710: 20 23 74 22 29 0a 09 09 09 09 09 09 09 20 20 20 #t")........
4720: 20 20 28 73 61 66 65 2d 73 65 74 65 6e 76 20 6b (safe-setenv k
4730: 65 79 20 66 76 61 6c 29 0a 09 09 09 09 09 09 09 ey fval)........
4740: 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 (hash-table
4750: 2d 73 65 74 21 20 72 65 73 20 63 75 72 72 2d 73 -set! res curr-s
4760: 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 0a 09 09 09 ection-name ....
4770: 09 09 09 09 09 09 20 20 20 20 20 20 28 63 6f 6e ...... (con
4780: 66 69 67 3a 61 73 73 6f 63 2d 73 61 66 65 2d 61 fig:assoc-safe-a
4790: 64 64 20 61 6c 69 73 74 20 6b 65 79 20 66 76 61 dd alist key fva
47a0: 6c 20 6d 65 74 61 64 61 74 61 3a 20 6d 65 74 61 l metadata: meta
47b0: 70 61 74 68 29 29 0a 09 09 09 09 09 09 09 20 20 path))........
47c0: 20 20 20 28 6c 6f 6f 70 20 28 63 6f 6e 66 69 67 (loop (config
47d0: 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 20 f:read-line inp
47e0: 72 65 73 20 28 63 61 6c 63 2d 61 6c 6c 6f 77 2d res (calc-allow-
47f0: 73 79 73 74 65 6d 20 61 6c 6c 6f 77 2d 73 79 73 system allow-sys
4800: 74 65 6d 20 63 75 72 72 2d 73 65 63 74 69 6f 6e tem curr-section
4810: 2d 6e 61 6d 65 20 73 65 63 74 69 6f 6e 73 29 20 -name sections)
4820: 73 65 74 74 69 6e 67 73 29 20 63 75 72 72 2d 73 settings) curr-s
4830: 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 6b 65 79 20 ection-name key
4840: 23 66 29 29 29 0a 09 20 20 20 20 20 20 20 28 63 #f))).. (c
4850: 6f 6e 66 69 67 66 3a 6b 65 79 2d 76 61 6c 2d 70 onfigf:key-val-p
4860: 72 20 28 20 78 20 6b 65 79 20 75 6e 6b 31 20 76 r ( x key unk1 v
4870: 61 6c 20 75 6e 6b 32 20 29 20 28 6c 65 74 2a 20 al unk2 ) (let*
4880: 28 28 61 6c 69 73 74 20 20 20 28 68 61 73 68 2d ((alist (hash-
4890: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
48a0: 74 20 72 65 73 20 63 75 72 72 2d 73 65 63 74 69 t res curr-secti
48b0: 6f 6e 2d 6e 61 6d 65 20 27 28 29 29 29 0a 09 09 on-name '()))...
48c0: 09 09 09 09 09 09 20 20 28 65 6e 76 61 72 20 20 ...... (envar
48d0: 20 28 61 6e 64 20 65 6e 76 69 72 6f 6e 2d 70 61 (and environ-pa
48e0: 74 74 20 28 73 74 72 69 6e 67 2d 73 65 61 72 63 tt (string-searc
48f0: 68 20 28 72 65 67 65 78 70 20 65 6e 76 69 72 6f h (regexp enviro
4900: 6e 2d 70 61 74 74 29 20 63 75 72 72 2d 73 65 63 n-patt) curr-sec
4910: 74 69 6f 6e 2d 6e 61 6d 65 29 29 29 0a 09 09 09 tion-name)))....
4920: 09 09 09 09 09 20 20 28 72 65 61 6c 76 61 6c 20 ..... (realval
4930: 28 69 66 20 65 6e 76 61 72 0a 09 09 09 09 09 09 (if envar.......
4940: 09 09 09 20 20 20 20 20 20 20 28 63 6f 6e 66 69 ... (confi
4950: 67 3a 65 76 61 6c 2d 73 74 72 69 6e 67 2d 69 6e g:eval-string-in
4960: 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 76 61 6c -environment val
4970: 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 20 )..........
4980: 20 20 76 61 6c 29 29 29 0a 09 09 09 09 09 09 09 val)))........
4990: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
49a0: 74 2d 69 6e 66 6f 20 36 20 2a 64 65 66 61 75 6c t-info 6 *defaul
49b0: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 72 65 61 t-log-port* "rea
49c0: 64 2d 63 6f 6e 66 69 67 20 65 6e 76 20 73 65 74 d-config env set
49d0: 74 69 6e 67 2c 20 65 6e 76 61 72 3a 20 22 20 65 ting, envar: " e
49e0: 6e 76 61 72 20 22 20 72 65 61 6c 76 61 6c 3a 20 nvar " realval:
49f0: 22 20 72 65 61 6c 76 61 6c 20 22 20 76 61 6c 3a " realval " val:
4a00: 20 22 20 76 61 6c 20 22 20 6b 65 79 3a 20 22 20 " val " key: "
4a10: 6b 65 79 20 22 20 63 75 72 72 2d 73 65 63 74 69 key " curr-secti
4a20: 6f 6e 2d 6e 61 6d 65 3a 20 22 20 63 75 72 72 2d on-name: " curr-
4a30: 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 29 0a 09 09 section-name)...
4a40: 09 09 09 09 09 20 20 20 20 20 28 69 66 20 65 6e ..... (if en
4a50: 76 61 72 20 28 73 61 66 65 2d 73 65 74 65 6e 76 var (safe-setenv
4a60: 20 6b 65 79 20 72 65 61 6c 76 61 6c 29 29 0a 09 key realval))..
4a70: 09 09 09 09 09 09 20 20 20 20 20 28 64 65 62 75 ...... (debu
4a80: 67 3a 70 72 69 6e 74 20 31 30 20 2a 64 65 66 61 g:print 10 *defa
4a90: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 20 ult-log-port* "
4aa0: 20 20 73 65 74 74 69 6e 67 3a 20 5b 22 20 63 75 setting: [" cu
4ab0: 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 rr-section-name
4ac0: 22 5d 20 22 20 6b 65 79 20 22 20 3d 20 22 20 76 "] " key " = " v
4ad0: 61 6c 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 al)........
4ae0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 (hash-table-set!
4af0: 20 72 65 73 20 63 75 72 72 2d 73 65 63 74 69 6f res curr-sectio
4b00: 6e 2d 6e 61 6d 65 20 0a 09 09 09 09 09 09 09 09 n-name .........
4b10: 09 20 20 20 20 20 20 28 63 6f 6e 66 69 67 3a 61 . (config:a
4b20: 73 73 6f 63 2d 73 61 66 65 2d 61 64 64 20 61 6c ssoc-safe-add al
4b30: 69 73 74 20 6b 65 79 20 72 65 61 6c 76 61 6c 20 ist key realval
4b40: 6d 65 74 61 64 61 74 61 3a 20 6d 65 74 61 70 61 metadata: metapa
4b50: 74 68 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 th))........
4b60: 20 28 6c 6f 6f 70 20 28 63 6f 6e 66 69 67 66 3a (loop (configf:
4b70: 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 20 72 65 read-line inp re
4b80: 73 20 28 63 61 6c 63 2d 61 6c 6c 6f 77 2d 73 79 s (calc-allow-sy
4b90: 73 74 65 6d 20 61 6c 6c 6f 77 2d 73 79 73 74 65 stem allow-syste
4ba0: 6d 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e m curr-section-n
4bb0: 61 6d 65 20 73 65 63 74 69 6f 6e 73 29 20 73 65 ame sections) se
4bc0: 74 74 69 6e 67 73 29 20 63 75 72 72 2d 73 65 63 ttings) curr-sec
4bd0: 74 69 6f 6e 2d 6e 61 6d 65 20 6b 65 79 20 23 66 tion-name key #f
4be0: 29 29 29 0a 09 20 20 20 20 20 20 20 3b 3b 20 69 ))).. ;; i
4bf0: 66 20 61 20 63 6f 6e 74 69 6e 75 65 64 20 6c 69 f a continued li
4c00: 6e 65 0a 09 20 20 20 20 20 20 20 28 63 6f 6e 66 ne.. (conf
4c10: 69 67 66 3a 63 6f 6e 74 2d 6c 6e 2d 72 78 20 28 igf:cont-ln-rx (
4c20: 20 78 20 77 68 73 70 20 76 61 6c 20 20 20 20 20 x whsp val
4c30: 29 20 28 6c 65 74 20 28 28 61 6c 69 73 74 20 28 ) (let ((alist (
4c40: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d
4c50: 65 66 61 75 6c 74 20 72 65 73 20 63 75 72 72 2d efault res curr-
4c60: 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 27 28 29 section-name '()
4c70: 29 29 29 0a 09 09 09 09 09 09 28 69 66 20 76 61 ))).......(if va
4c80: 72 2d 66 6c 61 67 20 20 20 20 20 20 20 20 20 20 r-flag
4c90: 20 20 20 3b 3b 20 69 66 20 73 65 74 20 74 6f 20 ;; if set to
4ca0: 61 20 73 74 72 69 6e 67 20 74 68 65 6e 20 77 65 a string then we
4cb0: 20 68 61 76 65 20 61 20 63 6f 6e 74 69 6e 75 65 have a continue
4cc0: 64 20 76 61 72 0a 09 09 09 09 09 09 20 20 20 20 d var.......
4cd0: 28 6c 65 74 20 28 28 6e 65 77 76 61 6c 20 28 63 (let ((newval (c
4ce0: 6f 6e 63 20 0a 09 09 09 09 09 09 09 09 20 20 20 onc .........
4cf0: 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 72 (config-lookup r
4d00: 65 73 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d es curr-section-
4d10: 6e 61 6d 65 20 76 61 72 2d 66 6c 61 67 29 20 22 name var-flag) "
4d20: 5c 6e 22 0a 09 09 09 09 09 09 09 09 20 20 20 3b \n"......... ;
4d30: 3b 20 74 72 69 6d 20 6c 65 61 64 20 66 72 6f 6d ; trim lead from
4d40: 20 74 68 65 20 69 6e 63 6f 6d 69 6e 67 20 77 68 the incoming wh
4d50: 73 70 20 74 6f 20 73 75 70 70 6f 72 74 20 73 6f sp to support so
4d60: 6d 65 20 69 6e 64 65 6e 74 69 6e 67 2e 0a 09 09 me indenting....
4d70: 09 09 09 09 09 09 20 20 20 28 69 66 20 6c 65 61 ...... (if lea
4d80: 64 0a 09 09 09 09 09 09 09 09 20 20 20 20 20 20 d.........
4d90: 20 28 73 74 72 69 6e 67 2d 73 75 62 73 74 69 74 (string-substit
4da0: 75 74 65 20 28 72 65 67 65 78 70 20 6c 65 61 64 ute (regexp lead
4db0: 29 20 22 22 20 77 68 73 70 29 0a 09 09 09 09 09 ) "" whsp)......
4dc0: 09 09 09 20 20 20 20 20 20 20 22 22 29 0a 09 09 ... "")...
4dd0: 09 09 09 09 09 09 20 20 20 76 61 6c 29 29 29 0a ...... val))).
4de0: 09 09 09 09 09 09 20 20 20 20 20 20 3b 3b 20 28 ...... ;; (
4df0: 70 72 69 6e 74 20 22 76 61 6c 3a 20 22 20 76 61 print "val: " va
4e00: 6c 20 22 5c 6e 6e 65 77 76 61 6c 3a 20 5c 22 22 l "\nnewval: \""
4e10: 20 6e 65 77 76 61 6c 20 22 5c 22 5c 6e 76 61 72 newval "\"\nvar
4e20: 66 6c 61 67 3a 20 22 20 76 61 72 2d 66 6c 61 67 flag: " var-flag
4e30: 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 28 68 )....... (h
4e40: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 72 ash-table-set! r
4e50: 65 73 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d es curr-section-
4e60: 6e 61 6d 65 20 0a 09 09 09 09 09 09 09 09 20 20 name .........
4e70: 20 20 20 20 20 28 63 6f 6e 66 69 67 3a 61 73 73 (config:ass
4e80: 6f 63 2d 73 61 66 65 2d 61 64 64 20 61 6c 69 73 oc-safe-add alis
4e90: 74 20 76 61 72 2d 66 6c 61 67 20 6e 65 77 76 61 t var-flag newva
4ea0: 6c 20 6d 65 74 61 64 61 74 61 3a 20 6d 65 74 61 l metadata: meta
4eb0: 70 61 74 68 29 29 0a 09 09 09 09 09 09 20 20 20 path)).......
4ec0: 20 20 20 28 6c 6f 6f 70 20 28 63 6f 6e 66 69 67 (loop (config
4ed0: 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 20 f:read-line inp
4ee0: 72 65 73 20 28 63 61 6c 63 2d 61 6c 6c 6f 77 2d res (calc-allow-
4ef0: 73 79 73 74 65 6d 20 61 6c 6c 6f 77 2d 73 79 73 system allow-sys
4f00: 74 65 6d 20 63 75 72 72 2d 73 65 63 74 69 6f 6e tem curr-section
4f10: 2d 6e 61 6d 65 20 73 65 63 74 69 6f 6e 73 29 20 -name sections)
4f20: 73 65 74 74 69 6e 67 73 29 20 63 75 72 72 2d 73 settings) curr-s
4f30: 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 76 61 72 2d ection-name var-
4f40: 66 6c 61 67 20 28 69 66 20 6c 65 61 64 20 6c 65 flag (if lead le
4f50: 61 64 20 77 68 73 70 29 29 29 0a 09 09 09 09 09 ad whsp)))......
4f60: 09 20 20 20 20 28 6c 6f 6f 70 20 28 63 6f 6e 66 . (loop (conf
4f70: 69 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e igf:read-line in
4f80: 70 20 72 65 73 20 28 63 61 6c 63 2d 61 6c 6c 6f p res (calc-allo
4f90: 77 2d 73 79 73 74 65 6d 20 61 6c 6c 6f 77 2d 73 w-system allow-s
4fa0: 79 73 74 65 6d 20 63 75 72 72 2d 73 65 63 74 69 ystem curr-secti
4fb0: 6f 6e 2d 6e 61 6d 65 20 73 65 63 74 69 6f 6e 73 on-name sections
4fc0: 29 20 73 65 74 74 69 6e 67 73 29 20 63 75 72 72 ) settings) curr
4fd0: 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 -section-name #f
4fe0: 20 23 66 29 29 29 29 0a 09 20 20 20 20 20 20 20 #f))))..
4ff0: 28 65 6c 73 65 20 28 64 65 62 75 67 3a 70 72 69 (else (debug:pri
5000: 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 nt-error 0 *defa
5010: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 70 ult-log-port* "p
5020: 72 6f 62 6c 65 6d 20 70 61 72 73 69 6e 67 20 22 roblem parsing "
5030: 20 70 61 74 68 20 22 2c 5c 6e 20 20 20 5c 22 22 path ",\n \""
5040: 20 69 6e 6c 20 22 5c 22 22 29 0a 09 09 20 20 20 inl "\"")...
5050: 20 20 28 73 65 74 21 20 76 61 72 2d 66 6c 61 67 (set! var-flag
5060: 20 23 66 29 0a 09 09 20 20 20 20 20 28 6c 6f 6f #f)... (loo
5070: 70 20 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d p (configf:read-
5080: 6c 69 6e 65 20 69 6e 70 20 72 65 73 20 28 63 61 line inp res (ca
5090: 6c 63 2d 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 lc-allow-system
50a0: 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 63 75 72 allow-system cur
50b0: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 73 r-section-name s
50c0: 65 63 74 69 6f 6e 73 29 20 73 65 74 74 69 6e 67 ections) setting
50d0: 73 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d s) curr-section-
50e0: 6e 61 6d 65 20 23 66 20 23 66 29 29 29 29 29 29 name #f #f))))))
50f0: 29 29 0a 20 20 0a 3b 3b 20 70 61 74 68 65 6e 76 )). .;; pathenv
5100: 76 61 72 20 77 69 6c 6c 20 73 65 74 20 74 68 65 var will set the
5110: 20 6e 61 6d 65 64 20 76 61 72 20 74 6f 20 74 68 named var to th
5120: 65 20 70 61 74 68 20 6f 66 20 74 68 65 20 63 6f e path of the co
5130: 6e 66 69 67 0a 28 64 65 66 69 6e 65 20 28 66 69 nfig.(define (fi
5140: 6e 64 2d 61 6e 64 2d 72 65 61 64 2d 63 6f 6e 66 nd-and-read-conf
5150: 69 67 20 66 6e 61 6d 65 20 23 21 6b 65 79 20 28 ig fname #!key (
5160: 65 6e 76 69 72 6f 6e 2d 70 61 74 74 20 23 66 29 environ-patt #f)
5170: 28 67 69 76 65 6e 2d 74 6f 70 70 61 74 68 20 23 (given-toppath #
5180: 66 29 28 70 61 74 68 65 6e 76 76 61 72 20 23 66 f)(pathenvvar #f
5190: 29 29 0a 20 20 28 6c 65 74 2a 20 28 28 63 75 72 )). (let* ((cur
51a0: 72 2d 64 69 72 20 20 20 28 63 75 72 72 65 6e 74 r-dir (current
51b0: 2d 64 69 72 65 63 74 6f 72 79 29 29 0a 20 20 20 -directory)).
51c0: 20 20 20 20 20 20 28 63 6f 6e 66 69 67 69 6e 66 (configinf
51d0: 6f 20 28 66 69 6e 64 2d 63 6f 6e 66 69 67 20 66 o (find-config f
51e0: 6e 61 6d 65 20 74 6f 70 70 61 74 68 3a 20 67 69 name toppath: gi
51f0: 76 65 6e 2d 74 6f 70 70 61 74 68 29 29 0a 09 20 ven-toppath))..
5200: 28 74 6f 70 70 61 74 68 20 20 20 20 28 63 61 72 (toppath (car
5210: 20 63 6f 6e 66 69 67 69 6e 66 6f 29 29 0a 09 20 configinfo))..
5220: 28 63 6f 6e 66 69 67 66 69 6c 65 20 28 63 61 64 (configfile (cad
5230: 72 20 63 6f 6e 66 69 67 69 6e 66 6f 29 29 0a 09 r configinfo))..
5240: 20 28 73 65 74 2d 66 69 65 6c 64 73 20 28 6c 61 (set-fields (la
5250: 6d 62 64 61 20 28 63 75 72 72 2d 73 65 63 74 69 mbda (curr-secti
5260: 6f 6e 20 6e 65 78 74 2d 73 65 63 74 69 6f 6e 20 on next-section
5270: 68 74 20 70 61 74 68 29 0a 09 09 20 20 20 20 20 ht path)...
5280: 20 20 28 6c 65 74 20 28 28 66 69 65 6c 64 2d 6e (let ((field-n
5290: 61 6d 65 73 20 28 69 66 20 68 74 20 28 6b 65 79 ames (if ht (key
52a0: 73 3a 63 6f 6e 66 69 67 2d 67 65 74 2d 66 69 65 s:config-get-fie
52b0: 6c 64 73 20 68 74 29 20 27 28 29 29 29 0a 09 09 lds ht) '()))...
52c0: 09 20 20 20 20 20 28 74 61 72 67 65 74 20 20 20 . (target
52d0: 20 20 20 28 6f 72 20 28 67 65 74 65 6e 76 20 22 (or (getenv "
52e0: 4d 54 5f 54 41 52 47 45 54 22 29 28 61 72 67 73 MT_TARGET")(args
52f0: 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 71 74 61 :get-arg "-reqta
5300: 72 67 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 rg")(args:get-ar
5310: 67 20 22 2d 74 61 72 67 65 74 22 29 29 29 29 0a g "-target")))).
5320: 09 09 09 20 28 64 65 62 75 67 3a 70 72 69 6e 74 ... (debug:print
5330: 2d 69 6e 66 6f 20 39 20 2a 64 65 66 61 75 6c 74 -info 9 *default
5340: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 73 65 74 2d -log-port* "set-
5350: 66 69 65 6c 64 73 20 77 69 74 68 20 66 69 65 6c fields with fiel
5360: 64 2d 6e 61 6d 65 73 3d 22 20 66 69 65 6c 64 2d d-names=" field-
5370: 6e 61 6d 65 73 20 22 20 74 61 72 67 65 74 3d 22 names " target="
5380: 20 74 61 72 67 65 74 20 22 20 63 75 72 72 2d 73 target " curr-s
5390: 65 63 74 69 6f 6e 3d 22 20 63 75 72 72 2d 73 65 ection=" curr-se
53a0: 63 74 69 6f 6e 20 22 20 6e 65 78 74 2d 73 65 63 ction " next-sec
53b0: 74 69 6f 6e 3d 22 20 6e 65 78 74 2d 73 65 63 74 tion=" next-sect
53c0: 69 6f 6e 20 22 20 70 61 74 68 3d 22 20 70 61 74 ion " path=" pat
53d0: 68 20 22 20 68 74 3d 22 20 68 74 29 0a 09 09 09 h " ht=" ht)....
53e0: 20 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f (if (not (null?
53f0: 20 66 69 65 6c 64 2d 6e 61 6d 65 73 29 29 28 6b field-names))(k
5400: 65 79 73 3a 74 61 72 67 65 74 2d 73 65 74 2d 61 eys:target-set-a
5410: 72 67 73 20 66 69 65 6c 64 2d 6e 61 6d 65 73 20 rgs field-names
5420: 74 61 72 67 65 74 20 23 66 29 29 29 29 29 29 0a target #f)))))).
5430: 20 20 20 20 28 69 66 20 74 6f 70 70 61 74 68 20 (if toppath
5440: 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 (change-director
5450: 79 20 74 6f 70 70 61 74 68 29 29 20 0a 20 20 20 y toppath)) .
5460: 20 28 69 66 20 28 61 6e 64 20 74 6f 70 70 61 74 (if (and toppat
5470: 68 20 70 61 74 68 65 6e 76 76 61 72 29 28 73 65 h pathenvvar)(se
5480: 74 65 6e 76 20 70 61 74 68 65 6e 76 76 61 72 20 tenv pathenvvar
5490: 74 6f 70 70 61 74 68 29 29 0a 20 20 20 20 28 6c toppath)). (l
54a0: 65 74 20 28 28 63 6f 6e 66 69 67 64 61 74 20 20 et ((configdat
54b0: 28 69 66 20 63 6f 6e 66 69 67 66 69 6c 65 20 0a (if configfile .
54c0: 09 09 09 20 20 28 72 65 61 64 2d 63 6f 6e 66 69 ... (read-confi
54d0: 67 20 63 6f 6e 66 69 67 66 69 6c 65 20 23 66 20 g configfile #f
54e0: 23 74 20 65 6e 76 69 72 6f 6e 2d 70 61 74 74 3a #t environ-patt:
54f0: 20 65 6e 76 69 72 6f 6e 2d 70 61 74 74 20 70 6f environ-patt po
5500: 73 74 2d 73 65 63 74 69 6f 6e 2d 70 72 6f 63 73 st-section-procs
5510: 3a 20 28 6c 69 73 74 20 28 63 6f 6e 73 20 22 5e : (list (cons "^
5520: 66 69 65 6c 64 73 24 22 20 73 65 74 2d 66 69 65 fields$" set-fie
5530: 6c 64 73 29 29 20 23 66 29 29 29 29 0a 20 20 20 lds)) #f)))).
5540: 20 20 20 28 69 66 20 74 6f 70 70 61 74 68 20 28 (if toppath (
5550: 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 change-directory
5560: 20 63 75 72 72 2d 64 69 72 29 29 0a 20 20 20 20 curr-dir)).
5570: 20 20 28 6c 69 73 74 20 63 6f 6e 66 69 67 64 61 (list configda
5580: 74 20 74 6f 70 70 61 74 68 20 63 6f 6e 66 69 67 t toppath config
5590: 66 69 6c 65 20 66 6e 61 6d 65 29 29 29 29 0a 0a file fname))))..
55a0: 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 2d (define (config-
55b0: 6c 6f 6f 6b 75 70 20 63 66 67 64 61 74 20 73 65 lookup cfgdat se
55c0: 63 74 69 6f 6e 20 76 61 72 29 0a 20 20 28 69 66 ction var). (if
55d0: 20 28 68 61 73 68 2d 74 61 62 6c 65 3f 20 63 66 (hash-table? cf
55e0: 67 64 61 74 29 0a 20 20 20 20 20 20 28 6c 65 74 gdat). (let
55f0: 20 28 28 73 65 63 74 64 61 74 20 28 68 61 73 68 ((sectdat (hash
5600: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau
5610: 6c 74 20 63 66 67 64 61 74 20 73 65 63 74 69 6f lt cfgdat sectio
5620: 6e 20 27 28 29 29 29 29 0a 09 28 69 66 20 28 6e n '())))..(if (n
5630: 75 6c 6c 3f 20 73 65 63 74 64 61 74 29 0a 09 20 ull? sectdat)..
5640: 20 20 20 23 66 0a 09 20 20 20 20 28 6c 65 74 20 #f.. (let
5650: 28 28 6d 61 74 63 68 20 28 61 73 73 6f 63 20 76 ((match (assoc v
5660: 61 72 20 73 65 63 74 64 61 74 29 29 29 0a 09 20 ar sectdat)))..
5670: 20 20 20 20 20 28 69 66 20 6d 61 74 63 68 20 3b (if match ;
5680: 3b 20 28 61 6e 64 20 6d 61 74 63 68 20 28 6c 69 ; (and match (li
5690: 73 74 3f 20 6d 61 74 63 68 29 28 3e 20 28 6c 65 st? match)(> (le
56a0: 6e 67 74 68 20 6d 61 74 63 68 29 20 31 29 29 0a ngth match) 1)).
56b0: 09 09 20 20 28 63 61 64 72 20 6d 61 74 63 68 29 .. (cadr match)
56c0: 0a 09 09 20 20 23 66 29 29 0a 09 20 20 20 20 29 ... #f)).. )
56d0: 29 0a 20 20 20 20 20 20 23 66 29 29 0a 0a 28 64 ). #f))..(d
56e0: 65 66 69 6e 65 20 63 6f 6e 66 69 67 66 3a 6c 6f efine configf:lo
56f0: 6f 6b 75 70 20 63 6f 6e 66 69 67 2d 6c 6f 6f 6b okup config-look
5700: 75 70 29 0a 28 64 65 66 69 6e 65 20 63 6f 6e 66 up).(define conf
5710: 69 67 66 3a 72 65 61 64 2d 66 69 6c 65 20 72 65 igf:read-file re
5720: 61 64 2d 63 6f 6e 66 69 67 29 0a 0a 28 64 65 66 ad-config)..(def
5730: 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a 73 65 63 ine (configf:sec
5740: 74 69 6f 6e 2d 76 61 72 73 20 63 66 67 64 61 74 tion-vars cfgdat
5750: 20 73 65 63 74 69 6f 6e 29 0a 20 20 28 6c 65 74 section). (let
5760: 20 28 28 73 65 63 74 64 61 74 20 28 68 61 73 68 ((sectdat (hash
5770: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau
5780: 6c 74 20 63 66 67 64 61 74 20 73 65 63 74 69 6f lt cfgdat sectio
5790: 6e 20 27 28 29 29 29 29 0a 20 20 20 20 28 69 66 n '()))). (if
57a0: 20 28 6e 75 6c 6c 3f 20 73 65 63 74 64 61 74 29 (null? sectdat)
57b0: 0a 09 27 28 29 0a 09 28 6d 61 70 20 63 61 72 20 ..'()..(map car
57c0: 73 65 63 74 64 61 74 29 29 29 29 0a 0a 28 64 65 sectdat))))..(de
57d0: 66 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a 67 65 fine (configf:ge
57e0: 74 2d 73 65 63 74 69 6f 6e 20 63 66 67 64 61 74 t-section cfgdat
57f0: 20 73 65 63 74 69 6f 6e 29 0a 20 20 28 68 61 73 section). (has
5800: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
5810: 75 6c 74 20 63 66 67 64 61 74 20 73 65 63 74 69 ult cfgdat secti
5820: 6f 6e 20 27 28 29 29 29 0a 0a 28 64 65 66 69 6e on '()))..(defin
5830: 65 20 28 73 65 74 75 70 29 0a 20 20 28 6c 65 74 e (setup). (let
5840: 2a 20 28 28 63 6f 6e 66 69 67 66 20 28 66 69 6e * ((configf (fin
5850: 64 2d 63 6f 6e 66 69 67 20 22 6d 65 67 61 74 65 d-config "megate
5860: 73 74 2e 63 6f 6e 66 69 67 22 29 29 0a 09 20 28 st.config")).. (
5870: 63 6f 6e 66 69 67 20 20 28 69 66 20 63 6f 6e 66 config (if conf
5880: 69 67 66 20 28 72 65 61 64 2d 63 6f 6e 66 69 67 igf (read-config
5890: 20 63 6f 6e 66 69 67 66 20 23 66 20 23 74 29 20 configf #f #t)
58a0: 23 66 29 29 29 0a 20 20 20 20 28 69 66 20 63 6f #f))). (if co
58b0: 6e 66 69 67 0a 09 28 73 65 74 65 6e 76 20 22 52 nfig..(setenv "R
58c0: 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 22 20 28 70 UN_AREA_HOME" (p
58d0: 61 74 68 6e 61 6d 65 2d 64 69 72 65 63 74 6f 72 athname-director
58e0: 79 20 63 6f 6e 66 69 67 66 29 29 29 0a 20 20 20 y configf))).
58f0: 20 63 6f 6e 66 69 67 29 29 0a 0a 3b 3b 3d 3d 3d config))..;;===
5900: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5910: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5920: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5930: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5940: 3d 3d 3d 0a 3b 3b 20 4e 6f 6e 20 64 65 73 74 72 ===.;; Non destr
5950: 75 63 74 69 76 65 20 77 72 69 74 69 6e 67 20 6f uctive writing o
5960: 66 20 63 6f 6e 66 69 67 20 66 69 6c 65 0a 3b 3b f config file.;;
5970: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5980: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5990: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
59a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
59b0: 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 ======..(define
59c0: 28 63 6f 6e 66 69 67 66 3a 63 6f 6d 70 72 65 73 (configf:compres
59d0: 73 2d 6d 75 6c 74 69 2d 6c 69 6e 65 73 20 66 64 s-multi-lines fd
59e0: 61 74 29 0a 20 20 3b 3b 20 73 74 65 70 20 31 2e at). ;; step 1.
59f0: 35 20 2d 20 63 6f 6d 70 72 65 73 73 20 61 6e 79 5 - compress any
5a00: 20 63 6f 6e 74 69 6e 75 65 64 20 6c 69 6e 65 73 continued lines
5a10: 0a 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 66 64 . (if (null? fd
5a20: 61 74 29 20 66 64 61 74 0a 09 28 6c 65 74 20 6c at) fdat..(let l
5a30: 6f 6f 70 20 28 28 68 65 64 20 28 63 61 72 20 66 oop ((hed (car f
5a40: 64 61 74 29 29 0a 09 09 20 20 20 28 74 61 6c 20 dat))... (tal
5a50: 28 63 64 72 20 66 64 61 74 29 29 0a 09 09 20 20 (cdr fdat))...
5a60: 20 28 63 75 72 20 22 22 29 0a 09 09 20 20 20 28 (cur "")... (
5a70: 6c 65 64 20 23 66 29 0a 09 09 20 20 20 28 72 65 led #f)... (re
5a80: 73 20 27 28 29 29 29 0a 09 20 20 3b 3b 20 41 4c s '())).. ;; AL
5a90: 4c 20 57 48 49 54 45 53 50 41 43 45 20 4c 45 41 L WHITESPACE LEA
5aa0: 44 49 4e 47 20 4c 49 4e 45 53 20 41 52 45 20 54 DING LINES ARE T
5ab0: 41 43 4b 45 44 20 4f 4e 21 21 0a 09 20 20 3b 3b ACKED ON!!.. ;;
5ac0: 20 20 31 2e 20 72 65 6d 6f 76 65 20 6c 65 64 20 1. remove led
5ad0: 77 68 69 74 65 73 70 61 63 65 0a 09 20 20 3b 3b whitespace.. ;;
5ae0: 20 20 32 2e 20 74 61 63 6b 20 6f 6e 20 74 6f 20 2. tack on to
5af0: 68 65 64 20 77 69 74 68 20 22 5c 6e 22 0a 09 20 hed with "\n"..
5b00: 20 28 6c 65 74 20 28 28 6d 61 74 63 68 20 28 73 (let ((match (s
5b10: 74 72 69 6e 67 2d 6d 61 74 63 68 20 63 6f 6e 66 tring-match conf
5b20: 69 67 66 3a 63 6f 6e 74 2d 6c 6e 2d 72 78 20 68 igf:cont-ln-rx h
5b30: 65 64 29 29 29 0a 09 20 20 20 20 28 69 66 20 6d ed))).. (if m
5b40: 61 74 63 68 20 3b 3b 20 62 6c 61 73 74 21 20 68 atch ;; blast! h
5b50: 61 76 65 20 74 6f 20 64 65 61 6c 20 77 69 74 68 ave to deal with
5b60: 20 61 20 6d 75 6c 74 69 6c 69 6e 65 0a 09 09 28 a multiline...(
5b70: 6c 65 74 2a 20 28 28 6c 65 61 64 20 28 63 61 64 let* ((lead (cad
5b80: 72 20 6d 61 74 63 68 29 29 0a 09 09 20 20 20 20 r match))...
5b90: 20 20 20 28 6c 76 61 6c 20 28 63 61 64 64 72 20 (lval (caddr
5ba0: 6d 61 74 63 68 29 29 0a 09 09 20 20 20 20 20 20 match))...
5bb0: 20 28 6e 65 77 6c 20 28 63 6f 6e 63 20 63 75 72 (newl (conc cur
5bc0: 20 22 5c 6e 22 20 6c 76 61 6c 29 29 29 0a 09 09 "\n" lval)))...
5bd0: 20 20 28 69 66 20 28 6e 6f 74 20 6c 65 64 29 28 (if (not led)(
5be0: 73 65 74 21 20 6c 65 64 20 6c 65 61 64 29 29 0a set! led lead)).
5bf0: 09 09 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 .. (if (null? t
5c00: 61 6c 29 20 0a 09 09 20 20 20 20 20 20 28 73 65 al) ... (se
5c10: 74 21 20 66 64 61 74 20 28 61 70 70 65 6e 64 20 t! fdat (append
5c20: 66 64 61 74 20 28 6c 69 73 74 20 6e 65 77 6c 29 fdat (list newl)
5c30: 29 29 0a 09 09 20 20 20 20 20 20 28 6c 6f 6f 70 ))... (loop
5c40: 20 28 63 61 72 20 74 61 6c 29 28 63 64 72 20 74 (car tal)(cdr t
5c50: 61 6c 29 20 6e 65 77 6c 20 6c 65 64 20 72 65 73 al) newl led res
5c60: 29 29 29 20 3b 3b 20 4e 42 2f 2f 20 6e 6f 74 20 ))) ;; NB// not
5c70: 74 61 63 6b 69 6e 67 20 6e 65 77 6c 20 6f 6e 74 tacking newl ont
5c80: 6f 20 72 65 73 0a 09 09 28 6c 65 74 20 28 28 6e o res...(let ((n
5c90: 65 77 72 65 73 20 28 69 66 20 6c 65 64 20 0a 09 ewres (if led ..
5ca0: 09 09 09 20 20 28 61 70 70 65 6e 64 20 72 65 73 ... (append res
5cb0: 20 28 6c 69 73 74 20 63 75 72 20 68 65 64 29 29 (list cur hed))
5cc0: 0a 09 09 09 09 20 20 28 61 70 70 65 6e 64 20 72 ..... (append r
5cd0: 65 73 20 28 6c 69 73 74 20 68 65 64 29 29 29 29 es (list hed))))
5ce0: 29 0a 09 09 20 20 3b 3b 20 70 72 65 76 20 77 61 )... ;; prev wa
5cf0: 73 20 61 20 6d 75 6c 74 69 6c 69 6e 65 0a 09 09 s a multiline...
5d00: 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 61 6c (if (null? tal
5d10: 29 0a 09 09 20 20 20 20 20 20 6e 65 77 72 65 73 )... newres
5d20: 0a 09 09 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 ... (loop (
5d30: 63 61 72 20 74 61 6c 29 28 63 64 72 20 74 61 6c car tal)(cdr tal
5d40: 29 20 22 22 20 23 66 20 6e 65 77 72 65 73 29 29 ) "" #f newres))
5d50: 29 29 29 29 29 29 0a 0a 3b 3b 20 6e 6f 74 65 3a ))))))..;; note:
5d60: 20 49 27 6d 20 63 68 65 61 74 69 6e 67 20 61 20 I'm cheating a
5d70: 6c 69 74 74 6c 65 20 68 65 72 65 2e 20 49 20 6d little here. I m
5d80: 65 72 65 6c 79 20 72 65 70 6c 61 63 65 20 22 5c erely replace "\
5d90: 6e 22 20 77 69 74 68 20 22 5c 6e 20 20 20 20 20 n" with "\n
5da0: 20 20 20 20 22 0a 28 64 65 66 69 6e 65 20 28 63 ".(define (c
5db0: 6f 6e 66 69 67 66 3a 65 78 70 61 6e 64 2d 6d 75 onfigf:expand-mu
5dc0: 6c 74 69 2d 6c 69 6e 65 73 20 66 64 61 74 29 0a lti-lines fdat).
5dd0: 20 20 3b 3b 20 73 74 65 70 20 31 2e 35 20 2d 20 ;; step 1.5 -
5de0: 63 6f 6d 70 72 65 73 73 20 61 6e 79 20 63 6f 6e compress any con
5df0: 74 69 6e 75 65 64 20 6c 69 6e 65 73 0a 20 20 28 tinued lines. (
5e00: 69 66 20 28 6e 75 6c 6c 3f 20 66 64 61 74 29 20 if (null? fdat)
5e10: 66 64 61 74 0a 20 20 20 20 20 20 28 6c 65 74 20 fdat. (let
5e20: 6c 6f 6f 70 20 28 28 68 65 64 20 28 63 61 72 20 loop ((hed (car
5e30: 66 64 61 74 29 29 0a 09 09 20 28 74 61 6c 20 28 fdat))... (tal (
5e40: 63 64 72 20 66 64 61 74 29 29 0a 09 09 20 28 72 cdr fdat))... (r
5e50: 65 73 20 27 28 29 29 29 0a 09 28 6c 65 74 20 28 es '()))..(let (
5e60: 28 6e 65 77 72 65 73 20 28 61 70 70 65 6e 64 20 (newres (append
5e70: 72 65 73 20 28 6c 69 73 74 20 28 73 74 72 69 6e res (list (strin
5e80: 67 2d 73 75 62 73 74 69 74 75 74 65 20 28 72 65 g-substitute (re
5e90: 67 65 78 70 20 22 5c 6e 22 29 20 22 5c 6e 20 20 gexp "\n") "\n
5ea0: 20 20 20 20 20 20 20 22 20 68 65 64 20 23 74 29 " hed #t)
5eb0: 29 29 29 29 0a 09 20 20 28 69 66 20 28 6e 75 6c )))).. (if (nul
5ec0: 6c 3f 20 74 61 6c 29 0a 09 20 20 20 20 20 20 6e l? tal).. n
5ed0: 65 77 72 65 73 0a 09 20 20 20 20 20 20 28 6c 6f ewres.. (lo
5ee0: 6f 70 20 28 63 61 72 20 74 61 6c 29 28 63 64 72 op (car tal)(cdr
5ef0: 20 74 61 6c 29 20 6e 65 77 72 65 73 29 29 29 29 tal) newres))))
5f00: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e ))..(define (con
5f10: 66 69 67 66 3a 66 69 6c 65 2d 3e 6c 69 73 74 20 figf:file->list
5f20: 66 6e 61 6d 65 29 0a 20 20 28 69 66 20 28 66 69 fname). (if (fi
5f30: 6c 65 2d 65 78 69 73 74 73 3f 20 66 6e 61 6d 65 le-exists? fname
5f40: 29 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 69 ). (let ((i
5f50: 6e 70 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 66 np (open-input-f
5f60: 69 6c 65 20 66 6e 61 6d 65 29 29 29 0a 09 28 6c ile fname)))..(l
5f70: 65 74 20 6c 6f 6f 70 20 28 28 69 6e 6c 20 28 72 et loop ((inl (r
5f80: 65 61 64 2d 6c 69 6e 65 20 69 6e 70 29 29 0a 09 ead-line inp))..
5f90: 09 20 20 20 28 72 65 73 20 27 28 29 29 29 0a 09 . (res '()))..
5fa0: 20 20 28 69 66 20 28 65 6f 66 2d 6f 62 6a 65 63 (if (eof-objec
5fb0: 74 3f 20 69 6e 6c 29 0a 09 20 20 20 20 20 20 28 t? inl).. (
5fc0: 62 65 67 69 6e 0a 09 09 28 63 6c 6f 73 65 2d 69 begin...(close-i
5fd0: 6e 70 75 74 2d 70 6f 72 74 20 69 6e 70 29 0a 09 nput-port inp)..
5fe0: 09 28 72 65 76 65 72 73 65 20 72 65 73 29 29 0a .(reverse res)).
5ff0: 09 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 72 65 . (loop (re
6000: 61 64 2d 6c 69 6e 65 20 69 6e 70 29 28 63 6f 6e ad-line inp)(con
6010: 73 20 69 6e 6c 20 72 65 73 29 29 29 29 29 0a 20 s inl res))))).
6020: 20 20 20 20 20 27 28 29 29 29 0a 0a 3b 3b 3d 3d '()))..;;==
6030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6040: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6050: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6060: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6070: 3d 3d 3d 3d 0a 3b 3b 20 57 72 69 74 65 20 61 20 ====.;; Write a
6080: 63 6f 6e 66 69 67 0a 3b 3b 20 20 20 30 2e 20 47 config.;; 0. G
6090: 69 76 65 6e 20 61 20 72 65 66 65 72 65 72 65 6e iven a refereren
60a0: 63 65 20 64 61 74 61 20 73 74 72 75 63 74 75 72 ce data structur
60b0: 65 20 22 69 6e 64 61 74 22 0a 3b 3b 20 20 20 31 e "indat".;; 1
60c0: 2e 20 4f 70 65 6e 20 74 68 65 20 6f 75 74 70 75 . Open the outpu
60d0: 74 20 66 69 6c 65 20 61 6e 64 20 72 65 61 64 20 t file and read
60e0: 69 74 20 69 6e 74 6f 20 61 20 6c 69 73 74 0a 3b it into a list.;
60f0: 3b 20 20 20 32 2e 20 46 6c 61 74 74 65 6e 20 61 ; 2. Flatten a
6100: 6e 79 20 6d 75 6c 74 69 6c 69 6e 65 20 65 6e 74 ny multiline ent
6110: 72 69 65 73 0a 3b 3b 20 20 20 33 2e 20 4d 6f 64 ries.;; 3. Mod
6120: 69 66 79 20 76 61 6c 75 65 73 20 70 65 72 20 63 ify values per c
6130: 6f 6e 74 65 6e 74 73 20 6f 66 20 22 69 6e 64 61 ontents of "inda
6140: 74 22 20 61 6e 64 20 72 65 6d 6f 76 65 20 61 62 t" and remove ab
6150: 73 65 6e 74 20 76 61 6c 75 65 73 0a 3b 3b 20 20 sent values.;;
6160: 20 34 2e 20 41 70 70 65 6e 64 20 6e 65 77 20 76 4. Append new v
6170: 61 6c 75 65 73 20 74 6f 20 74 68 65 20 73 65 63 alues to the sec
6180: 74 69 6f 6e 20 28 69 6d 6d 65 64 69 61 74 65 6c tion (immediatel
6190: 79 20 61 66 74 65 72 20 6c 61 73 74 20 6c 65 67 y after last leg
61a0: 69 74 20 65 6e 74 72 79 29 0a 3b 3b 20 20 20 35 it entry).;; 5
61b0: 2e 20 57 72 69 74 65 20 6f 75 74 20 74 68 65 20 . Write out the
61c0: 6e 65 77 20 6c 69 73 74 20 0a 3b 3b 3d 3d 3d 3d new list .;;====
61d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
61e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
61f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6200: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6210: 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e ==..(define (con
6220: 66 69 67 66 3a 77 72 69 74 65 2d 63 6f 6e 66 69 figf:write-confi
6230: 67 20 69 6e 64 61 74 20 66 6e 61 6d 65 20 23 21 g indat fname #!
6240: 6b 65 79 20 28 72 65 71 75 69 72 65 64 2d 73 65 key (required-se
6250: 63 74 69 6f 6e 73 20 27 28 29 29 29 0a 20 20 28 ctions '())). (
6260: 6c 65 74 2a 20 28 3b 3b 20 73 74 65 70 20 31 3a let* (;; step 1:
6270: 20 4f 70 65 6e 20 74 68 65 20 6f 75 74 70 75 74 Open the output
6280: 20 66 69 6c 65 20 61 6e 64 20 72 65 61 64 20 69 file and read i
6290: 74 20 69 6e 74 6f 20 61 20 6c 69 73 74 0a 09 20 t into a list..
62a0: 28 66 64 61 74 20 20 20 20 20 20 20 28 63 6f 6e (fdat (con
62b0: 66 69 67 66 3a 66 69 6c 65 2d 3e 6c 69 73 74 20 figf:file->list
62c0: 66 6e 61 6d 65 29 29 0a 09 20 28 72 65 66 64 61 fname)).. (refda
62d0: 74 20 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 t (make-hash-ta
62e0: 62 6c 65 29 29 0a 09 20 28 73 65 63 68 61 73 68 ble)).. (sechash
62f0: 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c (make-hash-tabl
6300: 65 29 29 20 3b 3b 20 63 75 72 72 65 6e 74 20 73 e)) ;; current s
6310: 65 63 74 69 6f 6e 20 68 61 73 68 2c 20 69 6e 69 ection hash, ini
6320: 74 20 77 69 74 68 20 68 61 73 68 20 66 6f 72 20 t with hash for
6330: 22 64 65 66 61 75 6c 74 22 20 73 65 63 74 69 6f "default" sectio
6340: 6e 0a 09 20 28 6e 65 77 20 20 20 20 20 23 66 29 n.. (new #f)
6350: 20 3b 3b 20 70 75 74 20 74 68 65 20 6c 69 6e 65 ;; put the line
6360: 20 74 6f 20 62 65 20 75 73 65 64 20 69 6e 20 6e to be used in n
6370: 65 77 2c 20 69 66 20 69 74 20 69 73 20 74 6f 20 ew, if it is to
6380: 62 65 20 64 65 6c 65 74 65 64 20 74 68 65 20 73 be deleted the s
6390: 65 74 20 6e 65 77 20 74 6f 20 23 66 0a 09 20 28 et new to #f.. (
63a0: 73 65 63 6e 61 6d 65 20 23 66 29 29 0a 0a 20 20 secname #f))..
63b0: 20 20 3b 3b 20 73 74 65 70 20 32 3a 20 46 6c 61 ;; step 2: Fla
63c0: 74 74 65 6e 20 6d 75 6c 74 69 6c 69 6e 65 20 65 tten multiline e
63d0: 6e 74 72 69 65 73 0a 20 20 20 20 28 69 66 20 28 ntries. (if (
63e0: 6e 6f 74 20 28 6e 75 6c 6c 3f 20 66 64 61 74 29 not (null? fdat)
63f0: 29 28 73 65 74 21 20 66 64 61 74 20 28 63 6f 6e )(set! fdat (con
6400: 66 69 67 66 3a 63 6f 6d 70 72 65 73 73 2d 6d 75 figf:compress-mu
6410: 6c 74 69 2d 6c 69 6e 65 20 66 64 61 74 29 29 29 lti-line fdat)))
6420: 0a 0a 20 20 20 20 3b 3b 20 73 74 65 70 20 33 3a .. ;; step 3:
6430: 20 4d 6f 64 69 66 79 20 76 61 6c 75 65 73 20 70 Modify values p
6440: 65 72 20 63 6f 6e 74 65 6e 74 73 20 6f 66 20 22 er contents of "
6450: 69 6e 64 61 74 22 20 61 6e 64 20 72 65 6d 6f 76 indat" and remov
6460: 65 20 61 62 73 65 6e 74 20 76 61 6c 75 65 73 0a e absent values.
6470: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6e 75 (if (not (nu
6480: 6c 6c 3f 20 66 64 61 74 29 29 0a 09 28 6c 65 74 ll? fdat))..(let
6490: 20 6c 6f 6f 70 20 28 28 68 65 64 20 20 28 63 61 loop ((hed (ca
64a0: 72 20 66 64 61 74 29 29 0a 09 09 20 20 20 28 74 r fdat))... (t
64b0: 61 6c 20 20 28 63 61 64 72 20 66 64 61 74 29 29 al (cadr fdat))
64c0: 0a 09 09 20 20 20 28 72 65 73 20 20 27 28 29 29 ... (res '())
64d0: 0a 09 09 20 20 20 28 6c 6e 75 6d 20 30 29 29 0a ... (lnum 0)).
64e0: 09 20 20 28 72 65 67 65 78 2d 63 61 73 65 20 0a . (regex-case .
64f0: 09 20 20 20 68 65 64 0a 09 20 20 20 28 63 6f 6e . hed.. (con
6500: 66 69 67 66 3a 63 6f 6d 6d 65 6e 74 2d 72 78 20 figf:comment-rx
6510: 5f 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 _
6520: 20 20 20 28 73 65 74 21 20 72 65 73 20 28 61 70 (set! res (ap
6530: 70 65 6e 64 20 72 65 73 20 28 6c 69 73 74 20 68 pend res (list h
6540: 65 64 29 29 29 29 20 3b 3b 20 28 6c 6f 6f 70 20 ed)))) ;; (loop
6550: 28 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 29 20 (read-line inp)
6560: 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d curr-section-nam
6570: 65 20 23 66 20 23 66 29 29 0a 09 20 20 20 28 63 e #f #f)).. (c
6580: 6f 6e 66 69 67 66 3a 62 6c 61 6e 6b 2d 6c 2d 72 onfigf:blank-l-r
6590: 78 20 5f 20 20 20 20 20 20 20 20 20 20 20 20 20 x _
65a0: 20 20 20 20 20 28 73 65 74 21 20 72 65 73 20 28 (set! res (
65b0: 61 70 70 65 6e 64 20 72 65 73 20 28 6c 69 73 74 append res (list
65c0: 20 68 65 64 29 29 29 29 20 3b 3b 20 28 6c 6f 6f hed)))) ;; (loo
65d0: 70 20 28 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 p (read-line inp
65e0: 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e ) curr-section-n
65f0: 61 6d 65 20 23 66 20 23 66 29 29 0a 09 20 20 20 ame #f #f))..
6600: 28 63 6f 6e 66 69 67 66 3a 73 65 63 74 69 6f 6e (configf:section
6610: 2d 72 78 20 28 20 78 20 73 65 63 74 69 6f 6e 2d -rx ( x section-
6620: 6e 61 6d 65 20 29 20 28 6c 65 74 20 28 28 73 65 name ) (let ((se
6630: 63 74 69 6f 6e 2d 68 61 73 68 20 28 68 61 73 68 ction-hash (hash
6640: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau
6650: 6c 74 20 72 65 66 64 61 74 20 73 65 63 74 69 6f lt refdat sectio
6660: 6e 2d 6e 61 6d 65 20 23 66 29 29 29 0a 09 09 09 n-name #f)))....
6670: 09 09 20 20 20 20 28 69 66 20 28 6e 6f 74 20 73 .. (if (not s
6680: 65 63 74 69 6f 6e 2d 68 61 73 68 29 0a 09 09 09 ection-hash)....
6690: 09 09 09 28 6c 65 74 20 28 28 6e 65 77 68 61 73 ...(let ((newhas
66a0: 68 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 h (make-hash-tab
66b0: 6c 65 29 29 29 0a 09 09 09 09 09 09 20 20 28 68 le)))....... (h
66c0: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 72 ash-table-set! r
66d0: 65 66 68 61 73 68 20 73 65 63 74 69 6f 6e 2d 6e efhash section-n
66e0: 61 6d 65 20 6e 65 77 68 61 73 68 29 0a 09 09 09 ame newhash)....
66f0: 09 09 09 20 20 28 73 65 74 21 20 73 65 63 68 61 ... (set! secha
6700: 73 68 20 6e 65 77 68 61 73 68 29 29 0a 09 09 09 sh newhash))....
6710: 09 09 09 28 73 65 74 21 20 73 65 63 68 61 73 68 ...(set! sechash
6720: 20 73 65 63 74 69 6f 6e 2d 68 61 73 68 29 29 0a section-hash)).
6730: 09 09 09 09 09 20 20 20 20 28 73 65 74 21 20 6e ..... (set! n
6740: 65 77 20 68 65 64 29 20 3b 3b 20 77 69 6c 6c 20 ew hed) ;; will
6750: 61 70 70 65 6e 64 20 74 68 69 73 20 61 74 20 74 append this at t
6760: 68 65 20 62 6f 74 74 6f 6d 20 6f 66 20 74 68 65 he bottom of the
6770: 20 6c 6f 6f 70 0a 09 09 09 09 09 20 20 20 20 28 loop...... (
6780: 73 65 74 21 20 73 65 63 6e 61 6d 65 20 73 65 63 set! secname sec
6790: 74 69 6f 6e 2d 6e 61 6d 65 29 0a 09 09 09 09 09 tion-name)......
67a0: 20 20 20 20 29 29 0a 09 20 20 20 3b 3b 20 4e 6f )).. ;; No
67b0: 20 6e 65 65 64 20 74 6f 20 70 72 6f 63 65 73 73 need to process
67c0: 20 6b 65 79 20 63 6d 64 2c 20 6c 65 74 20 69 74 key cmd, let it
67d0: 20 66 61 6c 6c 20 74 68 6f 75 67 68 20 74 6f 20 fall though to
67e0: 6b 65 79 20 76 61 6c 0a 09 20 20 20 28 63 6f 6e key val.. (con
67f0: 66 69 67 66 3a 6b 65 79 2d 76 61 6c 2d 70 72 20 figf:key-val-pr
6800: 28 20 78 20 6b 65 79 20 76 61 6c 20 20 20 20 20 ( x key val
6810: 20 29 0a 09 09 20 20 20 20 20 20 20 28 6c 65 74 )... (let
6820: 20 28 28 6e 65 77 76 61 6c 20 28 63 6f 6e 66 69 ((newval (confi
6830: 67 2d 6c 6f 6f 6b 75 70 20 69 6e 64 61 74 20 73 g-lookup indat s
6840: 65 63 20 6b 65 79 29 29 29 0a 09 09 09 20 3b 3b ec key))).... ;;
6850: 20 63 61 6e 20 68 61 6e 64 6c 65 20 6e 65 77 76 can handle newv
6860: 61 6c 20 3d 3d 20 23 66 20 68 65 72 65 20 3d 3e al == #f here =>
6870: 20 74 68 61 74 20 6d 65 61 6e 73 20 6b 65 79 20 that means key
6880: 69 73 20 72 65 6d 6f 76 65 64 0a 09 09 09 20 28 is removed.... (
6890: 63 6f 6e 64 20 0a 09 09 09 20 20 28 28 65 71 75 cond .... ((equ
68a0: 61 6c 3f 20 6e 65 77 76 61 6c 20 76 61 6c 29 0a al? newval val).
68b0: 09 09 09 20 20 20 28 73 65 74 21 20 72 65 73 20 ... (set! res
68c0: 28 61 70 70 65 6e 64 20 72 65 73 20 28 6c 69 73 (append res (lis
68d0: 74 20 68 65 64 29 29 29 29 0a 09 09 09 20 20 28 t hed)))).... (
68e0: 28 6e 6f 74 20 6e 65 77 76 61 6c 29 20 3b 3b 20 (not newval) ;;
68f0: 6b 65 79 20 68 61 73 20 62 65 65 6e 20 72 65 6d key has been rem
6900: 6f 76 65 64 0a 09 09 09 20 20 20 28 73 65 74 21 oved.... (set!
6910: 20 6e 65 77 20 23 66 29 29 0a 09 09 09 20 20 28 new #f)).... (
6920: 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 6e 65 77 (not (equal? new
6930: 76 61 6c 20 76 61 6c 29 29 0a 09 09 09 20 20 20 val val))....
6940: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 (hash-table-se
6950: 74 21 20 73 65 63 68 61 73 68 20 6b 65 79 20 6e t! sechash key n
6960: 65 77 76 61 6c 29 0a 09 09 09 20 20 20 20 20 28 ewval).... (
6970: 73 65 74 21 20 6e 65 77 20 28 63 6f 6e 63 20 6b set! new (conc k
6980: 65 79 20 22 20 22 20 6e 65 77 76 61 6c 29 29 29 ey " " newval)))
6990: 0a 09 09 09 20 20 28 65 6c 73 65 0a 09 09 09 20 .... (else....
69a0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 (debug:print-e
69b0: 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d rror 0 *default-
69c0: 6c 6f 67 2d 70 6f 72 74 2a 20 22 70 72 6f 62 6c log-port* "probl
69d0: 65 6d 20 70 61 72 73 69 6e 67 20 6c 69 6e 65 20 em parsing line
69e0: 6e 75 6d 62 65 72 20 22 20 6c 6e 75 6d 20 22 5c number " lnum "\
69f0: 22 22 20 68 65 64 20 22 5c 22 22 29 29 29 29 29 "" hed "\"")))))
6a00: 0a 09 20 20 20 28 65 6c 73 65 0a 09 20 20 20 20 .. (else..
6a10: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 (debug:print-err
6a20: 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f or 0 *default-lo
6a30: 67 2d 70 6f 72 74 2a 20 22 50 72 6f 62 6c 65 6d g-port* "Problem
6a40: 20 70 61 72 73 69 6e 67 20 6c 69 6e 65 20 6e 75 parsing line nu
6a50: 6d 20 22 20 6c 6e 75 6d 20 22 20 3a 5c 6e 20 20 m " lnum " :\n
6a60: 20 22 20 68 65 64 20 29 29 29 0a 09 20 20 28 69 " hed ))).. (i
6a70: 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 74 61 f (not (null? ta
6a80: 6c 29 29 0a 09 20 20 20 20 20 20 28 6c 6f 6f 70 l)).. (loop
6a90: 20 28 63 61 72 20 74 61 6c 29 28 63 64 72 20 74 (car tal)(cdr t
6aa0: 61 6c 29 28 69 66 20 6e 65 77 20 28 61 70 70 65 al)(if new (appe
6ab0: 6e 64 20 72 65 73 20 28 6c 69 73 74 20 6e 65 77 nd res (list new
6ac0: 29 29 20 72 65 73 29 28 2b 20 6c 6e 75 6d 20 31 )) res)(+ lnum 1
6ad0: 29 29 29 0a 09 20 20 3b 3b 20 64 72 6f 70 20 74 ))).. ;; drop t
6ae0: 6f 20 68 65 72 65 20 77 68 65 6e 20 64 6f 6e 65 o here when done
6af0: 20 70 72 6f 63 65 73 73 69 6e 67 2c 20 72 65 73 processing, res
6b00: 20 63 6f 6e 74 61 69 6e 73 20 6d 6f 64 69 66 69 contains modifi
6b10: 65 64 20 6c 69 73 74 20 6f 66 20 6c 69 6e 65 73 ed list of lines
6b20: 0a 09 20 20 28 73 65 74 21 20 66 64 61 74 20 72 .. (set! fdat r
6b30: 65 73 29 29 29 0a 0a 20 20 20 20 3b 3b 20 73 74 es))).. ;; st
6b40: 65 70 20 34 3a 20 41 70 70 65 6e 64 20 6e 65 77 ep 4: Append new
6b50: 20 76 61 6c 75 65 73 20 74 6f 20 74 68 65 20 73 values to the s
6b60: 65 63 74 69 6f 6e 0a 20 20 20 20 28 66 6f 72 2d ection. (for-
6b70: 65 61 63 68 20 0a 20 20 20 20 20 28 6c 61 6d 62 each . (lamb
6b80: 64 61 20 28 73 65 63 74 69 6f 6e 29 0a 20 20 20 da (section).
6b90: 20 20 20 20 28 6c 65 74 20 28 28 73 64 61 74 20 (let ((sdat
6ba0: 20 20 27 28 29 29 20 3b 3b 20 61 70 70 65 6e 64 '()) ;; append
6bb0: 20 6e 65 65 64 65 64 20 62 69 74 73 20 68 65 72 needed bits her
6bc0: 65 0a 09 20 20 20 20 20 28 73 76 61 72 73 20 20 e.. (svars
6bd0: 28 63 6f 6e 66 69 67 66 3a 73 65 63 74 69 6f 6e (configf:section
6be0: 2d 76 61 72 73 20 69 6e 64 61 74 20 73 65 63 74 -vars indat sect
6bf0: 69 6f 6e 29 29 29 0a 09 20 28 66 6f 72 2d 65 61 ion))).. (for-ea
6c00: 63 68 20 0a 09 20 20 28 6c 61 6d 62 64 61 20 28 ch .. (lambda (
6c10: 76 61 72 29 0a 09 20 20 20 20 28 6c 65 74 20 28 var).. (let (
6c20: 28 76 61 6c 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f (val (config-loo
6c30: 6b 75 70 20 72 65 66 64 61 74 20 73 65 63 74 69 kup refdat secti
6c40: 6f 6e 20 76 61 72 29 29 29 0a 09 20 20 20 20 20 on var)))..
6c50: 20 28 69 66 20 28 6e 6f 74 20 76 61 6c 29 20 3b (if (not val) ;
6c60: 3b 20 74 68 69 73 20 6f 6e 65 20 69 73 20 6e 65 ; this one is ne
6c70: 77 0a 09 09 20 20 28 62 65 67 69 6e 0a 09 09 20 w... (begin...
6c80: 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 73 64 (if (null? sd
6c90: 61 74 29 28 73 65 74 21 20 73 64 61 74 20 28 6c at)(set! sdat (l
6ca0: 69 73 74 20 28 63 6f 6e 63 20 22 5b 22 20 73 65 ist (conc "[" se
6cb0: 63 74 69 6f 6e 20 22 5d 22 29 29 29 29 0a 09 09 ction "]"))))...
6cc0: 20 20 20 20 28 73 65 74 21 20 73 64 61 74 20 28 (set! sdat (
6cd0: 61 70 70 65 6e 64 20 73 64 61 74 20 28 6c 69 73 append sdat (lis
6ce0: 74 20 28 63 6f 6e 63 20 76 61 72 20 22 20 22 20 t (conc var " "
6cf0: 76 61 6c 29 29 29 29 29 29 29 29 0a 09 20 20 73 val)))))))).. s
6d00: 76 61 72 73 29 0a 09 20 28 73 65 74 21 20 66 64 vars).. (set! fd
6d10: 61 74 20 28 61 70 70 65 6e 64 20 66 64 61 74 20 at (append fdat
6d20: 73 64 61 74 29 29 29 29 0a 20 20 20 20 20 28 64 sdat)))). (d
6d30: 65 6c 65 74 65 2d 64 75 70 6c 69 63 61 74 65 73 elete-duplicates
6d40: 20 28 61 70 70 65 6e 64 20 72 65 71 75 69 72 65 (append require
6d50: 2d 73 65 63 74 69 6f 6e 73 20 28 68 61 73 68 2d -sections (hash-
6d60: 74 61 62 6c 65 2d 6b 65 79 73 20 69 6e 64 61 74 table-keys indat
6d70: 29 29 29 29 0a 0a 20 20 20 20 3b 3b 20 73 74 65 )))).. ;; ste
6d80: 70 20 35 3a 20 57 72 69 74 65 20 6f 75 74 20 6e p 5: Write out n
6d90: 65 77 20 66 69 6c 65 0a 20 20 20 20 28 77 69 74 ew file. (wit
6da0: 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 69 6c 65 h-output-to-file
6db0: 20 66 6e 61 6d 65 20 0a 20 20 20 20 20 20 28 6c fname . (l
6dc0: 61 6d 62 64 61 20 28 29 0a 09 28 66 6f 72 2d 65 ambda ()..(for-e
6dd0: 61 63 68 20 0a 09 20 28 6c 61 6d 62 64 61 20 28 ach .. (lambda (
6de0: 6c 69 6e 65 29 0a 09 20 20 20 28 70 72 69 6e 74 line).. (print
6df0: 20 6c 69 6e 65 29 29 0a 09 20 28 63 6f 6e 66 69 line)).. (confi
6e00: 67 66 3a 65 78 70 61 6e 64 2d 6d 75 6c 74 69 2d gf:expand-multi-
6e10: 6c 69 6e 65 73 20 66 64 61 74 29 29 29 29 29 29 lines fdat))))))
6e20: 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
6e30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6e40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6e50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6e60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 72 65 ==========.;; re
6e70: 66 64 62 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d fdb.;;==========
6e80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6e90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6ea0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6eb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b ============..;;
6ec0: 20 72 65 61 64 73 20 61 20 72 65 66 64 62 20 69 reads a refdb i
6ed0: 6e 74 6f 20 61 6e 20 61 73 73 6f 63 20 61 72 72 nto an assoc arr
6ee0: 61 79 20 6f 66 20 61 73 73 6f 63 20 61 72 72 61 ay of assoc arra
6ef0: 79 73 0a 3b 3b 20 20 20 72 65 74 75 72 6e 73 20 ys.;; returns
6f00: 28 6c 69 73 74 20 64 61 74 20 6d 73 67 29 0a 28 (list dat msg).(
6f10: 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a define (configf:
6f20: 72 65 61 64 2d 72 65 66 64 62 20 72 65 66 64 62 read-refdb refdb
6f30: 2d 70 61 74 68 29 0a 20 20 28 6c 65 74 20 28 28 -path). (let ((
6f40: 73 68 65 65 74 73 2d 66 69 6c 65 20 20 28 63 6f sheets-file (co
6f50: 6e 63 20 72 65 66 64 62 2d 70 61 74 68 20 22 2f nc refdb-path "/
6f60: 73 68 65 65 74 2d 6e 61 6d 65 73 2e 63 66 67 22 sheet-names.cfg"
6f70: 29 29 29 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 ))). (if (not
6f80: 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 73 (file-exists? s
6f90: 68 65 65 74 73 2d 66 69 6c 65 29 29 0a 09 28 6c heets-file))..(l
6fa0: 69 73 74 20 23 66 20 28 63 6f 6e 63 20 22 45 52 ist #f (conc "ER
6fb0: 52 4f 52 3a 20 6e 6f 20 72 65 66 64 62 20 66 6f ROR: no refdb fo
6fc0: 75 6e 64 20 61 74 20 22 20 72 65 66 64 62 2d 70 und at " refdb-p
6fd0: 61 74 68 29 29 0a 09 28 69 66 20 28 6e 6f 74 20 ath))..(if (not
6fe0: 28 66 69 6c 65 2d 72 65 61 64 2d 61 63 63 65 73 (file-read-acces
6ff0: 73 3f 20 73 68 65 65 74 73 2d 66 69 6c 65 29 29 s? sheets-file))
7000: 0a 09 20 20 20 20 28 6c 69 73 74 20 23 66 20 28 .. (list #f (
7010: 63 6f 6e 63 20 22 45 52 52 4f 52 3a 20 72 65 66 conc "ERROR: ref
7020: 64 62 20 66 69 6c 65 20 6e 6f 74 20 72 65 61 64 db file not read
7030: 61 62 6c 65 20 61 74 20 22 20 72 65 66 64 62 2d able at " refdb-
7040: 70 61 74 68 29 29 0a 09 20 20 20 20 28 6c 65 74 path)).. (let
7050: 2a 20 28 28 73 68 65 65 74 73 20 28 77 69 74 68 * ((sheets (with
7060: 2d 69 6e 70 75 74 2d 66 72 6f 6d 2d 66 69 6c 65 -input-from-file
7070: 20 73 68 65 65 74 73 2d 66 69 6c 65 0a 09 09 09 sheets-file....
7080: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 29 0a (lambda ().
7090: 09 09 09 20 20 20 20 20 20 20 28 6c 65 74 20 6c ... (let l
70a0: 6f 6f 70 20 28 28 69 6e 6c 20 28 72 65 61 64 2d oop ((inl (read-
70b0: 6c 69 6e 65 29 29 0a 09 09 09 09 09 20 20 28 72 line))...... (r
70c0: 65 73 20 27 28 29 29 29 0a 09 09 09 09 20 28 69 es '()))..... (i
70d0: 66 20 28 65 6f 66 2d 6f 62 6a 65 63 74 3f 20 69 f (eof-object? i
70e0: 6e 6c 29 0a 09 09 09 09 20 20 20 20 20 28 72 65 nl)..... (re
70f0: 76 65 72 73 65 20 72 65 73 29 0a 09 09 09 09 20 verse res).....
7100: 20 20 20 20 28 6c 6f 6f 70 20 28 72 65 61 64 2d (loop (read-
7110: 6c 69 6e 65 29 28 63 6f 6e 73 20 69 6e 6c 20 72 line)(cons inl r
7120: 65 73 29 29 29 29 29 29 29 0a 09 09 20 20 20 28 es)))))))... (
7130: 64 61 74 61 20 20 20 27 28 29 29 29 0a 09 20 20 data '()))..
7140: 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 (for-each ..
7150: 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 (lambda (
7160: 73 68 65 65 74 2d 6e 61 6d 65 29 0a 09 09 20 28 sheet-name)... (
7170: 6c 65 74 2a 20 28 28 64 61 74 2d 70 61 74 68 20 let* ((dat-path
7180: 20 28 63 6f 6e 63 20 72 65 66 64 62 2d 70 61 74 (conc refdb-pat
7190: 68 20 22 2f 22 20 73 68 65 65 74 2d 6e 61 6d 65 h "/" sheet-name
71a0: 20 22 2e 64 61 74 22 29 29 0a 09 09 09 28 72 65 ".dat"))....(re
71b0: 66 2d 64 61 74 20 20 20 28 63 6f 6e 66 69 67 66 f-dat (configf
71c0: 3a 72 65 61 64 2d 66 69 6c 65 20 64 61 74 2d 70 :read-file dat-p
71d0: 61 74 68 20 23 66 20 23 74 29 29 0a 09 09 09 28 ath #f #t))....(
71e0: 72 65 66 2d 61 73 73 6f 63 20 28 6d 61 70 20 28 ref-assoc (map (
71f0: 6c 61 6d 62 64 61 20 28 6b 65 79 29 0a 09 09 09 lambda (key)....
7200: 09 09 20 20 28 6c 69 73 74 20 6b 65 79 20 28 68 .. (list key (h
7210: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 72 65 ash-table-ref re
7220: 66 2d 64 61 74 20 6b 65 79 29 29 29 0a 09 09 09 f-dat key)))....
7230: 09 09 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 ..(hash-table-ke
7240: 79 73 20 72 65 66 2d 64 61 74 29 29 29 29 0a 09 ys ref-dat))))..
7250: 09 09 09 20 20 20 3b 3b 20 28 68 61 73 68 2d 74 ... ;; (hash-t
7260: 61 62 6c 65 2d 3e 61 6c 69 73 74 20 72 65 66 2d able->alist ref-
7270: 64 61 74 29 29 29 0a 09 09 20 20 20 3b 3b 20 28 dat)))... ;; (
7280: 73 65 74 21 20 64 61 74 61 20 28 61 70 70 65 6e set! data (appen
7290: 64 20 64 61 74 61 20 28 6c 69 73 74 20 28 6c 69 d data (list (li
72a0: 73 74 20 73 68 65 65 74 2d 6e 61 6d 65 20 72 65 st sheet-name re
72b0: 66 2d 61 73 73 6f 63 29 29 29 29 29 29 0a 09 09 f-assoc))))))...
72c0: 20 20 20 28 73 65 74 21 20 64 61 74 61 20 28 63 (set! data (c
72d0: 6f 6e 73 20 28 6c 69 73 74 20 73 68 65 65 74 2d ons (list sheet-
72e0: 6e 61 6d 65 20 72 65 66 2d 61 73 73 6f 63 29 20 name ref-assoc)
72f0: 64 61 74 61 29 29 29 29 0a 09 20 20 20 20 20 20 data))))..
7300: 20 73 68 65 65 74 73 29 0a 09 20 20 20 20 20 20 sheets)..
7310: 28 6c 69 73 74 20 64 61 74 61 20 22 4e 4f 20 45 (list data "NO E
7320: 52 52 4f 52 53 22 29 29 29 29 29 29 0a 0a 3b 3b RRORS"))))))..;;
7330: 20 6d 61 70 20 6f 76 65 72 20 61 6c 6c 20 70 61 map over all pa
7340: 69 72 73 20 69 6e 20 61 20 74 68 72 65 65 20 6c irs in a three l
7350: 65 76 65 6c 20 68 69 65 72 61 72 63 68 69 61 6c evel hierarchial
7360: 20 61 6c 69 73 74 20 61 6e 64 20 61 70 70 6c 79 alist and apply
7370: 20 61 20 66 75 6e 63 74 69 6f 6e 20 74 6f 20 74 a function to t
7380: 68 65 20 6b 65 79 73 2f 76 61 6c 0a 3b 3b 0a 28 he keys/val.;;.(
7390: 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a define (configf:
73a0: 6d 61 70 2d 61 6c 6c 2d 68 69 65 72 2d 61 6c 69 map-all-hier-ali
73b0: 73 74 20 64 61 74 61 20 70 72 6f 63 20 23 21 6b st data proc #!k
73c0: 65 79 20 28 69 6e 69 74 70 72 6f 63 31 20 23 66 ey (initproc1 #f
73d0: 29 28 69 6e 69 74 70 72 6f 63 32 20 23 66 29 28 )(initproc2 #f)(
73e0: 69 6e 69 74 70 72 6f 63 33 20 23 66 29 29 0a 20 initproc3 #f)).
73f0: 20 28 66 6f 72 2d 65 61 63 68 20 0a 20 20 20 28 (for-each . (
7400: 6c 61 6d 62 64 61 20 28 73 68 65 65 74 6e 61 6d lambda (sheetnam
7410: 65 29 0a 20 20 20 20 20 28 6c 65 74 2a 20 28 28 e). (let* ((
7420: 73 68 65 65 74 74 6d 70 20 20 28 61 73 73 6f 63 sheettmp (assoc
7430: 20 73 68 65 65 74 6e 61 6d 65 20 64 61 74 61 29 sheetname data)
7440: 29 0a 09 20 20 20 20 28 73 68 65 65 74 64 61 74 ).. (sheetdat
7450: 20 20 28 69 66 20 73 68 65 65 74 74 6d 70 20 28 (if sheettmp (
7460: 63 61 64 72 20 73 68 65 65 74 74 6d 70 29 20 27 cadr sheettmp) '
7470: 28 29 29 29 29 0a 20 20 20 20 20 20 20 28 69 66 ()))). (if
7480: 20 69 6e 69 74 70 72 6f 63 31 20 28 69 6e 69 74 initproc1 (init
7490: 70 72 6f 63 31 20 73 68 65 65 74 6e 61 6d 65 29 proc1 sheetname)
74a0: 29 0a 20 20 20 20 20 20 20 28 66 6f 72 2d 65 61 ). (for-ea
74b0: 63 68 20 0a 09 28 6c 61 6d 62 64 61 20 28 73 65 ch ..(lambda (se
74c0: 63 74 69 6f 6e 6e 61 6d 65 29 0a 09 20 20 28 6c ctionname).. (l
74d0: 65 74 2a 20 28 28 73 65 63 74 69 6f 6e 74 6d 70 et* ((sectiontmp
74e0: 20 20 28 61 73 73 6f 63 20 73 65 63 74 69 6f 6e (assoc section
74f0: 6e 61 6d 65 20 73 68 65 65 74 64 61 74 29 29 0a name sheetdat)).
7500: 09 09 20 28 73 65 63 74 69 6f 6e 64 61 74 20 20 .. (sectiondat
7510: 28 69 66 20 73 65 63 74 69 6f 6e 74 6d 70 20 28 (if sectiontmp (
7520: 63 61 64 72 20 73 65 63 74 69 6f 6e 74 6d 70 29 cadr sectiontmp)
7530: 20 27 28 29 29 29 29 0a 09 20 20 20 20 28 69 66 '()))).. (if
7540: 20 69 6e 69 74 70 72 6f 63 32 20 28 69 6e 69 74 initproc2 (init
7550: 70 72 6f 63 32 20 73 68 65 65 74 6e 61 6d 65 20 proc2 sheetname
7560: 73 65 63 74 69 6f 6e 6e 61 6d 65 29 29 0a 09 20 sectionname))..
7570: 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 09 20 20 (for-each..
7580: 20 20 20 28 6c 61 6d 62 64 61 20 28 76 61 72 6e (lambda (varn
7590: 61 6d 65 29 0a 09 20 20 20 20 20 20 20 28 6c 65 ame).. (le
75a0: 74 2a 20 28 28 76 61 6c 74 6d 70 20 28 61 73 73 t* ((valtmp (ass
75b0: 6f 63 20 76 61 72 6e 61 6d 65 20 73 65 63 74 69 oc varname secti
75c0: 6f 6e 64 61 74 29 29 0a 09 09 20 20 20 20 20 20 ondat))...
75d0: 28 76 61 6c 20 20 20 20 28 69 66 20 76 61 6c 74 (val (if valt
75e0: 6d 70 20 28 63 61 64 72 20 76 61 6c 74 6d 70 29 mp (cadr valtmp)
75f0: 20 22 22 29 29 29 0a 09 09 20 28 70 72 6f 63 20 "")))... (proc
7600: 73 68 65 65 74 6e 61 6d 65 20 73 65 63 74 69 6f sheetname sectio
7610: 6e 6e 61 6d 65 20 76 61 72 6e 61 6d 65 20 76 61 nname varname va
7620: 6c 29 29 29 0a 09 20 20 20 20 20 28 6d 61 70 20 l))).. (map
7630: 63 61 72 20 73 65 63 74 69 6f 6e 64 61 74 29 29 car sectiondat))
7640: 29 29 0a 09 28 6d 61 70 20 63 61 72 20 73 68 65 ))..(map car she
7650: 65 74 64 61 74 29 29 29 29 0a 20 20 20 28 6d 61 etdat)))). (ma
7660: 70 20 63 61 72 20 64 61 74 61 29 29 0a 20 20 64 p car data)). d
7670: 61 74 61 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d ata)..;;========
7680: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7690: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
76a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
76b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
76c0: 3b 20 20 43 20 4f 20 4e 20 46 20 49 20 47 20 20 ; C O N F I G
76d0: 20 54 20 4f 20 2f 20 46 20 52 20 4f 20 4d 20 20 T O / F R O M
76e0: 20 41 20 4c 20 49 20 53 20 54 0a 3b 3b 3d 3d 3d A L I S T.;;===
76f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7700: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7710: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7720: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7730: 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f ===..(define (co
7740: 6e 66 69 67 66 3a 63 6f 6e 66 69 67 2d 3e 61 6c nfigf:config->al
7750: 69 73 74 20 63 66 67 64 61 74 29 0a 20 20 28 68 ist cfgdat). (h
7760: 61 73 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 74 ash-table->alist
7770: 20 63 66 67 64 61 74 29 29 0a 0a 28 64 65 66 69 cfgdat))..(defi
7780: 6e 65 20 28 63 6f 6e 66 69 67 66 3a 61 6c 69 73 ne (configf:alis
7790: 74 2d 3e 63 6f 6e 66 69 67 20 61 64 61 74 29 0a t->config adat).
77a0: 20 20 28 6c 65 74 20 28 28 68 74 20 28 6d 61 6b (let ((ht (mak
77b0: 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 29 0a e-hash-table))).
77c0: 20 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 20 20 (for-each.
77d0: 20 20 20 28 6c 61 6d 62 64 61 20 28 73 65 63 74 (lambda (sect
77e0: 69 6f 6e 29 0a 20 20 20 20 20 20 20 28 68 61 73 ion). (has
77f0: 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 68 74 20 h-table-set! ht
7800: 28 63 61 72 20 73 65 63 74 69 6f 6e 29 28 63 64 (car section)(cd
7810: 72 20 73 65 63 74 69 6f 6e 29 29 29 0a 20 20 20 r section))).
7820: 20 20 61 64 61 74 29 0a 20 20 20 20 68 74 29 29 adat). ht))
7830: 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 ..(define (confi
7840: 67 66 3a 72 65 61 64 2d 61 6c 69 73 74 20 66 6e gf:read-alist fn
7850: 61 6d 65 29 0a 20 20 28 63 6f 6e 66 69 67 66 3a ame). (configf:
7860: 61 6c 69 73 74 2d 3e 63 6f 6e 66 69 67 0a 20 20 alist->config.
7870: 20 28 77 69 74 68 2d 69 6e 70 75 74 2d 66 72 6f (with-input-fro
7880: 6d 2d 66 69 6c 65 20 66 6e 61 6d 65 20 72 65 61 m-file fname rea
7890: 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 d)))..(define (c
78a0: 6f 6e 66 69 67 66 3a 77 72 69 74 65 2d 61 6c 69 onfigf:write-ali
78b0: 73 74 20 63 64 61 74 20 66 6e 61 6d 65 29 0a 20 st cdat fname).
78c0: 20 28 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f (with-output-to
78d0: 2d 66 69 6c 65 20 66 6e 61 6d 65 0a 20 20 20 20 -file fname.
78e0: 28 6c 61 6d 62 64 61 20 28 29 0a 20 20 20 20 20 (lambda ().
78f0: 20 28 70 70 20 28 63 6f 6e 66 69 67 66 3a 63 6f (pp (configf:co
7900: 6e 66 69 67 2d 3e 61 6c 69 73 74 20 63 64 61 74 nfig->alist cdat
7910: 29 29 29 29 29 0a 20 20 20 20 20 0a 0a 3b 3b 20 ))))). ..;;
7920: 63 6f 6e 76 65 72 74 20 68 69 65 72 61 72 63 68 convert hierarch
7930: 69 61 6c 20 6c 69 73 74 20 74 6f 20 69 6e 69 20 ial list to ini
7940: 66 6f 72 6d 61 74 0a 3b 3b 0a 28 64 65 66 69 6e format.;;.(defin
7950: 65 20 28 63 6f 6e 66 69 67 66 3a 63 6f 6e 66 69 e (configf:confi
7960: 67 2d 3e 69 6e 69 20 64 61 74 61 29 0a 20 20 28 g->ini data). (
7970: 6d 61 70 20 0a 20 20 20 28 6c 61 6d 62 64 61 20 map . (lambda
7980: 28 73 65 63 74 69 6f 6e 29 0a 20 20 20 20 20 28 (section). (
7990: 6c 65 74 20 28 28 73 65 63 74 69 6f 6e 2d 6e 61 let ((section-na
79a0: 6d 65 20 28 63 61 72 20 73 65 63 74 69 6f 6e 29 me (car section)
79b0: 29 0a 09 20 20 20 28 73 65 63 74 69 6f 6e 2d 64 ).. (section-d
79c0: 61 74 20 20 28 63 64 72 20 73 65 63 74 69 6f 6e at (cdr section
79d0: 29 29 29 0a 20 20 20 20 20 20 20 28 70 72 69 6e ))). (prin
79e0: 74 20 22 5c 6e 5b 22 20 73 65 63 74 69 6f 6e 2d t "\n[" section-
79f0: 6e 61 6d 65 20 22 5d 22 29 0a 20 20 20 20 20 20 name "]").
7a00: 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 64 (map (lambda (d
7a10: 61 74 2d 70 61 69 72 29 0a 09 20 20 20 20 20 20 at-pair)..
7a20: 28 6c 65 74 2a 20 28 28 76 61 72 20 28 63 61 72 (let* ((var (car
7a30: 20 64 61 74 2d 70 61 69 72 29 29 0a 09 09 20 20 dat-pair))...
7a40: 20 20 20 28 76 61 6c 20 28 63 61 64 72 20 64 61 (val (cadr da
7a50: 74 2d 70 61 69 72 29 29 0a 09 09 20 20 20 20 20 t-pair))...
7a60: 28 66 6e 61 6d 65 20 28 69 66 20 28 3e 20 28 6c (fname (if (> (l
7a70: 65 6e 67 74 68 20 64 61 74 2d 70 61 69 72 29 20 ength dat-pair)
7a80: 32 29 28 63 61 64 64 72 20 64 61 74 2d 70 61 69 2)(caddr dat-pai
7a90: 72 29 20 23 66 29 29 29 0a 09 09 28 69 66 20 66 r) #f)))...(if f
7aa0: 6e 61 6d 65 20 28 70 72 69 6e 74 20 22 23 20 22 name (print "# "
7ab0: 20 76 61 72 20 22 3d 3e 22 20 66 6e 61 6d 65 29 var "=>" fname)
7ac0: 29 0a 09 09 28 70 72 69 6e 74 20 76 61 72 20 22 )...(print var "
7ad0: 20 22 20 76 61 6c 29 29 29 0a 09 20 20 20 20 73 " val))).. s
7ae0: 65 63 74 69 6f 6e 2d 64 61 74 29 29 29 20 3b 3b ection-dat))) ;;
7af0: 20 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 73 (print "s
7b00: 65 63 74 69 6f 6e 2d 64 61 74 3a 20 22 20 73 65 ection-dat: " se
7b10: 63 74 69 6f 6e 2d 64 61 74 29 29 0a 20 20 20 28 ction-dat)). (
7b20: 68 61 73 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 hash-table->alis
7b30: 74 20 64 61 74 61 29 29 29 0a t data))).