Artifact
61db1e25bb02adf203fdaa8243d64b8782d1abc5:
0000: 3b 3d 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 0a 3b 3b 20 43 6f 70 79 72 =======.;; Copyr
0050: 69 67 68 74 20 32 30 30 36 2d 32 30 31 36 2c 20 ight 2006-2016,
0060: 4d 61 74 74 68 65 77 20 57 65 6c 6c 61 6e 64 2e Matthew Welland.
0070: 0a 3b 3b 20 0a 3b 3b 20 54 68 69 73 20 66 69 6c .;; .;; This fil
0080: 65 20 69 73 20 70 61 72 74 20 6f 66 20 4d 65 67 e is part of Meg
0090: 61 74 65 73 74 2e 0a 3b 3b 20 0a 3b 3b 20 20 20 atest..;; .;;
00a0: 20 20 4d 65 67 61 74 65 73 74 20 69 73 20 66 72 Megatest is fr
00b0: 65 65 20 73 6f 66 74 77 61 72 65 3a 20 79 6f 75 ee software: you
00c0: 20 63 61 6e 20 72 65 64 69 73 74 72 69 62 75 74 can redistribut
00d0: 65 20 69 74 20 61 6e 64 2f 6f 72 20 6d 6f 64 69 e it and/or modi
00e0: 66 79 0a 3b 3b 20 20 20 20 20 69 74 20 75 6e 64 fy.;; it und
00f0: 65 72 20 74 68 65 20 74 65 72 6d 73 20 6f 66 20 er the terms of
0100: 74 68 65 20 47 4e 55 20 47 65 6e 65 72 61 6c 20 the GNU General
0110: 50 75 62 6c 69 63 20 4c 69 63 65 6e 73 65 20 61 Public License a
0120: 73 20 70 75 62 6c 69 73 68 65 64 20 62 79 0a 3b s published by.;
0130: 3b 20 20 20 20 20 74 68 65 20 46 72 65 65 20 53 ; the Free S
0140: 6f 66 74 77 61 72 65 20 46 6f 75 6e 64 61 74 69 oftware Foundati
0150: 6f 6e 2c 20 65 69 74 68 65 72 20 76 65 72 73 69 on, either versi
0160: 6f 6e 20 33 20 6f 66 20 74 68 65 20 4c 69 63 65 on 3 of the Lice
0170: 6e 73 65 2c 20 6f 72 0a 3b 3b 20 20 20 20 20 28 nse, or.;; (
0180: 61 74 20 79 6f 75 72 20 6f 70 74 69 6f 6e 29 20 at your option)
0190: 61 6e 79 20 6c 61 74 65 72 20 76 65 72 73 69 6f any later versio
01a0: 6e 2e 0a 3b 3b 20 0a 3b 3b 20 20 20 20 20 4d 65 n..;; .;; Me
01b0: 67 61 74 65 73 74 20 69 73 20 64 69 73 74 72 69 gatest is distri
01c0: 62 75 74 65 64 20 69 6e 20 74 68 65 20 68 6f 70 buted in the hop
01d0: 65 20 74 68 61 74 20 69 74 20 77 69 6c 6c 20 62 e that it will b
01e0: 65 20 75 73 65 66 75 6c 2c 0a 3b 3b 20 20 20 20 e useful,.;;
01f0: 20 62 75 74 20 57 49 54 48 4f 55 54 20 41 4e 59 but WITHOUT ANY
0200: 20 57 41 52 52 41 4e 54 59 3b 20 77 69 74 68 6f WARRANTY; witho
0210: 75 74 20 65 76 65 6e 20 74 68 65 20 69 6d 70 6c ut even the impl
0220: 69 65 64 20 77 61 72 72 61 6e 74 79 20 6f 66 0a ied warranty of.
0230: 3b 3b 20 20 20 20 20 4d 45 52 43 48 41 4e 54 41 ;; MERCHANTA
0240: 42 49 4c 49 54 59 20 6f 72 20 46 49 54 4e 45 53 BILITY or FITNES
0250: 53 20 46 4f 52 20 41 20 50 41 52 54 49 43 55 4c S FOR A PARTICUL
0260: 41 52 20 50 55 52 50 4f 53 45 2e 20 20 53 65 65 AR PURPOSE. See
0270: 20 74 68 65 0a 3b 3b 20 20 20 20 20 47 4e 55 20 the.;; GNU
0280: 47 65 6e 65 72 61 6c 20 50 75 62 6c 69 63 20 4c General Public L
0290: 69 63 65 6e 73 65 20 66 6f 72 20 6d 6f 72 65 20 icense for more
02a0: 64 65 74 61 69 6c 73 2e 0a 3b 3b 20 0a 3b 3b 20 details..;; .;;
02b0: 20 20 20 20 59 6f 75 20 73 68 6f 75 6c 64 20 68 You should h
02c0: 61 76 65 20 72 65 63 65 69 76 65 64 20 61 20 63 ave received a c
02d0: 6f 70 79 20 6f 66 20 74 68 65 20 47 4e 55 20 47 opy of the GNU G
02e0: 65 6e 65 72 61 6c 20 50 75 62 6c 69 63 20 4c 69 eneral Public Li
02f0: 63 65 6e 73 65 0a 3b 3b 20 20 20 20 20 61 6c 6f cense.;; alo
0300: 6e 67 20 77 69 74 68 20 4d 65 67 61 74 65 73 74 ng with Megatest
0310: 2e 20 20 49 66 20 6e 6f 74 2c 20 73 65 65 20 3c . If not, see <
0320: 68 74 74 70 3a 2f 2f 77 77 77 2e 67 6e 75 2e 6f http://www.gnu.o
0330: 72 67 2f 6c 69 63 65 6e 73 65 73 2f 3e 2e 0a 3b rg/licenses/>..;
0340: 3b 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;.;;============
0350: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0360: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0370: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0380: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 4e ==========..;; N
0390: 4f 54 45 3a 20 54 68 69 73 20 69 73 20 74 68 65 OTE: This is the
03a0: 20 63 6f 6e 66 69 67 66 20 6d 6f 64 75 6c 65 2c configf module,
03b0: 20 6c 6f 6e 67 20 74 65 72 6d 20 69 74 20 77 69 long term it wi
03c0: 6c 6c 20 72 65 70 6c 61 63 65 20 63 6f 6e 66 69 ll replace confi
03d0: 67 66 2e 73 63 6d 2e 0a 0a 28 64 65 63 6c 61 72 gf.scm...(declar
03e0: 65 20 28 75 6e 69 74 20 6d 74 63 6f 6e 66 69 67 e (unit mtconfig
03f0: 66 29 29 0a 0a 28 6d 6f 64 75 6c 65 20 6d 74 63 f))..(module mtc
0400: 6f 6e 66 69 67 66 0a 20 20 20 20 20 20 20 20 28 onfigf. (
0410: 0a 0a 20 20 20 20 20 20 20 20 20 29 0a 0a 28 69 .. )..(i
0420: 6d 70 6f 72 74 20 73 63 68 65 6d 65 20 63 68 69 mport scheme chi
0430: 63 6b 65 6e 20 64 61 74 61 2d 73 74 72 75 63 74 cken data-struct
0440: 75 72 65 73 20 65 78 74 72 61 73 20 70 6f 72 74 ures extras port
0450: 73 20 66 69 6c 65 73 29 0a 28 75 73 65 20 70 6f s files).(use po
0460: 73 69 78 20 74 79 70 65 64 2d 72 65 63 6f 72 64 six typed-record
0470: 73 20 73 72 66 69 2d 31 38 29 0a 28 75 73 65 20 s srfi-18).(use
0480: 72 65 67 65 78 20 72 65 67 65 78 2d 63 61 73 65 regex regex-case
0490: 20 73 72 66 69 2d 36 39 20 73 72 66 69 2d 31 20 srfi-69 srfi-1
04a0: 64 69 72 65 63 74 6f 72 79 2d 75 74 69 6c 73 20 directory-utils
04b0: 65 78 74 72 61 73 20 73 72 66 69 2d 31 33 29 0a extras srfi-13).
04c0: 28 69 6d 70 6f 72 74 20 70 6f 73 69 78 29 0a 0a (import posix)..
04d0: 3b 3b 20 76 65 72 79 20 77 69 65 72 64 2c 20 74 ;; very wierd, t
04e0: 68 65 20 72 65 66 65 72 65 6e 63 65 20 74 6f 20 he reference to
04f0: 70 61 74 68 6e 61 6d 65 2d 64 69 72 65 63 74 6f pathname-directo
0500: 72 79 20 68 65 72 65 20 66 69 78 65 73 20 61 20 ry here fixes a
0510: 72 65 66 65 72 65 6e 63 65 20 74 6f 20 70 6f 73 reference to pos
0520: 73 69 62 6c 79 20 75 6e 62 6f 75 6e 64 20 69 64 sibly unbound id
0530: 65 6e 74 69 66 69 65 72 20 70 72 6f 62 6c 65 6d entifier problem
0540: 0a 3b 3b 0a 3b 3b 20 28 64 65 66 69 6e 65 20 28 .;;.;; (define (
0550: 64 75 6d 6d 79 2d 66 75 6e 63 74 69 6f 6e 20 70 dummy-function p
0560: 61 74 68 29 0a 3b 3b 20 20 20 28 70 61 74 68 6e ath).;; (pathn
0570: 61 6d 65 2d 64 69 72 65 63 74 6f 72 79 20 70 61 ame-directory pa
0580: 74 68 29 0a 3b 3b 20 20 20 28 61 62 73 6f 6c 75 th).;; (absolu
0590: 74 65 2d 70 61 74 68 6e 61 6d 65 3f 20 70 61 74 te-pathname? pat
05a0: 68 29 0a 3b 3b 20 20 20 28 6e 6f 72 6d 61 6c 69 h).;; (normali
05b0: 7a 65 2d 70 61 74 68 6e 61 6d 65 20 70 61 74 68 ze-pathname path
05c0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 64 65 62 75 ))..(define debu
05d0: 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 70 72 g:print-error pr
05e0: 69 6e 74 29 0a 28 64 65 66 69 6e 65 20 64 65 62 int).(define deb
05f0: 75 67 3a 70 72 69 6e 74 20 20 20 20 20 20 20 70 ug:print p
0600: 72 69 6e 74 29 0a 28 64 65 66 69 6e 65 20 64 65 rint).(define de
0610: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 20 bug:print-info
0620: 70 72 69 6e 74 29 0a 28 64 65 66 69 6e 65 20 2a print).(define *
0630: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
0640: 2a 20 28 63 75 72 72 65 6e 74 2d 65 72 72 6f 72 * (current-error
0650: 2d 70 6f 72 74 29 29 0a 0a 28 64 65 66 69 6e 65 -port))..(define
0660: 20 28 73 65 74 2d 64 65 62 75 67 2d 70 72 69 6e (set-debug-prin
0670: 74 65 72 73 20 6e 6f 72 6d 61 6c 2d 66 6e 20 69 ters normal-fn i
0680: 6e 66 6f 2d 66 6e 20 65 72 72 6f 72 2d 66 6e 20 nfo-fn error-fn
0690: 64 65 66 61 75 6c 74 2d 70 6f 72 74 29 0a 20 20 default-port).
06a0: 28 69 66 20 65 72 72 6f 72 2d 66 6e 20 20 28 73 (if error-fn (s
06b0: 65 74 21 20 64 65 62 75 67 3a 70 72 69 6e 74 2d et! debug:print-
06c0: 65 72 72 6f 72 20 65 72 72 6f 72 2d 66 6e 29 29 error error-fn))
06d0: 0a 20 20 28 69 66 20 69 6e 66 6f 2d 66 6e 20 20 . (if info-fn
06e0: 20 28 73 65 74 21 20 64 65 62 75 67 3a 70 72 69 (set! debug:pri
06f0: 6e 74 2d 69 6e 66 6f 20 20 69 6e 66 6f 2d 66 6e nt-info info-fn
0700: 29 29 0a 20 20 28 69 66 20 6e 6f 72 6d 61 6c 2d )). (if normal-
0710: 66 6e 20 28 73 65 74 21 20 64 65 62 75 67 3a 70 fn (set! debug:p
0720: 72 69 6e 74 20 20 20 20 20 20 20 6e 6f 72 6d 61 rint norma
0730: 6c 2d 66 6e 29 29 0a 20 20 28 69 66 20 64 65 66 l-fn)). (if def
0740: 61 75 6c 74 2d 70 6f 72 74 20 28 73 65 74 21 20 ault-port (set!
0750: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
0760: 74 2a 20 64 65 66 61 75 6c 74 2d 70 6f 72 74 29 t* default-port)
0770: 29 29 0a 20 20 0a 3b 3b 20 69 66 20 69 74 20 6c )). .;; if it l
0780: 6f 6f 6b 73 20 6c 69 6b 65 20 61 20 6e 75 6d 62 ooks like a numb
0790: 65 72 20 2d 3e 20 63 6f 6e 76 65 72 74 20 69 74 er -> convert it
07a0: 20 74 6f 20 61 20 6e 75 6d 62 65 72 2c 20 65 6c to a number, el
07b0: 73 65 20 72 65 74 75 72 6e 20 69 74 0a 3b 3b 0a se return it.;;.
07c0: 28 64 65 66 69 6e 65 20 28 6c 61 7a 79 2d 63 6f (define (lazy-co
07d0: 6e 76 65 72 74 20 69 6e 76 61 6c 29 0a 20 20 28 nvert inval). (
07e0: 6c 65 74 2a 20 28 28 61 73 2d 6e 75 6d 20 28 69 let* ((as-num (i
07f0: 66 20 28 73 74 72 69 6e 67 3f 20 69 6e 76 61 6c f (string? inval
0800: 29 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 )(string->number
0810: 20 69 6e 76 61 6c 29 20 23 66 29 29 29 0a 20 20 inval) #f))).
0820: 20 20 28 6f 72 20 61 73 2d 6e 75 6d 20 69 6e 76 (or as-num inv
0830: 61 6c 29 29 29 0a 0a 3b 3b 20 4d 6f 76 65 64 20 al)))..;; Moved
0840: 74 6f 20 63 6f 6d 6d 6f 6e 0a 3b 3b 0a 3b 3b 3b to common.;;.;;;
0850: 3b 20 72 65 74 75 72 6e 20 6c 69 73 74 20 28 70 ; return list (p
0860: 61 74 68 20 66 75 6c 6c 70 61 74 68 20 63 6f 6e ath fullpath con
0870: 66 69 67 6e 61 6d 65 29 0a 3b 3b 28 64 65 66 69 figname).;;(defi
0880: 6e 65 20 28 66 69 6e 64 2d 63 6f 6e 66 69 67 20 ne (find-config
0890: 63 6f 6e 66 69 67 6e 61 6d 65 20 23 21 6b 65 79 configname #!key
08a0: 20 28 74 6f 70 70 61 74 68 20 23 66 29 29 0a 3b (toppath #f)).;
08b0: 3b 20 20 28 69 66 20 74 6f 70 70 61 74 68 0a 3b ; (if toppath.;
08c0: 3b 20 20 20 20 20 20 28 6c 65 74 20 28 28 63 66 ; (let ((cf
08d0: 6e 61 6d 65 20 28 63 6f 6e 63 20 74 6f 70 70 61 name (conc toppa
08e0: 74 68 20 22 2f 22 20 63 6f 6e 66 69 67 6e 61 6d th "/" confignam
08f0: 65 29 29 29 0a 3b 3b 09 28 69 66 20 28 63 6f 6d e))).;;.(if (com
0900: 6d 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 74 73 3f mon:file-exists?
0910: 20 63 66 6e 61 6d 65 29 0a 3b 3b 09 20 20 20 20 cfname).;;.
0920: 28 6c 69 73 74 20 74 6f 70 70 61 74 68 20 63 66 (list toppath cf
0930: 6e 61 6d 65 20 63 6f 6e 66 69 67 6e 61 6d 65 29 name configname)
0940: 0a 3b 3b 09 20 20 20 20 28 6c 69 73 74 20 23 66 .;;. (list #f
0950: 20 20 20 20 20 20 23 66 20 20 20 20 20 23 66 29 #f #f)
0960: 29 29 0a 3b 3b 20 20 20 20 20 20 28 6c 65 74 2a )).;; (let*
0970: 20 28 28 63 77 64 20 28 73 74 72 69 6e 67 2d 73 ((cwd (string-s
0980: 70 6c 69 74 20 28 63 75 72 72 65 6e 74 2d 64 69 plit (current-di
0990: 72 65 63 74 6f 72 79 29 20 22 2f 22 29 29 29 0a rectory) "/"))).
09a0: 3b 3b 09 28 6c 65 74 20 6c 6f 6f 70 20 28 28 64 ;;.(let loop ((d
09b0: 69 72 20 63 77 64 29 29 0a 3b 3b 09 20 20 28 6c ir cwd)).;;. (l
09c0: 65 74 2a 20 28 28 70 61 74 68 20 20 20 20 20 28 et* ((path (
09d0: 63 6f 6e 63 20 22 2f 22 20 28 73 74 72 69 6e 67 conc "/" (string
09e0: 2d 69 6e 74 65 72 73 70 65 72 73 65 20 64 69 72 -intersperse dir
09f0: 20 22 2f 22 29 29 29 0a 3b 3b 09 09 20 28 66 75 "/"))).;;.. (fu
0a00: 6c 6c 70 61 74 68 20 28 63 6f 6e 63 20 70 61 74 llpath (conc pat
0a10: 68 20 22 2f 22 20 63 6f 6e 66 69 67 6e 61 6d 65 h "/" configname
0a20: 29 29 29 0a 3b 3b 09 20 20 20 20 28 69 66 20 28 ))).;;. (if (
0a30: 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 common:file-exis
0a40: 74 73 3f 20 66 75 6c 6c 70 61 74 68 29 0a 3b 3b ts? fullpath).;;
0a50: 09 09 28 6c 69 73 74 20 70 61 74 68 20 66 75 6c ..(list path ful
0a60: 6c 70 61 74 68 20 63 6f 6e 66 69 67 6e 61 6d 65 lpath configname
0a70: 29 0a 3b 3b 09 09 28 6c 65 74 20 28 28 72 65 6d ).;;..(let ((rem
0a80: 63 77 64 20 28 74 61 6b 65 20 64 69 72 20 28 2d cwd (take dir (-
0a90: 20 28 6c 65 6e 67 74 68 20 64 69 72 29 20 31 29 (length dir) 1)
0aa0: 29 29 29 0a 3b 3b 09 09 20 20 28 69 66 20 28 6e ))).;;.. (if (n
0ab0: 75 6c 6c 3f 20 72 65 6d 63 77 64 29 0a 3b 3b 09 ull? remcwd).;;.
0ac0: 09 20 20 20 20 20 20 28 6c 69 73 74 20 23 66 20 . (list #f
0ad0: 23 66 20 23 66 29 20 3b 3b 20 20 23 66 20 23 66 #f #f) ;; #f #f
0ae0: 29 20 0a 3b 3b 09 09 20 20 28 6c 6f 6f 70 20 72 ) .;;.. (loop r
0af0: 65 6d 63 77 64 29 29 29 29 29 29 29 29 29 0a 0a emcwd)))))))))..
0b00: 28 64 65 66 69 6e 65 20 28 61 73 73 6f 63 2d 73 (define (assoc-s
0b10: 61 66 65 2d 61 64 64 20 61 6c 69 73 74 20 6b 65 afe-add alist ke
0b20: 79 20 76 61 6c 20 23 21 6b 65 79 20 28 6d 65 74 y val #!key (met
0b30: 61 64 61 74 61 20 23 66 29 29 0a 20 20 28 6c 65 adata #f)). (le
0b40: 74 20 28 28 6e 65 77 61 6c 69 73 74 20 28 66 69 t ((newalist (fi
0b50: 6c 74 65 72 20 28 6c 61 6d 62 64 61 20 28 78 29 lter (lambda (x)
0b60: 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 6b 65 79 (not (equal? key
0b70: 20 28 63 61 72 20 78 29 29 29 29 20 61 6c 69 73 (car x)))) alis
0b80: 74 29 29 29 0a 20 20 20 20 28 61 70 70 65 6e 64 t))). (append
0b90: 20 6e 65 77 61 6c 69 73 74 20 28 6c 69 73 74 20 newalist (list
0ba0: 28 69 66 20 6d 65 74 61 64 61 74 61 0a 09 09 09 (if metadata....
0bb0: 20 20 20 20 20 20 20 28 6c 69 73 74 20 6b 65 79 (list key
0bc0: 20 76 61 6c 20 6d 65 74 61 64 61 74 61 29 0a 09 val metadata)..
0bd0: 09 09 20 20 20 20 20 20 20 28 6c 69 73 74 20 6b .. (list k
0be0: 65 79 20 76 61 6c 29 29 29 29 29 29 0a 0a 28 64 ey val))))))..(d
0bf0: 65 66 69 6e 65 20 28 73 65 63 74 69 6f 6e 2d 76 efine (section-v
0c00: 61 72 2d 73 65 74 21 20 63 66 67 64 61 74 20 73 ar-set! cfgdat s
0c10: 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 76 61 72 20 ection-name var
0c20: 76 61 6c 75 65 20 23 21 6b 65 79 20 28 6d 65 74 value #!key (met
0c30: 61 64 61 74 61 20 23 66 29 29 0a 20 20 28 68 61 adata #f)). (ha
0c40: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 63 66 sh-table-set! cf
0c50: 67 64 61 74 20 73 65 63 74 69 6f 6e 2d 6e 61 6d gdat section-nam
0c60: 65 0a 09 09 20 20 20 28 61 73 73 6f 63 2d 73 61 e... (assoc-sa
0c70: 66 65 2d 61 64 64 0a 09 09 20 20 20 20 28 68 61 fe-add... (ha
0c80: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def
0c90: 61 75 6c 74 20 63 66 67 64 61 74 20 73 65 63 74 ault cfgdat sect
0ca0: 69 6f 6e 2d 6e 61 6d 65 20 27 28 29 29 0a 09 09 ion-name '())...
0cb0: 20 20 20 20 76 61 72 20 76 61 6c 75 65 20 6d 65 var value me
0cc0: 74 61 64 61 74 61 3a 20 6d 65 74 61 64 61 74 61 tadata: metadata
0cd0: 29 29 29 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))).;;==========
0ce0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0cf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0d00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0d10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
0d20: 45 6e 76 69 72 6f 6e 6d 65 6e 74 20 68 61 6e 64 Environment hand
0d30: 6c 69 6e 67 20 73 74 75 66 66 0a 3b 3b 3d 3d 3d ling stuff.;;===
0d40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0d50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0d60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0d70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0d80: 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 73 61 ===..(define (sa
0d90: 66 65 2d 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 fe-file-exists?
0da0: 70 61 74 68 29 0a 20 20 28 68 61 6e 64 6c 65 2d path). (handle-
0db0: 65 78 63 65 70 74 69 6f 6e 73 20 65 78 6e 20 23 exceptions exn #
0dc0: 66 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 f (file-exists?
0dd0: 70 61 74 68 29 29 29 0a 0a 28 64 65 66 69 6e 65 path)))..(define
0de0: 20 28 72 65 61 64 2d 6c 69 6e 6b 2d 66 20 70 61 (read-link-f pa
0df0: 74 68 29 0a 20 20 28 68 61 6e 64 6c 65 2d 65 78 th). (handle-ex
0e00: 63 65 70 74 69 6f 6e 73 0a 20 20 20 20 20 20 65 ceptions. e
0e10: 78 6e 0a 20 20 20 20 20 20 28 62 65 67 69 6e 0a xn. (begin.
0e20: 09 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 .(debug:print-er
0e30: 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c ror 0 *default-l
0e40: 6f 67 2d 70 6f 72 74 2a 20 22 63 6f 6d 6d 61 6e og-port* "comman
0e50: 64 20 5c 22 2f 62 69 6e 2f 72 65 61 64 6c 69 6e d \"/bin/readlin
0e60: 6b 20 2d 66 20 22 20 70 61 74 68 20 22 5c 22 20 k -f " path "\"
0e70: 66 61 69 6c 65 64 2e 22 29 0a 09 70 61 74 68 29 failed.")..path)
0e80: 20 3b 3b 20 6a 75 73 74 20 67 69 76 65 20 75 70 ;; just give up
0e90: 0a 20 20 20 20 28 77 69 74 68 2d 69 6e 70 75 74 . (with-input
0ea0: 2d 66 72 6f 6d 2d 70 69 70 65 0a 09 28 63 6f 6e -from-pipe..(con
0eb0: 63 20 22 2f 62 69 6e 2f 72 65 61 64 6c 69 6e 6b c "/bin/readlink
0ec0: 20 2d 66 20 22 20 70 61 74 68 29 0a 20 20 20 20 -f " path).
0ed0: 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 28 72 (lambda ()..(r
0ee0: 65 61 64 2d 6c 69 6e 65 29 29 29 29 29 0a 0a 3b ead-line)))))..;
0ef0: 3b 20 72 65 74 75 72 6e 20 61 20 6e 69 63 65 20 ; return a nice
0f00: 63 6c 65 61 6e 20 70 61 74 68 6e 61 6d 65 20 6d clean pathname m
0f10: 61 64 65 20 61 62 73 6f 6c 75 74 65 0a 28 64 65 ade absolute.(de
0f20: 66 69 6e 65 20 28 6e 69 63 65 2d 70 61 74 68 20 fine (nice-path
0f30: 64 69 72 29 0a 20 20 28 6c 65 74 20 28 28 6d 61 dir). (let ((ma
0f40: 74 63 68 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 tch (string-matc
0f50: 68 20 22 5e 28 7e 5b 5e 5c 5c 2f 5d 2a 29 28 5c h "^(~[^\\/]*)(\
0f60: 5c 2f 2e 2a 7c 29 24 22 20 64 69 72 29 29 29 0a \/.*|)$" dir))).
0f70: 20 20 20 20 28 69 66 20 6d 61 74 63 68 20 3b 3b (if match ;;
0f80: 20 75 73 69 6e 67 20 7e 20 66 6f 72 20 68 6f 6d using ~ for hom
0f90: 65 3f 0a 09 28 6e 69 63 65 2d 70 61 74 68 20 28 e?..(nice-path (
0fa0: 63 6f 6e 63 20 28 72 65 61 64 2d 6c 69 6e 6b 2d conc (read-link-
0fb0: 66 20 28 63 61 64 72 20 6d 61 74 63 68 29 29 20 f (cadr match))
0fc0: 22 2f 22 20 28 63 61 64 64 72 20 6d 61 74 63 68 "/" (caddr match
0fd0: 29 29 29 0a 09 28 6e 6f 72 6d 61 6c 69 7a 65 2d )))..(normalize-
0fe0: 70 61 74 68 6e 61 6d 65 20 28 69 66 20 28 61 62 pathname (if (ab
0ff0: 73 6f 6c 75 74 65 2d 70 61 74 68 6e 61 6d 65 3f solute-pathname?
1000: 20 64 69 72 29 0a 09 09 09 09 64 69 72 0a 09 09 dir).....dir...
1010: 09 09 28 63 6f 6e 63 20 28 63 75 72 72 65 6e 74 ..(conc (current
1020: 2d 64 69 72 65 63 74 6f 72 79 29 20 22 2f 22 20 -directory) "/"
1030: 64 69 72 29 29 29 29 29 29 0a 0a 28 64 65 66 69 dir))))))..(defi
1040: 6e 65 20 28 65 76 61 6c 2d 73 74 72 69 6e 67 2d ne (eval-string-
1050: 69 6e 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 73 in-environment s
1060: 74 72 29 0a 20 20 28 68 61 6e 64 6c 65 2d 65 78 tr). (handle-ex
1070: 63 65 70 74 69 6f 6e 73 0a 20 20 20 65 78 6e 0a ceptions. exn.
1080: 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 28 (begin. (
1090: 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f debug:print-erro
10a0: 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 r 0 *default-log
10b0: 2d 70 6f 72 74 2a 20 22 70 72 6f 62 6c 65 6d 20 -port* "problem
10c0: 65 76 61 6c 75 61 74 69 6e 67 20 5c 22 22 20 73 evaluating \"" s
10d0: 74 72 20 22 5c 22 20 69 6e 20 74 68 65 20 73 68 tr "\" in the sh
10e0: 65 6c 6c 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 22 ell environment"
10f0: 29 0a 20 20 20 20 20 23 66 29 0a 20 20 20 28 6c ). #f). (l
1100: 65 74 20 28 28 63 6d 64 72 65 73 20 28 63 6d 64 et ((cmdres (cmd
1110: 2d 72 75 6e 2d 3e 6c 69 73 74 20 28 63 6f 6e 63 -run->list (conc
1120: 20 22 65 63 68 6f 20 22 20 73 74 72 29 29 29 29 "echo " str))))
1130: 0a 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f . (if (null?
1140: 20 63 6d 64 72 65 73 29 20 22 22 0a 09 20 28 63 cmdres) "".. (c
1150: 61 61 72 20 63 6d 64 72 65 73 29 29 29 29 29 0a aar cmdres))))).
1160: 0a 28 64 65 66 69 6e 65 20 28 73 61 66 65 2d 73 .(define (safe-s
1170: 65 74 65 6e 76 20 6b 65 79 20 76 61 6c 29 0a 20 etenv key val).
1180: 20 28 69 66 20 28 73 75 62 73 74 72 69 6e 67 2d (if (substring-
1190: 69 6e 64 65 78 20 22 3a 22 20 6b 65 79 29 20 3b index ":" key) ;
11a0: 3b 20 76 61 72 69 61 62 6c 65 73 20 63 6f 6e 74 ; variables cont
11b0: 61 69 6e 69 6e 67 20 3a 20 61 72 65 20 66 6f 72 aining : are for
11c0: 20 69 6e 74 65 72 6e 61 6c 20 75 73 65 20 61 6e internal use an
11d0: 64 20 63 61 6e 6e 6f 74 20 62 65 20 65 6e 76 69 d cannot be envi
11e0: 72 6f 6e 6d 65 6e 74 20 76 61 72 69 61 62 6c 65 ronment variable
11f0: 73 2e 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a s.. (debug:
1200: 70 72 69 6e 74 2d 65 72 72 6f 72 20 34 20 2a 64 print-error 4 *d
1210: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
1220: 20 22 73 6b 69 70 20 73 65 74 74 69 6e 67 20 69 "skip setting i
1230: 6e 74 65 72 6e 61 6c 20 75 73 65 20 6f 6e 6c 79 nternal use only
1240: 20 76 61 72 69 61 62 6c 65 73 20 63 6f 6e 74 61 variables conta
1250: 69 6e 69 6e 67 20 5c 22 3a 5c 22 22 29 0a 20 20 ining \":\"").
1260: 20 20 20 20 28 69 66 20 28 61 6e 64 20 28 73 74 (if (and (st
1270: 72 69 6e 67 3f 20 76 61 6c 29 0a 09 20 20 20 20 ring? val)..
1280: 20 20 20 28 73 74 72 69 6e 67 3f 20 6b 65 79 29 (string? key)
1290: 29 0a 09 20 20 28 68 61 6e 64 6c 65 2d 65 78 63 ).. (handle-exc
12a0: 65 70 74 69 6f 6e 73 0a 09 20 20 20 20 20 20 65 eptions.. e
12b0: 78 6e 0a 09 20 20 20 20 20 20 28 64 65 62 75 67 xn.. (debug
12c0: 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a :print-error 0 *
12d0: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
12e0: 2a 20 22 62 61 64 20 76 61 6c 75 65 20 66 6f 72 * "bad value for
12f0: 20 73 65 74 65 6e 76 2c 20 6b 65 79 3d 22 20 6b setenv, key=" k
1300: 65 79 20 22 2c 20 76 61 6c 75 65 3d 22 20 76 61 ey ", value=" va
1310: 6c 29 0a 09 20 20 20 20 28 73 65 74 65 6e 76 20 l).. (setenv
1320: 6b 65 79 20 76 61 6c 29 29 0a 09 20 20 28 64 65 key val)).. (de
1330: 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 bug:print-error
1340: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
1350: 6f 72 74 2a 20 22 62 61 64 20 76 61 6c 75 65 20 ort* "bad value
1360: 66 6f 72 20 73 65 74 65 6e 76 2c 20 6b 65 79 3d for setenv, key=
1370: 22 20 6b 65 79 20 22 2c 20 76 61 6c 75 65 3d 22 " key ", value="
1380: 20 76 61 6c 29 29 29 29 0a 0a 3b 3b 20 61 63 63 val))))..;; acc
1390: 65 70 74 20 61 6e 20 61 6c 69 73 74 20 6f 72 20 ept an alist or
13a0: 68 61 73 68 20 74 61 62 6c 65 20 63 6f 6e 74 61 hash table conta
13b0: 69 6e 69 6e 67 20 65 6e 76 76 61 72 2f 65 6e 76 ining envvar/env
13c0: 20 76 61 6c 75 65 20 70 61 69 72 73 20 28 76 61 value pairs (va
13d0: 6c 75 65 20 6f 66 20 23 66 20 63 61 75 73 65 73 lue of #f causes
13e0: 20 75 6e 73 65 74 29 20 0a 3b 3b 20 20 20 65 78 unset) .;; ex
13f0: 65 63 75 74 65 20 74 68 75 6e 6b 20 69 6e 20 63 ecute thunk in c
1400: 6f 6e 74 65 78 74 20 6f 66 20 65 6e 76 69 72 6f ontext of enviro
1410: 6e 6d 65 6e 74 20 6d 6f 64 69 66 69 65 64 20 61 nment modified a
1420: 73 20 70 65 72 20 74 68 69 73 20 6c 69 73 74 0a s per this list.
1430: 3b 3b 20 20 20 72 65 73 74 6f 72 65 20 65 6e 76 ;; restore env
1440: 20 74 6f 20 70 72 69 6f 72 20 73 74 61 74 65 20 to prior state
1450: 74 68 65 6e 20 72 65 74 75 72 6e 20 76 61 6c 75 then return valu
1460: 65 20 6f 66 20 65 76 61 6c 27 64 20 74 68 75 6e e of eval'd thun
1470: 6b 2e 0a 3b 3b 20 20 20 2a 2a 20 74 68 69 73 20 k..;; ** this
1480: 69 73 20 6e 6f 74 20 74 68 72 65 61 64 20 73 61 is not thread sa
1490: 66 65 20 2a 2a 0a 28 64 65 66 69 6e 65 20 28 77 fe **.(define (w
14a0: 69 74 68 2d 65 6e 76 2d 76 61 72 73 20 64 65 6c ith-env-vars del
14b0: 74 61 2d 65 6e 76 2d 61 6c 69 73 74 2d 6f 72 2d ta-env-alist-or-
14c0: 68 61 73 68 2d 74 61 62 6c 65 20 74 68 75 6e 6b hash-table thunk
14d0: 29 0a 20 20 28 6c 65 74 2a 20 28 28 64 65 6c 74 ). (let* ((delt
14e0: 61 2d 65 6e 76 2d 61 6c 69 73 74 20 28 69 66 20 a-env-alist (if
14f0: 28 68 61 73 68 2d 74 61 62 6c 65 3f 20 64 65 6c (hash-table? del
1500: 74 61 2d 65 6e 76 2d 61 6c 69 73 74 2d 6f 72 2d ta-env-alist-or-
1510: 68 61 73 68 2d 74 61 62 6c 65 29 0a 20 20 20 20 hash-table).
1520: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1530: 20 20 20 20 20 20 20 20 20 20 28 68 61 73 68 2d (hash-
1540: 74 61 62 6c 65 2d 3e 61 6c 69 73 74 20 64 65 6c table->alist del
1550: 74 61 2d 65 6e 76 2d 61 6c 69 73 74 2d 6f 72 2d ta-env-alist-or-
1560: 68 61 73 68 2d 74 61 62 6c 65 29 0a 20 20 20 20 hash-table).
1570: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1580: 20 20 20 20 20 20 20 20 20 20 64 65 6c 74 61 2d delta-
1590: 65 6e 76 2d 61 6c 69 73 74 2d 6f 72 2d 68 61 73 env-alist-or-has
15a0: 68 2d 74 61 62 6c 65 29 29 0a 20 20 20 20 20 20 h-table)).
15b0: 20 20 20 28 72 65 73 74 6f 72 65 2d 74 68 75 6e (restore-thun
15c0: 6b 73 0a 20 20 20 20 20 20 20 20 20 20 28 66 69 ks. (fi
15d0: 6c 74 65 72 0a 20 20 20 20 20 20 20 20 20 20 20 lter.
15e0: 69 64 65 6e 74 69 74 79 0a 20 20 20 20 20 20 20 identity.
15f0: 20 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 (map (lambda
1600: 20 28 65 6e 76 2d 70 61 69 72 29 0a 20 20 20 20 (env-pair).
1610: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
1620: 65 74 2a 20 28 28 65 6e 76 2d 76 61 72 20 20 20 et* ((env-var
1630: 20 20 28 63 61 72 20 65 6e 76 2d 70 61 69 72 29 (car env-pair)
1640: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
1650: 20 20 20 20 20 20 20 20 20 20 20 28 6e 65 77 2d (new-
1660: 76 61 6c 20 20 20 20 20 28 6c 65 74 20 28 28 74 val (let ((t
1670: 6d 70 20 28 63 64 72 20 65 6e 76 2d 70 61 69 72 mp (cdr env-pair
1680: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
1690: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
16a0: 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 (if
16b0: 28 6c 69 73 74 3f 20 74 6d 70 29 20 28 63 61 72 (list? tmp) (car
16c0: 20 74 6d 70 29 20 74 6d 70 29 29 29 0a 20 20 20 tmp) tmp))).
16d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
16e0: 20 20 20 20 20 20 28 63 75 72 72 65 6e 74 2d 76 (current-v
16f0: 61 6c 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d al (get-environm
1700: 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 65 6e 76 ent-variable env
1710: 2d 76 61 72 29 29 0a 20 20 20 20 20 20 20 20 20 -var)).
1720: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1730: 28 72 65 73 74 6f 72 65 2d 74 68 75 6e 6b 0a 20 (restore-thunk.
1740: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1750: 20 20 20 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 (cond.
1760: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1770: 20 20 20 20 20 20 20 20 20 20 28 28 6e 6f 74 20 ((not
1780: 63 75 72 72 65 6e 74 2d 76 61 6c 29 20 28 6c 61 current-val) (la
1790: 6d 62 64 61 20 28 29 20 28 75 6e 73 65 74 65 6e mbda () (unseten
17a0: 76 20 65 6e 76 2d 76 61 72 29 29 29 0a 20 20 20 v env-var))).
17b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17c0: 20 20 20 20 20 20 20 20 28 28 6e 6f 74 20 28 73 ((not (s
17d0: 74 72 69 6e 67 3f 20 6e 65 77 2d 76 61 6c 29 29 tring? new-val))
17e0: 20 23 66 29 0a 20 20 20 20 20 20 20 20 20 20 20 #f).
17f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1800: 28 28 65 71 3f 20 63 75 72 72 65 6e 74 2d 76 61 ((eq? current-va
1810: 6c 20 6e 65 77 2d 76 61 6c 29 20 23 66 29 0a 20 l new-val) #f).
1820: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1830: 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 20 (else
1840: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1850: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 (la
1860: 6d 62 64 61 20 28 29 20 28 73 65 74 65 6e 76 20 mbda () (setenv
1870: 65 6e 76 2d 76 61 72 20 63 75 72 72 65 6e 74 2d env-var current-
1880: 76 61 6c 29 29 29 29 29 29 0a 20 20 20 20 20 20 val)))))).
1890: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b ;;
18a0: 28 77 68 65 6e 20 28 6e 6f 74 20 28 73 74 72 69 (when (not (stri
18b0: 6e 67 3f 20 6e 65 77 2d 76 61 6c 29 29 0a 20 20 ng? new-val)).
18c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
18d0: 20 20 3b 3b 20 20 20 20 28 64 65 62 75 67 3a 70 ;; (debug:p
18e0: 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d rint 0 *default-
18f0: 6c 6f 67 2d 70 6f 72 74 2a 20 22 20 50 52 4f 42 log-port* " PROB
1900: 4c 45 4d 3a 20 6e 6f 74 20 61 20 73 74 72 69 6e LEM: not a strin
1910: 67 3a 20 22 6e 65 77 2d 76 61 6c 22 5c 6e 20 66 g: "new-val"\n f
1920: 72 6f 6d 20 65 6e 76 2d 61 6c 69 73 74 3a 5c 6e rom env-alist:\n
1930: 22 64 65 6c 74 61 2d 65 6e 76 2d 61 6c 69 73 74 "delta-env-alist
1940: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
1950: 20 20 20 20 20 20 3b 3b 20 20 20 20 28 70 70 20 ;; (pp
1960: 64 65 6c 74 61 2d 65 6e 76 2d 61 6c 69 73 74 29 delta-env-alist)
1970: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1980: 20 20 20 20 20 3b 3b 20 20 20 20 28 65 78 69 74 ;; (exit
1990: 20 31 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 1)).
19a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 0a 20 20 .
19b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19c0: 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 .
19d0: 20 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 (cond.
19e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19f0: 20 20 28 28 6e 6f 74 20 6e 65 77 2d 76 61 6c 29 ((not new-val)
1a00: 20 20 3b 3b 20 6d 6f 64 69 66 79 20 65 6e 76 20 ;; modify env
1a10: 68 65 72 65 0a 20 20 20 20 20 20 20 20 20 20 20 here.
1a20: 20 20 20 20 20 20 20 20 20 20 20 28 75 6e 73 65 (unse
1a30: 74 65 6e 76 20 65 6e 76 2d 76 61 72 29 29 0a 20 tenv env-var)).
1a40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a50: 20 20 20 20 28 28 73 74 72 69 6e 67 3f 20 6e 65 ((string? ne
1a60: 77 2d 76 61 6c 29 0a 20 20 20 20 20 20 20 20 20 w-val).
1a70: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 65 (se
1a80: 74 65 6e 76 20 65 6e 76 2d 76 61 72 20 6e 65 77 tenv env-var new
1a90: 2d 76 61 6c 29 29 29 0a 20 20 20 20 20 20 20 20 -val))).
1aa0: 20 20 20 20 20 20 20 20 20 20 20 20 72 65 73 74 rest
1ab0: 6f 72 65 2d 74 68 75 6e 6b 29 29 0a 20 20 20 20 ore-thunk)).
1ac0: 20 20 20 20 20 20 20 20 20 20 20 20 64 65 6c 74 delt
1ad0: 61 2d 65 6e 76 2d 61 6c 69 73 74 29 29 29 29 0a a-env-alist)))).
1ae0: 20 20 20 20 28 6c 65 74 20 28 28 72 76 20 28 74 (let ((rv (t
1af0: 68 75 6e 6b 29 29 29 0a 20 20 20 20 20 20 28 66 hunk))). (f
1b00: 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 or-each (lambda
1b10: 28 78 29 20 28 78 29 29 20 72 65 73 74 6f 72 65 (x) (x)) restore
1b20: 2d 74 68 75 6e 6b 73 29 20 3b 3b 20 72 65 73 74 -thunks) ;; rest
1b30: 6f 72 65 20 65 6e 76 20 74 6f 20 6f 72 69 67 69 ore env to origi
1b40: 6e 61 6c 20 73 74 61 74 65 0a 20 20 20 20 20 20 nal state.
1b50: 72 76 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 rv)))..(define (
1b60: 63 6d 64 2d 72 75 6e 2d 3e 6c 69 73 74 20 63 6d cmd-run->list cm
1b70: 64 20 23 21 6b 65 79 20 28 64 65 6c 74 61 2d 65 d #!key (delta-e
1b80: 6e 76 2d 61 6c 69 73 74 2d 6f 72 2d 68 61 73 68 nv-alist-or-hash
1b90: 2d 74 61 62 6c 65 20 27 28 29 29 29 0a 20 20 28 -table '())). (
1ba0: 77 69 74 68 2d 65 6e 76 2d 76 61 72 73 0a 20 20 with-env-vars.
1bb0: 20 64 65 6c 74 61 2d 65 6e 76 2d 61 6c 69 73 74 delta-env-alist
1bc0: 2d 6f 72 2d 68 61 73 68 2d 74 61 62 6c 65 0a 20 -or-hash-table.
1bd0: 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 20 20 20 (lambda ().
1be0: 20 20 28 6c 65 74 2a 20 28 28 66 68 20 28 6f 70 (let* ((fh (op
1bf0: 65 6e 2d 69 6e 70 75 74 2d 70 69 70 65 20 63 6d en-input-pipe cm
1c00: 64 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 d)).
1c10: 28 72 65 73 20 28 70 6f 72 74 2d 3e 6c 69 73 74 (res (port->list
1c20: 20 66 68 29 29 0a 20 20 20 20 20 20 20 20 20 20 fh)).
1c30: 20 20 28 73 74 61 74 75 73 20 28 63 6c 6f 73 65 (status (close
1c40: 2d 69 6e 70 75 74 2d 70 69 70 65 20 66 68 29 29 -input-pipe fh))
1c50: 29 0a 20 20 20 20 20 20 20 28 6c 69 73 74 20 72 ). (list r
1c60: 65 73 20 73 74 61 74 75 73 29 29 29 29 29 0a 20 es status))))).
1c70: 20 20 0a 28 64 65 66 69 6e 65 20 28 70 6f 72 74 .(define (port
1c80: 2d 3e 6c 69 73 74 20 66 68 29 0a 20 20 28 69 66 ->list fh). (if
1c90: 20 28 65 6f 66 2d 6f 62 6a 65 63 74 3f 20 66 68 (eof-object? fh
1ca0: 29 20 23 66 0a 20 20 20 20 20 20 28 6c 65 74 20 ) #f. (let
1cb0: 6c 6f 6f 70 20 28 28 63 75 72 72 20 28 72 65 61 loop ((curr (rea
1cc0: 64 2d 6c 69 6e 65 20 66 68 29 29 0a 20 20 20 20 d-line fh)).
1cd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 72 65 (re
1ce0: 73 75 6c 74 20 27 28 29 29 29 0a 20 20 20 20 20 sult '())).
1cf0: 20 20 20 28 69 66 20 28 6e 6f 74 20 28 65 6f 66 (if (not (eof
1d00: 2d 6f 62 6a 65 63 74 3f 20 63 75 72 72 29 29 0a -object? curr)).
1d10: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f (loo
1d20: 70 20 28 72 65 61 64 2d 6c 69 6e 65 20 66 68 29 p (read-line fh)
1d30: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1d40: 20 20 20 28 61 70 70 65 6e 64 20 72 65 73 75 6c (append resul
1d50: 74 20 28 6c 69 73 74 20 63 75 72 72 29 29 29 0a t (list curr))).
1d60: 20 20 20 20 20 20 20 20 20 20 20 20 72 65 73 75 resu
1d70: 6c 74 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d lt))))..;;======
1d80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1d90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1da0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1db0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1dc0: 0a 3b 3b 20 4d 61 6b 65 20 74 68 65 20 72 65 67 .;; Make the reg
1dd0: 65 78 70 27 73 20 6e 65 65 64 65 64 20 67 6c 6f exp's needed glo
1de0: 62 61 6c 6c 79 20 61 76 61 69 6c 61 62 6c 65 0a bally available.
1df0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
1e00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1e10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1e20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1e30: 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e ========..(defin
1e40: 65 20 63 6f 6e 66 69 67 66 3a 69 6e 63 6c 75 64 e configf:includ
1e50: 65 2d 72 78 20 28 72 65 67 65 78 70 20 22 5e 5c e-rx (regexp "^\
1e60: 5c 5b 69 6e 63 6c 75 64 65 5c 5c 73 2b 28 2e 2a \[include\\s+(.*
1e70: 29 5c 5c 5d 5c 5c 73 2a 24 22 29 29 0a 28 64 65 )\\]\\s*$")).(de
1e80: 66 69 6e 65 20 63 6f 6e 66 69 67 66 3a 73 63 72 fine configf:scr
1e90: 69 70 74 2d 72 78 20 20 28 72 65 67 65 78 70 20 ipt-rx (regexp
1ea0: 22 5e 5c 5c 5b 73 63 72 69 70 74 69 6e 63 5c 5c "^\\[scriptinc\\
1eb0: 73 2b 28 5c 5c 53 2b 29 28 5b 5e 5c 5c 5d 5d 2a s+(\\S+)([^\\]]*
1ec0: 29 5c 5c 5d 5c 5c 73 2a 24 22 29 29 20 3b 3b 20 )\\]\\s*$")) ;;
1ed0: 69 6e 63 6c 75 64 65 20 6f 75 74 70 75 74 20 66 include output f
1ee0: 72 6f 6d 20 61 20 73 63 72 69 70 74 0a 28 64 65 rom a script.(de
1ef0: 66 69 6e 65 20 63 6f 6e 66 69 67 66 3a 73 65 63 fine configf:sec
1f00: 74 69 6f 6e 2d 72 78 20 28 72 65 67 65 78 70 20 tion-rx (regexp
1f10: 22 5e 5c 5c 5b 28 2e 2a 29 5c 5c 5d 5c 5c 73 2a "^\\[(.*)\\]\\s*
1f20: 24 22 29 29 0a 28 64 65 66 69 6e 65 20 63 6f 6e $")).(define con
1f30: 66 69 67 66 3a 62 6c 61 6e 6b 2d 6c 2d 72 78 20 figf:blank-l-rx
1f40: 28 72 65 67 65 78 70 20 22 5e 5c 5c 73 2a 24 22 (regexp "^\\s*$"
1f50: 29 29 0a 28 64 65 66 69 6e 65 20 63 6f 6e 66 69 )).(define confi
1f60: 67 66 3a 6b 65 79 2d 73 79 73 2d 70 72 20 28 72 gf:key-sys-pr (r
1f70: 65 67 65 78 70 20 22 5e 28 5c 5c 53 2b 29 5c 5c egexp "^(\\S+)\\
1f80: 73 2b 5c 5c 5b 73 79 73 74 65 6d 5c 5c 73 2b 28 s+\\[system\\s+(
1f90: 5c 5c 53 2b 2e 2a 29 5c 5c 5d 5c 5c 73 2a 24 22 \\S+.*)\\]\\s*$"
1fa0: 29 29 0a 28 64 65 66 69 6e 65 20 63 6f 6e 66 69 )).(define confi
1fb0: 67 66 3a 6b 65 79 2d 76 61 6c 2d 70 72 20 28 72 gf:key-val-pr (r
1fc0: 65 67 65 78 70 20 22 5e 28 5c 5c 53 2b 29 28 5c egexp "^(\\S+)(\
1fd0: 5c 73 2b 28 2e 2a 29 7c 28 29 29 24 22 29 29 0a \s+(.*)|())$")).
1fe0: 28 64 65 66 69 6e 65 20 63 6f 6e 66 69 67 66 3a (define configf:
1ff0: 6b 65 79 2d 6e 6f 2d 76 61 6c 20 28 72 65 67 65 key-no-val (rege
2000: 78 70 20 22 5e 28 5c 5c 53 2b 29 28 5c 5c 73 2a xp "^(\\S+)(\\s*
2010: 29 24 22 29 29 0a 28 64 65 66 69 6e 65 20 63 6f )$")).(define co
2020: 6e 66 69 67 66 3a 63 6f 6d 6d 65 6e 74 2d 72 78 nfigf:comment-rx
2030: 20 28 72 65 67 65 78 70 20 22 5e 5c 5c 73 2a 23 (regexp "^\\s*#
2040: 2e 2a 22 29 29 0a 28 64 65 66 69 6e 65 20 63 6f .*")).(define co
2050: 6e 66 69 67 66 3a 63 6f 6e 74 2d 6c 6e 2d 72 78 nfigf:cont-ln-rx
2060: 20 28 72 65 67 65 78 70 20 22 5e 28 5c 5c 73 2b (regexp "^(\\s+
2070: 29 28 5c 5c 53 2b 2e 2a 29 24 22 29 29 0a 28 64 )(\\S+.*)$")).(d
2080: 65 66 69 6e 65 20 63 6f 6e 66 69 67 66 3a 73 65 efine configf:se
2090: 74 74 69 6e 67 73 20 20 20 28 72 65 67 65 78 70 ttings (regexp
20a0: 20 22 5e 5c 5c 5b 63 6f 6e 66 69 67 66 3a 73 65 "^\\[configf:se
20b0: 74 74 69 6e 67 73 5c 5c 73 2b 28 5c 5c 53 2b 29 ttings\\s+(\\S+)
20c0: 5c 5c 73 2b 28 5c 5c 53 2b 29 5d 5c 5c 73 2a 24 \\s+(\\S+)]\\s*$
20d0: 22 29 29 0a 0a 3b 3b 20 72 65 61 64 20 61 20 6c "))..;; read a l
20e0: 69 6e 65 20 61 6e 64 20 70 72 6f 63 65 73 73 20 ine and process
20f0: 61 6e 79 20 23 7b 20 2e 2e 2e 20 7d 20 63 6f 6e any #{ ... } con
2100: 73 74 72 75 63 74 73 0a 0a 28 64 65 66 69 6e 65 structs..(define
2110: 20 63 6f 6e 66 69 67 66 3a 76 61 72 2d 65 78 70 configf:var-exp
2120: 61 6e 64 2d 72 65 67 65 78 20 28 72 65 67 65 78 and-regex (regex
2130: 70 20 22 5e 28 2e 2a 29 23 5c 5c 7b 28 73 63 68 p "^(.*)#\\{(sch
2140: 65 6d 65 7c 73 79 73 74 65 6d 7c 73 68 65 6c 6c eme|system|shell
2150: 7c 67 65 74 65 6e 76 7c 67 65 74 7c 72 75 6e 63 |getenv|get|runc
2160: 6f 6e 66 69 67 73 2d 67 65 74 7c 72 67 65 74 7c onfigs-get|rget|
2170: 73 63 6d 7c 73 68 7c 72 70 7c 67 76 7c 67 7c 6d scm|sh|rp|gv|g|m
2180: 74 72 61 68 29 5c 5c 73 2b 28 5b 5e 5c 5c 7d 5c trah)\\s+([^\\}\
2190: 5c 7b 5d 2a 29 5c 5c 7d 28 2e 2a 29 22 29 29 0a \{]*)\\}(.*)")).
21a0: 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 .(define (config
21b0: 66 3a 73 79 73 74 65 6d 20 68 74 20 63 6d 64 29 f:system ht cmd)
21c0: 0a 20 20 28 73 79 73 74 65 6d 20 63 6d 64 29 0a . (system cmd).
21d0: 20 20 29 0a 0a 28 64 65 66 69 6e 65 20 28 70 72 )..(define (pr
21e0: 6f 63 65 73 73 2d 6c 69 6e 65 20 6c 20 68 74 20 ocess-line l ht
21f0: 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 23 21 6b allow-system #!k
2200: 65 79 20 28 6c 69 6e 65 6e 75 6d 20 23 66 29 29 ey (linenum #f))
2210: 0a 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 72 . (let loop ((r
2220: 65 73 20 6c 29 29 0a 20 20 20 20 28 69 66 20 28 es l)). (if (
2230: 73 74 72 69 6e 67 3f 20 72 65 73 29 0a 09 28 6c string? res)..(l
2240: 65 74 20 28 28 6d 61 74 63 68 64 61 74 20 28 73 et ((matchdat (s
2250: 74 72 69 6e 67 2d 73 65 61 72 63 68 20 63 6f 6e tring-search con
2260: 66 69 67 66 3a 76 61 72 2d 65 78 70 61 6e 64 2d figf:var-expand-
2270: 72 65 67 65 78 20 72 65 73 29 29 29 0a 09 20 20 regex res)))..
2280: 28 69 66 20 6d 61 74 63 68 64 61 74 0a 09 20 20 (if matchdat..
2290: 20 20 20 20 28 6c 65 74 2a 20 28 28 70 72 65 73 (let* ((pres
22a0: 74 72 20 20 28 6c 69 73 74 2d 72 65 66 20 6d 61 tr (list-ref ma
22b0: 74 63 68 64 61 74 20 31 29 29 0a 09 09 20 20 20 tchdat 1))...
22c0: 20 20 28 63 6d 64 74 79 70 65 20 28 6c 69 73 74 (cmdtype (list
22d0: 2d 72 65 66 20 6d 61 74 63 68 64 61 74 20 32 29 -ref matchdat 2)
22e0: 29 20 3b 3b 20 65 76 61 6c 2c 20 73 79 73 74 65 ) ;; eval, syste
22f0: 6d 2c 20 73 68 65 6c 6c 2c 20 67 65 74 65 6e 76 m, shell, getenv
2300: 0a 09 09 20 20 20 20 20 28 63 6d 64 20 20 20 20 ... (cmd
2310: 20 28 6c 69 73 74 2d 72 65 66 20 6d 61 74 63 68 (list-ref match
2320: 64 61 74 20 33 29 29 0a 09 09 20 20 20 20 20 28 dat 3))... (
2330: 70 6f 73 74 73 74 72 20 28 6c 69 73 74 2d 72 65 poststr (list-re
2340: 66 20 6d 61 74 63 68 64 61 74 20 34 29 29 0a 09 f matchdat 4))..
2350: 09 20 20 20 20 20 28 72 65 73 75 6c 74 20 20 23 . (result #
2360: 66 29 0a 09 09 20 20 20 20 20 28 73 74 61 72 74 f)... (start
2370: 2d 74 69 6d 65 20 28 63 75 72 72 65 6e 74 2d 73 -time (current-s
2380: 65 63 6f 6e 64 73 29 29 0a 09 09 20 20 20 20 20 econds))...
2390: 28 63 6d 64 73 79 6d 20 20 28 73 74 72 69 6e 67 (cmdsym (string
23a0: 2d 3e 73 79 6d 62 6f 6c 20 63 6d 64 74 79 70 65 ->symbol cmdtype
23b0: 29 29 0a 09 09 20 20 20 20 20 28 66 75 6c 6c 63 ))... (fullc
23c0: 6d 64 20 28 63 61 73 65 20 63 6d 64 73 79 6d 0a md (case cmdsym.
23d0: 09 09 09 09 28 28 73 63 68 65 6d 65 20 73 63 6d ....((scheme scm
23e0: 29 20 28 63 6f 6e 63 20 22 28 6c 61 6d 62 64 61 ) (conc "(lambda
23f0: 20 28 68 74 29 22 20 63 6d 64 20 22 29 22 29 29 (ht)" cmd ")"))
2400: 0a 09 09 09 09 28 28 73 79 73 74 65 6d 29 20 20 .....((system)
2410: 20 20 20 28 63 6f 6e 63 20 22 28 6c 61 6d 62 64 (conc "(lambd
2420: 61 20 28 68 74 29 28 63 6f 6e 66 69 67 66 3a 73 a (ht)(configf:s
2430: 79 73 74 65 6d 20 68 74 20 5c 22 22 20 63 6d 64 ystem ht \"" cmd
2440: 20 22 5c 22 29 29 22 29 29 0a 09 09 09 09 28 28 "\"))")).....((
2450: 73 68 65 6c 6c 20 73 68 29 20 20 20 28 63 6f 6e shell sh) (con
2460: 63 20 22 28 6c 61 6d 62 64 61 20 28 68 74 29 28 c "(lambda (ht)(
2470: 73 74 72 69 6e 67 2d 74 72 61 6e 73 6c 61 74 65 string-translate
2480: 20 28 73 68 65 6c 6c 20 5c 22 22 20 20 63 6d 64 (shell \"" cmd
2490: 20 22 5c 22 29 20 5c 22 5c 6e 5c 22 20 5c 22 20 "\") \"\n\" \"
24a0: 5c 22 29 29 22 29 29 0a 09 09 09 09 28 28 72 65 \"))")).....((re
24b0: 61 6c 70 61 74 68 20 72 70 29 28 63 6f 6e 63 20 alpath rp)(conc
24c0: 22 28 6c 61 6d 62 64 61 20 28 68 74 29 28 6e 69 "(lambda (ht)(ni
24d0: 63 65 2d 70 61 74 68 20 5c 22 22 20 63 6d 64 20 ce-path \"" cmd
24e0: 22 5c 22 29 29 22 29 29 0a 09 09 09 09 28 28 67 "\"))")).....((g
24f0: 65 74 65 6e 76 20 67 76 29 20 20 28 63 6f 6e 63 etenv gv) (conc
2500: 20 22 28 6c 61 6d 62 64 61 20 28 68 74 29 28 67 "(lambda (ht)(g
2510: 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 et-environment-v
2520: 61 72 69 61 62 6c 65 20 5c 22 22 20 63 6d 64 20 ariable \"" cmd
2530: 22 5c 22 29 29 22 29 29 0a 09 09 09 09 28 28 6d "\"))")).....((m
2540: 74 72 61 68 29 20 20 20 20 20 20 28 63 6f 6e 63 trah) (conc
2550: 20 22 28 6c 61 6d 62 64 61 20 28 68 74 29 22 0a "(lambda (ht)".
2560: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2570: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2580: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2590: 20 20 20 20 22 20 20 20 20 28 6c 65 74 20 28 28 " (let ((
25a0: 65 78 74 72 61 20 5c 22 22 20 63 6d 64 20 22 5c extra \"" cmd "\
25b0: 22 29 29 22 0a 09 09 09 09 09 09 20 20 20 20 22 "))"....... "
25c0: 20 20 20 20 20 20 20 28 63 6f 6e 63 20 28 6f 72 (conc (or
25d0: 20 2a 74 6f 70 70 61 74 68 2a 20 28 67 65 74 2d *toppath* (get-
25e0: 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 environment-vari
25f0: 61 62 6c 65 20 5c 22 4d 54 5f 52 55 4e 5f 41 52 able \"MT_RUN_AR
2600: 45 41 5f 48 4f 4d 45 5c 22 29 29 22 0a 09 09 09 EA_HOME\"))"....
2610: 09 09 09 20 20 20 20 22 20 20 20 20 20 20 20 20 ... "
2620: 20 20 20 20 20 28 69 66 20 28 73 74 72 69 6e 67 (if (string
2630: 2d 6e 75 6c 6c 3f 20 65 78 74 72 61 29 20 5c 22 -null? extra) \"
2640: 5c 22 20 5c 22 2f 5c 22 29 22 0a 09 09 09 09 09 \" \"/\")"......
2650: 09 20 20 20 20 22 20 20 20 20 20 20 20 20 20 20 . "
2660: 20 20 20 65 78 74 72 61 29 29 29 22 29 29 0a 09 extra)))"))..
2670: 09 09 09 28 28 67 65 74 20 67 29 20 20 20 0a 09 ...((get g) ..
2680: 09 09 09 20 28 6c 65 74 2a 20 28 28 70 61 72 74 ... (let* ((part
2690: 73 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 s (string-split
26a0: 63 6d 64 29 29 0a 09 09 09 09 09 28 73 65 63 74 cmd))......(sect
26b0: 20 20 28 63 61 72 20 70 61 72 74 73 29 29 0a 09 (car parts))..
26c0: 09 09 09 09 28 76 61 72 20 20 20 28 63 61 64 72 ....(var (cadr
26d0: 20 70 61 72 74 73 29 29 29 0a 09 09 09 09 20 20 parts))).....
26e0: 20 28 63 6f 6e 63 20 22 28 6c 61 6d 62 64 61 20 (conc "(lambda
26f0: 28 68 74 29 28 6c 6f 6f 6b 75 70 20 68 74 20 5c (ht)(lookup ht \
2700: 22 22 20 73 65 63 74 20 22 5c 22 20 5c 22 22 20 "" sect "\" \""
2710: 76 61 72 20 22 5c 22 29 29 22 29 29 29 0a 09 09 var "\"))")))...
2720: 09 09 28 28 72 75 6e 63 6f 6e 66 69 67 73 2d 67 ..((runconfigs-g
2730: 65 74 20 72 67 65 74 29 20 28 63 6f 6e 63 20 22 et rget) (conc "
2740: 28 6c 61 6d 62 64 61 20 28 68 74 29 28 72 75 6e (lambda (ht)(run
2750: 63 6f 6e 66 69 67 73 2d 67 65 74 20 68 74 20 5c configs-get ht \
2760: 22 22 20 63 6d 64 20 22 5c 22 29 29 22 29 29 0a "" cmd "\"))")).
2770: 09 09 09 09 3b 3b 20 28 28 72 67 65 74 29 20 20 ....;; ((rget)
2780: 20 20 20 20 20 20 20 20 20 28 63 6f 6e 63 20 22 (conc "
2790: 28 6c 61 6d 62 64 61 20 28 68 74 29 28 72 75 6e (lambda (ht)(run
27a0: 63 6f 6e 66 69 67 73 2d 67 65 74 20 68 74 20 5c configs-get ht \
27b0: 22 22 20 63 6d 64 20 22 5c 22 29 29 22 29 29 0a "" cmd "\"))")).
27c0: 09 09 09 09 28 65 6c 73 65 20 22 28 6c 61 6d 62 ....(else "(lamb
27d0: 64 61 20 28 68 74 29 28 70 72 69 6e 74 20 5c 22 da (ht)(print \"
27e0: 45 52 52 4f 52 5c 22 29 20 5c 22 45 52 52 4f 52 ERROR\") \"ERROR
27f0: 5c 22 29 22 29 29 29 29 0a 09 09 3b 3b 20 28 70 \")"))))...;; (p
2800: 72 69 6e 74 20 22 66 75 6c 6c 63 6d 64 3d 22 20 rint "fullcmd="
2810: 66 75 6c 6c 63 6d 64 29 0a 09 09 28 68 61 6e 64 fullcmd)...(hand
2820: 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 09 le-exceptions...
2830: 20 65 78 6e 0a 09 09 20 28 62 65 67 69 6e 0a 09 exn... (begin..
2840: 09 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 . (debug:print
2850: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
2860: 70 6f 72 74 2a 20 22 57 41 52 4e 49 4e 47 3a 20 port* "WARNING:
2870: 66 61 69 6c 65 64 20 74 6f 20 70 72 6f 63 65 73 failed to proces
2880: 73 20 63 6f 6e 66 69 67 20 69 6e 70 75 74 20 5c s config input \
2890: 22 22 20 6c 20 22 5c 22 22 29 0a 09 09 20 20 20 "" l "\"")...
28a0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a (debug:print 0 *
28b0: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
28c0: 2a 20 22 20 6d 65 73 73 61 67 65 3a 20 22 20 28 * " message: " (
28d0: 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 65 (condition-prope
28e0: 72 74 79 2d 61 63 63 65 73 73 6f 72 20 27 65 78 rty-accessor 'ex
28f0: 6e 20 27 6d 65 73 73 61 67 65 29 20 65 78 6e 29 n 'message) exn)
2900: 29 0a 09 09 20 20 20 3b 3b 20 28 70 72 69 6e 74 )... ;; (print
2910: 20 22 65 78 6e 3d 22 20 28 63 6f 6e 64 69 74 69 "exn=" (conditi
2920: 6f 6e 2d 3e 6c 69 73 74 20 65 78 6e 29 29 0a 09 on->list exn))..
2930: 09 20 20 20 28 73 65 74 21 20 72 65 73 75 6c 74 . (set! result
2940: 20 28 63 6f 6e 63 20 22 23 7b 28 20 22 20 63 6d (conc "#{( " cm
2950: 64 74 79 70 65 20 22 29 20 22 20 63 6d 64 20 22 dtype ") " cmd "
2960: 7d 2c 20 66 75 6c 6c 20 65 78 70 61 6e 73 69 6f }, full expansio
2970: 6e 3a 20 22 20 66 75 6c 6c 63 6d 64 29 29 29 0a n: " fullcmd))).
2980: 09 09 20 28 69 66 20 28 6f 72 20 61 6c 6c 6f 77 .. (if (or allow
2990: 2d 73 79 73 74 65 6d 0a 09 09 09 20 28 6e 6f 74 -system.... (not
29a0: 20 28 6d 65 6d 62 65 72 20 63 6d 64 74 79 70 65 (member cmdtype
29b0: 20 27 28 22 73 79 73 74 65 6d 22 20 22 73 68 65 '("system" "she
29c0: 6c 6c 22 20 22 73 68 22 29 29 29 29 0a 09 09 20 ll" "sh"))))...
29d0: 20 20 20 20 28 77 69 74 68 2d 69 6e 70 75 74 2d (with-input-
29e0: 66 72 6f 6d 2d 73 74 72 69 6e 67 20 66 75 6c 6c from-string full
29f0: 63 6d 64 0a 09 09 20 20 20 20 20 20 20 28 6c 61 cmd... (la
2a00: 6d 62 64 61 20 28 29 0a 09 09 09 20 28 73 65 74 mbda ().... (set
2a10: 21 20 72 65 73 75 6c 74 20 28 28 65 76 61 6c 20 ! result ((eval
2a20: 28 72 65 61 64 29 29 20 68 74 29 29 29 29 0a 09 (read)) ht))))..
2a30: 09 20 20 20 20 20 28 73 65 74 21 20 72 65 73 75 . (set! resu
2a40: 6c 74 20 28 63 6f 6e 63 20 22 23 7b 28 22 20 63 lt (conc "#{(" c
2a50: 6d 64 74 79 70 65 20 22 29 20 22 20 20 63 6d 64 mdtype ") " cmd
2a60: 20 22 7d 22 29 29 29 29 0a 09 09 28 63 61 73 65 "}"))))...(case
2a70: 20 63 6d 64 73 79 6d 0a 09 09 20 20 28 28 73 79 cmdsym... ((sy
2a80: 73 74 65 6d 20 73 68 65 6c 6c 20 73 63 68 65 6d stem shell schem
2a90: 65 29 0a 09 09 20 20 20 28 6c 65 74 20 28 28 64 e)... (let ((d
2aa0: 65 6c 74 61 20 28 2d 20 28 63 75 72 72 65 6e 74 elta (- (current
2ab0: 2d 73 65 63 6f 6e 64 73 29 20 73 74 61 72 74 2d -seconds) start-
2ac0: 74 69 6d 65 29 29 29 0a 09 09 20 20 20 20 20 28 time)))... (
2ad0: 69 66 20 28 3e 20 64 65 6c 74 61 20 32 29 0a 09 if (> delta 2)..
2ae0: 09 09 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d .. (debug:print-
2af0: 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d info 0 *default-
2b00: 6c 6f 67 2d 70 6f 72 74 2a 20 22 66 6f 72 20 6c log-port* "for l
2b10: 69 6e 65 20 5c 22 22 20 6c 20 22 5c 22 5c 6e 20 ine \"" l "\"\n
2b20: 63 6f 6d 6d 61 6e 64 3a 20 20 22 20 63 6d 64 20 command: " cmd
2b30: 22 20 74 6f 6f 6b 20 22 20 64 65 6c 74 61 20 22 " took " delta "
2b40: 20 73 65 63 6f 6e 64 73 20 74 6f 20 72 75 6e 20 seconds to run
2b50: 77 69 74 68 20 6f 75 74 70 75 74 3a 5c 6e 20 20 with output:\n
2b60: 20 22 20 72 65 73 75 6c 74 29 0a 09 09 09 20 28 " result).... (
2b70: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
2b80: 20 39 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 9 *default-log-
2b90: 70 6f 72 74 2a 20 22 66 6f 72 20 6c 69 6e 65 20 port* "for line
2ba0: 5c 22 22 20 6c 20 22 5c 22 5c 6e 20 63 6f 6d 6d \"" l "\"\n comm
2bb0: 61 6e 64 3a 20 20 22 20 63 6d 64 20 22 20 74 6f and: " cmd " to
2bc0: 6f 6b 20 22 20 64 65 6c 74 61 20 22 20 73 65 63 ok " delta " sec
2bd0: 6f 6e 64 73 20 74 6f 20 72 75 6e 20 77 69 74 68 onds to run with
2be0: 20 6f 75 74 70 75 74 3a 5c 6e 20 20 20 22 20 72 output:\n " r
2bf0: 65 73 75 6c 74 29 29 29 29 29 0a 09 09 28 6c 6f esult)))))...(lo
2c00: 6f 70 20 28 63 6f 6e 63 20 70 72 65 73 74 72 20 op (conc prestr
2c10: 72 65 73 75 6c 74 20 70 6f 73 74 73 74 72 29 29 result poststr))
2c20: 29 0a 09 20 20 20 20 20 20 72 65 73 29 29 0a 09 ).. res))..
2c30: 72 65 73 29 29 29 0a 0a 3b 3b 20 52 75 6e 20 61 res)))..;; Run a
2c40: 20 73 68 65 6c 6c 20 63 6f 6d 6d 61 6e 64 20 61 shell command a
2c50: 6e 64 20 72 65 74 75 72 6e 20 74 68 65 20 6f 75 nd return the ou
2c60: 74 70 75 74 20 61 73 20 61 20 73 74 72 69 6e 67 tput as a string
2c70: 0a 28 64 65 66 69 6e 65 20 28 73 68 65 6c 6c 20 .(define (shell
2c80: 63 6d 64 29 0a 20 20 28 6c 65 74 2a 20 28 28 6f cmd). (let* ((o
2c90: 75 74 70 75 74 20 28 63 6d 64 2d 72 75 6e 2d 3e utput (cmd-run->
2ca0: 6c 69 73 74 20 63 6d 64 29 29 0a 09 20 28 72 65 list cmd)).. (re
2cb0: 73 20 20 20 20 28 63 61 72 20 6f 75 74 70 75 74 s (car output
2cc0: 29 29 0a 09 20 28 73 74 61 74 75 73 20 28 63 61 )).. (status (ca
2cd0: 64 72 20 6f 75 74 70 75 74 29 29 29 0a 20 20 20 dr output))).
2ce0: 20 28 69 66 20 28 65 71 75 61 6c 3f 20 73 74 61 (if (equal? sta
2cf0: 74 75 73 20 30 29 0a 09 28 6c 65 74 20 28 28 6f tus 0)..(let ((o
2d00: 75 74 72 65 73 20 28 73 74 72 69 6e 67 2d 69 6e utres (string-in
2d10: 74 65 72 73 70 65 72 73 65 20 0a 09 09 20 20 20 tersperse ...
2d20: 20 20 20 20 72 65 73 0a 09 09 20 20 20 20 20 20 res...
2d30: 20 22 5c 6e 22 29 29 29 0a 09 20 20 28 64 65 62 "\n"))).. (deb
2d40: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 34 20 ug:print-info 4
2d50: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
2d60: 74 2a 20 22 73 68 65 6c 6c 20 72 65 73 75 6c 74 t* "shell result
2d70: 3a 5c 6e 22 20 6f 75 74 72 65 73 29 0a 09 20 20 :\n" outres)..
2d80: 6f 75 74 72 65 73 29 0a 09 28 62 65 67 69 6e 0a outres)..(begin.
2d90: 09 20 20 28 77 69 74 68 2d 6f 75 74 70 75 74 2d . (with-output-
2da0: 74 6f 2d 70 6f 72 74 20 28 63 75 72 72 65 6e 74 to-port (current
2db0: 2d 65 72 72 6f 72 2d 70 6f 72 74 29 0a 09 20 20 -error-port)..
2dc0: 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 20 20 (lambda ()..
2dd0: 20 20 20 20 28 70 72 69 6e 74 20 22 45 52 52 4f (print "ERRO
2de0: 52 3a 20 22 20 63 6d 64 20 22 20 72 65 74 75 72 R: " cmd " retur
2df0: 6e 65 64 20 62 61 64 20 65 78 69 74 20 63 6f 64 ned bad exit cod
2e00: 65 20 22 20 73 74 61 74 75 73 29 29 29 0a 09 20 e " status)))..
2e10: 20 22 22 29 29 29 29 0a 0a 3b 3b 20 74 68 69 73 ""))))..;; this
2e20: 20 77 61 73 20 69 6e 6c 69 6e 65 20 62 75 74 20 was inline but
2e30: 49 27 6d 20 70 72 65 74 74 79 20 73 75 72 65 20 I'm pretty sure
2e40: 74 68 61 74 20 69 73 20 61 20 68 6f 6c 64 20 6f that is a hold o
2e50: 76 65 72 20 66 72 6f 6d 20 77 68 65 6e 20 69 74 ver from when it
2e60: 20 77 61 73 20 2a 76 65 72 79 2a 20 73 69 6d 70 was *very* simp
2e70: 6c 65 20 2e 2e 2e 0a 3b 3b 0a 28 64 65 66 69 6e le ....;;.(defin
2e80: 65 20 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d e (configf:read-
2e90: 6c 69 6e 65 20 70 20 68 74 20 61 6c 6c 6f 77 2d line p ht allow-
2ea0: 70 72 6f 63 65 73 73 69 6e 67 20 73 65 74 74 69 processing setti
2eb0: 6e 67 73 29 0a 20 20 28 6c 65 74 20 6c 6f 6f 70 ngs). (let loop
2ec0: 20 28 28 69 6e 6c 20 28 72 65 61 64 2d 6c 69 6e ((inl (read-lin
2ed0: 65 20 70 29 29 29 0a 20 20 20 20 28 6c 65 74 20 e p))). (let
2ee0: 28 28 63 6f 6e 74 2d 6c 69 6e 65 20 28 61 6e 64 ((cont-line (and
2ef0: 20 28 73 74 72 69 6e 67 3f 20 69 6e 6c 29 0a 09 (string? inl)..
2f00: 09 09 20 20 28 6e 6f 74 20 28 73 74 72 69 6e 67 .. (not (string
2f10: 2d 6e 75 6c 6c 3f 20 69 6e 6c 29 29 0a 09 09 09 -null? inl))....
2f20: 20 20 28 65 71 75 61 6c 3f 20 22 5c 5c 22 20 28 (equal? "\\" (
2f30: 73 74 72 69 6e 67 2d 74 61 6b 65 2d 72 69 67 68 string-take-righ
2f40: 74 20 69 6e 6c 20 31 29 29 29 29 29 0a 20 20 20 t inl 1))))).
2f50: 20 20 20 28 69 66 20 63 6f 6e 74 2d 6c 69 6e 65 (if cont-line
2f60: 20 3b 3b 20 6c 61 73 74 20 63 68 61 72 61 63 74 ;; last charact
2f70: 65 72 20 69 73 20 5c 20 0a 09 20 20 28 6c 65 74 er is \ .. (let
2f80: 20 28 28 6e 65 78 74 6c 20 28 72 65 61 64 2d 6c ((nextl (read-l
2f90: 69 6e 65 20 70 29 29 29 0a 09 20 20 20 20 28 69 ine p))).. (i
2fa0: 66 20 28 6e 6f 74 20 28 65 6f 66 2d 6f 62 6a 65 f (not (eof-obje
2fb0: 63 74 3f 20 6e 65 78 74 6c 29 29 0a 09 09 28 6c ct? nextl))...(l
2fc0: 6f 6f 70 20 28 73 74 72 69 6e 67 2d 61 70 70 65 oop (string-appe
2fd0: 6e 64 20 28 69 66 20 63 6f 6e 74 2d 6c 69 6e 65 nd (if cont-line
2fe0: 20 0a 09 09 09 09 09 20 28 73 74 72 69 6e 67 2d ...... (string-
2ff0: 74 61 6b 65 20 69 6e 6c 20 28 2d 20 28 73 74 72 take inl (- (str
3000: 69 6e 67 2d 6c 65 6e 67 74 68 20 69 6e 6c 29 20 ing-length inl)
3010: 31 29 29 0a 09 09 09 09 09 20 69 6e 6c 29 0a 09 1))...... inl)..
3020: 09 09 09 20 20 20 20 20 6e 65 78 74 6c 29 29 29 ... nextl)))
3030: 29 0a 09 20 20 28 6c 65 74 20 28 28 72 65 73 20 ).. (let ((res
3040: 28 63 61 73 65 20 61 6c 6c 6f 77 2d 70 72 6f 63 (case allow-proc
3050: 65 73 73 69 6e 67 20 3b 3b 20 69 66 20 28 61 6e essing ;; if (an
3060: 64 20 61 6c 6c 6f 77 2d 70 72 6f 63 65 73 73 69 d allow-processi
3070: 6e 67 20 0a 09 09 20 20 20 20 20 20 20 3b 3b 09 ng ... ;;.
3080: 20 20 20 28 6e 6f 74 20 28 65 71 3f 20 61 6c 6c (not (eq? all
3090: 6f 77 2d 70 72 6f 63 65 73 73 69 6e 67 20 27 72 ow-processing 'r
30a0: 65 74 75 72 6e 2d 73 74 72 69 6e 67 29 29 29 0a eturn-string))).
30b0: 09 09 20 20 20 20 20 20 20 28 28 23 74 20 23 66 .. ((#t #f
30c0: 29 0a 09 09 09 28 70 72 6f 63 65 73 73 2d 6c 69 )....(process-li
30d0: 6e 65 20 69 6e 6c 20 68 74 20 61 6c 6c 6f 77 2d ne inl ht allow-
30e0: 70 72 6f 63 65 73 73 69 6e 67 29 29 0a 09 09 20 processing))...
30f0: 20 20 20 20 20 20 28 28 72 65 74 75 72 6e 2d 73 ((return-s
3100: 74 72 69 6e 67 29 0a 09 09 09 69 6e 6c 29 0a 09 tring)....inl)..
3110: 09 20 20 20 20 20 20 20 28 65 6c 73 65 0a 09 09 . (else...
3120: 09 28 70 72 6f 63 65 73 73 2d 6c 69 6e 65 20 69 .(process-line i
3130: 6e 6c 20 68 74 20 61 6c 6c 6f 77 2d 70 72 6f 63 nl ht allow-proc
3140: 65 73 73 69 6e 67 29 29 29 29 29 0a 09 20 20 20 essing)))))..
3150: 20 28 69 66 20 28 61 6e 64 20 28 73 74 72 69 6e (if (and (strin
3160: 67 3f 20 72 65 73 29 0a 09 09 20 20 20 20 20 28 g? res)... (
3170: 6e 6f 74 20 28 65 71 75 61 6c 3f 20 28 68 61 73 not (equal? (has
3180: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
3190: 75 6c 74 20 73 65 74 74 69 6e 67 73 20 22 74 72 ult settings "tr
31a0: 69 6d 2d 74 72 61 69 6c 69 6e 67 2d 73 70 61 63 im-trailing-spac
31b0: 65 73 22 20 22 6e 6f 22 29 20 22 6e 6f 22 29 29 es" "no") "no"))
31c0: 29 0a 09 09 28 73 74 72 69 6e 67 2d 73 75 62 73 )...(string-subs
31d0: 74 69 74 75 74 65 20 22 5c 5c 73 2b 24 22 20 22 titute "\\s+$" "
31e0: 22 20 72 65 73 29 0a 09 09 72 65 73 29 29 29 29 " res)...res))))
31f0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 66 67 ))..(define (cfg
3200: 64 61 74 2d 3e 65 6e 76 2d 61 6c 69 73 74 20 73 dat->env-alist s
3210: 65 63 74 69 6f 6e 20 63 66 67 64 61 74 2d 68 74 ection cfgdat-ht
3220: 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 29 0a 20 allow-system).
3230: 20 28 66 69 6c 74 65 72 0a 20 20 20 28 6c 61 6d (filter. (lam
3240: 62 64 61 20 28 70 61 69 72 29 0a 20 20 20 20 20 bda (pair).
3250: 28 6c 65 74 2a 20 28 28 76 61 72 20 28 63 61 72 (let* ((var (car
3260: 20 70 61 69 72 29 29 0a 20 20 20 20 20 20 20 20 pair)).
3270: 20 20 20 20 28 76 61 6c 20 28 63 64 72 20 70 61 (val (cdr pa
3280: 69 72 29 29 29 0a 20 20 20 20 20 20 20 28 63 6f ir))). (co
3290: 6e 73 20 76 61 72 0a 20 20 20 20 20 20 20 20 20 ns var.
32a0: 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 (cond.
32b0: 20 20 20 20 20 20 20 20 28 28 61 6e 64 20 61 6c ((and al
32c0: 6c 6f 77 2d 73 79 73 74 65 6d 20 28 70 72 6f 63 low-system (proc
32d0: 65 64 75 72 65 3f 20 76 61 6c 29 29 20 3b 3b 20 edure? val)) ;;
32e0: 69 66 20 77 65 20 64 65 63 69 64 65 64 20 74 6f if we decided to
32f0: 20 75 73 65 20 73 6f 6d 65 74 68 69 6e 67 20 6f use something o
3300: 74 68 65 72 20 74 68 61 6e 20 23 74 20 6f 72 20 ther than #t or
3310: 23 66 20 66 6f 72 20 61 6c 6c 6f 77 2d 73 79 73 #f for allow-sys
3320: 74 65 6d 20 28 27 72 65 74 75 72 6e 2d 70 72 6f tem ('return-pro
3330: 63 73 20 6f 72 20 27 72 65 74 75 72 6e 2d 73 74 cs or 'return-st
3340: 72 69 6e 67 29 20 2c 20 74 68 69 73 20 6d 61 79 ring) , this may
3350: 20 62 65 63 6f 6d 65 20 70 72 6f 62 6c 65 6d 61 become problema
3360: 74 69 63 0a 20 20 20 20 20 20 20 20 20 20 20 20 tic.
3370: 20 20 20 28 76 61 6c 29 29 0a 20 20 20 20 20 20 (val)).
3380: 20 20 20 20 20 20 20 20 28 28 70 72 6f 63 65 64 ((proced
3390: 75 72 65 3f 20 76 61 6c 29 20 23 66 29 0a 20 20 ure? val) #f).
33a0: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 73 74 ((st
33b0: 72 69 6e 67 3f 20 76 61 6c 29 20 76 61 6c 29 0a ring? val) val).
33c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 (e
33d0: 6c 73 65 20 22 23 66 22 29 29 29 29 29 0a 20 20 lse "#f"))))).
33e0: 20 28 61 70 70 65 6e 64 0a 20 20 20 20 28 68 61 (append. (ha
33f0: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def
3400: 61 75 6c 74 20 63 66 67 64 61 74 2d 68 74 20 22 ault cfgdat-ht "
3410: 64 65 66 61 75 6c 74 22 20 27 28 29 29 0a 20 20 default" '()).
3420: 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 73 65 (if (equal? se
3430: 63 74 69 6f 6e 20 22 64 65 66 61 75 6c 74 22 29 ction "default")
3440: 20 27 28 29 20 28 68 61 73 68 2d 74 61 62 6c 65 '() (hash-table
3450: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 63 66 67 -ref/default cfg
3460: 64 61 74 2d 68 74 20 73 65 63 74 69 6f 6e 20 27 dat-ht section '
3470: 28 29 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 ())))))..(define
3480: 20 28 63 61 6c 63 2d 61 6c 6c 6f 77 2d 73 79 73 (calc-allow-sys
3490: 74 65 6d 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d tem allow-system
34a0: 20 73 65 63 74 69 6f 6e 20 73 65 63 74 69 6f 6e section section
34b0: 73 29 0a 20 20 28 69 66 20 73 65 63 74 69 6f 6e s). (if section
34c0: 73 0a 20 20 20 20 20 20 28 61 6e 64 20 28 6f 72 s. (and (or
34d0: 20 28 65 71 75 61 6c 3f 20 22 64 65 66 61 75 6c (equal? "defaul
34e0: 74 22 20 73 65 63 74 69 6f 6e 29 0a 09 20 20 20 t" section)..
34f0: 20 20 20 20 28 6d 65 6d 62 65 72 20 73 65 63 74 (member sect
3500: 69 6f 6e 20 73 65 63 74 69 6f 6e 73 29 29 0a 09 ion sections))..
3510: 20 20 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 29 allow-system)
3520: 20 3b 3b 20 61 63 63 6f 75 6e 74 20 66 6f 72 20 ;; account for
3530: 73 65 63 74 69 6f 6e 73 20 61 6e 64 20 72 65 74 sections and ret
3540: 75 72 6e 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d urn allow-system
3550: 20 61 73 20 69 74 20 6d 69 67 68 74 20 62 65 20 as it might be
3560: 61 20 73 79 6d 62 6f 6c 20 73 75 63 68 20 61 73 a symbol such as
3570: 20 72 65 74 75 72 6e 2d 73 74 72 69 6e 67 73 0a return-strings.
3580: 20 20 20 20 20 20 61 6c 6c 6f 77 2d 73 79 73 74 allow-syst
3590: 65 6d 29 29 0a 20 20 20 20 0a 3b 3b 20 67 69 76 em)). .;; giv
35a0: 65 6e 20 61 20 63 6f 6e 66 69 67 20 68 61 73 68 en a config hash
35b0: 20 61 6e 64 20 61 20 73 65 63 74 69 6f 6e 20 6e and a section n
35c0: 61 6d 65 2c 20 61 70 70 6c 79 20 74 68 61 74 20 ame, apply that
35d0: 73 65 63 74 69 6f 6e 20 74 6f 20 61 6c 6c 20 6d section to all m
35e0: 61 74 63 68 69 6e 67 20 73 65 63 74 69 6f 6e 73 atching sections
35f0: 20 28 75 73 69 6e 67 20 77 69 6c 64 63 61 72 64 (using wildcard
3600: 20 25 20 6f 72 20 72 65 67 65 78 20 69 66 20 2f % or regex if /
3610: 2e 2e 2e 2e 2f 29 0a 3b 3b 20 72 65 6d 6f 76 65 ..../).;; remove
3620: 20 74 68 65 20 73 65 63 74 69 6f 6e 20 77 68 65 the section whe
3630: 6e 20 64 6f 6e 65 20 73 6f 20 74 68 61 74 20 74 n done so that t
3640: 68 65 72 65 20 69 73 20 6e 6f 20 64 6f 77 6e 73 here is no downs
3650: 74 72 65 61 6d 20 63 6c 6f 62 62 65 72 69 6e 67 tream clobbering
3660: 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 61 70 70 .;;.(define (app
3670: 6c 79 2d 77 69 6c 64 63 61 72 64 73 20 68 74 20 ly-wildcards ht
3680: 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 29 0a 20 20 section-name).
3690: 28 69 66 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (if (hash-table-
36a0: 65 78 69 73 74 73 3f 20 68 74 20 73 65 63 74 69 exists? ht secti
36b0: 6f 6e 2d 6e 61 6d 65 29 0a 20 20 20 20 20 20 28 on-name). (
36c0: 6c 65 74 2a 20 28 28 76 61 72 73 20 20 28 68 61 let* ((vars (ha
36d0: 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 68 74 20 sh-table-ref ht
36e0: 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 29 29 0a 09 section-name))..
36f0: 20 20 20 20 20 28 72 78 73 74 72 20 28 69 66 20 (rxstr (if
3700: 28 73 74 72 69 6e 67 2d 63 6f 6e 74 61 69 6e 73 (string-contains
3710: 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 22 25 section-name "%
3720: 22 29 0a 09 09 09 28 73 74 72 69 6e 67 2d 73 75 ")....(string-su
3730: 62 73 74 69 74 75 74 65 20 28 72 65 67 65 78 70 bstitute (regexp
3740: 20 22 25 22 29 20 22 2e 2a 22 20 73 65 63 74 69 "%") ".*" secti
3750: 6f 6e 2d 6e 61 6d 65 29 0a 09 09 09 28 73 74 72 on-name)....(str
3760: 69 6e 67 2d 73 75 62 73 74 69 74 75 74 65 20 28 ing-substitute (
3770: 72 65 67 65 78 70 20 22 5e 2f 28 2e 2a 29 2f 24 regexp "^/(.*)/$
3780: 22 29 20 22 5c 5c 31 22 20 73 65 63 74 69 6f 6e ") "\\1" section
3790: 2d 6e 61 6d 65 29 29 29 0a 09 20 20 20 20 20 28 -name))).. (
37a0: 72 78 20 20 20 20 28 72 65 67 65 78 70 20 72 78 rx (regexp rx
37b0: 73 74 72 29 29 29 0a 09 3b 3b 20 28 70 72 69 6e str)))..;; (prin
37c0: 74 20 22 5c 6e 73 65 63 74 69 6f 6e 2d 6e 61 6d t "\nsection-nam
37d0: 65 3a 20 22 20 73 65 63 74 69 6f 6e 2d 6e 61 6d e: " section-nam
37e0: 65 20 22 20 72 78 73 74 72 3a 20 22 20 72 78 73 e " rxstr: " rxs
37f0: 74 72 29 0a 20 20 20 20 20 20 20 20 28 66 6f 72 tr). (for
3800: 2d 65 61 63 68 0a 20 20 20 20 20 20 20 20 20 28 -each. (
3810: 6c 61 6d 62 64 61 20 28 73 65 63 74 69 6f 6e 29 lambda (section)
3820: 0a 09 20 20 20 28 69 66 20 73 65 63 74 69 6f 6e .. (if section
3830: 0a 09 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 .. (let ((
3840: 73 61 6d 65 2d 73 65 63 74 69 6f 6e 20 28 73 74 same-section (st
3850: 72 69 6e 67 3d 3f 20 73 65 63 74 69 6f 6e 2d 6e ring=? section-n
3860: 61 6d 65 20 73 65 63 74 69 6f 6e 29 29 0a 09 09 ame section))...
3870: 20 20 20 20 20 28 72 78 2d 6d 61 74 63 68 20 20 (rx-match
3880: 20 20 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 (string-match
3890: 20 72 78 20 73 65 63 74 69 6f 6e 29 29 29 0a 09 rx section)))..
38a0: 09 20 3b 3b 20 28 70 72 69 6e 74 20 22 73 65 63 . ;; (print "sec
38b0: 74 69 6f 6e 3a 20 22 20 73 65 63 74 69 6f 6e 20 tion: " section
38c0: 22 20 76 61 72 73 3a 20 22 20 76 61 72 73 20 22 " vars: " vars "
38d0: 20 73 61 6d 65 2d 73 65 63 74 69 6f 6e 3a 20 22 same-section: "
38e0: 20 73 61 6d 65 2d 73 65 63 74 69 6f 6e 20 22 20 same-section "
38f0: 72 78 2d 6d 61 74 63 68 3a 20 22 20 72 78 2d 6d rx-match: " rx-m
3900: 61 74 63 68 29 0a 09 09 20 28 69 66 20 28 61 6e atch)... (if (an
3910: 64 20 28 6e 6f 74 20 73 61 6d 65 2d 73 65 63 74 d (not same-sect
3920: 69 6f 6e 29 20 72 78 2d 6d 61 74 63 68 29 0a 09 ion) rx-match)..
3930: 09 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 0a . (for-each.
3940: 09 09 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 .. (lambda
3950: 28 62 75 6e 64 6c 65 29 0a 09 09 09 3b 3b 20 28 (bundle)....;; (
3960: 70 72 69 6e 74 20 22 62 75 6e 64 6c 65 3a 20 22 print "bundle: "
3970: 20 62 75 6e 64 6c 65 29 0a 09 09 09 28 6c 65 74 bundle)....(let
3980: 20 28 28 6b 65 79 20 20 28 63 61 72 20 62 75 6e ((key (car bun
3990: 64 6c 65 29 29 0a 09 09 09 20 20 20 20 20 20 28 dle)).... (
39a0: 76 61 6c 20 20 28 63 61 64 72 20 62 75 6e 64 6c val (cadr bundl
39b0: 65 29 29 0a 09 09 09 20 20 20 20 20 20 28 6d 65 e)).... (me
39c0: 74 61 20 28 69 66 20 28 3e 20 28 6c 65 6e 67 74 ta (if (> (lengt
39d0: 68 20 62 75 6e 64 6c 65 29 20 32 29 28 63 61 64 h bundle) 2)(cad
39e0: 64 72 20 62 75 6e 64 6c 65 29 20 23 66 29 29 29 dr bundle) #f)))
39f0: 0a 09 09 09 20 20 28 68 61 73 68 2d 74 61 62 6c .... (hash-tabl
3a00: 65 2d 73 65 74 21 20 68 74 20 73 65 63 74 69 6f e-set! ht sectio
3a10: 6e 20 28 61 73 73 6f 63 2d 73 61 66 65 2d 61 64 n (assoc-safe-ad
3a20: 64 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 d (hash-table-re
3a30: 66 20 68 74 20 73 65 63 74 69 6f 6e 29 20 6b 65 f ht section) ke
3a40: 79 20 76 61 6c 20 6d 65 74 61 64 61 74 61 3a 20 y val metadata:
3a50: 6d 65 74 61 29 29 29 29 0a 09 09 20 20 20 20 20 meta))))...
3a60: 20 76 61 72 73 29 29 29 29 29 0a 20 20 20 20 20 vars))))).
3a70: 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (hash-table-
3a80: 6b 65 79 73 20 68 74 29 29 29 29 0a 20 20 68 74 keys ht)))). ht
3a90: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
3aa0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3ab0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3ac0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3ad0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 45 ===========.;; E
3ae0: 78 74 65 6e 64 65 64 20 63 6f 6e 66 69 67 20 6c xtended config l
3af0: 69 6e 65 73 2c 20 61 6c 6c 6f 77 73 20 73 74 6f ines, allows sto
3b00: 72 69 6e 67 20 6d 6f 72 65 20 68 69 65 72 61 72 ring more hierar
3b10: 63 68 69 61 6c 20 64 61 74 61 20 69 6e 20 74 68 chial data in th
3b20: 65 20 63 6f 6e 66 69 67 20 6c 69 6e 65 73 0a 3b e config lines.;
3b30: 3b 20 20 20 41 42 43 20 61 3d 31 3b 20 62 3d 68 ; ABC a=1; b=h
3b40: 65 6c 6c 6f 20 77 6f 72 6c 64 3b 20 63 3d 61 0a ello world; c=a.
3b50: 3b 3b 0a 3b 3b 20 4e 4f 54 45 3a 20 69 6d 70 6c ;;.;; NOTE: impl
3b60: 65 6d 65 6e 74 61 74 69 6f 6e 20 69 73 20 71 75 ementation is qu
3b70: 69 74 65 20 6c 69 6d 69 74 65 64 2e 20 59 6f 75 ite limited. You
3b80: 20 63 75 72 72 65 6e 74 6c 79 20 63 61 6e 6e 6f currently canno
3b90: 74 20 68 61 76 65 0a 3b 3b 20 20 20 20 20 20 20 t have.;;
3ba0: 73 65 6d 69 63 6f 6c 6f 6e 73 20 69 6e 20 79 6f semicolons in yo
3bb0: 75 72 20 73 74 72 69 6e 67 20 76 61 6c 75 65 73 ur string values
3bc0: 2e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
3bd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3be0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3bf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3c00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 63 ==========..;; c
3c10: 6f 6e 76 65 72 74 20 73 74 72 69 6e 67 20 61 3d onvert string a=
3c20: 31 3b 20 62 3d 32 3b 20 63 3d 61 20 73 69 6c 6c 1; b=2; c=a sill
3c30: 79 20 74 68 69 6e 67 3b 20 64 3d 0a 3b 3b 20 74 y thing; d=.;; t
3c40: 6f 20 27 28 28 61 20 2e 20 31 29 28 62 20 2e 20 o '((a . 1)(b .
3c50: 32 29 28 63 20 2e 20 22 61 20 73 69 6c 6c 79 20 2)(c . "a silly
3c60: 74 68 69 6e 67 22 29 28 64 20 2e 20 22 22 29 29 thing")(d . ""))
3c70: 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 76 61 6c .;;.(define (val
3c80: 2d 3e 61 6c 69 73 74 20 76 61 6c 20 23 21 6b 65 ->alist val #!ke
3c90: 79 20 28 63 6f 6e 76 65 72 74 20 23 66 29 29 0a y (convert #f)).
3ca0: 20 20 28 6c 65 74 20 28 28 76 61 6c 2d 6c 69 73 (let ((val-lis
3cb0: 74 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 2d t (string-split-
3cc0: 66 69 65 6c 64 73 20 22 3b 5c 5c 73 2a 22 20 76 fields ";\\s*" v
3cd0: 61 6c 20 23 3a 69 6e 66 69 78 29 29 29 0a 20 20 al #:infix))).
3ce0: 20 20 28 69 66 20 76 61 6c 2d 6c 69 73 74 0a 09 (if val-list..
3cf0: 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 78 29 (map (lambda (x)
3d00: 0a 09 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 .. (let ((
3d10: 66 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 2d f (string-split-
3d20: 66 69 65 6c 64 73 20 22 5c 5c 73 2a 3d 5c 5c 73 fields "\\s*=\\s
3d30: 2a 22 20 78 20 23 3a 69 6e 66 69 78 29 29 29 0a *" x #:infix))).
3d40: 09 09 20 28 63 61 73 65 20 28 6c 65 6e 67 74 68 .. (case (length
3d50: 20 66 29 0a 09 09 20 20 20 28 28 30 29 20 60 28 f)... ((0) `(
3d60: 2c 23 66 29 29 20 20 3b 3b 20 6e 75 6c 6c 20 73 ,#f)) ;; null s
3d70: 74 72 69 6e 67 20 63 61 73 65 0a 09 09 20 20 20 tring case...
3d80: 28 28 31 29 20 60 28 2c 28 73 74 72 69 6e 67 2d ((1) `(,(string-
3d90: 3e 73 79 6d 62 6f 6c 20 28 63 61 72 20 66 29 29 >symbol (car f))
3da0: 29 29 0a 09 09 20 20 20 28 28 32 29 20 60 28 2c ))... ((2) `(,
3db0: 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 (string->symbol
3dc0: 28 63 61 72 20 66 29 29 20 2e 20 2c 28 6c 65 74 (car f)) . ,(let
3dd0: 20 28 28 69 6e 76 61 6c 20 28 63 61 64 72 20 66 ((inval (cadr f
3de0: 29 29 29 0a 09 09 09 09 09 09 09 20 28 69 66 20 )))........ (if
3df0: 63 6f 6e 76 65 72 74 20 28 6c 61 7a 79 2d 63 6f convert (lazy-co
3e00: 6e 76 65 72 74 20 69 6e 76 61 6c 29 20 69 6e 76 nvert inval) inv
3e10: 61 6c 29 29 29 29 0a 09 09 20 20 20 28 65 6c 73 al))))... (els
3e20: 65 20 66 29 29 29 29 0a 09 20 20 20 20 20 76 61 e f)))).. va
3e30: 6c 2d 6c 69 73 74 29 0a 09 27 28 29 29 29 29 0a l-list)..'()))).
3e40: 0a 3b 3b 20 49 20 64 6f 6e 27 74 20 77 61 6e 74 .;; I don't want
3e50: 20 63 6f 6e 66 69 67 66 20 74 6f 20 74 75 72 6e configf to turn
3e60: 20 69 6e 74 6f 20 61 20 77 65 61 6b 20 79 61 6d into a weak yam
3e70: 6c 20 66 6f 72 6d 61 74 20 62 75 74 20 74 68 69 l format but thi
3e80: 73 20 65 78 74 65 6e 74 69 6f 6e 20 69 73 20 72 s extention is r
3e90: 65 61 6c 6c 79 20 75 73 65 66 75 6c 0a 3b 3b 0a eally useful.;;.
3ea0: 28 64 65 66 69 6e 65 20 28 73 65 63 74 69 6f 6e (define (section
3eb0: 2d 3e 76 61 6c 2d 61 6c 69 73 74 20 63 66 67 64 ->val-alist cfgd
3ec0: 61 74 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 at section-name
3ed0: 23 21 6b 65 79 20 28 63 6f 6e 76 65 72 74 20 23 #!key (convert #
3ee0: 66 29 29 0a 20 20 28 6c 65 74 20 28 28 73 65 63 f)). (let ((sec
3ef0: 74 69 6f 6e 20 28 67 65 74 2d 73 65 63 74 69 6f tion (get-sectio
3f00: 6e 20 63 66 67 64 61 74 20 73 65 63 74 69 6f 6e n cfgdat section
3f10: 2d 6e 61 6d 65 29 29 29 0a 20 20 20 20 28 6d 61 -name))). (ma
3f20: 70 20 28 6c 61 6d 62 64 61 20 28 69 74 65 6d 29 p (lambda (item)
3f30: 0a 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 . (let
3f40: 20 28 28 6b 65 79 20 28 63 61 72 20 69 74 65 6d ((key (car item
3f50: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
3f60: 20 20 20 20 28 76 61 6c 20 28 63 61 64 72 20 69 (val (cadr i
3f70: 74 65 6d 29 29 29 20 3b 3b 20 42 55 47 20 49 4e tem))) ;; BUG IN
3f80: 20 57 41 49 54 2e 20 73 65 63 74 69 6f 6e 73 20 WAIT. sections
3f90: 61 72 65 20 6e 6f 74 20 72 65 74 75 72 6e 65 64 are not returned
3fa0: 20 61 73 20 70 72 6f 70 65 72 20 61 6c 69 73 74 as proper alist
3fb0: 73 2c 20 73 68 6f 75 6c 64 20 66 69 78 20 74 68 s, should fix th
3fc0: 69 73 2e 0a 20 20 20 20 20 20 20 20 20 20 20 20 is..
3fd0: 20 28 63 6f 6e 73 20 6b 65 79 20 28 76 61 6c 2d (cons key (val-
3fe0: 3e 61 6c 69 73 74 20 76 61 6c 20 63 6f 6e 76 65 >alist val conve
3ff0: 72 74 3a 20 63 6f 6e 76 65 72 74 29 29 29 29 0a rt: convert)))).
4000: 20 20 20 20 20 20 20 20 20 73 65 63 74 69 6f 6e section
4010: 29 29 29 0a 20 20 0a 3b 3b 20 72 65 61 64 20 61 ))). .;; read a
4020: 20 63 6f 6e 66 69 67 20 66 69 6c 65 2c 20 72 65 config file, re
4030: 74 75 72 6e 73 20 68 61 73 68 20 74 61 62 6c 65 turns hash table
4040: 20 6f 66 20 61 6c 69 73 74 73 0a 0a 3b 3b 20 72 of alists..;; r
4050: 65 61 64 20 61 20 63 6f 6e 66 69 67 20 66 69 6c ead a config fil
4060: 65 2c 20 72 65 74 75 72 6e 73 20 68 61 73 68 20 e, returns hash
4070: 74 61 62 6c 65 20 6f 66 20 61 6c 69 73 74 73 0a table of alists.
4080: 3b 3b 20 61 64 64 73 20 74 6f 20 68 74 20 69 66 ;; adds to ht if
4090: 20 67 69 76 65 6e 20 28 6d 75 73 74 20 62 65 20 given (must be
40a0: 23 66 20 6f 74 68 65 72 77 69 73 65 29 0a 3b 3b #f otherwise).;;
40b0: 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 3a 0a 3b allow-system:.;
40c0: 3b 20 20 20 20 23 66 20 2d 20 64 6f 20 6e 6f 74 ; #f - do not
40d0: 20 65 76 61 6c 75 61 74 65 20 5b 73 79 73 74 65 evaluate [syste
40e0: 6d 0a 3b 3b 20 20 20 20 23 74 20 2d 20 69 6d 6d m.;; #t - imm
40f0: 65 64 69 61 74 65 6c 79 20 65 76 61 6c 75 61 74 ediately evaluat
4100: 65 20 5b 73 79 73 74 65 6d 20 61 6e 64 20 73 74 e [system and st
4110: 6f 72 65 20 72 65 73 75 6c 74 20 61 73 20 73 74 ore result as st
4120: 72 69 6e 67 0a 3b 3b 20 20 20 20 27 72 65 74 75 ring.;; 'retu
4130: 72 6e 2d 70 72 6f 63 73 20 2d 2d 20 72 65 74 75 rn-procs -- retu
4140: 72 6e 20 61 20 70 72 6f 63 20 74 61 6b 69 6e 67 rn a proc taking
4150: 20 68 74 20 61 73 20 61 6e 20 61 72 67 75 6d 65 ht as an argume
4160: 6e 74 20 74 68 61 74 20 6d 61 79 20 62 65 20 65 nt that may be e
4170: 76 61 75 6c 61 74 65 64 20 61 74 20 73 6f 6d 65 vaulated at some
4180: 20 66 75 74 75 72 65 20 74 69 6d 65 0a 3b 3b 20 future time.;;
4190: 20 20 20 27 72 65 74 75 72 6e 2d 73 74 72 69 6e 'return-strin
41a0: 67 20 2d 2d 20 72 65 74 75 72 6e 20 61 20 73 74 g -- return a st
41b0: 72 69 6e 67 20 72 65 70 72 65 73 65 6e 74 69 6e ring representin
41c0: 67 20 61 20 70 72 6f 63 20 74 61 6b 69 6e 67 20 g a proc taking
41d0: 68 74 20 61 73 20 61 6e 20 61 72 67 75 6d 65 6e ht as an argumen
41e0: 74 20 74 68 61 74 20 6d 61 79 20 62 65 20 65 76 t that may be ev
41f0: 61 75 6c 61 74 65 64 20 61 74 20 73 6f 6d 65 20 aulated at some
4200: 66 75 74 75 72 65 20 74 69 6d 65 0a 3b 3b 20 65 future time.;; e
4210: 6e 76 69 6f 6e 2d 70 61 74 74 20 69 73 20 61 20 nvion-patt is a
4220: 72 65 67 65 78 20 73 70 65 63 20 74 68 61 74 20 regex spec that
4230: 69 64 65 6e 74 69 66 69 65 73 20 73 65 63 74 69 identifies secti
4240: 6f 6e 73 20 74 68 61 74 20 77 69 6c 6c 20 62 65 ons that will be
4250: 20 65 76 61 6c 27 64 0a 3b 3b 20 69 6e 20 74 68 eval'd.;; in th
4260: 65 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 6f 6e e environment on
4270: 20 74 68 65 20 66 6c 79 0a 3b 3b 20 73 65 63 74 the fly.;; sect
4280: 69 6f 6e 73 3a 20 23 66 20 3d 3e 20 67 65 74 20 ions: #f => get
4290: 61 6c 6c 2c 20 65 6c 73 65 20 6c 69 73 74 20 6f all, else list o
42a0: 66 20 73 65 63 74 69 6f 6e 73 20 74 6f 20 67 61 f sections to ga
42b0: 74 68 65 72 0a 3b 3b 20 70 6f 73 74 2d 73 65 63 ther.;; post-sec
42c0: 74 69 6f 6e 2d 70 72 6f 63 73 20 61 6c 69 73 74 tion-procs alist
42d0: 20 6f 66 20 73 65 63 74 69 6f 6e 2d 70 61 74 74 of section-patt
42e0: 65 72 6e 20 3d 3e 20 70 72 6f 63 2c 20 77 68 65 ern => proc, whe
42f0: 72 65 3a 20 28 70 72 6f 63 20 73 65 63 74 69 6f re: (proc sectio
4300: 6e 2d 6e 61 6d 65 20 6e 65 78 74 2d 73 65 63 74 n-name next-sect
4310: 69 6f 6e 2d 6e 61 6d 65 20 68 74 20 63 75 72 72 ion-name ht curr
4320: 2d 70 61 74 68 29 0a 3b 3b 20 61 70 70 6c 79 2d -path).;; apply-
4330: 77 69 6c 64 63 61 72 64 73 3a 20 23 74 2f 23 66 wildcards: #t/#f
4340: 20 2d 20 61 70 70 6c 79 20 76 61 72 73 20 66 72 - apply vars fr
4350: 6f 6d 20 74 61 72 67 65 74 73 20 77 69 74 68 20 om targets with
4360: 25 20 77 69 6c 64 63 61 72 64 73 20 74 6f 20 61 % wildcards to a
4370: 6c 6c 20 6d 61 74 63 68 69 6e 67 20 73 65 63 74 ll matching sect
4380: 69 6f 6e 73 0a 3b 3b 0a 3b 3b 20 4e 4f 54 45 3a ions.;;.;; NOTE:
4390: 20 61 70 70 6c 79 2d 77 69 6c 64 20 76 61 72 69 apply-wild vari
43a0: 61 62 6c 65 20 69 73 20 69 6e 74 65 6e 74 69 6f able is intentio
43b0: 6e 61 6c 20 28 62 75 74 20 61 20 62 65 74 74 65 nal (but a bette
43c0: 72 20 6e 61 6d 65 20 77 6f 75 6c 64 20 62 65 20 r name would be
43d0: 67 6f 6f 64 29 0a 3b 3b 0a 28 64 65 66 69 6e 65 good).;;.(define
43e0: 20 28 72 65 61 64 2d 63 6f 6e 66 69 67 20 70 61 (read-config pa
43f0: 74 68 20 68 74 20 61 6c 6c 6f 77 2d 73 79 73 74 th ht allow-syst
4400: 65 6d 20 23 21 6b 65 79 20 28 65 6e 76 69 72 6f em #!key (enviro
4410: 6e 2d 70 61 74 74 20 23 66 29 20 20 20 20 20 20 n-patt #f)
4420: 20 20 20 20 20 20 28 63 75 72 72 2d 73 65 63 74 (curr-sect
4430: 69 6f 6e 20 23 66 29 20 20 20 0a 09 09 20 20 20 ion #f) ...
4440: 20 20 28 73 65 63 74 69 6f 6e 73 20 23 66 29 20 (sections #f)
4450: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 65 (se
4460: 74 74 69 6e 67 73 20 28 6d 61 6b 65 2d 68 61 73 ttings (make-has
4470: 68 2d 74 61 62 6c 65 29 29 20 28 6b 65 65 70 2d h-table)) (keep-
4480: 66 69 6c 65 6e 61 6d 65 73 20 23 66 29 0a 09 09 filenames #f)...
4490: 20 20 20 20 20 28 70 6f 73 74 2d 73 65 63 74 69 (post-secti
44a0: 6f 6e 2d 70 72 6f 63 73 20 27 28 29 29 20 20 20 on-procs '())
44b0: 28 61 70 70 6c 79 2d 77 69 6c 64 20 23 74 29 20 (apply-wild #t)
44c0: 29 0a 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 ). (debug:print
44d0: 20 39 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 9 *default-log-
44e0: 70 6f 72 74 2a 20 22 53 54 41 52 54 3a 20 22 20 port* "START: "
44f0: 70 61 74 68 29 0a 3b 3b 20 28 69 66 20 2a 63 6f path).;; (if *co
4500: 6e 66 69 67 64 61 74 2a 0a 3b 3b 20 20 20 20 20 nfigdat*.;;
4510: 28 63 6f 6d 6d 6f 6e 3a 73 61 76 65 2d 70 6b 74 (common:save-pkt
4520: 20 60 28 28 61 63 74 69 6f 6e 20 2e 20 72 65 61 `((action . rea
4530: 64 2d 63 6f 6e 66 69 67 29 0a 3b 3b 20 20 20 20 d-config).;;
4540: 20 20 20 09 09 20 28 66 20 20 20 20 20 20 2e 20 .. (f .
4550: 2c 28 63 6f 6e 64 20 28 28 73 74 72 69 6e 67 3f ,(cond ((string?
4560: 20 70 61 74 68 29 20 70 61 74 68 29 0a 3b 3b 20 path) path).;;
4570: 20 20 20 20 20 20 09 09 09 09 20 20 28 28 70 6f .... ((po
4580: 72 74 3f 20 20 20 70 61 74 68 29 20 22 70 6f 72 rt? path) "por
4590: 74 22 29 0a 3b 3b 20 20 20 20 20 20 20 09 09 09 t").;; ...
45a0: 09 20 20 28 65 6c 73 65 20 28 63 6f 6e 63 20 70 . (else (conc p
45b0: 61 74 68 29 29 29 29 0a 3b 3b 20 20 20 20 20 20 ath)))).;;
45c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
45d0: 20 20 28 54 20 20 20 20 20 20 2e 20 63 6f 6e 66 (T . conf
45e0: 69 67 66 29 29 0a 3b 3b 20 20 20 20 20 20 20 09 igf)).;; .
45f0: 20 20 20 20 20 20 20 2a 63 6f 6e 66 69 67 64 61 *configda
4600: 74 2a 20 23 74 20 61 64 64 2d 6f 6e 6c 79 3a 20 t* #t add-only:
4610: 23 74 29 29 0a 20 20 28 69 66 20 28 61 6e 64 20 #t)). (if (and
4620: 28 6e 6f 74 20 28 70 6f 72 74 3f 20 70 61 74 68 (not (port? path
4630: 29 29 0a 09 20 20 20 28 6e 6f 74 20 28 73 61 66 )).. (not (saf
4640: 65 2d 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 70 e-file-exists? p
4650: 61 74 68 29 29 29 20 3b 3b 20 66 6f 72 20 63 61 ath))) ;; for ca
4660: 73 65 20 77 68 65 72 65 20 77 65 20 61 72 65 20 se where we are
4670: 68 61 6e 64 65 64 20 61 20 70 6f 72 74 0a 20 20 handed a port.
4680: 20 20 20 20 28 62 65 67 69 6e 20 0a 09 28 64 65 (begin ..(de
4690: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 bug:print-info 1
46a0: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
46b0: 72 74 2a 20 22 72 65 61 64 2d 63 6f 6e 66 69 67 rt* "read-config
46c0: 20 2d 20 66 69 6c 65 20 6e 6f 74 20 66 6f 75 6e - file not foun
46d0: 64 20 22 20 70 61 74 68 20 22 20 63 75 72 72 65 d " path " curre
46e0: 6e 74 20 70 61 74 68 3a 20 22 20 28 63 75 72 72 nt path: " (curr
46f0: 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 29 0a ent-directory)).
4700: 09 3b 3b 20 57 41 52 4e 49 4e 47 3a 20 54 68 69 .;; WARNING: Thi
4710: 73 20 69 73 20 61 20 72 69 73 6b 79 20 63 68 61 s is a risky cha
4720: 6e 67 65 20 62 75 74 20 72 65 61 6c 6c 79 2c 20 nge but really,
4730: 77 65 20 73 68 6f 75 6c 64 20 6e 6f 74 20 72 65 we should not re
4740: 74 75 72 6e 20 61 6e 20 65 6d 70 74 79 20 68 61 turn an empty ha
4750: 73 68 20 74 61 62 6c 65 20 69 66 20 6e 6f 20 66 sh table if no f
4760: 69 6c 65 20 72 65 61 64 3f 0a 09 23 66 29 20 3b ile read?..#f) ;
4770: 3b 20 28 69 66 20 28 6e 6f 74 20 68 74 29 28 6d ; (if (not ht)(m
4780: 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 20 ake-hash-table)
4790: 68 74 29 29 0a 20 20 20 20 20 20 28 6c 65 74 20 ht)). (let
47a0: 28 28 69 6e 70 20 20 20 20 20 20 20 20 28 69 66 ((inp (if
47b0: 20 28 73 74 72 69 6e 67 3f 20 70 61 74 68 29 0a (string? path).
47c0: 09 09 09 20 20 20 20 28 6f 70 65 6e 2d 69 6e 70 ... (open-inp
47d0: 75 74 2d 66 69 6c 65 20 70 61 74 68 29 0a 09 09 ut-file path)...
47e0: 09 20 20 20 20 20 20 70 61 74 68 29 29 20 3b 3b . path)) ;;
47f0: 20 77 65 20 63 61 6e 20 62 65 20 68 61 6e 64 65 we can be hande
4800: 64 20 61 20 70 6f 72 74 0a 09 20 20 20 20 28 72 d a port.. (r
4810: 65 73 20 20 20 20 20 20 20 20 28 69 66 20 28 6e es (if (n
4820: 6f 74 20 68 74 29 28 6d 61 6b 65 2d 68 61 73 68 ot ht)(make-hash
4830: 2d 74 61 62 6c 65 29 20 68 74 29 29 0a 09 20 20 -table) ht))..
4840: 20 20 28 6d 65 74 61 70 61 74 68 20 20 20 28 69 (metapath (i
4850: 66 20 6b 65 65 70 2d 66 69 6c 65 6e 61 6d 65 73 f keep-filenames
4860: 0a 09 09 09 20 20 20 20 70 61 74 68 20 23 66 29 .... path #f)
4870: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 70 ). (p
4880: 72 6f 63 65 73 73 2d 77 69 6c 64 63 61 72 64 73 rocess-wildcards
4890: 20 20 28 6c 61 6d 62 64 61 20 28 72 65 73 20 63 (lambda (res c
48a0: 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 urr-section-name
48b0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
48c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
48d0: 20 20 20 20 28 69 66 20 28 61 6e 64 20 61 70 70 (if (and app
48e0: 6c 79 2d 77 69 6c 64 0a 20 20 20 20 20 20 20 20 ly-wild.
48f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4900: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4910: 20 20 20 28 6f 72 20 28 73 74 72 69 6e 67 2d 63 (or (string-c
4920: 6f 6e 74 61 69 6e 73 20 63 75 72 72 2d 73 65 63 ontains curr-sec
4930: 74 69 6f 6e 2d 6e 61 6d 65 20 22 25 22 29 20 20 tion-name "%")
4940: 20 3b 3b 20 77 69 6c 64 63 61 72 64 0a 20 20 20 ;; wildcard.
4950: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4960: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4970: 20 20 20 20 20 20 20 20 20 20 20 20 28 73 74 72 (str
4980: 69 6e 67 2d 6d 61 74 63 68 20 22 2f 2e 2a 2f 22 ing-match "/.*/"
4990: 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 curr-section-na
49a0: 6d 65 29 29 29 20 3b 3b 20 72 65 67 65 78 0a 20 me))) ;; regex.
49b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
49c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
49d0: 20 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 (begin.
49e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
49f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4a00: 20 20 20 20 28 61 70 70 6c 79 2d 77 69 6c 64 63 (apply-wildc
4a10: 61 72 64 73 20 72 65 73 20 63 75 72 72 2d 73 65 ards res curr-se
4a20: 63 74 69 6f 6e 2d 6e 61 6d 65 29 0a 20 20 20 20 ction-name).
4a30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4a40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4a50: 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (hash-table-
4a60: 64 65 6c 65 74 65 21 20 72 65 73 20 63 75 72 72 delete! res curr
4a70: 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 29 29 29 -section-name)))
4a80: 29 29 29 20 20 3b 3b 20 4e 4f 54 45 3a 20 69 66 ))) ;; NOTE: if
4a90: 20 74 68 65 20 73 65 63 74 69 6f 6e 20 69 73 20 the section is
4aa0: 61 20 77 69 6c 64 20 63 61 72 64 20 69 74 20 77 a wild card it w
4ab0: 69 6c 6c 20 62 65 20 52 45 4d 4f 56 45 44 20 66 ill be REMOVED f
4ac0: 72 6f 6d 20 72 65 73 20 0a 09 28 6c 65 74 20 6c rom res ..(let l
4ad0: 6f 6f 70 20 28 28 69 6e 6c 20 20 20 20 20 20 20 oop ((inl
4ae0: 20 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 66 (configf
4af0: 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 20 72 :read-line inp r
4b00: 65 73 20 28 63 61 6c 63 2d 61 6c 6c 6f 77 2d 73 es (calc-allow-s
4b10: 79 73 74 65 6d 20 61 6c 6c 6f 77 2d 73 79 73 74 ystem allow-syst
4b20: 65 6d 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 20 em curr-section
4b30: 73 65 63 74 69 6f 6e 73 29 20 73 65 74 74 69 6e sections) settin
4b40: 67 73 29 29 20 3b 3b 20 28 72 65 61 64 2d 6c 69 gs)) ;; (read-li
4b50: 6e 65 20 69 6e 70 29 29 0a 09 09 20 20 20 28 63 ne inp))... (c
4b60: 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 urr-section-name
4b70: 20 28 69 66 20 63 75 72 72 2d 73 65 63 74 69 6f (if curr-sectio
4b80: 6e 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 20 22 n curr-section "
4b90: 64 65 66 61 75 6c 74 22 29 29 0a 09 09 20 20 20 default"))...
4ba0: 28 76 61 72 2d 66 6c 61 67 20 23 66 29 3b 3b 20 (var-flag #f);;
4bb0: 74 75 72 6e 20 6f 6e 20 66 6f 72 20 6b 65 79 2d turn on for key-
4bc0: 76 61 72 2d 70 72 20 61 6e 64 20 63 6f 6e 74 2d var-pr and cont-
4bd0: 6c 6e 2d 72 78 2c 20 74 75 72 6e 20 6f 66 66 20 ln-rx, turn off
4be0: 65 6c 73 65 77 68 65 72 65 0a 09 09 20 20 20 28 elsewhere... (
4bf0: 6c 65 61 64 20 20 20 20 20 23 66 29 29 0a 09 20 lead #f))..
4c00: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
4c10: 66 6f 20 38 20 2a 64 65 66 61 75 6c 74 2d 6c 6f fo 8 *default-lo
4c20: 67 2d 70 6f 72 74 2a 20 22 63 75 72 72 2d 73 65 g-port* "curr-se
4c30: 63 74 69 6f 6e 2d 6e 61 6d 65 3a 20 22 20 63 75 ction-name: " cu
4c40: 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 rr-section-name
4c50: 22 20 76 61 72 2d 66 6c 61 67 3a 20 22 20 76 61 " var-flag: " va
4c60: 72 2d 66 6c 61 67 20 22 5c 6e 20 20 20 69 6e 6c r-flag "\n inl
4c70: 3a 20 5c 22 22 20 69 6e 6c 20 22 5c 22 22 29 0a : \"" inl "\"").
4c80: 09 20 20 28 69 66 20 28 65 6f 66 2d 6f 62 6a 65 . (if (eof-obje
4c90: 63 74 3f 20 69 6e 6c 29 20 0a 09 20 20 20 20 20 ct? inl) ..
4ca0: 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 (begin.
4cb0: 20 20 20 20 20 20 20 20 3b 3b 20 70 72 6f 63 65 ;; proce
4cc0: 73 73 20 6c 61 73 74 20 73 65 63 74 69 6f 6e 20 ss last section
4cd0: 66 6f 72 20 77 69 6c 64 63 61 72 64 73 0a 20 20 for wildcards.
4ce0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 70 (p
4cf0: 72 6f 63 65 73 73 2d 77 69 6c 64 63 61 72 64 73 rocess-wildcards
4d00: 20 72 65 73 20 63 75 72 72 2d 73 65 63 74 69 6f res curr-sectio
4d10: 6e 2d 6e 61 6d 65 29 0a 09 09 28 69 66 20 28 73 n-name)...(if (s
4d20: 74 72 69 6e 67 3f 20 70 61 74 68 29 20 3b 3b 20 tring? path) ;;
4d30: 77 65 20 72 65 63 65 69 76 65 64 20 61 20 70 61 we received a pa
4d40: 74 68 2c 20 6e 6f 74 20 61 20 70 6f 72 74 2c 20 th, not a port,
4d50: 74 68 75 73 20 77 65 20 61 72 65 20 72 65 73 70 thus we are resp
4d60: 6f 6e 73 69 62 6c 65 20 66 6f 72 20 63 6c 6f 73 onsible for clos
4d70: 69 6e 67 20 69 74 2e 0a 09 09 20 20 20 20 28 63 ing it.... (c
4d80: 6c 6f 73 65 2d 69 6e 70 75 74 2d 70 6f 72 74 20 lose-input-port
4d90: 69 6e 70 29 29 0a 09 09 28 69 66 20 28 6c 69 73 inp))...(if (lis
4da0: 74 3f 20 73 65 63 74 69 6f 6e 73 29 20 3b 3b 20 t? sections) ;;
4db0: 64 65 6c 65 74 65 20 61 6c 6c 20 73 65 63 74 69 delete all secti
4dc0: 6f 6e 73 20 65 78 63 65 70 74 20 67 69 76 65 6e ons except given
4dd0: 20 77 68 65 6e 20 73 65 63 74 69 6f 6e 73 20 69 when sections i
4de0: 73 20 70 72 6f 76 69 64 65 64 0a 09 09 20 20 20 s provided...
4df0: 20 28 66 6f 72 2d 65 61 63 68 0a 09 09 20 20 20 (for-each...
4e00: 20 20 28 6c 61 6d 62 64 61 20 28 73 65 63 74 69 (lambda (secti
4e10: 6f 6e 29 0a 09 09 20 20 20 20 20 20 20 28 69 66 on)... (if
4e20: 20 28 6e 6f 74 20 28 6d 65 6d 62 65 72 20 73 65 (not (member se
4e30: 63 74 69 6f 6e 20 73 65 63 74 69 6f 6e 73 29 29 ction sections))
4e40: 0a 09 09 09 20 20 20 28 68 61 73 68 2d 74 61 62 .... (hash-tab
4e50: 6c 65 2d 64 65 6c 65 74 65 21 20 72 65 73 20 73 le-delete! res s
4e60: 65 63 74 69 6f 6e 29 29 29 20 3b 3b 20 77 65 20 ection))) ;; we
4e70: 61 72 65 20 75 73 69 6e 67 20 22 22 20 61 73 20 are using "" as
4e80: 61 20 64 75 6d 70 69 6e 67 20 67 72 6f 75 6e 64 a dumping ground
4e90: 20 61 6e 64 20 6d 75 73 74 20 72 65 6d 6f 76 65 and must remove
4ea0: 20 69 74 20 62 65 66 6f 72 65 20 72 65 74 75 72 it before retur
4eb0: 6e 69 6e 67 20 74 68 65 20 68 74 0a 09 09 20 20 ning the ht...
4ec0: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b (hash-table-k
4ed0: 65 79 73 20 72 65 73 29 29 29 0a 09 09 28 64 65 eys res)))...(de
4ee0: 62 75 67 3a 70 72 69 6e 74 20 39 20 2a 64 65 66 bug:print 9 *def
4ef0: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
4f00: 45 4e 44 3a 20 22 20 70 61 74 68 29 0a 20 20 20 END: " path).
4f10: 20 20 20 20 20 20 20 20 20 20 20 20 20 72 65 73 res
4f20: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4f30: 20 29 20 3b 3b 20 72 65 74 76 61 6c 0a 09 20 20 ) ;; retval..
4f40: 20 20 20 20 28 72 65 67 65 78 2d 63 61 73 65 20 (regex-case
4f50: 0a 09 20 20 20 20 20 20 20 69 6e 6c 20 0a 09 20 .. inl ..
4f60: 20 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 63 (configf:c
4f70: 6f 6d 6d 65 6e 74 2d 72 78 20 5f 20 20 20 20 20 omment-rx _
4f80: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 6f (lo
4f90: 6f 70 20 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 op (configf:read
4fa0: 2d 6c 69 6e 65 20 69 6e 70 20 72 65 73 20 28 63 -line inp res (c
4fb0: 61 6c 63 2d 61 6c 6c 6f 77 2d 73 79 73 74 65 6d alc-allow-system
4fc0: 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 63 75 allow-system cu
4fd0: 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 rr-section-name
4fe0: 73 65 63 74 69 6f 6e 73 29 20 73 65 74 74 69 6e sections) settin
4ff0: 67 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 gs).
5000: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5010: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5020: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5030: 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d curr-section-nam
5040: 65 20 23 66 20 23 66 29 29 0a 20 20 20 20 20 20 e #f #f)).
5050: 20 20 20 20 20 20 20 20 20 0a 09 20 20 20 20 20 ..
5060: 20 20 28 63 6f 6e 66 69 67 66 3a 62 6c 61 6e 6b (configf:blank
5070: 2d 6c 2d 72 78 20 5f 20 20 20 20 20 20 20 20 20 -l-rx _
5080: 20 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 (loop (
5090: 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d 6c 69 6e configf:read-lin
50a0: 65 20 69 6e 70 20 72 65 73 20 28 63 61 6c 63 2d e inp res (calc-
50b0: 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 61 6c 6c allow-system all
50c0: 6f 77 2d 73 79 73 74 65 6d 20 63 75 72 72 2d 73 ow-system curr-s
50d0: 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 73 65 63 74 ection-name sect
50e0: 69 6f 6e 73 29 20 73 65 74 74 69 6e 67 73 29 0a ions) settings).
50f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5100: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5110: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5120: 20 20 20 20 20 20 20 20 20 20 20 20 63 75 72 72 curr
5130: 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 -section-name #f
5140: 20 23 66 29 29 0a 09 20 20 20 20 20 20 20 28 63 #f)).. (c
5150: 6f 6e 66 69 67 66 3a 73 65 74 74 69 6e 67 73 20 onfigf:settings
5160: 20 20 28 20 78 20 73 65 74 74 69 6e 67 20 76 61 ( x setting va
5170: 6c 20 20 29 0a 20 20 20 20 20 20 20 20 20 20 20 l ).
5180: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5190: 20 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a 20 (begin.
51a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
51b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
51c0: 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (hash-table-
51d0: 73 65 74 21 20 73 65 74 74 69 6e 67 73 20 73 65 set! settings se
51e0: 74 74 69 6e 67 20 76 61 6c 29 0a 20 20 20 20 20 tting val).
51f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5200: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5210: 28 6c 6f 6f 70 20 28 63 6f 6e 66 69 67 66 3a 72 (loop (configf:r
5220: 65 61 64 2d 6c 69 6e 65 20 69 6e 70 20 72 65 73 ead-line inp res
5230: 20 28 63 61 6c 63 2d 61 6c 6c 6f 77 2d 73 79 73 (calc-allow-sys
5240: 74 65 6d 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d tem allow-system
5250: 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 curr-section-na
5260: 6d 65 20 73 65 63 74 69 6f 6e 73 29 20 73 65 74 me sections) set
5270: 74 69 6e 67 73 29 0a 20 20 20 20 20 20 20 20 20 tings).
5280: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5290: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
52a0: 20 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e curr-section-n
52b0: 61 6d 65 20 23 66 20 23 66 29 29 29 0a 20 20 20 ame #f #f))).
52c0: 20 20 20 20 20 20 20 20 20 20 20 20 0a 09 20 20 ..
52d0: 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 69 6e (configf:in
52e0: 63 6c 75 64 65 2d 72 78 20 28 20 78 20 69 6e 63 clude-rx ( x inc
52f0: 6c 75 64 65 2d 66 69 6c 65 20 29 0a 20 20 20 20 lude-file ).
5300: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5310: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
5320: 6c 65 74 2a 20 28 28 63 75 72 72 2d 63 6f 6e 66 let* ((curr-conf
5330: 2d 64 69 72 20 28 70 61 74 68 6e 61 6d 65 2d 64 -dir (pathname-d
5340: 69 72 65 63 74 6f 72 79 20 70 61 74 68 29 29 0a irectory path)).
5350: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5360: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5370: 20 20 20 20 20 20 20 20 20 20 28 66 75 6c 6c 2d (full-
5380: 63 6f 6e 66 20 20 20 20 20 28 69 66 20 28 61 62 conf (if (ab
5390: 73 6f 6c 75 74 65 2d 70 61 74 68 6e 61 6d 65 3f solute-pathname?
53a0: 20 69 6e 63 6c 75 64 65 2d 66 69 6c 65 29 0a 20 include-file).
53b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
53c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
53d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
53e0: 20 20 20 20 20 20 20 20 20 20 20 20 69 6e 63 6c incl
53f0: 75 64 65 2d 66 69 6c 65 0a 20 20 20 20 20 20 20 ude-file.
5400: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5410: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5420: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5430: 20 20 20 20 20 20 28 6e 69 63 65 2d 70 61 74 68 (nice-path
5440: 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
5450: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5460: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5470: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5480: 28 63 6f 6e 63 20 28 69 66 20 63 75 72 72 2d 63 (conc (if curr-c
5490: 6f 6e 66 2d 64 69 72 0a 20 20 20 20 20 20 20 20 onf-dir.
54a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
54b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
54c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
54d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
54e0: 63 75 72 72 2d 63 6f 6e 66 2d 64 69 72 0a 20 20 curr-conf-dir.
54f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5500: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5510: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5520: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5530: 20 20 20 20 20 20 22 2e 22 29 0a 20 20 20 20 20 ".").
5540: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5550: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5560: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5570: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 22 "
5580: 2f 22 20 69 6e 63 6c 75 64 65 2d 66 69 6c 65 29 /" include-file)
5590: 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 )))).
55a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
55b0: 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 73 (if (s
55c0: 61 66 65 2d 66 69 6c 65 2d 65 78 69 73 74 73 3f afe-file-exists?
55d0: 20 66 75 6c 6c 2d 63 6f 6e 66 29 0a 20 20 20 20 full-conf).
55e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
55f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5600: 20 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 (begin.
5610: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5620: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5630: 20 20 20 20 20 20 20 3b 3b 20 28 70 75 73 68 2d ;; (push-
5640: 64 69 72 65 63 74 6f 72 79 20 63 6f 6e 66 2d 64 directory conf-d
5650: 69 72 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ir).
5660: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5670: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
5680: 64 65 62 75 67 3a 70 72 69 6e 74 20 39 20 2a 64 debug:print 9 *d
5690: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
56a0: 20 22 49 6e 63 6c 75 64 69 6e 67 3a 20 22 20 66 "Including: " f
56b0: 75 6c 6c 2d 63 6f 6e 66 29 0a 20 20 20 20 20 20 ull-conf).
56c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
56d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
56e0: 20 20 20 20 20 28 72 65 61 64 2d 63 6f 6e 66 69 (read-confi
56f0: 67 20 66 75 6c 6c 2d 63 6f 6e 66 20 72 65 73 20 g full-conf res
5700: 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 65 6e 76 allow-system env
5710: 69 72 6f 6e 2d 70 61 74 74 3a 20 65 6e 76 69 72 iron-patt: envir
5720: 6f 6e 2d 70 61 74 74 0a 20 20 20 20 20 20 20 20 on-patt.
5730: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5740: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5750: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5760: 63 75 72 72 2d 73 65 63 74 69 6f 6e 3a 20 63 75 curr-section: cu
5770: 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 rr-section-name
5780: 73 65 63 74 69 6f 6e 73 3a 20 73 65 63 74 69 6f sections: sectio
5790: 6e 73 20 73 65 74 74 69 6e 67 73 3a 20 73 65 74 ns settings: set
57a0: 74 69 6e 67 73 0a 20 20 20 20 20 20 20 20 20 20 tings.
57b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
57c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
57d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6b 65 ke
57e0: 65 70 2d 66 69 6c 65 6e 61 6d 65 73 3a 20 6b 65 ep-filenames: ke
57f0: 65 70 2d 66 69 6c 65 6e 61 6d 65 73 29 0a 20 20 ep-filenames).
5800: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5810: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5820: 20 20 20 20 20 20 20 20 20 3b 3b 20 28 70 6f 70 ;; (pop
5830: 2d 64 69 72 65 63 74 6f 72 79 29 0a 20 20 20 20 -directory).
5840: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5850: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5860: 20 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 6f (loop (co
5870: 6e 66 69 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 nfigf:read-line
5880: 69 6e 70 20 72 65 73 20 28 63 61 6c 63 2d 61 6c inp res (calc-al
5890: 6c 6f 77 2d 73 79 73 74 65 6d 20 61 6c 6c 6f 77 low-system allow
58a0: 2d 73 79 73 74 65 6d 20 63 75 72 72 2d 73 65 63 -system curr-sec
58b0: 74 69 6f 6e 2d 6e 61 6d 65 20 73 65 63 74 69 6f tion-name sectio
58c0: 6e 73 29 20 73 65 74 74 69 6e 67 73 29 20 63 75 ns) settings) cu
58d0: 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 rr-section-name
58e0: 23 66 20 23 66 29 29 0a 20 20 20 20 20 20 20 20 #f #f)).
58f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5900: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5910: 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 (begin.
5920: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5930: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5940: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
5950: 27 28 32 20 39 29 20 23 66 20 22 49 4e 46 4f 3a '(2 9) #f "INFO:
5960: 20 69 6e 63 6c 75 64 65 20 66 69 6c 65 20 22 20 include file "
5970: 69 6e 63 6c 75 64 65 2d 66 69 6c 65 20 22 20 6e include-file " n
5980: 6f 74 20 66 6f 75 6e 64 20 28 63 61 6c 6c 65 64 ot found (called
5990: 20 66 72 6f 6d 20 22 20 70 61 74 68 20 22 29 22 from " path ")"
59a0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
59b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
59c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 64 65 (de
59d0: 62 75 67 3a 70 72 69 6e 74 20 32 20 2a 64 65 66 bug:print 2 *def
59e0: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
59f0: 20 20 20 20 20 20 20 20 22 20 66 75 6c 6c 2d 63 " full-c
5a00: 6f 6e 66 29 0a 09 09 09 09 09 09 09 20 20 20 20 onf)........
5a10: 20 20 28 6c 6f 6f 70 20 28 63 6f 6e 66 69 67 66 (loop (configf
5a20: 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 20 72 :read-line inp r
5a30: 65 73 20 28 63 61 6c 63 2d 61 6c 6c 6f 77 2d 73 es (calc-allow-s
5a40: 79 73 74 65 6d 20 61 6c 6c 6f 77 2d 73 79 73 74 ystem allow-syst
5a50: 65 6d 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d em curr-section-
5a60: 6e 61 6d 65 20 73 65 63 74 69 6f 6e 73 29 20 73 name sections) s
5a70: 65 74 74 69 6e 67 73 29 0a 20 20 20 20 20 20 20 ettings).
5a80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5a90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5aa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5ab0: 20 20 20 20 20 20 20 20 20 20 20 20 20 63 75 72 cur
5ac0: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 r-section-name #
5ad0: 66 20 23 66 29 29 29 29 29 0a 09 20 20 20 20 20 f #f)))))..
5ae0: 20 20 28 63 6f 6e 66 69 67 66 3a 73 63 72 69 70 (configf:scrip
5af0: 74 2d 72 78 20 28 20 78 20 69 6e 63 6c 75 64 65 t-rx ( x include
5b00: 2d 73 63 72 69 70 74 20 70 61 72 61 6d 73 29 3b -script params);
5b10: 3b 20 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 ; handle-excepti
5b20: 6f 6e 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 ons.
5b30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5b40: 20 20 20 20 20 20 3b 3b 20 20 20 20 65 78 6e 0a ;; exn.
5b50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5b60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5b70: 20 20 3b 3b 20 20 20 20 28 62 65 67 69 6e 0a 20 ;; (begin.
5b80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5b90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5ba0: 20 3b 3b 20 20 20 20 20 20 28 64 65 62 75 67 3a ;; (debug:
5bb0: 70 72 69 6e 74 20 27 28 30 20 32 20 39 29 20 23 print '(0 2 9) #
5bc0: 66 20 22 49 4e 46 4f 3a 20 69 6e 63 6c 75 64 65 f "INFO: include
5bd0: 20 66 72 6f 6d 20 73 63 72 69 70 74 20 22 20 69 from script " i
5be0: 6e 63 6c 75 64 65 2d 73 63 72 69 70 74 20 22 20 nclude-script "
5bf0: 66 61 69 6c 65 64 2e 22 29 0a 20 20 20 20 20 20 failed.").
5c00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5c10: 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 20 ;;
5c20: 20 20 20 20 28 6c 6f 6f 70 20 28 63 6f 6e 66 69 (loop (confi
5c30: 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 gf:read-line inp
5c40: 20 72 65 73 20 28 63 61 6c 63 2d 61 6c 6c 6f 77 res (calc-allow
5c50: 2d 73 79 73 74 65 6d 20 61 6c 6c 6f 77 2d 73 79 -system allow-sy
5c60: 73 74 65 6d 20 63 75 72 72 2d 73 65 63 74 69 6f stem curr-sectio
5c70: 6e 2d 6e 61 6d 65 20 73 65 63 74 69 6f 6e 73 29 n-name sections)
5c80: 20 73 65 74 74 69 6e 67 73 29 20 63 75 72 72 2d settings) curr-
5c90: 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 section-name #f
5ca0: 23 66 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 #f)).
5cb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5cc0: 20 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 (if (and
5cd0: 28 73 61 66 65 2d 66 69 6c 65 2d 65 78 69 73 74 (safe-file-exist
5ce0: 73 3f 20 69 6e 63 6c 75 64 65 2d 73 63 72 69 70 s? include-scrip
5cf0: 74 29 28 66 69 6c 65 2d 65 78 65 63 75 74 65 2d t)(file-execute-
5d00: 61 63 63 65 73 73 3f 20 69 6e 63 6c 75 64 65 2d access? include-
5d10: 73 63 72 69 70 74 29 29 0a 20 20 20 20 20 20 20 script)).
5d20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5d30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
5d40: 6c 65 74 2a 20 28 28 6c 6f 63 61 6c 2d 61 6c 6c let* ((local-all
5d50: 6f 77 2d 73 79 73 74 65 6d 20 20 28 63 61 6c 63 ow-system (calc
5d60: 2d 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 61 6c -allow-system al
5d70: 6c 6f 77 2d 73 79 73 74 65 6d 20 63 75 72 72 2d low-system curr-
5d80: 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 73 65 63 section-name sec
5d90: 74 69 6f 6e 73 29 29 0a 20 20 20 20 20 20 20 20 tions)).
5da0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5db0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5dc0: 20 20 20 20 20 28 65 6e 76 2d 64 65 6c 74 61 20 (env-delta
5dd0: 20 28 63 66 67 64 61 74 2d 3e 65 6e 76 2d 61 6c (cfgdat->env-al
5de0: 69 73 74 20 63 75 72 72 2d 73 65 63 74 69 6f 6e ist curr-section
5df0: 2d 6e 61 6d 65 20 72 65 73 20 6c 6f 63 61 6c 2d -name res local-
5e00: 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 29 29 0a 20 allow-system)).
5e10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5e20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5e30: 20 20 20 20 20 20 20 20 20 20 20 20 28 6e 65 77 (new
5e40: 2d 69 6e 70 2d 70 6f 72 74 0a 20 20 20 20 20 20 -inp-port.
5e50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5e60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5e70: 20 20 20 20 20 20 20 20 28 77 69 74 68 2d 65 6e (with-en
5e80: 76 2d 76 61 72 73 0a 20 20 20 20 20 20 20 20 20 v-vars.
5e90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5ea0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5eb0: 20 20 20 20 20 20 65 6e 76 2d 64 65 6c 74 61 0a env-delta.
5ec0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5ed0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5ee0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
5ef0: 6c 61 6d 62 64 61 20 28 29 0a 20 20 20 20 20 20 lambda ().
5f00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5f10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5f20: 20 20 20 20 20 20 20 20 20 20 20 28 6f 70 65 6e (open
5f30: 2d 69 6e 70 75 74 2d 70 69 70 65 20 28 63 6f 6e -input-pipe (con
5f40: 63 20 69 6e 63 6c 75 64 65 2d 73 63 72 69 70 74 c include-script
5f50: 20 22 20 22 20 70 61 72 61 6d 73 29 29 29 29 29 " " params)))))
5f60: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
5f70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5f80: 20 20 20 20 20 20 20 20 20 20 28 64 65 62 75 67 (debug
5f90: 3a 70 72 69 6e 74 20 27 28 32 20 39 29 20 2a 64 :print '(2 9) *d
5fa0: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
5fb0: 20 22 49 6e 63 6c 75 64 69 6e 67 20 66 72 6f 6d "Including from
5fc0: 20 73 63 72 69 70 74 20 6f 75 74 70 75 74 3a 20 script output:
5fd0: 22 20 69 6e 63 6c 75 64 65 2d 73 63 72 69 70 74 " include-script
5fe0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
5ff0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6000: 20 20 20 20 20 20 20 20 20 20 3b 3b 20 20 28 70 ;; (p
6010: 72 69 6e 74 20 22 57 65 20 67 6f 74 20 68 65 72 rint "We got her
6020: 65 2c 20 63 61 6c 6c 69 6e 67 20 72 65 61 64 2d e, calling read-
6030: 63 6f 6e 66 69 67 20 6e 65 78 74 2e 20 50 6f 72 config next. Por
6040: 74 20 69 73 3a 20 22 20 6e 65 77 2d 69 6e 70 2d t is: " new-inp-
6050: 70 6f 72 74 29 0a 20 20 20 20 20 20 20 20 20 20 port).
6060: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6070: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 72 (r
6080: 65 61 64 2d 63 6f 6e 66 69 67 20 6e 65 77 2d 69 ead-config new-i
6090: 6e 70 2d 70 6f 72 74 20 72 65 73 20 61 6c 6c 6f np-port res allo
60a0: 77 2d 73 79 73 74 65 6d 20 65 6e 76 69 72 6f 6e w-system environ
60b0: 2d 70 61 74 74 3a 20 65 6e 76 69 72 6f 6e 2d 70 -patt: environ-p
60c0: 61 74 74 20 63 75 72 72 2d 73 65 63 74 69 6f 6e att curr-section
60d0: 3a 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e : curr-section-n
60e0: 61 6d 65 20 73 65 63 74 69 6f 6e 73 3a 20 73 65 ame sections: se
60f0: 63 74 69 6f 6e 73 20 73 65 74 74 69 6e 67 73 3a ctions settings:
6100: 20 73 65 74 74 69 6e 67 73 20 6b 65 65 70 2d 66 settings keep-f
6110: 69 6c 65 6e 61 6d 65 73 3a 20 6b 65 65 70 2d 66 ilenames: keep-f
6120: 69 6c 65 6e 61 6d 65 73 29 0a 20 20 20 20 20 20 ilenames).
6130: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6140: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6150: 20 20 28 63 6c 6f 73 65 2d 69 6e 70 75 74 2d 70 (close-input-p
6160: 6f 72 74 20 6e 65 77 2d 69 6e 70 2d 70 6f 72 74 ort new-inp-port
6170: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
6180: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6190: 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 20 (loop
61a0: 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d 6c 69 (configf:read-li
61b0: 6e 65 20 69 6e 70 20 72 65 73 20 28 63 61 6c 63 ne inp res (calc
61c0: 2d 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 61 6c -allow-system al
61d0: 6c 6f 77 2d 73 79 73 74 65 6d 20 63 75 72 72 2d low-system curr-
61e0: 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 73 65 63 section-name sec
61f0: 74 69 6f 6e 73 29 20 73 65 74 74 69 6e 67 73 29 tions) settings)
6200: 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 curr-section-na
6210: 6d 65 20 23 66 20 23 66 29 29 0a 20 20 20 20 20 me #f #f)).
6220: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6230: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6240: 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 (begin.
6250: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6260: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6270: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a (debug:print 0 *
6280: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
6290: 2a 20 22 53 63 72 69 70 74 20 6e 6f 74 20 66 6f * "Script not fo
62a0: 75 6e 64 20 6f 72 20 6e 6f 74 20 65 78 65 63 74 und or not exect
62b0: 75 74 61 62 6c 65 3a 20 22 20 69 6e 63 6c 75 64 utable: " includ
62c0: 65 2d 73 63 72 69 70 74 29 0a 20 20 20 20 20 20 e-script).
62d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
62e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
62f0: 20 20 28 6c 6f 6f 70 20 28 63 6f 6e 66 69 67 66 (loop (configf
6300: 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 20 72 :read-line inp r
6310: 65 73 20 28 63 61 6c 63 2d 61 6c 6c 6f 77 2d 73 es (calc-allow-s
6320: 79 73 74 65 6d 20 61 6c 6c 6f 77 2d 73 79 73 74 ystem allow-syst
6330: 65 6d 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d em curr-section-
6340: 6e 61 6d 65 20 73 65 63 74 69 6f 6e 73 29 20 73 name sections) s
6350: 65 74 74 69 6e 67 73 29 20 63 75 72 72 2d 73 65 ettings) curr-se
6360: 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 66 ction-name #f #f
6370: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
6380: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6390: 20 20 20 20 20 20 29 20 3b 3b 20 29 0a 09 20 20 ) ;; )..
63a0: 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 73 65 (configf:se
63b0: 63 74 69 6f 6e 2d 72 78 20 28 20 78 20 73 65 63 ction-rx ( x sec
63c0: 74 69 6f 6e 2d 6e 61 6d 65 20 29 0a 20 20 20 20 tion-name ).
63d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
63e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
63f0: 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 20 20 begin.
6400: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6410: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 63 61 ;; ca
6420: 6c 6c 20 70 6f 73 74 2d 73 65 63 74 69 6f 6e 2d ll post-section-
6430: 70 72 6f 63 73 0a 20 20 20 20 20 20 20 20 20 20 procs.
6440: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6450: 20 20 20 20 20 20 20 20 20 20 20 28 66 6f 72 2d (for-
6460: 65 61 63 68 20 0a 20 20 20 20 20 20 20 20 20 20 each .
6470: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6480: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d (lam
6490: 62 64 61 20 28 64 61 74 29 0a 20 20 20 20 20 20 bda (dat).
64a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
64b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
64c0: 20 20 28 6c 65 74 20 28 28 70 61 74 74 20 28 63 (let ((patt (c
64d0: 61 72 20 64 61 74 29 29 0a 20 20 20 20 20 20 20 ar dat)).
64e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
64f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6500: 20 20 20 20 20 20 20 28 70 72 6f 63 20 28 63 64 (proc (cd
6510: 72 20 64 61 74 29 29 29 0a 20 20 20 20 20 20 20 r dat))).
6520: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6530: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6540: 20 20 20 28 69 66 20 28 73 74 72 69 6e 67 2d 6d (if (string-m
6550: 61 74 63 68 20 70 61 74 74 20 63 75 72 72 2d 73 atch patt curr-s
6560: 65 63 74 69 6f 6e 2d 6e 61 6d 65 29 0a 20 20 20 ection-name).
6570: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6580: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6590: 20 20 20 20 20 20 20 20 20 20 20 28 70 72 6f 63 (proc
65a0: 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 curr-section-na
65b0: 6d 65 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 me section-name
65c0: 72 65 73 20 70 61 74 68 29 29 29 29 0a 20 20 20 res path)))).
65d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
65e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
65f0: 20 20 20 70 6f 73 74 2d 73 65 63 74 69 6f 6e 2d post-section-
6600: 70 72 6f 63 73 29 0a 20 20 20 20 20 20 20 20 20 procs).
6610: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6620: 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 61 ;; a
6630: 66 74 65 72 20 67 61 74 68 65 72 69 6e 67 20 74 fter gathering t
6640: 68 65 20 76 61 72 73 20 66 6f 72 20 61 20 73 65 he vars for a se
6650: 63 74 69 6f 6e 20 61 6e 64 20 69 66 20 61 70 70 ction and if app
6660: 6c 79 2d 77 69 6c 64 63 61 72 64 73 20 69 73 20 ly-wildcards is
6670: 74 72 75 65 20 61 6e 64 20 69 66 20 74 68 65 72 true and if ther
6680: 65 20 69 73 20 61 20 77 69 6c 64 63 61 72 64 20 e is a wildcard
6690: 69 6e 20 74 68 65 20 73 65 63 74 69 6f 6e 20 6e in the section n
66a0: 61 6d 65 20 70 72 6f 63 65 73 73 20 77 69 6c 64 ame process wild
66b0: 63 61 72 64 73 0a 20 20 20 20 20 20 20 20 20 20 cards.
66c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
66d0: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 4e 4f ;; NO
66e0: 54 45 3a 20 77 65 20 61 72 65 20 70 72 6f 63 65 TE: we are proce
66f0: 73 73 69 6e 67 20 74 68 65 20 63 75 72 72 2d 73 ssing the curr-s
6700: 65 63 74 69 6f 6e 2d 6e 61 6d 65 2c 20 4e 4f 54 ection-name, NOT
6710: 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 2e 0a 20 section-name..
6720: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6730: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6740: 20 20 20 20 28 70 72 6f 63 65 73 73 2d 77 69 6c (process-wil
6750: 64 63 61 72 64 73 20 72 65 73 20 63 75 72 72 2d dcards res curr-
6760: 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 29 0a 20 20 section-name).
6770: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6780: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6790: 20 20 20 28 69 66 20 28 6e 6f 74 20 28 68 61 73 (if (not (has
67a0: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
67b0: 75 6c 74 20 72 65 73 20 73 65 63 74 69 6f 6e 2d ult res section-
67c0: 6e 61 6d 65 20 23 66 29 29 28 68 61 73 68 2d 74 name #f))(hash-t
67d0: 61 62 6c 65 2d 73 65 74 21 20 72 65 73 20 73 65 able-set! res se
67e0: 63 74 69 6f 6e 2d 6e 61 6d 65 20 27 28 29 29 29 ction-name '()))
67f0: 20 3b 3b 20 65 6e 73 75 72 65 20 74 68 61 74 20 ;; ensure that
6800: 6d 65 72 65 20 6d 65 6e 74 69 6f 6e 20 6f 66 20 mere mention of
6810: 61 20 73 65 63 74 69 6f 6e 20 69 73 20 6e 6f 74 a section is not
6820: 20 6c 6f 73 74 0a 20 20 20 20 20 20 20 20 20 20 lost.
6830: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6840: 20 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 (loop
6850: 20 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d 6c (configf:read-l
6860: 69 6e 65 20 69 6e 70 20 72 65 73 20 28 63 61 6c ine inp res (cal
6870: 63 2d 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 61 c-allow-system a
6880: 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 63 75 72 72 llow-system curr
6890: 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 73 65 -section-name se
68a0: 63 74 69 6f 6e 73 29 20 73 65 74 74 69 6e 67 73 ctions) settings
68b0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
68c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
68d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 ;;
68e0: 69 66 20 77 65 20 68 61 76 65 20 74 68 65 20 73 if we have the s
68f0: 65 63 74 69 6f 6e 73 20 6c 69 73 74 20 74 68 65 ections list the
6900: 6e 20 66 6f 72 63 65 20 61 6c 6c 20 73 65 74 74 n force all sett
6910: 69 6e 67 73 20 69 6e 74 6f 20 22 22 20 61 6e 64 ings into "" and
6920: 20 64 65 6c 65 74 65 20 69 74 20 6c 61 74 65 72 delete it later
6930: 3f 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ?.
6940: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6950: 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 ;;
6960: 28 69 66 20 28 6f 72 20 28 6e 6f 74 20 73 65 63 (if (or (not sec
6970: 74 69 6f 6e 73 29 20 0a 20 20 20 20 20 20 20 20 tions) .
6980: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6990: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
69a0: 20 20 20 3b 3b 09 20 20 20 20 20 20 28 6d 65 6d ;;. (mem
69b0: 62 65 72 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 ber section-name
69c0: 20 73 65 63 74 69 6f 6e 73 29 29 0a 20 20 20 20 sections)).
69d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
69e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
69f0: 20 20 20 20 20 20 20 3b 3b 09 20 20 73 65 63 74 ;;. sect
6a00: 69 6f 6e 2d 6e 61 6d 65 20 22 22 29 20 3b 3b 20 ion-name "") ;;
6a10: 73 74 69 63 6b 20 65 76 65 72 79 74 68 69 6e 67 stick everything
6a20: 20 69 6e 74 6f 20 22 22 2e 20 4e 4f 50 45 3a 20 into "". NOPE:
6a30: 57 65 20 6e 65 65 64 20 6e 65 77 20 73 74 72 61 We need new stra
6a40: 74 65 67 79 2e 20 50 75 74 20 73 74 75 66 66 20 tegy. Put stuff
6a50: 69 6e 20 63 6f 72 72 65 63 74 20 73 65 63 74 69 in correct secti
6a60: 6f 6e 73 20 61 6e 64 20 74 68 65 6e 20 64 65 6c ons and then del
6a70: 65 74 65 20 61 6c 6c 20 73 65 63 74 69 6f 6e 73 ete all sections
6a80: 20 6c 61 74 65 72 2e 0a 20 20 20 20 20 20 20 20 later..
6a90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6aa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6ab0: 20 20 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 0a section-name.
6ac0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6ad0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6ae0: 20 20 20 20 20 20 20 20 20 20 20 23 66 20 23 66 #f #f
6af0: 29 29 29 0a 09 20 20 20 20 20 20 20 28 63 6f 6e ))).. (con
6b00: 66 69 67 66 3a 6b 65 79 2d 73 79 73 2d 70 72 20 figf:key-sys-pr
6b10: 28 20 78 20 6b 65 79 20 63 6d 64 20 20 20 20 20 ( x key cmd
6b20: 20 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
6b30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6b40: 20 20 20 20 20 20 28 69 66 20 28 63 61 6c 63 2d (if (calc-
6b50: 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 61 6c 6c allow-system all
6b60: 6f 77 2d 73 79 73 74 65 6d 20 63 75 72 72 2d 73 ow-system curr-s
6b70: 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 73 65 63 74 ection-name sect
6b80: 69 6f 6e 73 29 0a 20 20 20 20 20 20 20 20 20 20 ions).
6b90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6ba0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 (le
6bb0: 74 20 28 28 61 6c 69 73 74 20 20 20 20 28 68 61 t ((alist (ha
6bc0: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def
6bd0: 61 75 6c 74 20 72 65 73 20 63 75 72 72 2d 73 65 ault res curr-se
6be0: 63 74 69 6f 6e 2d 6e 61 6d 65 20 27 28 29 29 29 ction-name '()))
6bf0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
6c00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6c10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 76 (v
6c20: 61 6c 2d 70 72 6f 63 20 28 6c 61 6d 62 64 61 20 al-proc (lambda
6c30: 28 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ().
6c40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6c50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6c60: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 (let
6c70: 2a 20 28 28 73 74 61 72 74 2d 74 69 6d 65 20 28 * ((start-time (
6c80: 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 current-seconds)
6c90: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
6ca0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6cb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6cc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6cd0: 20 20 28 6c 6f 63 61 6c 2d 61 6c 6c 6f 77 2d 73 (local-allow-s
6ce0: 79 73 74 65 6d 20 20 28 63 61 6c 63 2d 61 6c 6c ystem (calc-all
6cf0: 6f 77 2d 73 79 73 74 65 6d 20 61 6c 6c 6f 77 2d ow-system allow-
6d00: 73 79 73 74 65 6d 20 63 75 72 72 2d 73 65 63 74 system curr-sect
6d10: 69 6f 6e 2d 6e 61 6d 65 20 73 65 63 74 69 6f 6e ion-name section
6d20: 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 s)).
6d30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6d40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6d50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6d60: 20 20 20 20 28 65 6e 76 2d 64 65 6c 74 61 20 20 (env-delta
6d70: 28 63 66 67 64 61 74 2d 3e 65 6e 76 2d 61 6c 69 (cfgdat->env-ali
6d80: 73 74 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d st curr-section-
6d90: 6e 61 6d 65 20 72 65 73 20 6c 6f 63 61 6c 2d 61 name res local-a
6da0: 6c 6c 6f 77 2d 73 79 73 74 65 6d 29 29 0a 20 20 llow-system)).
6db0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6dc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6dd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6de0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
6df0: 6d 64 72 65 73 20 20 20 20 20 28 63 6d 64 2d 72 mdres (cmd-r
6e00: 75 6e 2d 3e 6c 69 73 74 20 63 6d 64 20 64 65 6c un->list cmd del
6e10: 74 61 2d 65 6e 76 2d 61 6c 69 73 74 2d 6f 72 2d ta-env-alist-or-
6e20: 68 61 73 68 2d 74 61 62 6c 65 3a 20 65 6e 76 2d hash-table: env-
6e30: 64 65 6c 74 61 29 29 20 3b 3b 20 42 42 3a 20 68 delta)) ;; BB: h
6e40: 65 72 65 20 69 73 20 77 68 65 72 65 20 5b 73 79 ere is where [sy
6e50: 73 74 65 6d 20 69 73 20 65 78 65 63 27 64 2e 20 stem is exec'd.
6e60: 20 6e 65 65 64 73 20 74 6f 20 68 61 76 65 20 65 needs to have e
6e70: 6e 76 20 66 72 6f 6d 20 6f 74 68 65 72 20 76 61 nv from other va
6e80: 72 73 21 0a 20 20 20 20 20 20 20 20 20 20 20 20 rs!.
6e90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6ea0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6eb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6ec0: 20 20 20 20 28 64 65 6c 74 61 20 20 20 20 20 20 (delta
6ed0: 28 2d 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f (- (current-seco
6ee0: 6e 64 73 29 20 73 74 61 72 74 2d 74 69 6d 65 29 nds) start-time)
6ef0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
6f00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6f10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6f20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6f30: 20 20 28 73 74 61 74 75 73 20 20 20 20 20 28 63 (status (c
6f40: 61 64 72 20 63 6d 64 72 65 73 29 29 0a 20 20 20 adr cmdres)).
6f50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6f60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6f70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6f80: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 72 65 (re
6f90: 73 20 20 20 20 20 20 20 20 28 63 61 72 20 20 63 s (car c
6fa0: 6d 64 72 65 73 29 29 29 0a 20 20 20 20 20 20 20 mdres))).
6fb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6fc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6fd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6fe0: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
6ff0: 2d 69 6e 66 6f 20 34 20 2a 64 65 66 61 75 6c 74 -info 4 *default
7000: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 22 20 69 6e -log-port* "" in
7010: 6c 20 22 5c 6e 20 3d 3e 20 22 20 28 73 74 72 69 l "\n => " (stri
7020: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 72 ng-intersperse r
7030: 65 73 20 22 5c 6e 22 29 29 0a 20 20 20 20 20 20 es "\n")).
7040: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7050: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7060: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7070: 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 65 (if (not (e
7080: 71 3f 20 73 74 61 74 75 73 20 30 29 29 0a 20 20 q? status 0)).
7090: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
70a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
70b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
70c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 62 65 (be
70d0: 67 69 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 gin.
70e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
70f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7100: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7110: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
7120: 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 t-error 0 *defau
7130: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 70 72 lt-log-port* "pr
7140: 6f 62 6c 65 6d 20 77 69 74 68 20 22 20 69 6e 6c oblem with " inl
7150: 20 22 2c 20 72 65 74 75 72 6e 20 63 6f 64 65 20 ", return code
7160: 22 20 73 74 61 74 75 73 0a 20 20 20 20 20 20 20 " status.
7170: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7180: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7190: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
71a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
71b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 22 20 6f " o
71c0: 75 74 70 75 74 3a 20 22 20 63 6d 64 72 65 73 29 utput: " cmdres)
71d0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
71e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
71f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7200: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 (i
7210: 66 20 28 3e 20 64 65 6c 74 61 20 32 29 0a 20 20 f (> delta 2).
7220: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7230: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7240: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7250: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 64 65 (de
7260: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 bug:print-info 0
7270: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
7280: 72 74 2a 20 22 66 6f 72 20 6c 69 6e 65 20 5c 22 rt* "for line \"
7290: 22 20 69 6e 6c 20 22 5c 22 5c 6e 20 20 63 6f 6d " inl "\"\n com
72a0: 6d 61 6e 64 3a 20 22 20 63 6d 64 20 22 20 74 6f mand: " cmd " to
72b0: 6f 6b 20 22 20 64 65 6c 74 61 20 22 20 73 65 63 ok " delta " sec
72c0: 6f 6e 64 73 20 74 6f 20 72 75 6e 20 77 69 74 68 onds to run with
72d0: 20 6f 75 74 70 75 74 3a 5c 6e 20 20 20 22 20 72 output:\n " r
72e0: 65 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 es).
72f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7300: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7310: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7320: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d (debug:print-
7330: 69 6e 66 6f 20 39 20 2a 64 65 66 61 75 6c 74 2d info 9 *default-
7340: 6c 6f 67 2d 70 6f 72 74 2a 20 22 66 6f 72 20 6c log-port* "for l
7350: 69 6e 65 20 5c 22 22 20 69 6e 6c 20 22 5c 22 5c ine \"" inl "\"\
7360: 6e 20 20 63 6f 6d 6d 61 6e 64 3a 20 22 20 63 6d n command: " cm
7370: 64 20 22 20 74 6f 6f 6b 20 22 20 64 65 6c 74 61 d " took " delta
7380: 20 22 20 73 65 63 6f 6e 64 73 20 74 6f 20 72 75 " seconds to ru
7390: 6e 20 77 69 74 68 20 6f 75 74 70 75 74 3a 5c 6e n with output:\n
73a0: 20 20 20 22 20 72 65 73 29 29 0a 20 20 20 20 20 " res)).
73b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
73c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
73d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
73e0: 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f (if (null?
73f0: 20 72 65 73 29 0a 20 20 20 20 20 20 20 20 20 20 res).
7400: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7410: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7420: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7430: 20 20 20 20 20 22 22 0a 20 20 20 20 20 20 20 20 "".
7440: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7450: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7460: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7470: 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d 69 (string-i
7480: 6e 74 65 72 73 70 65 72 73 65 20 72 65 73 20 22 ntersperse res "
7490: 20 22 29 29 29 29 29 29 0a 20 20 20 20 20 20 20 ")))))).
74a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
74b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
74c0: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 (hash-table-se
74d0: 74 21 20 72 65 73 20 63 75 72 72 2d 73 65 63 74 t! res curr-sect
74e0: 69 6f 6e 2d 6e 61 6d 65 20 0a 20 20 20 20 20 20 ion-name .
74f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7500: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7510: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7520: 20 20 20 20 28 61 73 73 6f 63 2d 73 61 66 65 2d (assoc-safe-
7530: 61 64 64 20 61 6c 69 73 74 0a 20 20 20 20 20 20 add alist.
7540: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7550: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7560: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7570: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7580: 20 20 20 20 20 20 20 20 20 20 20 6b 65 79 20 0a key .
7590: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
75a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
75b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
75c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
75d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
75e0: 20 28 63 61 73 65 20 28 63 61 6c 63 2d 61 6c 6c (case (calc-all
75f0: 6f 77 2d 73 79 73 74 65 6d 20 61 6c 6c 6f 77 2d ow-system allow-
7600: 73 79 73 74 65 6d 20 63 75 72 72 2d 73 65 63 74 system curr-sect
7610: 69 6f 6e 2d 6e 61 6d 65 20 73 65 63 74 69 6f 6e ion-name section
7620: 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 s).
7630: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7640: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7650: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7660: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7670: 20 20 20 20 20 20 28 28 72 65 74 75 72 6e 2d 70 ((return-p
7680: 72 6f 63 73 29 20 76 61 6c 2d 70 72 6f 63 29 0a rocs) val-proc).
7690: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
76a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
76b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
76c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
76d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
76e0: 20 20 20 28 28 72 65 74 75 72 6e 2d 73 74 72 69 ((return-stri
76f0: 6e 67 29 20 63 6d 64 29 0a 20 20 20 20 20 20 20 ng) cmd).
7700: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7710: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7720: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7730: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7740: 20 20 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 (els
7750: 65 20 28 76 61 6c 2d 70 72 6f 63 29 29 29 0a 20 e (val-proc))).
7760: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7770: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7780: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7790: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
77a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
77b0: 6d 65 74 61 64 61 74 61 3a 20 6d 65 74 61 70 61 metadata: metapa
77c0: 74 68 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 th)).
77d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
77e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
77f0: 6f 6f 70 20 28 63 6f 6e 66 69 67 66 3a 72 65 61 oop (configf:rea
7800: 64 2d 6c 69 6e 65 20 69 6e 70 20 72 65 73 20 28 d-line inp res (
7810: 63 61 6c 63 2d 61 6c 6c 6f 77 2d 73 79 73 74 65 calc-allow-syste
7820: 6d 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 63 m allow-system c
7830: 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 urr-section-name
7840: 20 73 65 63 74 69 6f 6e 73 29 20 73 65 74 74 69 sections) setti
7850: 6e 67 73 29 20 63 75 72 72 2d 73 65 63 74 69 6f ngs) curr-sectio
7860: 6e 2d 6e 61 6d 65 20 23 66 20 23 66 29 29 0a 20 n-name #f #f)).
7870: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7880: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7890: 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 6f 6e (loop (con
78a0: 66 69 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 figf:read-line i
78b0: 6e 70 20 72 65 73 0a 20 20 20 20 20 20 20 20 20 np res.
78c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
78d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
78e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
78f0: 20 20 20 20 20 20 20 28 63 61 6c 63 2d 61 6c 6c (calc-all
7900: 6f 77 2d 73 79 73 74 65 6d 20 61 6c 6c 6f 77 2d ow-system allow-
7910: 73 79 73 74 65 6d 20 63 75 72 72 2d 73 65 63 74 system curr-sect
7920: 69 6f 6e 2d 6e 61 6d 65 20 73 65 63 74 69 6f 6e ion-name section
7930: 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 s).
7940: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7950: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7960: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7970: 20 20 20 73 65 74 74 69 6e 67 73 29 0a 20 20 20 settings).
7980: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7990: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
79a0: 20 20 20 20 20 20 20 20 20 20 63 75 72 72 2d 73 curr-s
79b0: 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 ection-name #f #
79c0: 66 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 f))).
79d0: 20 20 20 20 0a 09 20 20 20 20 20 20 20 28 63 6f .. (co
79e0: 6e 66 69 67 66 3a 6b 65 79 2d 6e 6f 2d 76 61 6c nfigf:key-no-val
79f0: 20 28 20 78 20 6b 65 79 20 76 61 6c 29 0a 20 20 ( x key val).
7a00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7a10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7a20: 20 28 6c 65 74 2a 20 28 28 61 6c 69 73 74 20 20 (let* ((alist
7a30: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
7a40: 2f 64 65 66 61 75 6c 74 20 72 65 73 20 63 75 72 /default res cur
7a50: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 27 r-section-name '
7a60: 28 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ())).
7a70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7a80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
7a90: 66 76 61 6c 20 20 20 20 28 6f 72 20 28 69 66 20 fval (or (if
7aa0: 28 73 74 72 69 6e 67 3f 20 76 61 6c 29 20 76 61 (string? val) va
7ab0: 6c 20 23 66 29 20 22 22 29 29 29 20 3b 3b 20 66 l #f) ""))) ;; f
7ac0: 76 61 6c 20 73 68 6f 75 6c 64 20 62 65 20 65 69 val should be ei
7ad0: 74 68 65 72 20 22 22 20 6f 72 20 22 20 22 20 28 ther "" or " " (
7ae0: 6f 6e 65 20 6f 72 20 6d 6f 72 65 20 73 70 61 63 one or more spac
7af0: 65 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 es).
7b00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7b10: 20 20 20 20 20 20 20 20 20 28 64 65 62 75 67 3a (debug:
7b20: 70 72 69 6e 74 20 31 30 20 2a 64 65 66 61 75 6c print 10 *defaul
7b30: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 20 20 20 t-log-port* "
7b40: 73 65 74 74 69 6e 67 3a 20 5b 22 20 63 75 72 72 setting: [" curr
7b50: 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 22 5d -section-name "]
7b60: 20 22 20 6b 65 79 20 22 20 3d 20 23 74 22 29 0a " key " = #t").
7b70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7b80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7b90: 20 20 20 20 20 28 73 61 66 65 2d 73 65 74 65 6e (safe-seten
7ba0: 76 20 6b 65 79 20 66 76 61 6c 29 0a 20 20 20 20 v key fval).
7bb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7bc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7bd0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 (hash-table-set
7be0: 21 20 72 65 73 20 63 75 72 72 2d 73 65 63 74 69 ! res curr-secti
7bf0: 6f 6e 2d 6e 61 6d 65 20 0a 20 20 20 20 20 20 20 on-name .
7c00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7c10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7c20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
7c30: 61 73 73 6f 63 2d 73 61 66 65 2d 61 64 64 20 61 assoc-safe-add a
7c40: 6c 69 73 74 20 6b 65 79 20 66 76 61 6c 20 6d 65 list key fval me
7c50: 74 61 64 61 74 61 3a 20 6d 65 74 61 70 61 74 68 tadata: metapath
7c60: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
7c70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7c80: 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 (loop (c
7c90: 6f 6e 66 69 67 66 3a 72 65 61 64 2d 6c 69 6e 65 onfigf:read-line
7ca0: 20 69 6e 70 20 72 65 73 0a 20 20 20 20 20 20 20 inp res.
7cb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7cc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7cd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7ce0: 20 20 20 20 20 20 20 28 63 61 6c 63 2d 61 6c 6c (calc-all
7cf0: 6f 77 2d 73 79 73 74 65 6d 20 61 6c 6c 6f 77 2d ow-system allow-
7d00: 73 79 73 74 65 6d 20 63 75 72 72 2d 73 65 63 74 system curr-sect
7d10: 69 6f 6e 2d 6e 61 6d 65 20 73 65 63 74 69 6f 6e ion-name section
7d20: 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 s).
7d30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7d40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7d50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7d60: 20 73 65 74 74 69 6e 67 73 29 0a 20 20 20 20 20 settings).
7d70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7d80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7d90: 20 20 20 20 20 20 63 75 72 72 2d 73 65 63 74 69 curr-secti
7da0: 6f 6e 2d 6e 61 6d 65 20 6b 65 79 20 23 66 29 29 on-name key #f))
7db0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
7dc0: 20 0a 09 20 20 20 20 20 20 20 28 63 6f 6e 66 69 .. (confi
7dd0: 67 66 3a 6b 65 79 2d 76 61 6c 2d 70 72 20 28 20 gf:key-val-pr (
7de0: 78 20 6b 65 79 20 75 6e 6b 31 20 76 61 6c 20 75 x key unk1 val u
7df0: 6e 6b 32 20 29 0a 20 20 20 20 20 20 20 20 20 20 nk2 ).
7e00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7e10: 20 20 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 (let* (
7e20: 28 61 6c 69 73 74 20 20 20 28 68 61 73 68 2d 74 (alist (hash-t
7e30: 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 able-ref/default
7e40: 20 72 65 73 20 63 75 72 72 2d 73 65 63 74 69 6f res curr-sectio
7e50: 6e 2d 6e 61 6d 65 20 27 28 29 29 29 0a 20 20 20 n-name '())).
7e60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7e70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7e80: 20 20 20 20 20 20 20 28 65 6e 76 61 72 20 20 20 (envar
7e90: 28 61 6e 64 20 65 6e 76 69 72 6f 6e 2d 70 61 74 (and environ-pat
7ea0: 74 20 28 73 74 72 69 6e 67 2d 73 65 61 72 63 68 t (string-search
7eb0: 20 28 72 65 67 65 78 70 20 65 6e 76 69 72 6f 6e (regexp environ
7ec0: 2d 70 61 74 74 29 20 63 75 72 72 2d 73 65 63 74 -patt) curr-sect
7ed0: 69 6f 6e 2d 6e 61 6d 65 29 29 29 0a 20 20 20 20 ion-name))).
7ee0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7ef0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7f00: 20 20 20 20 20 20 28 72 65 61 6c 76 61 6c 20 28 (realval (
7f10: 69 66 20 65 6e 76 61 72 0a 20 20 20 20 20 20 20 if envar.
7f20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7f30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7f40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7f50: 28 65 76 61 6c 2d 73 74 72 69 6e 67 2d 69 6e 2d (eval-string-in-
7f60: 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 76 61 6c 29 environment val)
7f70: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
7f80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7f90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7fa0: 20 20 20 20 20 20 20 20 76 61 6c 29 29 29 0a 20 val))).
7fb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7fc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7fd0: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
7fe0: 2d 69 6e 66 6f 20 36 20 2a 64 65 66 61 75 6c 74 -info 6 *default
7ff0: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 72 65 61 64 -log-port* "read
8000: 2d 63 6f 6e 66 69 67 20 65 6e 76 20 73 65 74 74 -config env sett
8010: 69 6e 67 2c 20 65 6e 76 61 72 3a 20 22 20 65 6e ing, envar: " en
8020: 76 61 72 20 22 20 72 65 61 6c 76 61 6c 3a 20 22 var " realval: "
8030: 20 72 65 61 6c 76 61 6c 20 22 20 76 61 6c 3a 20 realval " val:
8040: 22 20 76 61 6c 20 22 20 6b 65 79 3a 20 22 20 6b " val " key: " k
8050: 65 79 20 22 20 63 75 72 72 2d 73 65 63 74 69 6f ey " curr-sectio
8060: 6e 2d 6e 61 6d 65 3a 20 22 20 63 75 72 72 2d 73 n-name: " curr-s
8070: 65 63 74 69 6f 6e 2d 6e 61 6d 65 29 0a 20 20 20 ection-name).
8080: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8090: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
80a0: 20 20 28 69 66 20 65 6e 76 61 72 20 28 73 61 66 (if envar (saf
80b0: 65 2d 73 65 74 65 6e 76 20 6b 65 79 20 72 65 61 e-setenv key rea
80c0: 6c 76 61 6c 29 29 0a 20 20 20 20 20 20 20 20 20 lval)).
80d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
80e0: 20 20 20 20 20 20 20 20 20 20 20 20 28 64 65 62 (deb
80f0: 75 67 3a 70 72 69 6e 74 20 31 30 20 2a 64 65 66 ug:print 10 *def
8100: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
8110: 20 20 20 73 65 74 74 69 6e 67 3a 20 5b 22 20 63 setting: [" c
8120: 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 urr-section-name
8130: 20 22 5d 20 22 20 6b 65 79 20 22 20 3d 20 22 20 "] " key " = "
8140: 76 61 6c 29 0a 20 20 20 20 20 20 20 20 20 20 20 val).
8150: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8160: 20 20 20 20 20 20 20 20 20 20 28 68 61 73 68 2d (hash-
8170: 74 61 62 6c 65 2d 73 65 74 21 20 72 65 73 20 63 table-set! res c
8180: 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 urr-section-name
8190: 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
81a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
81b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
81c0: 20 20 20 20 20 20 20 20 28 61 73 73 6f 63 2d 73 (assoc-s
81d0: 61 66 65 2d 61 64 64 20 61 6c 69 73 74 20 6b 65 afe-add alist ke
81e0: 79 20 72 65 61 6c 76 61 6c 20 6d 65 74 61 64 61 y realval metada
81f0: 74 61 3a 20 6d 65 74 61 70 61 74 68 29 29 0a 20 ta: metapath)).
8200: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8210: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8220: 20 20 20 20 28 6c 6f 6f 70 20 28 63 6f 6e 66 69 (loop (confi
8230: 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 gf:read-line inp
8240: 20 72 65 73 0a 20 20 20 20 20 20 20 20 20 20 20 res.
8250: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8260: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8270: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8280: 20 20 20 28 63 61 6c 63 2d 61 6c 6c 6f 77 2d 73 (calc-allow-s
8290: 79 73 74 65 6d 20 61 6c 6c 6f 77 2d 73 79 73 74 ystem allow-syst
82a0: 65 6d 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d em curr-section-
82b0: 6e 61 6d 65 20 73 65 63 74 69 6f 6e 73 29 20 73 name sections) s
82c0: 65 74 74 69 6e 67 73 29 0a 20 20 20 20 20 20 20 ettings).
82d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
82e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
82f0: 20 20 20 20 63 75 72 72 2d 73 65 63 74 69 6f 6e curr-section
8300: 2d 6e 61 6d 65 20 6b 65 79 20 23 66 29 29 29 0a -name key #f))).
8310: 09 20 20 20 20 20 20 20 3b 3b 20 69 66 20 61 20 . ;; if a
8320: 63 6f 6e 74 69 6e 75 65 64 20 6c 69 6e 65 0a 09 continued line..
8330: 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a (configf:
8340: 63 6f 6e 74 2d 6c 6e 2d 72 78 20 28 20 78 20 77 cont-ln-rx ( x w
8350: 68 73 70 20 76 61 6c 20 20 20 20 20 29 0a 20 20 hsp val ).
8360: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8370: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8380: 20 28 6c 65 74 20 28 28 61 6c 69 73 74 20 28 68 (let ((alist (h
8390: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
83a0: 66 61 75 6c 74 20 72 65 73 20 63 75 72 72 2d 73 fault res curr-s
83b0: 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 27 28 29 29 ection-name '())
83c0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
83d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
83e0: 20 20 20 20 20 20 20 20 28 69 66 20 76 61 72 2d (if var-
83f0: 66 6c 61 67 20 20 20 20 20 20 20 20 20 20 20 20 flag
8400: 20 3b 3b 20 69 66 20 73 65 74 20 74 6f 20 61 20 ;; if set to a
8410: 73 74 72 69 6e 67 20 74 68 65 6e 20 77 65 20 68 string then we h
8420: 61 76 65 20 61 20 63 6f 6e 74 69 6e 75 65 64 20 ave a continued
8430: 76 61 72 0a 20 20 20 20 20 20 20 20 20 20 20 20 var.
8440: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8450: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 (le
8460: 74 20 28 28 6e 65 77 76 61 6c 20 28 63 6f 6e 63 t ((newval (conc
8470: 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
8480: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8490: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
84a0: 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f 6b 75 (looku
84b0: 70 20 72 65 73 20 63 75 72 72 2d 73 65 63 74 69 p res curr-secti
84c0: 6f 6e 2d 6e 61 6d 65 20 76 61 72 2d 66 6c 61 67 on-name var-flag
84d0: 29 20 22 5c 6e 22 0a 20 20 20 20 20 20 20 20 20 ) "\n".
84e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
84f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8500: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
8510: 3b 20 74 72 69 6d 20 6c 65 61 64 20 66 72 6f 6d ; trim lead from
8520: 20 74 68 65 20 69 6e 63 6f 6d 69 6e 67 20 77 68 the incoming wh
8530: 73 70 20 74 6f 20 73 75 70 70 6f 72 74 20 73 6f sp to support so
8540: 6d 65 20 69 6e 64 65 6e 74 69 6e 67 2e 0a 20 20 me indenting..
8550: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8560: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8570: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8580: 20 20 20 20 20 20 28 69 66 20 6c 65 61 64 0a 20 (if lead.
8590: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
85a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
85b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
85c0: 20 20 20 20 20 20 20 20 20 20 20 28 73 74 72 69 (stri
85d0: 6e 67 2d 73 75 62 73 74 69 74 75 74 65 20 28 72 ng-substitute (r
85e0: 65 67 65 78 70 20 6c 65 61 64 29 20 22 22 20 77 egexp lead) "" w
85f0: 68 73 70 29 0a 20 20 20 20 20 20 20 20 20 20 20 hsp).
8600: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8610: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8620: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8630: 20 22 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 "").
8640: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8650: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8660: 20 20 20 20 20 20 20 20 20 20 20 20 20 76 61 6c val
8670: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
8680: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8690: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
86a0: 3b 20 28 70 72 69 6e 74 20 22 76 61 6c 3a 20 22 ; (print "val: "
86b0: 20 76 61 6c 20 22 5c 6e 6e 65 77 76 61 6c 3a 20 val "\nnewval:
86c0: 5c 22 22 20 6e 65 77 76 61 6c 20 22 5c 22 5c 6e \"" newval "\"\n
86d0: 76 61 72 66 6c 61 67 3a 20 22 20 76 61 72 2d 66 varflag: " var-f
86e0: 6c 61 67 29 0a 20 20 20 20 20 20 20 20 20 20 20 lag).
86f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8700: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8710: 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 (hash-table-set!
8720: 20 72 65 73 20 63 75 72 72 2d 73 65 63 74 69 6f res curr-sectio
8730: 6e 2d 6e 61 6d 65 20 0a 20 20 20 20 20 20 20 20 n-name .
8740: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8750: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8760: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8770: 20 20 20 20 28 61 73 73 6f 63 2d 73 61 66 65 2d (assoc-safe-
8780: 61 64 64 20 61 6c 69 73 74 20 76 61 72 2d 66 6c add alist var-fl
8790: 61 67 20 6e 65 77 76 61 6c 20 6d 65 74 61 64 61 ag newval metada
87a0: 74 61 3a 20 6d 65 74 61 70 61 74 68 29 29 0a 20 ta: metapath)).
87b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
87c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
87d0: 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 20 (loop
87e0: 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d 6c 69 (configf:read-li
87f0: 6e 65 20 69 6e 70 20 72 65 73 20 28 63 61 6c 63 ne inp res (calc
8800: 2d 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 61 6c -allow-system al
8810: 6c 6f 77 2d 73 79 73 74 65 6d 20 63 75 72 72 2d low-system curr-
8820: 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 73 65 63 section-name sec
8830: 74 69 6f 6e 73 29 20 73 65 74 74 69 6e 67 73 29 tions) settings)
8840: 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 curr-section-na
8850: 6d 65 20 76 61 72 2d 66 6c 61 67 20 28 69 66 20 me var-flag (if
8860: 6c 65 61 64 20 6c 65 61 64 20 77 68 73 70 29 29 lead lead whsp))
8870: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
8880: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8890: 20 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 (loop
88a0: 20 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d 6c (configf:read-l
88b0: 69 6e 65 20 69 6e 70 20 72 65 73 20 28 63 61 6c ine inp res (cal
88c0: 63 2d 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 61 c-allow-system a
88d0: 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 63 75 72 72 llow-system curr
88e0: 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 73 65 -section-name se
88f0: 63 74 69 6f 6e 73 29 20 73 65 74 74 69 6e 67 73 ctions) settings
8900: 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e ) curr-section-n
8910: 61 6d 65 20 23 66 20 23 66 29 29 29 29 0a 09 20 ame #f #f))))..
8920: 20 20 20 20 20 20 28 65 6c 73 65 20 28 64 65 62 (else (deb
8930: 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 ug:print-error 0
8940: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
8950: 72 74 2a 20 22 70 72 6f 62 6c 65 6d 20 70 61 72 rt* "problem par
8960: 73 69 6e 67 20 22 20 70 61 74 68 20 22 2c 5c 6e sing " path ",\n
8970: 20 20 20 5c 22 22 20 69 6e 6c 20 22 5c 22 22 29 \"" inl "\"")
8980: 0a 09 09 20 20 20 20 20 28 73 65 74 21 20 76 61 ... (set! va
8990: 72 2d 66 6c 61 67 20 23 66 29 0a 09 09 20 20 20 r-flag #f)...
89a0: 20 20 28 6c 6f 6f 70 20 28 63 6f 6e 66 69 67 66 (loop (configf
89b0: 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 20 72 :read-line inp r
89c0: 65 73 20 28 63 61 6c 63 2d 61 6c 6c 6f 77 2d 73 es (calc-allow-s
89d0: 79 73 74 65 6d 20 61 6c 6c 6f 77 2d 73 79 73 74 ystem allow-syst
89e0: 65 6d 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d em curr-section-
89f0: 6e 61 6d 65 20 73 65 63 74 69 6f 6e 73 29 20 73 name sections) s
8a00: 65 74 74 69 6e 67 73 29 20 63 75 72 72 2d 73 65 ettings) curr-se
8a10: 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 66 ction-name #f #f
8a20: 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 29 )))). )
8a30: 20 3b 3b 20 65 6e 64 20 6c 6f 6f 70 0a 20 20 20 ;; end loop.
8a40: 20 20 20 20 20 29 29 29 0a 0a 3b 3b 20 6d 6f 76 )))..;; mov
8a50: 65 64 20 74 6f 20 63 6f 6d 6d 6f 6e 2e 73 63 6d ed to common.scm
8a60: 20 61 73 20 69 74 20 69 73 20 76 65 72 79 20 6d as it is very m
8a70: 65 67 61 74 65 73 74 20 73 70 65 63 69 66 69 63 egatest specific
8a80: 0a 3b 3b 0a 3b 3b 20 3b 3b 20 70 61 74 68 65 6e .;;.;; ;; pathen
8a90: 76 76 61 72 20 77 69 6c 6c 20 73 65 74 20 74 68 vvar will set th
8aa0: 65 20 6e 61 6d 65 64 20 76 61 72 20 74 6f 20 74 e named var to t
8ab0: 68 65 20 70 61 74 68 20 6f 66 20 74 68 65 20 63 he path of the c
8ac0: 6f 6e 66 69 67 0a 3b 3b 20 28 64 65 66 69 6e 65 onfig.;; (define
8ad0: 20 28 66 69 6e 64 2d 61 6e 64 2d 72 65 61 64 2d (find-and-read-
8ae0: 63 6f 6e 66 69 67 20 66 6e 61 6d 65 20 23 21 6b config fname #!k
8af0: 65 79 20 28 65 6e 76 69 72 6f 6e 2d 70 61 74 74 ey (environ-patt
8b00: 20 23 66 29 28 67 69 76 65 6e 2d 74 6f 70 70 61 #f)(given-toppa
8b10: 74 68 20 23 66 29 28 70 61 74 68 65 6e 76 76 61 th #f)(pathenvva
8b20: 72 20 23 66 29 29 0a 3b 3b 20 20 20 28 6c 65 74 r #f)).;; (let
8b30: 2a 20 28 28 63 75 72 72 2d 64 69 72 20 20 20 28 * ((curr-dir (
8b40: 63 75 72 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 current-director
8b50: 79 29 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 y)).;;
8b60: 28 63 6f 6e 66 69 67 69 6e 66 6f 20 28 66 69 6e (configinfo (fin
8b70: 64 2d 63 6f 6e 66 69 67 20 66 6e 61 6d 65 20 74 d-config fname t
8b80: 6f 70 70 61 74 68 3a 20 67 69 76 65 6e 2d 74 6f oppath: given-to
8b90: 70 70 61 74 68 29 29 0a 3b 3b 20 09 20 28 74 6f ppath)).;; . (to
8ba0: 70 70 61 74 68 20 20 20 20 28 63 61 72 20 63 6f ppath (car co
8bb0: 6e 66 69 67 69 6e 66 6f 29 29 0a 3b 3b 20 09 20 nfiginfo)).;; .
8bc0: 28 63 6f 6e 66 69 67 66 69 6c 65 20 28 63 61 64 (configfile (cad
8bd0: 72 20 63 6f 6e 66 69 67 69 6e 66 6f 29 29 0a 3b r configinfo)).;
8be0: 3b 20 09 20 28 73 65 74 2d 66 69 65 6c 64 73 20 ; . (set-fields
8bf0: 28 6c 61 6d 62 64 61 20 28 63 75 72 72 2d 73 65 (lambda (curr-se
8c00: 63 74 69 6f 6e 20 6e 65 78 74 2d 73 65 63 74 69 ction next-secti
8c10: 6f 6e 20 68 74 20 70 61 74 68 29 0a 3b 3b 20 09 on ht path).;; .
8c20: 09 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 66 . (let ((f
8c30: 69 65 6c 64 2d 6e 61 6d 65 73 20 28 69 66 20 68 ield-names (if h
8c40: 74 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 66 69 t (common:get-fi
8c50: 65 6c 64 73 20 68 74 29 20 27 28 29 29 29 0a 3b elds ht) '())).;
8c60: 3b 20 09 09 09 20 20 20 20 20 28 74 61 72 67 65 ; ... (targe
8c70: 74 20 20 20 20 20 20 28 6f 72 20 28 67 65 74 65 t (or (gete
8c80: 6e 76 20 22 4d 54 5f 54 41 52 47 45 54 22 29 28 nv "MT_TARGET")(
8c90: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
8ca0: 65 71 74 61 72 67 22 29 28 61 72 67 73 3a 67 65 eqtarg")(args:ge
8cb0: 74 2d 61 72 67 20 22 2d 74 61 72 67 65 74 22 29 t-arg "-target")
8cc0: 29 29 29 0a 3b 3b 20 09 09 09 20 28 64 65 62 75 ))).;; ... (debu
8cd0: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 39 20 2a g:print-info 9 *
8ce0: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
8cf0: 2a 20 22 73 65 74 2d 66 69 65 6c 64 73 20 77 69 * "set-fields wi
8d00: 74 68 20 66 69 65 6c 64 2d 6e 61 6d 65 73 3d 22 th field-names="
8d10: 20 66 69 65 6c 64 2d 6e 61 6d 65 73 20 22 20 74 field-names " t
8d20: 61 72 67 65 74 3d 22 20 74 61 72 67 65 74 20 22 arget=" target "
8d30: 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 3d 22 20 curr-section="
8d40: 63 75 72 72 2d 73 65 63 74 69 6f 6e 20 22 20 6e curr-section " n
8d50: 65 78 74 2d 73 65 63 74 69 6f 6e 3d 22 20 6e 65 ext-section=" ne
8d60: 78 74 2d 73 65 63 74 69 6f 6e 20 22 20 70 61 74 xt-section " pat
8d70: 68 3d 22 20 70 61 74 68 20 22 20 68 74 3d 22 20 h=" path " ht="
8d80: 68 74 29 0a 3b 3b 20 09 09 09 20 28 69 66 20 28 ht).;; ... (if (
8d90: 6e 6f 74 20 28 6e 75 6c 6c 3f 20 66 69 65 6c 64 not (null? field
8da0: 2d 6e 61 6d 65 73 29 29 28 6b 65 79 73 3a 74 61 -names))(keys:ta
8db0: 72 67 65 74 2d 73 65 74 2d 61 72 67 73 20 66 69 rget-set-args fi
8dc0: 65 6c 64 2d 6e 61 6d 65 73 20 74 61 72 67 65 74 eld-names target
8dd0: 20 23 66 29 29 29 29 29 29 0a 3b 3b 20 20 20 20 #f)))))).;;
8de0: 20 28 69 66 20 74 6f 70 70 61 74 68 20 28 63 68 (if toppath (ch
8df0: 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 74 ange-directory t
8e00: 6f 70 70 61 74 68 29 29 20 0a 3b 3b 20 20 20 20 oppath)) .;;
8e10: 20 28 69 66 20 28 61 6e 64 20 74 6f 70 70 61 74 (if (and toppat
8e20: 68 20 70 61 74 68 65 6e 76 76 61 72 29 28 73 65 h pathenvvar)(se
8e30: 74 65 6e 76 20 70 61 74 68 65 6e 76 76 61 72 20 tenv pathenvvar
8e40: 74 6f 70 70 61 74 68 29 29 0a 3b 3b 20 20 20 20 toppath)).;;
8e50: 20 28 6c 65 74 20 28 28 63 6f 6e 66 69 67 64 61 (let ((configda
8e60: 74 20 20 28 69 66 20 63 6f 6e 66 69 67 66 69 6c t (if configfil
8e70: 65 20 0a 3b 3b 20 09 09 09 20 20 28 72 65 61 64 e .;; ... (read
8e80: 2d 63 6f 6e 66 69 67 20 63 6f 6e 66 69 67 66 69 -config configfi
8e90: 6c 65 20 23 66 20 23 74 20 65 6e 76 69 72 6f 6e le #f #t environ
8ea0: 2d 70 61 74 74 3a 20 65 6e 76 69 72 6f 6e 2d 70 -patt: environ-p
8eb0: 61 74 74 20 70 6f 73 74 2d 73 65 63 74 69 6f 6e att post-section
8ec0: 2d 70 72 6f 63 73 3a 20 28 6c 69 73 74 20 28 63 -procs: (list (c
8ed0: 6f 6e 73 20 22 5e 66 69 65 6c 64 73 24 22 20 73 ons "^fields$" s
8ee0: 65 74 2d 66 69 65 6c 64 73 29 29 20 23 66 29 29 et-fields)) #f))
8ef0: 29 29 0a 3b 3b 20 20 20 20 20 20 20 28 69 66 20 )).;; (if
8f00: 74 6f 70 70 61 74 68 20 28 63 68 61 6e 67 65 2d toppath (change-
8f10: 64 69 72 65 63 74 6f 72 79 20 63 75 72 72 2d 64 directory curr-d
8f20: 69 72 29 29 0a 3b 3b 20 20 20 20 20 20 20 28 6c ir)).;; (l
8f30: 69 73 74 20 63 6f 6e 66 69 67 64 61 74 20 74 6f ist configdat to
8f40: 70 70 61 74 68 20 63 6f 6e 66 69 67 66 69 6c 65 ppath configfile
8f50: 20 66 6e 61 6d 65 29 29 29 29 0a 0a 28 64 65 66 fname))))..(def
8f60: 69 6e 65 20 28 6c 6f 6f 6b 75 70 20 63 66 67 64 ine (lookup cfgd
8f70: 61 74 20 73 65 63 74 69 6f 6e 20 76 61 72 29 0a at section var).
8f80: 20 20 28 69 66 20 28 68 61 73 68 2d 74 61 62 6c (if (hash-tabl
8f90: 65 3f 20 63 66 67 64 61 74 29 0a 20 20 20 20 20 e? cfgdat).
8fa0: 20 28 6c 65 74 20 28 28 73 65 63 74 64 61 74 20 (let ((sectdat
8fb0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/
8fc0: 64 65 66 61 75 6c 74 20 63 66 67 64 61 74 20 73 default cfgdat s
8fd0: 65 63 74 69 6f 6e 20 27 28 29 29 29 29 0a 09 28 ection '())))..(
8fe0: 69 66 20 28 6e 75 6c 6c 3f 20 73 65 63 74 64 61 if (null? sectda
8ff0: 74 29 0a 09 20 20 20 20 23 66 0a 09 20 20 20 20 t).. #f..
9000: 28 6c 65 74 20 28 28 6d 61 74 63 68 20 28 61 73 (let ((match (as
9010: 73 6f 63 20 76 61 72 20 73 65 63 74 64 61 74 29 soc var sectdat)
9020: 29 29 0a 09 20 20 20 20 20 20 28 69 66 20 6d 61 )).. (if ma
9030: 74 63 68 20 3b 3b 20 28 61 6e 64 20 6d 61 74 63 tch ;; (and matc
9040: 68 20 28 6c 69 73 74 3f 20 6d 61 74 63 68 29 28 h (list? match)(
9050: 3e 20 28 6c 65 6e 67 74 68 20 6d 61 74 63 68 29 > (length match)
9060: 20 31 29 29 0a 09 09 20 20 28 63 61 64 72 20 6d 1))... (cadr m
9070: 61 74 63 68 29 0a 09 09 20 20 23 66 29 29 0a 09 atch)... #f))..
9080: 20 20 20 20 29 29 0a 20 20 20 20 20 20 23 66 29 )). #f)
9090: 29 0a 0a 3b 3b 20 75 73 65 20 74 6f 20 68 61 76 )..;; use to hav
90a0: 65 20 64 65 66 69 6e 69 74 69 76 65 20 73 65 74 e definitive set
90b0: 74 69 6e 67 3a 0a 3b 3b 20 20 5b 66 6f 6f 5d 0a ting:.;; [foo].
90c0: 3b 3b 20 20 76 61 72 20 79 65 73 0a 3b 3b 0a 3b ;; var yes.;;.;
90d0: 3b 20 20 28 76 61 72 2d 69 73 3f 20 63 66 67 64 ; (var-is? cfgd
90e0: 61 74 20 22 66 6f 6f 22 20 22 76 61 72 22 20 22 at "foo" "var" "
90f0: 79 65 73 22 29 20 3d 3e 20 23 74 0a 3b 3b 0a 28 yes") => #t.;;.(
9100: 64 65 66 69 6e 65 20 28 76 61 72 2d 69 73 3f 20 define (var-is?
9110: 63 66 67 64 61 74 20 73 65 63 74 69 6f 6e 20 76 cfgdat section v
9120: 61 72 20 65 78 70 65 63 74 65 64 2d 76 61 6c 29 ar expected-val)
9130: 0a 20 20 28 65 71 75 61 6c 3f 20 28 6c 6f 6f 6b . (equal? (look
9140: 75 70 20 63 66 67 64 61 74 20 73 65 63 74 69 6f up cfgdat sectio
9150: 6e 20 76 61 72 29 20 65 78 70 65 63 74 65 64 2d n var) expected-
9160: 76 61 6c 29 29 0a 0a 3b 3b 20 73 61 66 65 6c 79 val))..;; safely
9170: 20 6c 6f 6f 6b 20 75 70 20 61 20 76 61 6c 75 65 look up a value
9180: 20 74 68 61 74 20 69 73 20 65 78 70 65 63 74 65 that is expecte
9190: 64 20 74 6f 20 62 65 20 61 20 6e 75 6d 62 65 72 d to be a number
91a0: 2c 20 72 65 74 75 72 6e 0a 3b 3b 20 61 20 64 65 , return.;; a de
91b0: 66 61 75 6c 74 20 28 23 66 20 75 6e 6c 65 73 73 fault (#f unless
91c0: 20 70 72 6f 76 69 64 65 64 29 0a 3b 3b 0a 28 64 provided).;;.(d
91d0: 65 66 69 6e 65 20 28 6c 6f 6f 6b 75 70 2d 6e 75 efine (lookup-nu
91e0: 6d 62 65 72 20 63 66 67 64 61 74 20 73 65 63 74 mber cfgdat sect
91f0: 69 6f 6e 20 76 61 72 6e 61 6d 65 20 23 21 6b 65 ion varname #!ke
9200: 79 20 28 64 65 66 61 75 6c 74 20 23 66 29 29 0a y (default #f)).
9210: 20 20 28 6c 65 74 2a 20 28 28 76 61 6c 20 28 6c (let* ((val (l
9220: 6f 6f 6b 75 70 20 63 66 67 64 61 74 20 73 65 63 ookup cfgdat sec
9230: 74 69 6f 6e 20 76 61 72 6e 61 6d 65 29 29 0a 20 tion varname)).
9240: 20 20 20 20 20 20 20 20 28 72 65 73 20 28 69 66 (res (if
9250: 20 76 61 6c 0a 20 20 20 20 20 20 20 20 20 20 20 val.
9260: 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d 3e (string->
9270: 6e 75 6d 62 65 72 20 28 73 74 72 69 6e 67 2d 73 number (string-s
9280: 75 62 73 74 69 74 75 74 65 20 22 5c 5c 73 2b 22 ubstitute "\\s+"
9290: 20 22 22 20 76 61 6c 20 23 74 29 29 0a 20 20 20 "" val #t)).
92a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 23 #
92b0: 66 29 29 29 0a 20 20 20 20 28 63 6f 6e 64 0a 20 f))). (cond.
92c0: 20 20 20 20 28 72 65 73 20 20 72 65 73 29 0a 20 (res res).
92d0: 20 20 20 20 28 76 61 6c 20 20 28 64 65 62 75 67 (val (debug
92e0: 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
92f0: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 45 52 52 t-log-port* "ERR
9300: 4f 52 3a 20 6e 6f 20 6e 75 6d 62 65 72 20 66 6f OR: no number fo
9310: 75 6e 64 20 66 6f 72 20 5b 22 20 73 65 63 74 69 und for [" secti
9320: 6f 6e 20 22 5d 2c 20 22 20 76 61 72 6e 61 6d 65 on "], " varname
9330: 20 22 2c 20 67 6f 74 3a 20 22 20 76 61 6c 29 29 ", got: " val))
9340: 0a 20 20 20 20 20 28 65 6c 73 65 20 64 65 66 61 . (else defa
9350: 75 6c 74 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 ult))))..(define
9360: 20 28 73 65 63 74 69 6f 6e 2d 76 61 72 73 20 63 (section-vars c
9370: 66 67 64 61 74 20 73 65 63 74 69 6f 6e 29 0a 20 fgdat section).
9380: 20 28 6c 65 74 20 28 28 73 65 63 74 64 61 74 20 (let ((sectdat
9390: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/
93a0: 64 65 66 61 75 6c 74 20 63 66 67 64 61 74 20 73 default cfgdat s
93b0: 65 63 74 69 6f 6e 20 27 28 29 29 29 29 0a 20 20 ection '()))).
93c0: 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 73 65 63 (if (null? sec
93d0: 74 64 61 74 29 0a 09 27 28 29 0a 09 28 6d 61 70 tdat)..'()..(map
93e0: 20 63 61 72 20 73 65 63 74 64 61 74 29 29 29 29 car sectdat))))
93f0: 0a 0a 28 64 65 66 69 6e 65 20 28 67 65 74 2d 73 ..(define (get-s
9400: 65 63 74 69 6f 6e 20 63 66 67 64 61 74 20 73 65 ection cfgdat se
9410: 63 74 69 6f 6e 29 0a 20 20 28 68 61 73 68 2d 74 ction). (hash-t
9420: 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 able-ref/default
9430: 20 63 66 67 64 61 74 20 73 65 63 74 69 6f 6e 20 cfgdat section
9440: 27 28 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 '()))..(define (
9450: 73 65 74 2d 73 65 63 74 69 6f 6e 2d 76 61 72 20 set-section-var
9460: 63 66 67 64 61 74 20 73 65 63 74 69 6f 6e 20 76 cfgdat section v
9470: 61 72 20 76 61 6c 29 0a 20 20 28 6c 65 74 20 28 ar val). (let (
9480: 28 73 65 63 74 64 61 74 20 28 67 65 74 2d 73 65 (sectdat (get-se
9490: 63 74 69 6f 6e 20 63 66 67 64 61 74 20 73 65 63 ction cfgdat sec
94a0: 74 69 6f 6e 29 29 29 0a 20 20 20 20 28 68 61 73 tion))). (has
94b0: 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 63 66 67 h-table-set! cfg
94c0: 64 61 74 20 73 65 63 74 69 6f 6e 0a 20 20 20 20 dat section.
94d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
94e0: 20 28 61 73 73 6f 63 2d 73 61 66 65 2d 61 64 64 (assoc-safe-add
94f0: 20 73 65 63 74 64 61 74 20 76 61 72 20 76 61 6c sectdat var val
9500: 29 29 29 29 0a 0a 20 20 20 20 3b 3b 28 61 70 70 )))).. ;;(app
9510: 65 6e 64 20 28 66 69 6c 74 65 72 20 28 6c 61 6d end (filter (lam
9520: 62 64 61 20 28 78 29 28 6e 6f 74 20 28 61 73 73 bda (x)(not (ass
9530: 6f 63 20 76 61 72 20 73 65 63 74 64 61 74 29 29 oc var sectdat))
9540: 29 20 73 65 63 74 64 61 74 29 0a 20 20 20 20 3b ) sectdat). ;
9550: 3b 09 20 20 20 20 28 6c 69 73 74 20 76 61 72 20 ;. (list var
9560: 76 61 6c 29 29 29 29 0a 0a 3b 3b 20 6d 6f 76 65 val))))..;; move
9570: 64 20 74 6f 20 63 6f 6d 6d 6f 6e 0a 3b 3b 20 28 d to common.;; (
9580: 64 65 66 69 6e 65 20 28 73 65 74 75 70 29 0a 3b define (setup).;
9590: 3b 20 20 20 28 6c 65 74 2a 20 28 28 63 6f 6e 66 ; (let* ((conf
95a0: 69 67 66 20 28 66 69 6e 64 2d 63 6f 6e 66 69 67 igf (find-config
95b0: 20 22 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 "megatest.confi
95c0: 67 22 29 29 0a 3b 3b 20 09 20 28 63 6f 6e 66 69 g")).;; . (confi
95d0: 67 20 20 28 69 66 20 63 6f 6e 66 69 67 66 20 28 g (if configf (
95e0: 72 65 61 64 2d 63 6f 6e 66 69 67 20 63 6f 6e 66 read-config conf
95f0: 69 67 66 20 23 66 20 23 74 29 20 23 66 29 29 29 igf #f #t) #f)))
9600: 0a 3b 3b 20 20 20 20 20 28 69 66 20 63 6f 6e 66 .;; (if conf
9610: 69 67 0a 3b 3b 20 09 28 73 65 74 65 6e 76 20 22 ig.;; .(setenv "
9620: 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 22 20 28 RUN_AREA_HOME" (
9630: 70 61 74 68 6e 61 6d 65 2d 64 69 72 65 63 74 6f pathname-directo
9640: 72 79 20 63 6f 6e 66 69 67 66 29 29 29 0a 3b 3b ry configf))).;;
9650: 20 20 20 20 20 63 6f 6e 66 69 67 29 29 0a 0a 3b config))..;
9660: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
9670: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9680: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9690: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
96a0: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4e 6f 6e 20 64 =======.;; Non d
96b0: 65 73 74 72 75 63 74 69 76 65 20 77 72 69 74 69 estructive writi
96c0: 6e 67 20 6f 66 20 63 6f 6e 66 69 67 20 66 69 6c ng of config fil
96d0: 65 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d e.;;============
96e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
96f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9700: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9710: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 ==========..(def
9720: 69 6e 65 20 28 63 6f 6d 70 72 65 73 73 2d 6d 75 ine (compress-mu
9730: 6c 74 69 2d 6c 69 6e 65 73 20 66 64 61 74 29 0a lti-lines fdat).
9740: 20 20 3b 3b 20 73 74 65 70 20 31 2e 35 20 2d 20 ;; step 1.5 -
9750: 63 6f 6d 70 72 65 73 73 20 61 6e 79 20 63 6f 6e compress any con
9760: 74 69 6e 75 65 64 20 6c 69 6e 65 73 0a 20 20 28 tinued lines. (
9770: 69 66 20 28 6e 75 6c 6c 3f 20 66 64 61 74 29 20 if (null? fdat)
9780: 66 64 61 74 0a 09 28 6c 65 74 20 6c 6f 6f 70 20 fdat..(let loop
9790: 28 28 68 65 64 20 28 63 61 72 20 66 64 61 74 29 ((hed (car fdat)
97a0: 29 0a 09 09 20 20 20 28 74 61 6c 20 28 63 64 72 )... (tal (cdr
97b0: 20 66 64 61 74 29 29 0a 09 09 20 20 20 28 63 75 fdat))... (cu
97c0: 72 20 22 22 29 0a 09 09 20 20 20 28 6c 65 64 20 r "")... (led
97d0: 23 66 29 0a 09 09 20 20 20 28 72 65 73 20 27 28 #f)... (res '(
97e0: 29 29 29 0a 09 20 20 3b 3b 20 41 4c 4c 20 57 48 ))).. ;; ALL WH
97f0: 49 54 45 53 50 41 43 45 20 4c 45 41 44 49 4e 47 ITESPACE LEADING
9800: 20 4c 49 4e 45 53 20 41 52 45 20 54 41 43 4b 45 LINES ARE TACKE
9810: 44 20 4f 4e 21 21 0a 09 20 20 3b 3b 20 20 31 2e D ON!!.. ;; 1.
9820: 20 72 65 6d 6f 76 65 20 6c 65 64 20 77 68 69 74 remove led whit
9830: 65 73 70 61 63 65 0a 09 20 20 3b 3b 20 20 32 2e espace.. ;; 2.
9840: 20 74 61 63 6b 20 6f 6e 20 74 6f 20 68 65 64 20 tack on to hed
9850: 77 69 74 68 20 22 5c 6e 22 0a 09 20 20 28 6c 65 with "\n".. (le
9860: 74 20 28 28 6d 61 74 63 68 20 28 73 74 72 69 6e t ((match (strin
9870: 67 2d 6d 61 74 63 68 20 63 6f 6e 66 69 67 66 3a g-match configf:
9880: 63 6f 6e 74 2d 6c 6e 2d 72 78 20 68 65 64 29 29 cont-ln-rx hed))
9890: 29 0a 09 20 20 20 20 28 69 66 20 6d 61 74 63 68 ).. (if match
98a0: 20 3b 3b 20 62 6c 61 73 74 21 20 68 61 76 65 20 ;; blast! have
98b0: 74 6f 20 64 65 61 6c 20 77 69 74 68 20 61 20 6d to deal with a m
98c0: 75 6c 74 69 6c 69 6e 65 0a 09 09 28 6c 65 74 2a ultiline...(let*
98d0: 20 28 28 6c 65 61 64 20 28 63 61 64 72 20 6d 61 ((lead (cadr ma
98e0: 74 63 68 29 29 0a 09 09 20 20 20 20 20 20 20 28 tch))... (
98f0: 6c 76 61 6c 20 28 63 61 64 64 72 20 6d 61 74 63 lval (caddr matc
9900: 68 29 29 0a 09 09 20 20 20 20 20 20 20 28 6e 65 h))... (ne
9910: 77 6c 20 28 63 6f 6e 63 20 63 75 72 20 22 5c 6e wl (conc cur "\n
9920: 22 20 6c 76 61 6c 29 29 29 0a 09 09 20 20 28 69 " lval)))... (i
9930: 66 20 28 6e 6f 74 20 6c 65 64 29 28 73 65 74 21 f (not led)(set!
9940: 20 6c 65 64 20 6c 65 61 64 29 29 0a 09 09 20 20 led lead))...
9950: 28 69 66 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 20 (if (null? tal)
9960: 0a 09 09 20 20 20 20 20 20 28 73 65 74 21 20 66 ... (set! f
9970: 64 61 74 20 28 61 70 70 65 6e 64 20 66 64 61 74 dat (append fdat
9980: 20 28 6c 69 73 74 20 6e 65 77 6c 29 29 29 0a 09 (list newl)))..
9990: 09 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 . (loop (ca
99a0: 72 20 74 61 6c 29 28 63 64 72 20 74 61 6c 29 20 r tal)(cdr tal)
99b0: 6e 65 77 6c 20 6c 65 64 20 72 65 73 29 29 29 20 newl led res)))
99c0: 3b 3b 20 4e 42 2f 2f 20 6e 6f 74 20 74 61 63 6b ;; NB// not tack
99d0: 69 6e 67 20 6e 65 77 6c 20 6f 6e 74 6f 20 72 65 ing newl onto re
99e0: 73 0a 09 09 28 6c 65 74 20 28 28 6e 65 77 72 65 s...(let ((newre
99f0: 73 20 28 69 66 20 6c 65 64 20 0a 09 09 09 09 20 s (if led .....
9a00: 20 28 61 70 70 65 6e 64 20 72 65 73 20 28 6c 69 (append res (li
9a10: 73 74 20 63 75 72 20 68 65 64 29 29 0a 09 09 09 st cur hed))....
9a20: 09 20 20 28 61 70 70 65 6e 64 20 72 65 73 20 28 . (append res (
9a30: 6c 69 73 74 20 68 65 64 29 29 29 29 29 0a 09 09 list hed)))))...
9a40: 20 20 3b 3b 20 70 72 65 76 20 77 61 73 20 61 20 ;; prev was a
9a50: 6d 75 6c 74 69 6c 69 6e 65 0a 09 09 20 20 28 69 multiline... (i
9a60: 66 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 0a 09 09 f (null? tal)...
9a70: 20 20 20 20 20 20 6e 65 77 72 65 73 0a 09 09 20 newres...
9a80: 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 (loop (car
9a90: 74 61 6c 29 28 63 64 72 20 74 61 6c 29 20 22 22 tal)(cdr tal) ""
9aa0: 20 23 66 20 6e 65 77 72 65 73 29 29 29 29 29 29 #f newres))))))
9ab0: 29 29 0a 0a 3b 3b 20 6e 6f 74 65 3a 20 49 27 6d ))..;; note: I'm
9ac0: 20 63 68 65 61 74 69 6e 67 20 61 20 6c 69 74 74 cheating a litt
9ad0: 6c 65 20 68 65 72 65 2e 20 49 20 6d 65 72 65 6c le here. I merel
9ae0: 79 20 72 65 70 6c 61 63 65 20 22 5c 6e 22 20 77 y replace "\n" w
9af0: 69 74 68 20 22 5c 6e 20 20 20 20 20 20 20 20 20 ith "\n
9b00: 22 0a 28 64 65 66 69 6e 65 20 28 65 78 70 61 6e ".(define (expan
9b10: 64 2d 6d 75 6c 74 69 2d 6c 69 6e 65 73 20 66 64 d-multi-lines fd
9b20: 61 74 29 0a 20 20 3b 3b 20 73 74 65 70 20 31 2e at). ;; step 1.
9b30: 35 20 2d 20 63 6f 6d 70 72 65 73 73 20 61 6e 79 5 - compress any
9b40: 20 63 6f 6e 74 69 6e 75 65 64 20 6c 69 6e 65 73 continued lines
9b50: 0a 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 66 64 . (if (null? fd
9b60: 61 74 29 20 66 64 61 74 0a 20 20 20 20 20 20 28 at) fdat. (
9b70: 6c 65 74 20 6c 6f 6f 70 20 28 28 68 65 64 20 28 let loop ((hed (
9b80: 63 61 72 20 66 64 61 74 29 29 0a 09 09 20 28 74 car fdat))... (t
9b90: 61 6c 20 28 63 64 72 20 66 64 61 74 29 29 0a 09 al (cdr fdat))..
9ba0: 09 20 28 72 65 73 20 27 28 29 29 29 0a 09 28 6c . (res '()))..(l
9bb0: 65 74 20 28 28 6e 65 77 72 65 73 20 28 61 70 70 et ((newres (app
9bc0: 65 6e 64 20 72 65 73 20 28 6c 69 73 74 20 28 73 end res (list (s
9bd0: 74 72 69 6e 67 2d 73 75 62 73 74 69 74 75 74 65 tring-substitute
9be0: 20 28 72 65 67 65 78 70 20 22 5c 6e 22 29 20 22 (regexp "\n") "
9bf0: 5c 6e 20 20 20 20 20 20 20 20 20 22 20 68 65 64 \n " hed
9c00: 20 23 74 29 29 29 29 29 0a 09 20 20 28 69 66 20 #t))))).. (if
9c10: 28 6e 75 6c 6c 3f 20 74 61 6c 29 0a 09 20 20 20 (null? tal)..
9c20: 20 20 20 6e 65 77 72 65 73 0a 09 20 20 20 20 20 newres..
9c30: 20 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 (loop (car tal)
9c40: 28 63 64 72 20 74 61 6c 29 20 6e 65 77 72 65 73 (cdr tal) newres
9c50: 29 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 ))))))..(define
9c60: 28 66 69 6c 65 2d 3e 6c 69 73 74 20 66 6e 61 6d (file->list fnam
9c70: 65 29 0a 20 20 28 69 66 20 28 73 61 66 65 2d 66 e). (if (safe-f
9c80: 69 6c 65 2d 65 78 69 73 74 73 3f 20 66 6e 61 6d ile-exists? fnam
9c90: 65 29 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 e). (let ((
9ca0: 69 6e 70 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d inp (open-input-
9cb0: 66 69 6c 65 20 66 6e 61 6d 65 29 29 29 0a 09 28 file fname)))..(
9cc0: 6c 65 74 20 6c 6f 6f 70 20 28 28 69 6e 6c 20 28 let loop ((inl (
9cd0: 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 29 29 0a read-line inp)).
9ce0: 09 09 20 20 20 28 72 65 73 20 27 28 29 29 29 0a .. (res '())).
9cf0: 09 20 20 28 69 66 20 28 65 6f 66 2d 6f 62 6a 65 . (if (eof-obje
9d00: 63 74 3f 20 69 6e 6c 29 0a 09 20 20 20 20 20 20 ct? inl)..
9d10: 28 62 65 67 69 6e 0a 09 09 28 63 6c 6f 73 65 2d (begin...(close-
9d20: 69 6e 70 75 74 2d 70 6f 72 74 20 69 6e 70 29 0a input-port inp).
9d30: 09 09 28 72 65 76 65 72 73 65 20 72 65 73 29 29 ..(reverse res))
9d40: 0a 09 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 72 .. (loop (r
9d50: 65 61 64 2d 6c 69 6e 65 20 69 6e 70 29 28 63 6f ead-line inp)(co
9d60: 6e 73 20 69 6e 6c 20 72 65 73 29 29 29 29 29 0a ns inl res))))).
9d70: 20 20 20 20 20 20 27 28 29 29 29 0a 0a 3b 3b 3d '()))..;;=
9d80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9d90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9da0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9db0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9dc0: 3d 3d 3d 3d 3d 0a 3b 3b 20 57 72 69 74 65 20 61 =====.;; Write a
9dd0: 20 63 6f 6e 66 69 67 0a 3b 3b 20 20 20 30 2e 20 config.;; 0.
9de0: 47 69 76 65 6e 20 61 20 72 65 66 65 72 65 72 65 Given a referere
9df0: 6e 63 65 20 64 61 74 61 20 73 74 72 75 63 74 75 nce data structu
9e00: 72 65 20 22 69 6e 64 61 74 22 0a 3b 3b 20 20 20 re "indat".;;
9e10: 31 2e 20 4f 70 65 6e 20 74 68 65 20 6f 75 74 70 1. Open the outp
9e20: 75 74 20 66 69 6c 65 20 61 6e 64 20 72 65 61 64 ut file and read
9e30: 20 69 74 20 69 6e 74 6f 20 61 20 6c 69 73 74 0a it into a list.
9e40: 3b 3b 20 20 20 32 2e 20 46 6c 61 74 74 65 6e 20 ;; 2. Flatten
9e50: 61 6e 79 20 6d 75 6c 74 69 6c 69 6e 65 20 65 6e any multiline en
9e60: 74 72 69 65 73 0a 3b 3b 20 20 20 33 2e 20 4d 6f tries.;; 3. Mo
9e70: 64 69 66 79 20 76 61 6c 75 65 73 20 70 65 72 20 dify values per
9e80: 63 6f 6e 74 65 6e 74 73 20 6f 66 20 22 69 6e 64 contents of "ind
9e90: 61 74 22 20 61 6e 64 20 72 65 6d 6f 76 65 20 61 at" and remove a
9ea0: 62 73 65 6e 74 20 76 61 6c 75 65 73 0a 3b 3b 20 bsent values.;;
9eb0: 20 20 34 2e 20 41 70 70 65 6e 64 20 6e 65 77 20 4. Append new
9ec0: 76 61 6c 75 65 73 20 74 6f 20 74 68 65 20 73 65 values to the se
9ed0: 63 74 69 6f 6e 20 28 69 6d 6d 65 64 69 61 74 65 ction (immediate
9ee0: 6c 79 20 61 66 74 65 72 20 6c 61 73 74 20 6c 65 ly after last le
9ef0: 67 69 74 20 65 6e 74 72 79 29 0a 3b 3b 20 20 20 git entry).;;
9f00: 35 2e 20 57 72 69 74 65 20 6f 75 74 20 74 68 65 5. Write out the
9f10: 20 6e 65 77 20 6c 69 73 74 20 0a 3b 3b 3d 3d 3d new list .;;===
9f20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9f30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9f40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9f50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9f60: 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 77 72 ===..(define (wr
9f70: 69 74 65 2d 63 6f 6e 66 69 67 20 69 6e 64 61 74 ite-config indat
9f80: 20 66 6e 61 6d 65 20 23 21 6b 65 79 20 28 72 65 fname #!key (re
9f90: 71 75 69 72 65 64 2d 73 65 63 74 69 6f 6e 73 20 quired-sections
9fa0: 27 28 29 29 29 0a 20 20 28 6c 65 74 2a 20 28 3b '())). (let* (;
9fb0: 3b 20 73 74 65 70 20 31 3a 20 4f 70 65 6e 20 74 ; step 1: Open t
9fc0: 68 65 20 6f 75 74 70 75 74 20 66 69 6c 65 20 61 he output file a
9fd0: 6e 64 20 72 65 61 64 20 69 74 20 69 6e 74 6f 20 nd read it into
9fe0: 61 20 6c 69 73 74 0a 09 20 28 66 64 61 74 20 20 a list.. (fdat
9ff0: 20 20 20 20 20 28 66 69 6c 65 2d 3e 6c 69 73 74 (file->list
a000: 20 66 6e 61 6d 65 29 29 0a 09 20 28 72 65 66 64 fname)).. (refd
a010: 61 74 20 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 at (make-hash-t
a020: 61 62 6c 65 29 29 0a 09 20 28 73 65 63 68 61 73 able)).. (sechas
a030: 68 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 h (make-hash-tab
a040: 6c 65 29 29 20 3b 3b 20 63 75 72 72 65 6e 74 20 le)) ;; current
a050: 73 65 63 74 69 6f 6e 20 68 61 73 68 2c 20 69 6e section hash, in
a060: 69 74 20 77 69 74 68 20 68 61 73 68 20 66 6f 72 it with hash for
a070: 20 22 64 65 66 61 75 6c 74 22 20 73 65 63 74 69 "default" secti
a080: 6f 6e 0a 09 20 28 6e 65 77 20 20 20 20 20 23 66 on.. (new #f
a090: 29 20 3b 3b 20 70 75 74 20 74 68 65 20 6c 69 6e ) ;; put the lin
a0a0: 65 20 74 6f 20 62 65 20 75 73 65 64 20 69 6e 20 e to be used in
a0b0: 6e 65 77 2c 20 69 66 20 69 74 20 69 73 20 74 6f new, if it is to
a0c0: 20 62 65 20 64 65 6c 65 74 65 64 20 74 68 65 20 be deleted the
a0d0: 73 65 74 20 6e 65 77 20 74 6f 20 23 66 0a 09 20 set new to #f..
a0e0: 28 73 65 63 6e 61 6d 65 20 23 66 29 29 0a 0a 20 (secname #f))..
a0f0: 20 20 20 3b 3b 20 73 74 65 70 20 32 3a 20 46 6c ;; step 2: Fl
a100: 61 74 74 65 6e 20 6d 75 6c 74 69 6c 69 6e 65 20 atten multiline
a110: 65 6e 74 72 69 65 73 0a 20 20 20 20 28 69 66 20 entries. (if
a120: 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 66 64 61 74 (not (null? fdat
a130: 29 29 28 73 65 74 21 20 66 64 61 74 20 28 63 6f ))(set! fdat (co
a140: 6d 70 72 65 73 73 2d 6d 75 6c 74 69 2d 6c 69 6e mpress-multi-lin
a150: 65 73 20 66 64 61 74 29 29 29 0a 0a 20 20 20 20 es fdat)))..
a160: 3b 3b 20 73 74 65 70 20 33 3a 20 4d 6f 64 69 66 ;; step 3: Modif
a170: 79 20 76 61 6c 75 65 73 20 70 65 72 20 63 6f 6e y values per con
a180: 74 65 6e 74 73 20 6f 66 20 22 69 6e 64 61 74 22 tents of "indat"
a190: 20 61 6e 64 20 72 65 6d 6f 76 65 20 61 62 73 65 and remove abse
a1a0: 6e 74 20 76 61 6c 75 65 73 0a 20 20 20 20 28 69 nt values. (i
a1b0: 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 66 64 f (not (null? fd
a1c0: 61 74 29 29 0a 09 28 6c 65 74 20 6c 6f 6f 70 20 at))..(let loop
a1d0: 28 28 68 65 64 20 20 28 63 61 72 20 66 64 61 74 ((hed (car fdat
a1e0: 29 29 0a 09 09 20 20 20 28 74 61 6c 20 20 28 63 ))... (tal (c
a1f0: 61 64 72 20 66 64 61 74 29 29 0a 09 09 20 20 20 adr fdat))...
a200: 28 72 65 73 20 20 27 28 29 29 0a 09 09 20 20 20 (res '())...
a210: 28 6c 6e 75 6d 20 30 29 29 0a 09 20 20 28 72 65 (lnum 0)).. (re
a220: 67 65 78 2d 63 61 73 65 20 0a 09 20 20 20 68 65 gex-case .. he
a230: 64 0a 09 20 20 20 28 63 6f 6e 66 69 67 66 3a 63 d.. (configf:c
a240: 6f 6d 6d 65 6e 74 2d 72 78 20 5f 20 20 20 20 20 omment-rx _
a250: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 65 (se
a260: 74 21 20 72 65 73 20 28 61 70 70 65 6e 64 20 72 t! res (append r
a270: 65 73 20 28 6c 69 73 74 20 68 65 64 29 29 29 29 es (list hed))))
a280: 20 3b 3b 20 28 6c 6f 6f 70 20 28 72 65 61 64 2d ;; (loop (read-
a290: 6c 69 6e 65 20 69 6e 70 29 20 63 75 72 72 2d 73 line inp) curr-s
a2a0: 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 ection-name #f #
a2b0: 66 29 29 0a 09 20 20 20 28 63 6f 6e 66 69 67 66 f)).. (configf
a2c0: 3a 62 6c 61 6e 6b 2d 6c 2d 72 78 20 5f 20 20 20 :blank-l-rx _
a2d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
a2e0: 73 65 74 21 20 72 65 73 20 28 61 70 70 65 6e 64 set! res (append
a2f0: 20 72 65 73 20 28 6c 69 73 74 20 68 65 64 29 29 res (list hed))
a300: 29 29 20 3b 3b 20 28 6c 6f 6f 70 20 28 72 65 61 )) ;; (loop (rea
a310: 64 2d 6c 69 6e 65 20 69 6e 70 29 20 63 75 72 72 d-line inp) curr
a320: 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 -section-name #f
a330: 20 23 66 29 29 0a 09 20 20 20 28 63 6f 6e 66 69 #f)).. (confi
a340: 67 66 3a 73 65 63 74 69 6f 6e 2d 72 78 20 28 20 gf:section-rx (
a350: 78 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 29 x section-name )
a360: 20 28 6c 65 74 20 28 28 73 65 63 74 69 6f 6e 2d (let ((section-
a370: 68 61 73 68 20 28 68 61 73 68 2d 74 61 62 6c 65 hash (hash-table
a380: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 72 65 66 -ref/default ref
a390: 64 61 74 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 dat section-name
a3a0: 20 23 66 29 29 29 0a 09 09 09 09 09 20 20 20 20 #f)))......
a3b0: 28 69 66 20 28 6e 6f 74 20 73 65 63 74 69 6f 6e (if (not section
a3c0: 2d 68 61 73 68 29 0a 09 09 09 09 09 09 28 6c 65 -hash).......(le
a3d0: 74 20 28 28 6e 65 77 68 61 73 68 20 28 6d 61 6b t ((newhash (mak
a3e0: 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 29 0a e-hash-table))).
a3f0: 09 09 09 09 09 09 20 20 28 68 61 73 68 2d 74 61 ...... (hash-ta
a400: 62 6c 65 2d 73 65 74 21 20 72 65 66 64 61 74 20 ble-set! refdat
a410: 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 6e 65 77 section-name new
a420: 68 61 73 68 29 0a 09 09 09 09 09 09 20 20 28 73 hash)....... (s
a430: 65 74 21 20 73 65 63 68 61 73 68 20 6e 65 77 68 et! sechash newh
a440: 61 73 68 29 29 0a 09 09 09 09 09 09 28 73 65 74 ash)).......(set
a450: 21 20 73 65 63 68 61 73 68 20 73 65 63 74 69 6f ! sechash sectio
a460: 6e 2d 68 61 73 68 29 29 0a 09 09 09 09 09 20 20 n-hash))......
a470: 20 20 28 73 65 74 21 20 6e 65 77 20 68 65 64 29 (set! new hed)
a480: 20 3b 3b 20 77 69 6c 6c 20 61 70 70 65 6e 64 20 ;; will append
a490: 74 68 69 73 20 61 74 20 74 68 65 20 62 6f 74 74 this at the bott
a4a0: 6f 6d 20 6f 66 20 74 68 65 20 6c 6f 6f 70 0a 09 om of the loop..
a4b0: 09 09 09 09 20 20 20 20 28 73 65 74 21 20 73 65 .... (set! se
a4c0: 63 6e 61 6d 65 20 73 65 63 74 69 6f 6e 2d 6e 61 cname section-na
a4d0: 6d 65 29 0a 09 09 09 09 09 20 20 20 20 29 29 0a me)...... )).
a4e0: 09 20 20 20 3b 3b 20 4e 6f 20 6e 65 65 64 20 74 . ;; No need t
a4f0: 6f 20 70 72 6f 63 65 73 73 20 6b 65 79 20 63 6d o process key cm
a500: 64 2c 20 6c 65 74 20 69 74 20 66 61 6c 6c 20 74 d, let it fall t
a510: 68 6f 75 67 68 20 74 6f 20 6b 65 79 20 76 61 6c hough to key val
a520: 0a 09 20 20 20 28 63 6f 6e 66 69 67 66 3a 6b 65 .. (configf:ke
a530: 79 2d 76 61 6c 2d 70 72 20 28 20 78 20 6b 65 79 y-val-pr ( x key
a540: 20 76 61 6c 20 20 20 20 20 20 29 0a 09 09 20 20 val )...
a550: 20 20 20 20 20 28 6c 65 74 20 28 28 6e 65 77 76 (let ((newv
a560: 61 6c 20 28 6c 6f 6f 6b 75 70 20 69 6e 64 61 74 al (lookup indat
a570: 20 73 65 63 6e 61 6d 65 20 6b 65 79 29 29 29 20 secname key)))
a580: 3b 3b 20 73 65 63 6e 61 6d 65 20 77 61 73 20 73 ;; secname was s
a590: 65 63 2e 20 49 20 74 68 69 6e 6b 20 74 68 61 74 ec. I think that
a5a0: 20 77 61 73 20 61 20 62 75 67 0a 09 09 09 20 3b was a bug.... ;
a5b0: 3b 20 63 61 6e 20 68 61 6e 64 6c 65 20 6e 65 77 ; can handle new
a5c0: 76 61 6c 20 3d 3d 20 23 66 20 68 65 72 65 20 3d val == #f here =
a5d0: 3e 20 74 68 61 74 20 6d 65 61 6e 73 20 6b 65 79 > that means key
a5e0: 20 69 73 20 72 65 6d 6f 76 65 64 0a 09 09 09 20 is removed....
a5f0: 28 63 6f 6e 64 20 0a 09 09 09 20 20 28 28 65 71 (cond .... ((eq
a600: 75 61 6c 3f 20 6e 65 77 76 61 6c 20 76 61 6c 29 ual? newval val)
a610: 0a 09 09 09 20 20 20 28 73 65 74 21 20 72 65 73 .... (set! res
a620: 20 28 61 70 70 65 6e 64 20 72 65 73 20 28 6c 69 (append res (li
a630: 73 74 20 68 65 64 29 29 29 29 0a 09 09 09 20 20 st hed))))....
a640: 28 28 6e 6f 74 20 6e 65 77 76 61 6c 29 20 3b 3b ((not newval) ;;
a650: 20 6b 65 79 20 68 61 73 20 62 65 65 6e 20 72 65 key has been re
a660: 6d 6f 76 65 64 0a 09 09 09 20 20 20 28 73 65 74 moved.... (set
a670: 21 20 6e 65 77 20 23 66 29 29 0a 09 09 09 20 20 ! new #f))....
a680: 28 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 6e 65 ((not (equal? ne
a690: 77 76 61 6c 20 76 61 6c 29 29 0a 09 09 09 20 20 wval val))....
a6a0: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 (hash-table-s
a6b0: 65 74 21 20 73 65 63 68 61 73 68 20 6b 65 79 20 et! sechash key
a6c0: 6e 65 77 76 61 6c 29 0a 09 09 09 20 20 20 20 20 newval)....
a6d0: 28 73 65 74 21 20 6e 65 77 20 28 63 6f 6e 63 20 (set! new (conc
a6e0: 6b 65 79 20 22 20 22 20 6e 65 77 76 61 6c 29 29 key " " newval))
a6f0: 29 0a 09 09 09 20 20 28 65 6c 73 65 0a 09 09 09 ).... (else....
a700: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d (debug:print-
a710: 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 error 0 *default
a720: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 70 72 6f 62 -log-port* "prob
a730: 6c 65 6d 20 70 61 72 73 69 6e 67 20 6c 69 6e 65 lem parsing line
a740: 20 6e 75 6d 62 65 72 20 22 20 6c 6e 75 6d 20 22 number " lnum "
a750: 5c 22 22 20 68 65 64 20 22 5c 22 22 29 29 29 29 \"" hed "\""))))
a760: 29 0a 09 20 20 20 28 65 6c 73 65 0a 09 20 20 20 ).. (else..
a770: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 (debug:print-er
a780: 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c ror 0 *default-l
a790: 6f 67 2d 70 6f 72 74 2a 20 22 50 72 6f 62 6c 65 og-port* "Proble
a7a0: 6d 20 70 61 72 73 69 6e 67 20 6c 69 6e 65 20 6e m parsing line n
a7b0: 75 6d 20 22 20 6c 6e 75 6d 20 22 20 3a 5c 6e 20 um " lnum " :\n
a7c0: 20 20 22 20 68 65 64 20 29 29 29 0a 09 20 20 28 " hed ))).. (
a7d0: 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 74 if (not (null? t
a7e0: 61 6c 29 29 0a 09 20 20 20 20 20 20 28 6c 6f 6f al)).. (loo
a7f0: 70 20 28 63 61 72 20 74 61 6c 29 28 63 64 72 20 p (car tal)(cdr
a800: 74 61 6c 29 28 69 66 20 6e 65 77 20 28 61 70 70 tal)(if new (app
a810: 65 6e 64 20 72 65 73 20 28 6c 69 73 74 20 6e 65 end res (list ne
a820: 77 29 29 20 72 65 73 29 28 2b 20 6c 6e 75 6d 20 w)) res)(+ lnum
a830: 31 29 29 29 0a 09 20 20 3b 3b 20 64 72 6f 70 20 1))).. ;; drop
a840: 74 6f 20 68 65 72 65 20 77 68 65 6e 20 64 6f 6e to here when don
a850: 65 20 70 72 6f 63 65 73 73 69 6e 67 2c 20 72 65 e processing, re
a860: 73 20 63 6f 6e 74 61 69 6e 73 20 6d 6f 64 69 66 s contains modif
a870: 69 65 64 20 6c 69 73 74 20 6f 66 20 6c 69 6e 65 ied list of line
a880: 73 0a 09 20 20 28 73 65 74 21 20 66 64 61 74 20 s.. (set! fdat
a890: 72 65 73 29 29 29 0a 0a 20 20 20 20 3b 3b 20 73 res))).. ;; s
a8a0: 74 65 70 20 34 3a 20 41 70 70 65 6e 64 20 6e 65 tep 4: Append ne
a8b0: 77 20 76 61 6c 75 65 73 20 74 6f 20 74 68 65 20 w values to the
a8c0: 73 65 63 74 69 6f 6e 0a 20 20 20 20 28 66 6f 72 section. (for
a8d0: 2d 65 61 63 68 20 0a 20 20 20 20 20 28 6c 61 6d -each . (lam
a8e0: 62 64 61 20 28 73 65 63 74 69 6f 6e 29 0a 20 20 bda (section).
a8f0: 20 20 20 20 20 28 6c 65 74 20 28 28 73 64 61 74 (let ((sdat
a900: 20 20 20 27 28 29 29 20 3b 3b 20 61 70 70 65 6e '()) ;; appen
a910: 64 20 6e 65 65 64 65 64 20 62 69 74 73 20 68 65 d needed bits he
a920: 72 65 0a 09 20 20 20 20 20 28 73 76 61 72 73 20 re.. (svars
a930: 20 28 73 65 63 74 69 6f 6e 2d 76 61 72 73 20 69 (section-vars i
a940: 6e 64 61 74 20 73 65 63 74 69 6f 6e 29 29 29 0a ndat section))).
a950: 09 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 20 20 . (for-each ..
a960: 28 6c 61 6d 62 64 61 20 28 76 61 72 29 0a 09 20 (lambda (var)..
a970: 20 20 20 28 6c 65 74 20 28 28 76 61 6c 20 28 6c (let ((val (l
a980: 6f 6f 6b 75 70 20 72 65 66 64 61 74 20 73 65 63 ookup refdat sec
a990: 74 69 6f 6e 20 76 61 72 29 29 29 0a 09 20 20 20 tion var)))..
a9a0: 20 20 20 28 69 66 20 28 6e 6f 74 20 76 61 6c 29 (if (not val)
a9b0: 20 3b 3b 20 74 68 69 73 20 6f 6e 65 20 69 73 20 ;; this one is
a9c0: 6e 65 77 0a 09 09 20 20 28 62 65 67 69 6e 0a 09 new... (begin..
a9d0: 09 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 . (if (null?
a9e0: 73 64 61 74 29 28 73 65 74 21 20 73 64 61 74 20 sdat)(set! sdat
a9f0: 28 6c 69 73 74 20 28 63 6f 6e 63 20 22 5b 22 20 (list (conc "["
aa00: 73 65 63 74 69 6f 6e 20 22 5d 22 29 29 29 29 0a section "]")))).
aa10: 09 09 20 20 20 20 28 73 65 74 21 20 73 64 61 74 .. (set! sdat
aa20: 20 28 61 70 70 65 6e 64 20 73 64 61 74 20 28 6c (append sdat (l
aa30: 69 73 74 20 28 63 6f 6e 63 20 76 61 72 20 22 20 ist (conc var "
aa40: 22 20 76 61 6c 29 29 29 29 29 29 29 29 0a 09 20 " val))))))))..
aa50: 20 73 76 61 72 73 29 0a 09 20 28 73 65 74 21 20 svars).. (set!
aa60: 66 64 61 74 20 28 61 70 70 65 6e 64 20 66 64 61 fdat (append fda
aa70: 74 20 73 64 61 74 29 29 29 29 0a 20 20 20 20 20 t sdat)))).
aa80: 28 64 65 6c 65 74 65 2d 64 75 70 6c 69 63 61 74 (delete-duplicat
aa90: 65 73 20 28 61 70 70 65 6e 64 20 72 65 71 75 69 es (append requi
aaa0: 72 65 64 2d 73 65 63 74 69 6f 6e 73 20 28 68 61 red-sections (ha
aab0: 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 69 6e sh-table-keys in
aac0: 64 61 74 29 29 29 29 0a 0a 20 20 20 20 3b 3b 20 dat)))).. ;;
aad0: 73 74 65 70 20 35 3a 20 57 72 69 74 65 20 6f 75 step 5: Write ou
aae0: 74 20 6e 65 77 20 66 69 6c 65 0a 20 20 20 20 28 t new file. (
aaf0: 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 with-output-to-f
ab00: 69 6c 65 20 66 6e 61 6d 65 20 0a 20 20 20 20 20 ile fname .
ab10: 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 28 66 6f (lambda ()..(fo
ab20: 72 2d 65 61 63 68 20 0a 09 20 28 6c 61 6d 62 64 r-each .. (lambd
ab30: 61 20 28 6c 69 6e 65 29 0a 09 20 20 20 28 70 72 a (line).. (pr
ab40: 69 6e 74 20 6c 69 6e 65 29 29 0a 09 20 28 65 78 int line)).. (ex
ab50: 70 61 6e 64 2d 6d 75 6c 74 69 2d 6c 69 6e 65 73 pand-multi-lines
ab60: 20 66 64 61 74 29 29 29 29 29 29 0a 0a 3b 3b 3d fdat))))))..;;=
ab70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ab80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ab90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
aba0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
abb0: 3d 3d 3d 3d 3d 0a 3b 3b 20 72 65 66 64 62 0a 3b =====.;; refdb.;
abc0: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
abd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
abe0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
abf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ac00: 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 72 65 61 64 =======..;; read
ac10: 73 20 61 20 72 65 66 64 62 20 69 6e 74 6f 20 61 s a refdb into a
ac20: 6e 20 61 73 73 6f 63 20 61 72 72 61 79 20 6f 66 n assoc array of
ac30: 20 61 73 73 6f 63 20 61 72 72 61 79 73 0a 3b 3b assoc arrays.;;
ac40: 20 20 20 72 65 74 75 72 6e 73 20 28 6c 69 73 74 returns (list
ac50: 20 64 61 74 20 6d 73 67 29 0a 28 64 65 66 69 6e dat msg).(defin
ac60: 65 20 28 72 65 61 64 2d 72 65 66 64 62 20 72 65 e (read-refdb re
ac70: 66 64 62 2d 70 61 74 68 29 0a 20 20 28 6c 65 74 fdb-path). (let
ac80: 20 28 28 73 68 65 65 74 73 2d 66 69 6c 65 20 20 ((sheets-file
ac90: 28 63 6f 6e 63 20 72 65 66 64 62 2d 70 61 74 68 (conc refdb-path
aca0: 20 22 2f 73 68 65 65 74 2d 6e 61 6d 65 73 2e 63 "/sheet-names.c
acb0: 66 67 22 29 29 29 0a 20 20 20 20 28 69 66 20 28 fg"))). (if (
acc0: 6e 6f 74 20 28 73 61 66 65 2d 66 69 6c 65 2d 65 not (safe-file-e
acd0: 78 69 73 74 73 3f 20 73 68 65 65 74 73 2d 66 69 xists? sheets-fi
ace0: 6c 65 29 29 0a 09 28 6c 69 73 74 20 23 66 20 28 le))..(list #f (
acf0: 63 6f 6e 63 20 22 45 52 52 4f 52 3a 20 6e 6f 20 conc "ERROR: no
ad00: 72 65 66 64 62 20 66 6f 75 6e 64 20 61 74 20 22 refdb found at "
ad10: 20 72 65 66 64 62 2d 70 61 74 68 29 29 0a 09 28 refdb-path))..(
ad20: 69 66 20 28 6e 6f 74 20 28 66 69 6c 65 2d 72 65 if (not (file-re
ad30: 61 64 2d 61 63 63 65 73 73 3f 20 73 68 65 65 74 ad-access? sheet
ad40: 73 2d 66 69 6c 65 29 29 0a 09 20 20 20 20 28 6c s-file)).. (l
ad50: 69 73 74 20 23 66 20 28 63 6f 6e 63 20 22 45 52 ist #f (conc "ER
ad60: 52 4f 52 3a 20 72 65 66 64 62 20 66 69 6c 65 20 ROR: refdb file
ad70: 6e 6f 74 20 72 65 61 64 61 62 6c 65 20 61 74 20 not readable at
ad80: 22 20 72 65 66 64 62 2d 70 61 74 68 29 29 0a 09 " refdb-path))..
ad90: 20 20 20 20 28 6c 65 74 2a 20 28 28 73 68 65 65 (let* ((shee
ada0: 74 73 20 28 77 69 74 68 2d 69 6e 70 75 74 2d 66 ts (with-input-f
adb0: 72 6f 6d 2d 66 69 6c 65 20 73 68 65 65 74 73 2d rom-file sheets-
adc0: 66 69 6c 65 0a 09 09 09 20 20 20 20 20 28 6c 61 file.... (la
add0: 6d 62 64 61 20 28 29 0a 09 09 09 20 20 20 20 20 mbda ()....
ade0: 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 69 6e (let loop ((in
adf0: 6c 20 28 72 65 61 64 2d 6c 69 6e 65 29 29 0a 09 l (read-line))..
ae00: 09 09 09 09 20 20 28 72 65 73 20 27 28 29 29 29 .... (res '()))
ae10: 0a 09 09 09 09 20 28 69 66 20 28 65 6f 66 2d 6f ..... (if (eof-o
ae20: 62 6a 65 63 74 3f 20 69 6e 6c 29 0a 09 09 09 09 bject? inl).....
ae30: 20 20 20 20 20 28 72 65 76 65 72 73 65 20 72 65 (reverse re
ae40: 73 29 0a 09 09 09 09 20 20 20 20 20 28 6c 6f 6f s)..... (loo
ae50: 70 20 28 72 65 61 64 2d 6c 69 6e 65 29 28 63 6f p (read-line)(co
ae60: 6e 73 20 69 6e 6c 20 72 65 73 29 29 29 29 29 29 ns inl res))))))
ae70: 29 0a 09 09 20 20 20 28 64 61 74 61 20 20 20 27 )... (data '
ae80: 28 29 29 29 0a 09 20 20 20 20 20 20 28 66 6f 72 ())).. (for
ae90: 2d 65 61 63 68 20 0a 09 20 20 20 20 20 20 20 28 -each .. (
aea0: 6c 61 6d 62 64 61 20 28 73 68 65 65 74 2d 6e 61 lambda (sheet-na
aeb0: 6d 65 29 0a 09 09 20 28 6c 65 74 2a 20 28 28 64 me)... (let* ((d
aec0: 61 74 2d 70 61 74 68 20 20 28 63 6f 6e 63 20 72 at-path (conc r
aed0: 65 66 64 62 2d 70 61 74 68 20 22 2f 22 20 73 68 efdb-path "/" sh
aee0: 65 65 74 2d 6e 61 6d 65 20 22 2e 64 61 74 22 29 eet-name ".dat")
aef0: 29 0a 09 09 09 28 72 65 66 2d 64 61 74 20 20 20 )....(ref-dat
af00: 28 72 65 61 64 2d 63 6f 6e 66 69 67 20 64 61 74 (read-config dat
af10: 2d 70 61 74 68 20 23 66 20 23 74 29 29 0a 09 09 -path #f #t))...
af20: 09 28 72 65 66 2d 61 73 73 6f 63 20 28 6d 61 70 .(ref-assoc (map
af30: 20 28 6c 61 6d 62 64 61 20 28 6b 65 79 29 0a 09 (lambda (key)..
af40: 09 09 09 09 20 20 28 6c 69 73 74 20 6b 65 79 20 .... (list key
af50: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 (hash-table-ref
af60: 72 65 66 2d 64 61 74 20 6b 65 79 29 29 29 0a 09 ref-dat key)))..
af70: 09 09 09 09 28 68 61 73 68 2d 74 61 62 6c 65 2d ....(hash-table-
af80: 6b 65 79 73 20 72 65 66 2d 64 61 74 29 29 29 29 keys ref-dat))))
af90: 0a 09 09 09 09 20 20 20 3b 3b 20 28 68 61 73 68 ..... ;; (hash
afa0: 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 74 20 72 65 -table->alist re
afb0: 66 2d 64 61 74 29 29 29 0a 09 09 20 20 20 3b 3b f-dat)))... ;;
afc0: 20 28 73 65 74 21 20 64 61 74 61 20 28 61 70 70 (set! data (app
afd0: 65 6e 64 20 64 61 74 61 20 28 6c 69 73 74 20 28 end data (list (
afe0: 6c 69 73 74 20 73 68 65 65 74 2d 6e 61 6d 65 20 list sheet-name
aff0: 72 65 66 2d 61 73 73 6f 63 29 29 29 29 29 29 0a ref-assoc)))))).
b000: 09 09 20 20 20 28 73 65 74 21 20 64 61 74 61 20 .. (set! data
b010: 28 63 6f 6e 73 20 28 6c 69 73 74 20 73 68 65 65 (cons (list shee
b020: 74 2d 6e 61 6d 65 20 72 65 66 2d 61 73 73 6f 63 t-name ref-assoc
b030: 29 20 64 61 74 61 29 29 29 29 0a 09 20 20 20 20 ) data))))..
b040: 20 20 20 73 68 65 65 74 73 29 0a 09 20 20 20 20 sheets)..
b050: 20 20 28 6c 69 73 74 20 64 61 74 61 20 22 4e 4f (list data "NO
b060: 20 45 52 52 4f 52 53 22 29 29 29 29 29 29 0a 0a ERRORS"))))))..
b070: 3b 3b 20 6d 61 70 20 6f 76 65 72 20 61 6c 6c 20 ;; map over all
b080: 70 61 69 72 73 20 69 6e 20 61 20 74 68 72 65 65 pairs in a three
b090: 20 6c 65 76 65 6c 20 68 69 65 72 61 72 63 68 69 level hierarchi
b0a0: 61 6c 20 61 6c 69 73 74 20 61 6e 64 20 61 70 70 al alist and app
b0b0: 6c 79 20 61 20 66 75 6e 63 74 69 6f 6e 20 74 6f ly a function to
b0c0: 20 74 68 65 20 6b 65 79 73 2f 76 61 6c 0a 3b 3b the keys/val.;;
b0d0: 0a 28 64 65 66 69 6e 65 20 28 6d 61 70 2d 61 6c .(define (map-al
b0e0: 6c 2d 68 69 65 72 2d 61 6c 69 73 74 20 64 61 74 l-hier-alist dat
b0f0: 61 20 70 72 6f 63 20 23 21 6b 65 79 20 28 69 6e a proc #!key (in
b100: 69 74 70 72 6f 63 31 20 23 66 29 28 69 6e 69 74 itproc1 #f)(init
b110: 70 72 6f 63 32 20 23 66 29 28 69 6e 69 74 70 72 proc2 #f)(initpr
b120: 6f 63 33 20 23 66 29 29 0a 20 20 28 66 6f 72 2d oc3 #f)). (for-
b130: 65 61 63 68 20 0a 20 20 20 28 6c 61 6d 62 64 61 each . (lambda
b140: 20 28 73 68 65 65 74 6e 61 6d 65 29 0a 20 20 20 (sheetname).
b150: 20 20 28 6c 65 74 2a 20 28 28 73 68 65 65 74 74 (let* ((sheett
b160: 6d 70 20 20 28 61 73 73 6f 63 20 73 68 65 65 74 mp (assoc sheet
b170: 6e 61 6d 65 20 64 61 74 61 29 29 0a 09 20 20 20 name data))..
b180: 20 28 73 68 65 65 74 64 61 74 20 20 28 69 66 20 (sheetdat (if
b190: 73 68 65 65 74 74 6d 70 20 28 63 61 64 72 20 73 sheettmp (cadr s
b1a0: 68 65 65 74 74 6d 70 29 20 27 28 29 29 29 29 0a heettmp) '()))).
b1b0: 20 20 20 20 20 20 20 28 69 66 20 69 6e 69 74 70 (if initp
b1c0: 72 6f 63 31 20 28 69 6e 69 74 70 72 6f 63 31 20 roc1 (initproc1
b1d0: 73 68 65 65 74 6e 61 6d 65 29 29 0a 20 20 20 20 sheetname)).
b1e0: 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 28 (for-each ..(
b1f0: 6c 61 6d 62 64 61 20 28 73 65 63 74 69 6f 6e 6e lambda (sectionn
b200: 61 6d 65 29 0a 09 20 20 28 6c 65 74 2a 20 28 28 ame).. (let* ((
b210: 73 65 63 74 69 6f 6e 74 6d 70 20 20 28 61 73 73 sectiontmp (ass
b220: 6f 63 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20 73 oc sectionname s
b230: 68 65 65 74 64 61 74 29 29 0a 09 09 20 28 73 65 heetdat))... (se
b240: 63 74 69 6f 6e 64 61 74 20 20 28 69 66 20 73 65 ctiondat (if se
b250: 63 74 69 6f 6e 74 6d 70 20 28 63 61 64 72 20 73 ctiontmp (cadr s
b260: 65 63 74 69 6f 6e 74 6d 70 29 20 27 28 29 29 29 ectiontmp) '()))
b270: 29 0a 09 20 20 20 20 28 69 66 20 69 6e 69 74 70 ).. (if initp
b280: 72 6f 63 32 20 28 69 6e 69 74 70 72 6f 63 32 20 roc2 (initproc2
b290: 73 68 65 65 74 6e 61 6d 65 20 73 65 63 74 69 6f sheetname sectio
b2a0: 6e 6e 61 6d 65 29 29 0a 09 20 20 20 20 28 66 6f nname)).. (fo
b2b0: 72 2d 65 61 63 68 0a 09 20 20 20 20 20 28 6c 61 r-each.. (la
b2c0: 6d 62 64 61 20 28 76 61 72 6e 61 6d 65 29 0a 09 mbda (varname)..
b2d0: 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 76 (let* ((v
b2e0: 61 6c 74 6d 70 20 28 61 73 73 6f 63 20 76 61 72 altmp (assoc var
b2f0: 6e 61 6d 65 20 73 65 63 74 69 6f 6e 64 61 74 29 name sectiondat)
b300: 29 0a 09 09 20 20 20 20 20 20 28 76 61 6c 20 20 )... (val
b310: 20 20 28 69 66 20 76 61 6c 74 6d 70 20 28 63 61 (if valtmp (ca
b320: 64 72 20 76 61 6c 74 6d 70 29 20 22 22 29 29 29 dr valtmp) "")))
b330: 0a 09 09 20 28 70 72 6f 63 20 73 68 65 65 74 6e ... (proc sheetn
b340: 61 6d 65 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20 ame sectionname
b350: 76 61 72 6e 61 6d 65 20 76 61 6c 29 29 29 0a 09 varname val)))..
b360: 20 20 20 20 20 28 6d 61 70 20 63 61 72 20 73 65 (map car se
b370: 63 74 69 6f 6e 64 61 74 29 29 29 29 0a 09 28 6d ctiondat))))..(m
b380: 61 70 20 63 61 72 20 73 68 65 65 74 64 61 74 29 ap car sheetdat)
b390: 29 29 29 0a 20 20 20 28 6d 61 70 20 63 61 72 20 ))). (map car
b3a0: 64 61 74 61 29 29 0a 20 20 64 61 74 61 29 0a 0a data)). data)..
b3b0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
b3c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b3d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b3e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b3f0: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 20 43 20 4f ========.;; C O
b400: 20 4e 20 46 20 49 20 47 20 20 20 54 20 4f 20 2f N F I G T O /
b410: 20 46 20 52 20 4f 20 4d 20 20 20 41 20 4c 20 49 F R O M A L I
b420: 20 53 20 54 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d S T.;;=========
b430: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b440: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b450: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b460: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 =============..(
b470: 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 2d 3e define (config->
b480: 61 6c 69 73 74 20 63 66 67 64 61 74 29 0a 20 20 alist cfgdat).
b490: 28 68 61 73 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 (hash-table->ali
b4a0: 73 74 20 63 66 67 64 61 74 29 29 0a 0a 28 64 65 st cfgdat))..(de
b4b0: 66 69 6e 65 20 28 61 6c 69 73 74 2d 3e 63 6f 6e fine (alist->con
b4c0: 66 69 67 20 61 64 61 74 29 0a 20 20 28 6c 65 74 fig adat). (let
b4d0: 20 28 28 68 74 20 28 6d 61 6b 65 2d 68 61 73 68 ((ht (make-hash
b4e0: 2d 74 61 62 6c 65 29 29 29 0a 20 20 20 20 28 66 -table))). (f
b4f0: 6f 72 2d 65 61 63 68 0a 20 20 20 20 20 28 6c 61 or-each. (la
b500: 6d 62 64 61 20 28 73 65 63 74 69 6f 6e 29 0a 20 mbda (section).
b510: 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c (hash-tabl
b520: 65 2d 73 65 74 21 20 68 74 20 28 63 61 72 20 73 e-set! ht (car s
b530: 65 63 74 69 6f 6e 29 28 63 64 72 20 73 65 63 74 ection)(cdr sect
b540: 69 6f 6e 29 29 29 0a 20 20 20 20 20 61 64 61 74 ion))). adat
b550: 29 0a 20 20 20 20 68 74 29 29 0a 0a 3b 3b 20 69 ). ht))..;; i
b560: 66 20 0a 28 64 65 66 69 6e 65 20 28 72 65 61 64 f .(define (read
b570: 2d 61 6c 69 73 74 20 66 6e 61 6d 65 29 0a 20 20 -alist fname).
b580: 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f (handle-exceptio
b590: 6e 73 0a 20 20 20 20 20 20 65 78 6e 0a 20 20 20 ns. exn.
b5a0: 20 20 20 23 66 0a 20 20 20 20 28 61 6c 69 73 74 #f. (alist
b5b0: 2d 3e 63 6f 6e 66 69 67 0a 20 20 20 20 20 28 77 ->config. (w
b5c0: 69 74 68 2d 69 6e 70 75 74 2d 66 72 6f 6d 2d 66 ith-input-from-f
b5d0: 69 6c 65 20 66 6e 61 6d 65 20 72 65 61 64 29 29 ile fname read))
b5e0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 77 72 69 ))..(define (wri
b5f0: 74 65 2d 61 6c 69 73 74 20 63 64 61 74 20 66 6e te-alist cdat fn
b600: 61 6d 65 20 23 21 6b 65 79 20 28 6c 6f 63 6b 65 ame #!key (locke
b610: 72 20 23 66 29 28 75 6e 6c 6f 63 6b 65 72 20 23 r #f)(unlocker #
b620: 66 29 29 0a 20 20 28 69 66 20 28 61 6e 64 20 6c f)). (if (and l
b630: 6f 63 6b 65 72 20 28 6e 6f 74 20 28 6c 6f 63 6b ocker (not (lock
b640: 65 72 20 66 6e 61 6d 65 29 29 29 0a 20 20 20 20 er fname))).
b650: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
b660: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
b670: 72 74 2a 20 22 49 4e 46 4f 3a 20 43 6f 75 6c 64 rt* "INFO: Could
b680: 20 6e 6f 74 20 67 65 74 20 6c 6f 63 6b 20 6f 6e not get lock on
b690: 20 22 20 66 6e 61 6d 65 29 29 0a 20 20 28 6c 65 " fname)). (le
b6a0: 74 2a 20 28 28 64 61 74 20 20 28 63 6f 6e 66 69 t* ((dat (confi
b6b0: 67 2d 3e 61 6c 69 73 74 20 63 64 61 74 29 29 0a g->alist cdat)).
b6c0: 20 20 20 20 20 20 20 20 20 28 72 65 73 0a 20 20 (res.
b6d0: 20 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a 20 (begin.
b6e0: 20 20 20 20 20 20 20 20 20 20 20 28 77 69 74 68 (with
b6f0: 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 69 6c 65 20 -output-to-file
b700: 66 6e 61 6d 65 20 3b 3b 20 66 69 72 73 74 20 77 fname ;; first w
b710: 72 69 74 65 20 6f 75 74 20 74 68 65 20 66 69 6c rite out the fil
b720: 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 e.
b730: 28 6c 61 6d 62 64 61 20 28 29 0a 20 20 20 20 20 (lambda ().
b740: 20 20 20 20 20 20 20 20 20 20 20 28 70 70 20 64 (pp d
b750: 61 74 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 at))).
b760: 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 . (
b770: 69 66 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f if (file-exists?
b780: 20 66 6e 61 6d 65 29 20 20 20 3b 3b 20 6e 6f 77 fname) ;; now
b790: 20 76 65 72 69 66 79 20 69 74 20 69 73 20 72 65 verify it is re
b7a0: 61 64 61 62 6c 65 0a 20 20 20 20 20 20 20 20 20 adable.
b7b0: 20 20 20 20 20 20 20 28 69 66 20 28 72 65 61 64 (if (read
b7c0: 2d 61 6c 69 73 74 20 66 6e 61 6d 65 29 0a 20 20 -alist fname).
b7d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b7e0: 20 20 23 74 20 3b 3b 20 64 61 74 61 20 69 73 20 #t ;; data is
b7f0: 67 6f 6f 64 2e 0a 20 20 20 20 20 20 20 20 20 20 good..
b800: 20 20 20 20 20 20 20 20 20 20 28 62 65 67 69 6e (begin
b810: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
b820: 20 20 20 20 20 20 20 28 68 61 6e 64 6c 65 2d 65 (handle-e
b830: 78 63 65 70 74 69 6f 6e 73 0a 20 20 20 20 20 20 xceptions.
b840: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b850: 20 65 78 6e 0a 20 20 20 20 20 20 20 20 20 20 20 exn.
b860: 20 20 20 20 20 20 20 20 20 20 20 20 23 66 0a 20 #f.
b870: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b880: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
b890: 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 0 *default-lo
b8a0: 67 2d 70 6f 72 74 2a 20 22 57 41 52 4e 49 4e 47 g-port* "WARNING
b8b0: 3a 20 63 6f 6e 74 65 6e 74 20 22 20 64 61 74 20 : content " dat
b8c0: 22 20 66 6f 72 20 63 61 63 68 65 20 22 20 66 6e " for cache " fn
b8d0: 61 6d 65 20 22 20 69 73 20 6e 6f 74 20 72 65 61 ame " is not rea
b8e0: 64 61 62 6c 65 2e 20 44 65 6c 65 74 69 6e 67 20 dable. Deleting
b8f0: 67 65 6e 65 72 61 74 65 64 20 66 69 6c 65 2e 22 generated file."
b900: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
b910: 20 20 20 20 20 20 20 20 20 28 64 65 6c 65 74 65 (delete
b920: 2d 66 69 6c 65 20 66 6e 61 6d 65 29 29 0a 20 20 -file fname)).
b930: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b940: 20 20 20 20 23 66 29 29 0a 20 20 20 20 20 20 20 #f)).
b950: 20 20 20 20 20 20 20 20 20 23 66 29 29 29 29 0a #f)))).
b960: 20 20 20 20 28 69 66 20 75 6e 6c 6f 63 6b 65 72 (if unlocker
b970: 20 28 75 6e 6c 6f 63 6b 65 72 20 66 6e 61 6d 65 (unlocker fname
b980: 29 29 0a 20 20 20 20 72 65 73 29 29 0a 20 20 0a )). res)). .
b990: 3b 3b 20 63 6f 6e 76 65 72 74 20 68 69 65 72 61 ;; convert hiera
b9a0: 72 63 68 69 61 6c 20 6c 69 73 74 20 74 6f 20 69 rchial list to i
b9b0: 6e 69 20 66 6f 72 6d 61 74 0a 3b 3b 0a 28 64 65 ni format.;;.(de
b9c0: 66 69 6e 65 20 28 63 6f 6e 66 69 67 2d 3e 69 6e fine (config->in
b9d0: 69 20 64 61 74 61 29 0a 20 20 28 6d 61 70 20 0a i data). (map .
b9e0: 20 20 20 28 6c 61 6d 62 64 61 20 28 73 65 63 74 (lambda (sect
b9f0: 69 6f 6e 29 0a 20 20 20 20 20 28 6c 65 74 20 28 ion). (let (
ba00: 28 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 28 63 (section-name (c
ba10: 61 72 20 73 65 63 74 69 6f 6e 29 29 0a 09 20 20 ar section))..
ba20: 20 28 73 65 63 74 69 6f 6e 2d 64 61 74 20 20 28 (section-dat (
ba30: 63 64 72 20 73 65 63 74 69 6f 6e 29 29 29 0a 20 cdr section))).
ba40: 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 5c 6e (print "\n
ba50: 5b 22 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 [" section-name
ba60: 22 5d 22 29 0a 20 20 20 20 20 20 20 28 6d 61 70 "]"). (map
ba70: 20 28 6c 61 6d 62 64 61 20 28 64 61 74 2d 70 61 (lambda (dat-pa
ba80: 69 72 29 0a 09 20 20 20 20 20 20 28 6c 65 74 2a ir).. (let*
ba90: 20 28 28 76 61 72 20 28 63 61 72 20 64 61 74 2d ((var (car dat-
baa0: 70 61 69 72 29 29 0a 09 09 20 20 20 20 20 28 76 pair))... (v
bab0: 61 6c 20 28 63 61 64 72 20 64 61 74 2d 70 61 69 al (cadr dat-pai
bac0: 72 29 29 0a 09 09 20 20 20 20 20 28 66 6e 61 6d r))... (fnam
bad0: 65 20 28 69 66 20 28 3e 20 28 6c 65 6e 67 74 68 e (if (> (length
bae0: 20 64 61 74 2d 70 61 69 72 29 20 32 29 28 63 61 dat-pair) 2)(ca
baf0: 64 64 72 20 64 61 74 2d 70 61 69 72 29 20 23 66 ddr dat-pair) #f
bb00: 29 29 29 0a 09 09 28 69 66 20 66 6e 61 6d 65 20 )))...(if fname
bb10: 28 70 72 69 6e 74 20 22 23 20 22 20 76 61 72 20 (print "# " var
bb20: 22 3d 3e 22 20 66 6e 61 6d 65 29 29 0a 09 09 28 "=>" fname))...(
bb30: 70 72 69 6e 74 20 76 61 72 20 22 20 22 20 76 61 print var " " va
bb40: 6c 29 29 29 0a 09 20 20 20 20 73 65 63 74 69 6f l))).. sectio
bb50: 6e 2d 64 61 74 29 29 29 20 3b 3b 20 20 20 20 20 n-dat))) ;;
bb60: 20 20 28 70 72 69 6e 74 20 22 73 65 63 74 69 6f (print "sectio
bb70: 6e 2d 64 61 74 3a 20 22 20 73 65 63 74 69 6f 6e n-dat: " section
bb80: 2d 64 61 74 29 29 0a 20 20 20 28 68 61 73 68 2d -dat)). (hash-
bb90: 74 61 62 6c 65 2d 3e 61 6c 69 73 74 20 64 61 74 table->alist dat
bba0: 61 29 29 29 0a 0a 29 0a a)))..).