Artifact
346c0caf522d3125fbfa79a768c12b6063f2d60e:
0000: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
0010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0040: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 43 6f 70 79 ========.;; Copy
0050: 72 69 67 68 74 20 32 30 30 36 2d 32 30 31 32 2c right 2006-2012,
0060: 20 4d 61 74 74 68 65 77 20 57 65 6c 6c 61 6e 64 Matthew Welland
0070: 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68 69 73 20 70 ..;; .;; This p
0080: 72 6f 67 72 61 6d 20 69 73 20 6d 61 64 65 20 61 rogram is made a
0090: 76 61 69 6c 61 62 6c 65 20 75 6e 64 65 72 20 74 vailable under t
00a0: 68 65 20 47 4e 55 20 47 50 4c 20 76 65 72 73 69 he GNU GPL versi
00b0: 6f 6e 20 32 2e 30 20 6f 72 0a 3b 3b 20 20 67 72 on 2.0 or.;; gr
00c0: 65 61 74 65 72 2e 20 53 65 65 20 74 68 65 20 61 eater. See the a
00d0: 63 63 6f 6d 70 61 6e 79 69 6e 67 20 66 69 6c 65 ccompanying file
00e0: 20 43 4f 50 59 49 4e 47 20 66 6f 72 20 64 65 74 COPYING for det
00f0: 61 69 6c 73 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68 ails..;; .;; Th
0100: 69 73 20 70 72 6f 67 72 61 6d 20 69 73 20 64 69 is program is di
0110: 73 74 72 69 62 75 74 65 64 20 57 49 54 48 4f 55 stributed WITHOU
0120: 54 20 41 4e 59 20 57 41 52 52 41 4e 54 59 3b 20 T ANY WARRANTY;
0130: 77 69 74 68 6f 75 74 20 65 76 65 6e 20 74 68 65 without even the
0140: 0a 3b 3b 20 20 69 6d 70 6c 69 65 64 20 77 61 72 .;; implied war
0150: 72 61 6e 74 79 20 6f 66 20 4d 45 52 43 48 41 4e ranty of MERCHAN
0160: 54 41 42 49 4c 49 54 59 20 6f 72 20 46 49 54 4e TABILITY or FITN
0170: 45 53 53 20 46 4f 52 20 41 20 50 41 52 54 49 43 ESS FOR A PARTIC
0180: 55 4c 41 52 0a 3b 3b 20 20 50 55 52 50 4f 53 45 ULAR.;; PURPOSE
0190: 2e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
01a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 3d 3d ==========..;;==
01e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0200: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0210: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0220: 3d 3d 3d 3d 0a 3b 3b 20 43 6f 6e 66 69 67 20 66 ====.;; Config f
0230: 69 6c 65 20 68 61 6e 64 6c 69 6e 67 0a 3b 3b 3d ile handling.;;=
0240: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0250: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0260: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0270: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0280: 3d 3d 3d 3d 3d 0a 0a 28 75 73 65 20 72 65 67 65 =====..(use rege
0290: 78 20 72 65 67 65 78 2d 63 61 73 65 29 20 3b 3b x regex-case) ;;
02a0: 20 20 64 69 72 65 63 74 6f 72 79 2d 75 74 69 6c directory-util
02b0: 73 29 0a 28 64 65 63 6c 61 72 65 20 28 75 6e 69 s).(declare (uni
02c0: 74 20 63 6f 6e 66 69 67 66 29 29 0a 28 64 65 63 t configf)).(dec
02d0: 6c 61 72 65 20 28 75 73 65 73 20 70 72 6f 63 65 lare (uses proce
02e0: 73 73 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 ss)).(declare (u
02f0: 73 65 73 20 65 6e 76 29 29 0a 28 64 65 63 6c 61 ses env)).(decla
0300: 72 65 20 28 75 73 65 73 20 6b 65 79 73 29 29 0a re (uses keys)).
0310: 0a 28 69 6e 63 6c 75 64 65 20 22 63 6f 6d 6d 6f .(include "commo
0320: 6e 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a n_records.scm").
0330: 0a 3b 3b 20 72 65 74 75 72 6e 20 6c 69 73 74 20 .;; return list
0340: 28 70 61 74 68 20 66 75 6c 6c 70 61 74 68 20 63 (path fullpath c
0350: 6f 6e 66 69 67 6e 61 6d 65 29 0a 28 64 65 66 69 onfigname).(defi
0360: 6e 65 20 28 66 69 6e 64 2d 63 6f 6e 66 69 67 20 ne (find-config
0370: 63 6f 6e 66 69 67 6e 61 6d 65 20 23 21 6b 65 79 configname #!key
0380: 20 28 74 6f 70 70 61 74 68 20 23 66 29 29 0a 20 (toppath #f)).
0390: 20 28 69 66 20 74 6f 70 70 61 74 68 0a 20 20 20 (if toppath.
03a0: 20 20 20 28 6c 65 74 20 28 28 63 66 6e 61 6d 65 (let ((cfname
03b0: 20 28 63 6f 6e 63 20 74 6f 70 70 61 74 68 20 22 (conc toppath "
03c0: 2f 22 20 63 6f 6e 66 69 67 6e 61 6d 65 29 29 29 /" configname)))
03d0: 0a 09 28 69 66 20 28 66 69 6c 65 2d 65 78 69 73 ..(if (file-exis
03e0: 74 73 3f 20 63 66 6e 61 6d 65 29 0a 09 20 20 20 ts? cfname)..
03f0: 20 28 6c 69 73 74 20 74 6f 70 70 61 74 68 20 63 (list toppath c
0400: 66 6e 61 6d 65 20 63 6f 6e 66 69 67 6e 61 6d 65 fname configname
0410: 29 0a 09 20 20 20 20 28 6c 69 73 74 20 23 66 20 ).. (list #f
0420: 20 20 20 20 20 23 66 20 20 20 20 20 23 66 29 29 #f #f))
0430: 29 0a 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 ). (let* ((
0440: 63 77 64 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 cwd (string-spli
0450: 74 20 28 63 75 72 72 65 6e 74 2d 64 69 72 65 63 t (current-direc
0460: 74 6f 72 79 29 20 22 2f 22 29 29 29 0a 09 28 6c tory) "/")))..(l
0470: 65 74 20 6c 6f 6f 70 20 28 28 64 69 72 20 63 77 et loop ((dir cw
0480: 64 29 29 0a 09 20 20 28 6c 65 74 2a 20 28 28 70 d)).. (let* ((p
0490: 61 74 68 20 20 20 20 20 28 63 6f 6e 63 20 22 2f ath (conc "/
04a0: 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 " (string-inters
04b0: 70 65 72 73 65 20 64 69 72 20 22 2f 22 29 29 29 perse dir "/")))
04c0: 0a 09 09 20 28 66 75 6c 6c 70 61 74 68 20 28 63 ... (fullpath (c
04d0: 6f 6e 63 20 70 61 74 68 20 22 2f 22 20 63 6f 6e onc path "/" con
04e0: 66 69 67 6e 61 6d 65 29 29 29 0a 09 20 20 20 20 figname)))..
04f0: 28 69 66 20 28 66 69 6c 65 2d 65 78 69 73 74 73 (if (file-exists
0500: 3f 20 66 75 6c 6c 70 61 74 68 29 0a 09 09 28 6c ? fullpath)...(l
0510: 69 73 74 20 70 61 74 68 20 66 75 6c 6c 70 61 74 ist path fullpat
0520: 68 20 63 6f 6e 66 69 67 6e 61 6d 65 29 0a 09 09 h configname)...
0530: 28 6c 65 74 20 28 28 72 65 6d 63 77 64 20 28 74 (let ((remcwd (t
0540: 61 6b 65 20 64 69 72 20 28 2d 20 28 6c 65 6e 67 ake dir (- (leng
0550: 74 68 20 64 69 72 29 20 31 29 29 29 29 0a 09 09 th dir) 1))))...
0560: 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 72 65 6d (if (null? rem
0570: 63 77 64 29 0a 09 09 20 20 20 20 20 20 28 6c 69 cwd)... (li
0580: 73 74 20 23 66 20 23 66 20 23 66 29 20 3b 3b 20 st #f #f #f) ;;
0590: 20 23 66 20 23 66 29 20 0a 09 09 20 20 28 6c 6f #f #f) ... (lo
05a0: 6f 70 20 72 65 6d 63 77 64 29 29 29 29 29 29 29 op remcwd)))))))
05b0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e ))..(define (con
05c0: 66 69 67 3a 61 73 73 6f 63 2d 73 61 66 65 2d 61 fig:assoc-safe-a
05d0: 64 64 20 61 6c 69 73 74 20 6b 65 79 20 76 61 6c dd alist key val
05e0: 20 23 21 6b 65 79 20 28 6d 65 74 61 64 61 74 61 #!key (metadata
05f0: 20 23 66 29 29 0a 20 20 28 6c 65 74 20 28 28 6e #f)). (let ((n
0600: 65 77 61 6c 69 73 74 20 28 66 69 6c 74 65 72 20 ewalist (filter
0610: 28 6c 61 6d 62 64 61 20 28 78 29 28 6e 6f 74 20 (lambda (x)(not
0620: 28 65 71 75 61 6c 3f 20 6b 65 79 20 28 63 61 72 (equal? key (car
0630: 20 78 29 29 29 29 20 61 6c 69 73 74 29 29 29 0a x)))) alist))).
0640: 20 20 20 20 28 61 70 70 65 6e 64 20 6e 65 77 61 (append newa
0650: 6c 69 73 74 20 28 6c 69 73 74 20 28 69 66 20 6d list (list (if m
0660: 65 74 61 64 61 74 61 0a 09 09 09 20 20 20 20 20 etadata....
0670: 20 20 28 6c 69 73 74 20 6b 65 79 20 76 61 6c 20 (list key val
0680: 6d 65 74 61 64 61 74 61 29 0a 09 09 09 20 20 20 metadata)....
0690: 20 20 20 20 28 6c 69 73 74 20 6b 65 79 20 76 61 (list key va
06a0: 6c 29 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 l))))))..(define
06b0: 20 28 63 6f 6e 66 69 67 66 3a 73 65 63 74 69 6f (configf:sectio
06c0: 6e 2d 76 61 72 2d 73 65 74 21 20 63 66 67 64 61 n-var-set! cfgda
06d0: 74 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 76 t section-name v
06e0: 61 72 20 76 61 6c 75 65 20 23 21 6b 65 79 20 28 ar value #!key (
06f0: 6d 65 74 61 64 61 74 61 20 23 66 29 29 0a 20 20 metadata #f)).
0700: 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 (hash-table-set!
0710: 20 63 66 67 64 61 74 20 73 65 63 74 69 6f 6e 2d cfgdat section-
0720: 6e 61 6d 65 0a 09 09 20 20 20 28 63 6f 6e 66 69 name... (confi
0730: 67 3a 61 73 73 6f 63 2d 73 61 66 65 2d 61 64 64 g:assoc-safe-add
0740: 0a 09 09 20 20 20 20 28 68 61 73 68 2d 74 61 62 ... (hash-tab
0750: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 63 le-ref/default c
0760: 66 67 64 61 74 20 73 65 63 74 69 6f 6e 2d 6e 61 fgdat section-na
0770: 6d 65 20 27 28 29 29 0a 09 09 20 20 20 20 76 61 me '())... va
0780: 72 20 76 61 6c 75 65 20 6d 65 74 61 64 61 74 61 r value metadata
0790: 3a 20 6d 65 74 61 64 61 74 61 29 29 29 0a 0a 28 : metadata)))..(
07a0: 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 3a 65 define (config:e
07b0: 76 61 6c 2d 73 74 72 69 6e 67 2d 69 6e 2d 65 6e val-string-in-en
07c0: 76 69 72 6f 6e 6d 65 6e 74 20 73 74 72 29 0a 20 vironment str).
07d0: 20 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 (handle-excepti
07e0: 6f 6e 73 0a 20 20 20 65 78 6e 0a 20 20 20 28 62 ons. exn. (b
07f0: 65 67 69 6e 0a 20 20 20 20 20 28 64 65 62 75 67 egin. (debug
0800: 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a :print-error 0 *
0810: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
0820: 2a 20 22 70 72 6f 62 6c 65 6d 20 65 76 61 6c 75 * "problem evalu
0830: 61 74 69 6e 67 20 5c 22 22 20 73 74 72 20 22 5c ating \"" str "\
0840: 22 20 69 6e 20 74 68 65 20 73 68 65 6c 6c 20 65 " in the shell e
0850: 6e 76 69 72 6f 6e 6d 65 6e 74 22 29 0a 20 20 20 nvironment").
0860: 20 20 23 66 29 0a 20 20 20 28 6c 65 74 20 28 28 #f). (let ((
0870: 63 6d 64 72 65 73 20 28 70 72 6f 63 65 73 73 3a cmdres (process:
0880: 63 6d 64 2d 72 75 6e 2d 3e 6c 69 73 74 20 28 63 cmd-run->list (c
0890: 6f 6e 63 20 22 65 63 68 6f 20 22 20 73 74 72 29 onc "echo " str)
08a0: 29 29 29 0a 20 20 20 20 20 28 69 66 20 28 6e 75 ))). (if (nu
08b0: 6c 6c 3f 20 63 6d 64 72 65 73 29 20 22 22 0a 09 ll? cmdres) ""..
08c0: 20 28 63 61 61 72 20 63 6d 64 72 65 73 29 29 29 (caar cmdres)))
08d0: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
08e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
08f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0900: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0910: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
0920: 4d 61 6b 65 20 74 68 65 20 72 65 67 65 78 70 27 Make the regexp'
0930: 73 20 6e 65 65 64 65 64 20 67 6c 6f 62 61 6c 6c s needed globall
0940: 79 20 61 76 61 69 6c 61 62 6c 65 0a 3b 3b 3d 3d y available.;;==
0950: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0960: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0970: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0980: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0990: 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 63 6f ====..(define co
09a0: 6e 66 69 67 66 3a 69 6e 63 6c 75 64 65 2d 72 78 nfigf:include-rx
09b0: 20 28 72 65 67 65 78 70 20 22 5e 5c 5c 5b 69 6e (regexp "^\\[in
09c0: 63 6c 75 64 65 5c 5c 73 2b 28 2e 2a 29 5c 5c 5d clude\\s+(.*)\\]
09d0: 5c 5c 73 2a 24 22 29 29 0a 28 64 65 66 69 6e 65 \\s*$")).(define
09e0: 20 63 6f 6e 66 69 67 66 3a 73 63 72 69 70 74 2d configf:script-
09f0: 72 78 20 20 28 72 65 67 65 78 70 20 22 5e 5c 5c rx (regexp "^\\
0a00: 5b 73 63 72 69 70 74 69 6e 63 5c 5c 73 2b 28 2e [scriptinc\\s+(.
0a10: 2a 29 5c 5c 5d 5c 5c 73 2a 24 22 29 29 20 3b 3b *)\\]\\s*$")) ;;
0a20: 20 69 6e 63 6c 75 64 65 20 6f 75 74 70 75 74 20 include output
0a30: 66 72 6f 6d 20 61 20 73 63 72 69 70 74 0a 28 64 from a script.(d
0a40: 65 66 69 6e 65 20 63 6f 6e 66 69 67 66 3a 73 65 efine configf:se
0a50: 63 74 69 6f 6e 2d 72 78 20 28 72 65 67 65 78 70 ction-rx (regexp
0a60: 20 22 5e 5c 5c 5b 28 2e 2a 29 5c 5c 5d 5c 5c 73 "^\\[(.*)\\]\\s
0a70: 2a 24 22 29 29 0a 28 64 65 66 69 6e 65 20 63 6f *$")).(define co
0a80: 6e 66 69 67 66 3a 62 6c 61 6e 6b 2d 6c 2d 72 78 nfigf:blank-l-rx
0a90: 20 28 72 65 67 65 78 70 20 22 5e 5c 5c 73 2a 24 (regexp "^\\s*$
0aa0: 22 29 29 0a 28 64 65 66 69 6e 65 20 63 6f 6e 66 ")).(define conf
0ab0: 69 67 66 3a 6b 65 79 2d 73 79 73 2d 70 72 20 28 igf:key-sys-pr (
0ac0: 72 65 67 65 78 70 20 22 5e 28 5c 5c 53 2b 29 5c regexp "^(\\S+)\
0ad0: 5c 73 2b 5c 5c 5b 73 79 73 74 65 6d 5c 5c 73 2b \s+\\[system\\s+
0ae0: 28 5c 5c 53 2b 2e 2a 29 5c 5c 5d 5c 5c 73 2a 24 (\\S+.*)\\]\\s*$
0af0: 22 29 29 0a 28 64 65 66 69 6e 65 20 63 6f 6e 66 ")).(define conf
0b00: 69 67 66 3a 6b 65 79 2d 76 61 6c 2d 70 72 20 28 igf:key-val-pr (
0b10: 72 65 67 65 78 70 20 22 5e 28 5c 5c 53 2b 29 28 regexp "^(\\S+)(
0b20: 5c 5c 73 2b 28 2e 2a 29 7c 28 29 29 24 22 29 29 \\s+(.*)|())$"))
0b30: 0a 28 64 65 66 69 6e 65 20 63 6f 6e 66 69 67 66 .(define configf
0b40: 3a 6b 65 79 2d 6e 6f 2d 76 61 6c 20 28 72 65 67 :key-no-val (reg
0b50: 65 78 70 20 22 5e 28 5c 5c 53 2b 29 28 5c 5c 73 exp "^(\\S+)(\\s
0b60: 2a 29 24 22 29 29 0a 28 64 65 66 69 6e 65 20 63 *)$")).(define c
0b70: 6f 6e 66 69 67 66 3a 63 6f 6d 6d 65 6e 74 2d 72 onfigf:comment-r
0b80: 78 20 28 72 65 67 65 78 70 20 22 5e 5c 5c 73 2a x (regexp "^\\s*
0b90: 23 2e 2a 22 29 29 0a 28 64 65 66 69 6e 65 20 63 #.*")).(define c
0ba0: 6f 6e 66 69 67 66 3a 63 6f 6e 74 2d 6c 6e 2d 72 onfigf:cont-ln-r
0bb0: 78 20 28 72 65 67 65 78 70 20 22 5e 28 5c 5c 73 x (regexp "^(\\s
0bc0: 2b 29 28 5c 5c 53 2b 2e 2a 29 24 22 29 29 0a 28 +)(\\S+.*)$")).(
0bd0: 64 65 66 69 6e 65 20 63 6f 6e 66 69 67 66 3a 73 define configf:s
0be0: 65 74 74 69 6e 67 73 20 20 20 28 72 65 67 65 78 ettings (regex
0bf0: 70 20 22 5e 5c 5c 5b 63 6f 6e 66 69 67 66 3a 73 p "^\\[configf:s
0c00: 65 74 74 69 6e 67 73 5c 5c 73 2b 28 5c 5c 53 2b ettings\\s+(\\S+
0c10: 29 5c 5c 73 2b 28 5c 5c 53 2b 29 5d 5c 5c 73 2a )\\s+(\\S+)]\\s*
0c20: 24 22 29 29 0a 0a 3b 3b 20 72 65 61 64 20 61 20 $"))..;; read a
0c30: 6c 69 6e 65 20 61 6e 64 20 70 72 6f 63 65 73 73 line and process
0c40: 20 61 6e 79 20 23 7b 20 2e 2e 2e 20 7d 20 63 6f any #{ ... } co
0c50: 6e 73 74 72 75 63 74 73 0a 0a 28 64 65 66 69 6e nstructs..(defin
0c60: 65 20 63 6f 6e 66 69 67 66 3a 76 61 72 2d 65 78 e configf:var-ex
0c70: 70 61 6e 64 2d 72 65 67 65 78 20 28 72 65 67 65 pand-regex (rege
0c80: 78 70 20 22 5e 28 2e 2a 29 23 5c 5c 7b 28 73 63 xp "^(.*)#\\{(sc
0c90: 68 65 6d 65 7c 73 79 73 74 65 6d 7c 73 68 65 6c heme|system|shel
0ca0: 6c 7c 67 65 74 65 6e 76 7c 67 65 74 7c 72 75 6e l|getenv|get|run
0cb0: 63 6f 6e 66 69 67 73 2d 67 65 74 7c 72 67 65 74 configs-get|rget
0cc0: 7c 73 63 6d 7c 73 68 7c 72 70 7c 67 76 7c 67 7c |scm|sh|rp|gv|g|
0cd0: 6d 74 72 61 68 29 5c 5c 73 2b 28 5b 5e 5c 5c 7d mtrah)\\s+([^\\}
0ce0: 5c 5c 7b 5d 2a 29 5c 5c 7d 28 2e 2a 29 22 29 29 \\{]*)\\}(.*)"))
0cf0: 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 ..(define (confi
0d00: 67 66 3a 70 72 6f 63 65 73 73 2d 6c 69 6e 65 20 gf:process-line
0d10: 6c 20 68 74 20 61 6c 6c 6f 77 2d 73 79 73 74 65 l ht allow-syste
0d20: 6d 20 23 21 6b 65 79 20 28 6c 69 6e 65 6e 75 6d m #!key (linenum
0d30: 20 23 66 29 29 0a 20 20 28 6c 65 74 20 6c 6f 6f #f)). (let loo
0d40: 70 20 28 28 72 65 73 20 6c 29 29 0a 20 20 20 20 p ((res l)).
0d50: 28 69 66 20 28 73 74 72 69 6e 67 3f 20 72 65 73 (if (string? res
0d60: 29 0a 09 28 6c 65 74 20 28 28 6d 61 74 63 68 64 )..(let ((matchd
0d70: 61 74 20 28 73 74 72 69 6e 67 2d 73 65 61 72 63 at (string-searc
0d80: 68 20 63 6f 6e 66 69 67 66 3a 76 61 72 2d 65 78 h configf:var-ex
0d90: 70 61 6e 64 2d 72 65 67 65 78 20 72 65 73 29 29 pand-regex res))
0da0: 29 0a 09 20 20 28 69 66 20 6d 61 74 63 68 64 61 ).. (if matchda
0db0: 74 0a 09 20 20 20 20 20 20 28 6c 65 74 2a 20 28 t.. (let* (
0dc0: 28 70 72 65 73 74 72 20 20 28 6c 69 73 74 2d 72 (prestr (list-r
0dd0: 65 66 20 6d 61 74 63 68 64 61 74 20 31 29 29 0a ef matchdat 1)).
0de0: 09 09 20 20 20 20 20 28 63 6d 64 74 79 70 65 20 .. (cmdtype
0df0: 28 6c 69 73 74 2d 72 65 66 20 6d 61 74 63 68 64 (list-ref matchd
0e00: 61 74 20 32 29 29 20 3b 3b 20 65 76 61 6c 2c 20 at 2)) ;; eval,
0e10: 73 79 73 74 65 6d 2c 20 73 68 65 6c 6c 2c 20 67 system, shell, g
0e20: 65 74 65 6e 76 0a 09 09 20 20 20 20 20 28 63 6d etenv... (cm
0e30: 64 20 20 20 20 20 28 6c 69 73 74 2d 72 65 66 20 d (list-ref
0e40: 6d 61 74 63 68 64 61 74 20 33 29 29 0a 09 09 20 matchdat 3))...
0e50: 20 20 20 20 28 70 6f 73 74 73 74 72 20 28 6c 69 (poststr (li
0e60: 73 74 2d 72 65 66 20 6d 61 74 63 68 64 61 74 20 st-ref matchdat
0e70: 34 29 29 0a 09 09 20 20 20 20 20 28 72 65 73 75 4))... (resu
0e80: 6c 74 20 20 23 66 29 0a 09 09 20 20 20 20 20 28 lt #f)... (
0e90: 73 74 61 72 74 2d 74 69 6d 65 20 28 63 75 72 72 start-time (curr
0ea0: 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 0a 09 09 ent-seconds))...
0eb0: 20 20 20 20 20 28 63 6d 64 73 79 6d 20 20 28 73 (cmdsym (s
0ec0: 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 63 6d tring->symbol cm
0ed0: 64 74 79 70 65 29 29 0a 09 09 20 20 20 20 20 28 dtype))... (
0ee0: 66 75 6c 6c 63 6d 64 20 28 63 61 73 65 20 63 6d fullcmd (case cm
0ef0: 64 73 79 6d 0a 09 09 09 09 28 28 73 63 68 65 6d dsym.....((schem
0f00: 65 20 73 63 6d 29 20 28 63 6f 6e 63 20 22 28 6c e scm) (conc "(l
0f10: 61 6d 62 64 61 20 28 68 74 29 22 20 63 6d 64 20 ambda (ht)" cmd
0f20: 22 29 22 29 29 0a 09 09 09 09 28 28 73 79 73 74 ")")).....((syst
0f30: 65 6d 29 20 20 20 20 20 28 63 6f 6e 63 20 22 28 em) (conc "(
0f40: 6c 61 6d 62 64 61 20 28 68 74 29 28 73 79 73 74 lambda (ht)(syst
0f50: 65 6d 20 5c 22 22 20 63 6d 64 20 22 5c 22 29 29 em \"" cmd "\"))
0f60: 22 29 29 0a 09 09 09 09 28 28 73 68 65 6c 6c 20 ")).....((shell
0f70: 73 68 29 20 20 20 28 63 6f 6e 63 20 22 28 6c 61 sh) (conc "(la
0f80: 6d 62 64 61 20 28 68 74 29 28 73 74 72 69 6e 67 mbda (ht)(string
0f90: 2d 74 72 61 6e 73 6c 61 74 65 20 28 73 68 65 6c -translate (shel
0fa0: 6c 20 5c 22 22 20 20 63 6d 64 20 22 5c 22 29 20 l \"" cmd "\")
0fb0: 5c 22 5c 6e 5c 22 20 5c 22 20 5c 22 29 29 22 29 \"\n\" \" \"))")
0fc0: 29 0a 09 09 09 09 28 28 72 65 61 6c 70 61 74 68 ).....((realpath
0fd0: 20 72 70 29 28 63 6f 6e 63 20 22 28 6c 61 6d 62 rp)(conc "(lamb
0fe0: 64 61 20 28 68 74 29 28 63 6f 6d 6d 6f 6e 3a 6e da (ht)(common:n
0ff0: 69 63 65 2d 70 61 74 68 20 5c 22 22 20 63 6d 64 ice-path \"" cmd
1000: 20 22 5c 22 29 29 22 29 29 0a 09 09 09 09 28 28 "\"))")).....((
1010: 67 65 74 65 6e 76 20 67 76 29 20 20 28 63 6f 6e getenv gv) (con
1020: 63 20 22 28 6c 61 6d 62 64 61 20 28 68 74 29 28 c "(lambda (ht)(
1030: 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d get-environment-
1040: 76 61 72 69 61 62 6c 65 20 5c 22 22 20 63 6d 64 variable \"" cmd
1050: 20 22 5c 22 29 29 22 29 29 0a 09 09 09 09 28 28 "\"))")).....((
1060: 6d 74 72 61 68 29 20 20 20 20 20 20 28 63 6f 6e mtrah) (con
1070: 63 20 22 28 6c 61 6d 62 64 61 20 28 68 74 29 22 c "(lambda (ht)"
1080: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1090: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
10a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
10b0: 20 20 20 20 20 22 20 20 20 20 28 6c 65 74 20 28 " (let (
10c0: 28 65 78 74 72 61 20 5c 22 22 20 63 6d 64 20 22 (extra \"" cmd "
10d0: 5c 22 29 29 22 0a 09 09 09 09 09 09 20 20 20 20 \"))".......
10e0: 22 20 20 20 20 20 20 20 28 63 6f 6e 63 20 28 6f " (conc (o
10f0: 72 20 2a 74 6f 70 70 61 74 68 2a 20 28 67 65 74 r *toppath* (get
1100: 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 -environment-var
1110: 69 61 62 6c 65 20 5c 22 4d 54 5f 52 55 4e 5f 41 iable \"MT_RUN_A
1120: 52 45 41 5f 48 4f 4d 45 5c 22 29 29 22 0a 09 09 REA_HOME\"))"...
1130: 09 09 09 09 20 20 20 20 22 20 20 20 20 20 20 20 .... "
1140: 20 20 20 20 20 20 28 69 66 20 28 73 74 72 69 6e (if (strin
1150: 67 2d 6e 75 6c 6c 3f 20 65 78 74 72 61 29 20 5c g-null? extra) \
1160: 22 5c 22 20 5c 22 2f 5c 22 29 22 0a 09 09 09 09 "\" \"/\")".....
1170: 09 09 20 20 20 20 22 20 20 20 20 20 20 20 20 20 .. "
1180: 20 20 20 20 65 78 74 72 61 29 29 29 22 29 29 0a extra)))")).
1190: 09 09 09 09 28 28 67 65 74 20 67 29 20 20 20 0a ....((get g) .
11a0: 09 09 09 09 20 28 6c 65 74 2a 20 28 28 70 61 72 .... (let* ((par
11b0: 74 73 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 ts (string-split
11c0: 20 63 6d 64 29 29 0a 09 09 09 09 09 28 73 65 63 cmd))......(sec
11d0: 74 20 20 28 63 61 72 20 70 61 72 74 73 29 29 0a t (car parts)).
11e0: 09 09 09 09 09 28 76 61 72 20 20 20 28 63 61 64 .....(var (cad
11f0: 72 20 70 61 72 74 73 29 29 29 0a 09 09 09 09 20 r parts))).....
1200: 20 20 28 63 6f 6e 63 20 22 28 6c 61 6d 62 64 61 (conc "(lambda
1210: 20 28 68 74 29 28 63 6f 6e 66 69 67 2d 6c 6f 6f (ht)(config-loo
1220: 6b 75 70 20 68 74 20 5c 22 22 20 73 65 63 74 20 kup ht \"" sect
1230: 22 5c 22 20 5c 22 22 20 76 61 72 20 22 5c 22 29 "\" \"" var "\")
1240: 29 22 29 29 29 0a 09 09 09 09 28 28 72 75 6e 63 )"))).....((runc
1250: 6f 6e 66 69 67 73 2d 67 65 74 20 72 67 65 74 29 onfigs-get rget)
1260: 20 28 63 6f 6e 63 20 22 28 6c 61 6d 62 64 61 20 (conc "(lambda
1270: 28 68 74 29 28 72 75 6e 63 6f 6e 66 69 67 73 2d (ht)(runconfigs-
1280: 67 65 74 20 68 74 20 5c 22 22 20 63 6d 64 20 22 get ht \"" cmd "
1290: 5c 22 29 29 22 29 29 0a 09 09 09 09 3b 3b 20 28 \"))")).....;; (
12a0: 28 72 67 65 74 29 20 20 20 20 20 20 20 20 20 20 (rget)
12b0: 20 28 63 6f 6e 63 20 22 28 6c 61 6d 62 64 61 20 (conc "(lambda
12c0: 28 68 74 29 28 72 75 6e 63 6f 6e 66 69 67 73 2d (ht)(runconfigs-
12d0: 67 65 74 20 68 74 20 5c 22 22 20 63 6d 64 20 22 get ht \"" cmd "
12e0: 5c 22 29 29 22 29 29 0a 09 09 09 09 28 65 6c 73 \"))")).....(els
12f0: 65 20 22 28 6c 61 6d 62 64 61 20 28 68 74 29 28 e "(lambda (ht)(
1300: 70 72 69 6e 74 20 5c 22 45 52 52 4f 52 5c 22 29 print \"ERROR\")
1310: 20 5c 22 45 52 52 4f 52 5c 22 29 22 29 29 29 29 \"ERROR\")"))))
1320: 0a 09 09 3b 3b 20 28 70 72 69 6e 74 20 22 66 75 ...;; (print "fu
1330: 6c 6c 63 6d 64 3d 22 20 66 75 6c 6c 63 6d 64 29 llcmd=" fullcmd)
1340: 0a 09 09 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 ...(handle-excep
1350: 74 69 6f 6e 73 0a 09 09 20 65 78 6e 0a 09 09 20 tions... exn...
1360: 28 62 65 67 69 6e 0a 09 09 20 20 20 28 64 65 62 (begin... (deb
1370: 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 ug:print 0 *defa
1380: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 ult-log-port* "W
1390: 41 52 4e 49 4e 47 3a 20 66 61 69 6c 65 64 20 74 ARNING: failed t
13a0: 6f 20 70 72 6f 63 65 73 73 20 63 6f 6e 66 69 67 o process config
13b0: 20 69 6e 70 75 74 20 5c 22 22 20 6c 20 22 5c 22 input \"" l "\"
13c0: 22 29 0a 09 09 20 20 20 28 64 65 62 75 67 3a 70 ")... (debug:p
13d0: 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d rint 0 *default-
13e0: 6c 6f 67 2d 70 6f 72 74 2a 20 22 20 6d 65 73 73 log-port* " mess
13f0: 61 67 65 3a 20 22 20 28 28 63 6f 6e 64 69 74 69 age: " ((conditi
1400: 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 65 on-property-acce
1410: 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 61 ssor 'exn 'messa
1420: 67 65 29 20 65 78 6e 29 29 0a 09 09 20 20 20 3b ge) exn))... ;
1430: 3b 20 28 70 72 69 6e 74 20 22 65 78 6e 3d 22 20 ; (print "exn="
1440: 28 63 6f 6e 64 69 74 69 6f 6e 2d 3e 6c 69 73 74 (condition->list
1450: 20 65 78 6e 29 29 0a 09 09 20 20 20 28 73 65 74 exn))... (set
1460: 21 20 72 65 73 75 6c 74 20 28 63 6f 6e 63 20 22 ! result (conc "
1470: 23 7b 28 20 22 20 63 6d 64 74 79 70 65 20 22 29 #{( " cmdtype ")
1480: 20 22 20 63 6d 64 20 22 7d 2c 20 66 75 6c 6c 20 " cmd "}, full
1490: 65 78 70 61 6e 73 69 6f 6e 3a 20 22 20 66 75 6c expansion: " ful
14a0: 6c 63 6d 64 29 29 29 0a 09 09 20 28 69 66 20 28 lcmd)))... (if (
14b0: 6f 72 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 0a or allow-system.
14c0: 09 09 09 20 28 6e 6f 74 20 28 6d 65 6d 62 65 72 ... (not (member
14d0: 20 63 6d 64 74 79 70 65 20 27 28 22 73 79 73 74 cmdtype '("syst
14e0: 65 6d 22 20 22 73 68 65 6c 6c 22 20 22 73 68 22 em" "shell" "sh"
14f0: 29 29 29 29 0a 09 09 20 20 20 20 20 28 77 69 74 ))))... (wit
1500: 68 2d 69 6e 70 75 74 2d 66 72 6f 6d 2d 73 74 72 h-input-from-str
1510: 69 6e 67 20 66 75 6c 6c 63 6d 64 0a 09 09 20 20 ing fullcmd...
1520: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 29 0a (lambda ().
1530: 09 09 09 20 28 73 65 74 21 20 72 65 73 75 6c 74 ... (set! result
1540: 20 28 28 65 76 61 6c 20 28 72 65 61 64 29 29 20 ((eval (read))
1550: 68 74 29 29 29 29 0a 09 09 20 20 20 20 20 28 73 ht))))... (s
1560: 65 74 21 20 72 65 73 75 6c 74 20 28 63 6f 6e 63 et! result (conc
1570: 20 22 23 7b 28 22 20 63 6d 64 74 79 70 65 20 22 "#{(" cmdtype "
1580: 29 20 22 20 20 63 6d 64 20 22 7d 22 29 29 29 29 ) " cmd "}"))))
1590: 0a 09 09 28 63 61 73 65 20 63 6d 64 73 79 6d 0a ...(case cmdsym.
15a0: 09 09 20 20 28 28 73 79 73 74 65 6d 20 73 68 65 .. ((system she
15b0: 6c 6c 20 73 63 68 65 6d 65 29 0a 09 09 20 20 20 ll scheme)...
15c0: 28 6c 65 74 20 28 28 64 65 6c 74 61 20 28 2d 20 (let ((delta (-
15d0: 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 (current-seconds
15e0: 29 20 73 74 61 72 74 2d 74 69 6d 65 29 29 29 0a ) start-time))).
15f0: 09 09 20 20 20 20 20 28 69 66 20 28 3e 20 64 65 .. (if (> de
1600: 6c 74 61 20 32 29 0a 09 09 09 20 28 64 65 62 75 lta 2).... (debu
1610: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a g:print-info 0 *
1620: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
1630: 2a 20 22 66 6f 72 20 6c 69 6e 65 20 5c 22 22 20 * "for line \""
1640: 6c 20 22 5c 22 5c 6e 20 63 6f 6d 6d 61 6e 64 3a l "\"\n command:
1650: 20 20 22 20 63 6d 64 20 22 20 74 6f 6f 6b 20 22 " cmd " took "
1660: 20 64 65 6c 74 61 20 22 20 73 65 63 6f 6e 64 73 delta " seconds
1670: 20 74 6f 20 72 75 6e 20 77 69 74 68 20 6f 75 74 to run with out
1680: 70 75 74 3a 5c 6e 20 20 20 22 20 72 65 73 75 6c put:\n " resul
1690: 74 29 0a 09 09 09 20 28 64 65 62 75 67 3a 70 72 t).... (debug:pr
16a0: 69 6e 74 2d 69 6e 66 6f 20 39 20 2a 64 65 66 61 int-info 9 *defa
16b0: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 66 ult-log-port* "f
16c0: 6f 72 20 6c 69 6e 65 20 5c 22 22 20 6c 20 22 5c or line \"" l "\
16d0: 22 5c 6e 20 63 6f 6d 6d 61 6e 64 3a 20 20 22 20 "\n command: "
16e0: 63 6d 64 20 22 20 74 6f 6f 6b 20 22 20 64 65 6c cmd " took " del
16f0: 74 61 20 22 20 73 65 63 6f 6e 64 73 20 74 6f 20 ta " seconds to
1700: 72 75 6e 20 77 69 74 68 20 6f 75 74 70 75 74 3a run with output:
1710: 5c 6e 20 20 20 22 20 72 65 73 75 6c 74 29 29 29 \n " result)))
1720: 29 29 0a 09 09 28 6c 6f 6f 70 20 28 63 6f 6e 63 ))...(loop (conc
1730: 20 70 72 65 73 74 72 20 72 65 73 75 6c 74 20 70 prestr result p
1740: 6f 73 74 73 74 72 29 29 29 0a 09 20 20 20 20 20 oststr)))..
1750: 20 72 65 73 29 29 0a 09 72 65 73 29 29 29 0a 0a res))..res)))..
1760: 3b 3b 20 52 75 6e 20 61 20 73 68 65 6c 6c 20 63 ;; Run a shell c
1770: 6f 6d 6d 61 6e 64 20 61 6e 64 20 72 65 74 75 72 ommand and retur
1780: 6e 20 74 68 65 20 6f 75 74 70 75 74 20 61 73 20 n the output as
1790: 61 20 73 74 72 69 6e 67 0a 28 64 65 66 69 6e 65 a string.(define
17a0: 20 28 73 68 65 6c 6c 20 63 6d 64 29 0a 20 20 28 (shell cmd). (
17b0: 6c 65 74 2a 20 28 28 6f 75 74 70 75 74 20 28 70 let* ((output (p
17c0: 72 6f 63 65 73 73 3a 63 6d 64 2d 72 75 6e 2d 3e rocess:cmd-run->
17d0: 6c 69 73 74 20 63 6d 64 29 29 0a 09 20 28 72 65 list cmd)).. (re
17e0: 73 20 20 20 20 28 63 61 72 20 6f 75 74 70 75 74 s (car output
17f0: 29 29 0a 09 20 28 73 74 61 74 75 73 20 28 63 61 )).. (status (ca
1800: 64 72 20 6f 75 74 70 75 74 29 29 29 0a 20 20 20 dr output))).
1810: 20 28 69 66 20 28 65 71 75 61 6c 3f 20 73 74 61 (if (equal? sta
1820: 74 75 73 20 30 29 0a 09 28 6c 65 74 20 28 28 6f tus 0)..(let ((o
1830: 75 74 72 65 73 20 28 73 74 72 69 6e 67 2d 69 6e utres (string-in
1840: 74 65 72 73 70 65 72 73 65 20 0a 09 09 20 20 20 tersperse ...
1850: 20 20 20 20 72 65 73 0a 09 09 20 20 20 20 20 20 res...
1860: 20 22 5c 6e 22 29 29 29 0a 09 20 20 28 64 65 62 "\n"))).. (deb
1870: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 34 20 ug:print-info 4
1880: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
1890: 74 2a 20 22 73 68 65 6c 6c 20 72 65 73 75 6c 74 t* "shell result
18a0: 3a 5c 6e 22 20 6f 75 74 72 65 73 29 0a 09 20 20 :\n" outres)..
18b0: 6f 75 74 72 65 73 29 0a 09 28 62 65 67 69 6e 0a outres)..(begin.
18c0: 09 20 20 28 77 69 74 68 2d 6f 75 74 70 75 74 2d . (with-output-
18d0: 74 6f 2d 70 6f 72 74 20 28 63 75 72 72 65 6e 74 to-port (current
18e0: 2d 65 72 72 6f 72 2d 70 6f 72 74 29 0a 09 20 20 -error-port)..
18f0: 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 20 20 (lambda ()..
1900: 20 20 20 20 28 70 72 69 6e 74 20 22 45 52 52 4f (print "ERRO
1910: 52 3a 20 22 20 63 6d 64 20 22 20 72 65 74 75 72 R: " cmd " retur
1920: 6e 65 64 20 62 61 64 20 65 78 69 74 20 63 6f 64 ned bad exit cod
1930: 65 20 22 20 73 74 61 74 75 73 29 29 29 0a 09 20 e " status)))..
1940: 20 22 22 29 29 29 29 0a 0a 3b 3b 20 74 68 69 73 ""))))..;; this
1950: 20 77 61 73 20 69 6e 6c 69 6e 65 20 62 75 74 20 was inline but
1960: 49 27 6d 20 70 72 65 74 74 79 20 73 75 72 65 20 I'm pretty sure
1970: 74 68 61 74 20 69 73 20 61 20 68 6f 6c 64 20 6f that is a hold o
1980: 76 65 72 20 66 72 6f 6d 20 77 68 65 6e 20 69 74 ver from when it
1990: 20 77 61 73 20 2a 76 65 72 79 2a 20 73 69 6d 70 was *very* simp
19a0: 6c 65 20 2e 2e 2e 0a 3b 3b 0a 28 64 65 66 69 6e le ....;;.(defin
19b0: 65 20 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d e (configf:read-
19c0: 6c 69 6e 65 20 70 20 68 74 20 61 6c 6c 6f 77 2d line p ht allow-
19d0: 70 72 6f 63 65 73 73 69 6e 67 20 73 65 74 74 69 processing setti
19e0: 6e 67 73 29 0a 20 20 28 6c 65 74 20 6c 6f 6f 70 ngs). (let loop
19f0: 20 28 28 69 6e 6c 20 28 72 65 61 64 2d 6c 69 6e ((inl (read-lin
1a00: 65 20 70 29 29 29 0a 20 20 20 20 28 6c 65 74 20 e p))). (let
1a10: 28 28 63 6f 6e 74 2d 6c 69 6e 65 20 28 61 6e 64 ((cont-line (and
1a20: 20 28 73 74 72 69 6e 67 3f 20 69 6e 6c 29 0a 09 (string? inl)..
1a30: 09 09 20 20 28 6e 6f 74 20 28 73 74 72 69 6e 67 .. (not (string
1a40: 2d 6e 75 6c 6c 3f 20 69 6e 6c 29 29 0a 09 09 09 -null? inl))....
1a50: 20 20 28 65 71 75 61 6c 3f 20 22 5c 5c 22 20 28 (equal? "\\" (
1a60: 73 74 72 69 6e 67 2d 74 61 6b 65 2d 72 69 67 68 string-take-righ
1a70: 74 20 69 6e 6c 20 31 29 29 29 29 29 0a 20 20 20 t inl 1))))).
1a80: 20 20 20 28 69 66 20 63 6f 6e 74 2d 6c 69 6e 65 (if cont-line
1a90: 20 3b 3b 20 6c 61 73 74 20 63 68 61 72 61 63 74 ;; last charact
1aa0: 65 72 20 69 73 20 5c 20 0a 09 20 20 28 6c 65 74 er is \ .. (let
1ab0: 20 28 28 6e 65 78 74 6c 20 28 72 65 61 64 2d 6c ((nextl (read-l
1ac0: 69 6e 65 20 70 29 29 29 0a 09 20 20 20 20 28 69 ine p))).. (i
1ad0: 66 20 28 6e 6f 74 20 28 65 6f 66 2d 6f 62 6a 65 f (not (eof-obje
1ae0: 63 74 3f 20 6e 65 78 74 6c 29 29 0a 09 09 28 6c ct? nextl))...(l
1af0: 6f 6f 70 20 28 73 74 72 69 6e 67 2d 61 70 70 65 oop (string-appe
1b00: 6e 64 20 28 69 66 20 63 6f 6e 74 2d 6c 69 6e 65 nd (if cont-line
1b10: 20 0a 09 09 09 09 09 20 28 73 74 72 69 6e 67 2d ...... (string-
1b20: 74 61 6b 65 20 69 6e 6c 20 28 2d 20 28 73 74 72 take inl (- (str
1b30: 69 6e 67 2d 6c 65 6e 67 74 68 20 69 6e 6c 29 20 ing-length inl)
1b40: 31 29 29 0a 09 09 09 09 09 20 69 6e 6c 29 0a 09 1))...... inl)..
1b50: 09 09 09 20 20 20 20 20 6e 65 78 74 6c 29 29 29 ... nextl)))
1b60: 29 0a 09 20 20 28 6c 65 74 20 28 28 72 65 73 20 ).. (let ((res
1b70: 28 63 61 73 65 20 61 6c 6c 6f 77 2d 70 72 6f 63 (case allow-proc
1b80: 65 73 73 69 6e 67 20 3b 3b 20 69 66 20 28 61 6e essing ;; if (an
1b90: 64 20 61 6c 6c 6f 77 2d 70 72 6f 63 65 73 73 69 d allow-processi
1ba0: 6e 67 20 0a 09 09 20 20 20 20 20 20 20 3b 3b 09 ng ... ;;.
1bb0: 20 20 20 28 6e 6f 74 20 28 65 71 3f 20 61 6c 6c (not (eq? all
1bc0: 6f 77 2d 70 72 6f 63 65 73 73 69 6e 67 20 27 72 ow-processing 'r
1bd0: 65 74 75 72 6e 2d 73 74 72 69 6e 67 29 29 29 0a eturn-string))).
1be0: 09 09 20 20 20 20 20 20 20 28 28 23 74 20 23 66 .. ((#t #f
1bf0: 29 0a 09 09 09 28 63 6f 6e 66 69 67 66 3a 70 72 )....(configf:pr
1c00: 6f 63 65 73 73 2d 6c 69 6e 65 20 69 6e 6c 20 68 ocess-line inl h
1c10: 74 20 61 6c 6c 6f 77 2d 70 72 6f 63 65 73 73 69 t allow-processi
1c20: 6e 67 29 29 0a 09 09 20 20 20 20 20 20 20 28 28 ng))... ((
1c30: 72 65 74 75 72 6e 2d 73 74 72 69 6e 67 29 0a 09 return-string)..
1c40: 09 09 69 6e 6c 29 0a 09 09 20 20 20 20 20 20 20 ..inl)...
1c50: 28 65 6c 73 65 0a 09 09 09 28 63 6f 6e 66 69 67 (else....(config
1c60: 66 3a 70 72 6f 63 65 73 73 2d 6c 69 6e 65 20 69 f:process-line i
1c70: 6e 6c 20 68 74 20 61 6c 6c 6f 77 2d 70 72 6f 63 nl ht allow-proc
1c80: 65 73 73 69 6e 67 29 29 29 29 29 0a 09 20 20 20 essing)))))..
1c90: 20 28 69 66 20 28 61 6e 64 20 28 73 74 72 69 6e (if (and (strin
1ca0: 67 3f 20 72 65 73 29 0a 09 09 20 20 20 20 20 28 g? res)... (
1cb0: 6e 6f 74 20 28 65 71 75 61 6c 3f 20 28 68 61 73 not (equal? (has
1cc0: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
1cd0: 75 6c 74 20 73 65 74 74 69 6e 67 73 20 22 74 72 ult settings "tr
1ce0: 69 6d 2d 74 72 61 69 6c 69 6e 67 2d 73 70 61 63 im-trailing-spac
1cf0: 65 73 22 20 22 6e 6f 22 29 20 22 6e 6f 22 29 29 es" "no") "no"))
1d00: 29 0a 09 09 28 73 74 72 69 6e 67 2d 73 75 62 73 )...(string-subs
1d10: 74 69 74 75 74 65 20 22 5c 5c 73 2b 24 22 20 22 titute "\\s+$" "
1d20: 22 20 72 65 73 29 0a 09 09 72 65 73 29 29 29 29 " res)...res))))
1d30: 29 29 0a 20 20 0a 28 64 65 66 69 6e 65 20 28 63 )). .(define (c
1d40: 61 6c 63 2d 61 6c 6c 6f 77 2d 73 79 73 74 65 6d alc-allow-system
1d50: 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 73 65 allow-system se
1d60: 63 74 69 6f 6e 20 73 65 63 74 69 6f 6e 73 29 0a ction sections).
1d70: 20 20 28 69 66 20 73 65 63 74 69 6f 6e 73 0a 20 (if sections.
1d80: 20 20 20 20 20 28 61 6e 64 20 28 6f 72 20 28 65 (and (or (e
1d90: 71 75 61 6c 3f 20 22 64 65 66 61 75 6c 74 22 20 qual? "default"
1da0: 73 65 63 74 69 6f 6e 29 0a 09 20 20 20 20 20 20 section)..
1db0: 20 28 6d 65 6d 62 65 72 20 73 65 63 74 69 6f 6e (member section
1dc0: 20 73 65 63 74 69 6f 6e 73 29 29 0a 09 20 20 20 sections))..
1dd0: 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 29 20 3b 3b allow-system) ;;
1de0: 20 61 63 63 6f 75 6e 74 20 66 6f 72 20 73 65 63 account for sec
1df0: 74 69 6f 6e 73 20 61 6e 64 20 72 65 74 75 72 6e tions and return
1e00: 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 61 73 allow-system as
1e10: 20 69 74 20 6d 69 67 68 74 20 62 65 20 61 20 73 it might be a s
1e20: 79 6d 62 6f 6c 20 73 75 63 68 20 61 73 20 72 65 ymbol such as re
1e30: 74 75 72 6e 2d 73 74 72 69 6e 67 73 0a 20 20 20 turn-strings.
1e40: 20 20 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 29 allow-system)
1e50: 29 0a 20 20 20 20 0a 3b 3b 20 67 69 76 65 6e 20 ). .;; given
1e60: 61 20 63 6f 6e 66 69 67 20 68 61 73 68 20 61 6e a config hash an
1e70: 64 20 61 20 73 65 63 74 69 6f 6e 20 6e 61 6d 65 d a section name
1e80: 2c 20 61 70 70 6c 79 20 74 68 61 74 20 73 65 63 , apply that sec
1e90: 74 69 6f 6e 20 74 6f 20 61 6c 6c 20 6d 61 74 63 tion to all matc
1ea0: 68 69 6e 67 20 73 65 63 74 69 6f 6e 73 20 28 75 hing sections (u
1eb0: 73 69 6e 67 20 77 69 6c 64 63 61 72 64 20 25 20 sing wildcard %
1ec0: 6f 72 20 72 65 67 65 78 20 69 66 20 2f 2e 2e 2e or regex if /...
1ed0: 2e 2f 29 0a 3b 3b 20 72 65 6d 6f 76 65 20 74 68 ./).;; remove th
1ee0: 65 20 73 65 63 74 69 6f 6e 20 77 68 65 6e 20 64 e section when d
1ef0: 6f 6e 65 20 73 6f 20 74 68 61 74 20 74 68 65 72 one so that ther
1f00: 65 20 69 73 20 6e 6f 20 64 6f 77 6e 73 74 72 65 e is no downstre
1f10: 61 6d 20 63 6c 6f 62 62 65 72 69 6e 67 0a 3b 3b am clobbering.;;
1f20: 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 .(define (config
1f30: 66 3a 61 70 70 6c 79 2d 77 69 6c 64 63 61 72 64 f:apply-wildcard
1f40: 73 20 68 74 20 73 65 63 74 69 6f 6e 2d 6e 61 6d s ht section-nam
1f50: 65 29 0a 20 20 28 69 66 20 28 68 61 73 68 2d 74 e). (if (hash-t
1f60: 61 62 6c 65 2d 65 78 69 73 74 73 3f 20 68 74 20 able-exists? ht
1f70: 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 29 0a 20 20 section-name).
1f80: 20 20 20 20 28 6c 65 74 2a 20 28 28 76 61 72 73 (let* ((vars
1f90: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 (hash-table-re
1fa0: 66 20 68 74 20 73 65 63 74 69 6f 6e 2d 6e 61 6d f ht section-nam
1fb0: 65 29 29 0a 09 20 20 20 20 20 28 72 78 73 74 72 e)).. (rxstr
1fc0: 20 28 69 66 20 28 73 74 72 69 6e 67 2d 63 6f 6e (if (string-con
1fd0: 74 61 69 6e 73 20 73 65 63 74 69 6f 6e 2d 6e 61 tains section-na
1fe0: 6d 65 20 22 25 22 29 0a 09 09 09 28 73 74 72 69 me "%")....(stri
1ff0: 6e 67 2d 73 75 62 73 74 69 74 75 74 65 20 28 72 ng-substitute (r
2000: 65 67 65 78 70 20 22 25 22 29 20 22 2e 2a 22 20 egexp "%") ".*"
2010: 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 29 0a 09 09 section-name)...
2020: 09 28 73 74 72 69 6e 67 2d 73 75 62 73 74 69 74 .(string-substit
2030: 75 74 65 20 28 72 65 67 65 78 70 20 22 5e 2f 28 ute (regexp "^/(
2040: 2e 2a 29 2f 24 22 29 20 22 5c 5c 31 22 20 73 65 .*)/$") "\\1" se
2050: 63 74 69 6f 6e 2d 6e 61 6d 65 29 29 29 0a 09 20 ction-name)))..
2060: 20 20 20 20 28 72 78 20 20 20 20 28 72 65 67 65 (rx (rege
2070: 78 70 20 72 78 73 74 72 29 29 29 0a 09 3b 3b 20 xp rxstr)))..;;
2080: 28 70 72 69 6e 74 20 22 5c 6e 73 65 63 74 69 6f (print "\nsectio
2090: 6e 2d 6e 61 6d 65 3a 20 22 20 73 65 63 74 69 6f n-name: " sectio
20a0: 6e 2d 6e 61 6d 65 20 22 20 72 78 73 74 72 3a 20 n-name " rxstr:
20b0: 22 20 72 78 73 74 72 29 0a 20 20 20 20 20 20 20 " rxstr).
20c0: 20 28 66 6f 72 2d 65 61 63 68 0a 20 20 20 20 20 (for-each.
20d0: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 73 65 63 (lambda (sec
20e0: 74 69 6f 6e 29 0a 09 20 20 20 28 69 66 20 73 65 tion).. (if se
20f0: 63 74 69 6f 6e 0a 09 20 20 20 20 20 20 20 28 6c ction.. (l
2100: 65 74 20 28 28 73 61 6d 65 2d 73 65 63 74 69 6f et ((same-sectio
2110: 6e 20 28 73 74 72 69 6e 67 3d 3f 20 73 65 63 74 n (string=? sect
2120: 69 6f 6e 2d 6e 61 6d 65 20 73 65 63 74 69 6f 6e ion-name section
2130: 29 29 0a 09 09 20 20 20 20 20 28 72 78 2d 6d 61 ))... (rx-ma
2140: 74 63 68 20 20 20 20 20 28 73 74 72 69 6e 67 2d tch (string-
2150: 6d 61 74 63 68 20 72 78 20 73 65 63 74 69 6f 6e match rx section
2160: 29 29 29 0a 09 09 20 3b 3b 20 28 70 72 69 6e 74 )))... ;; (print
2170: 20 22 73 65 63 74 69 6f 6e 3a 20 22 20 73 65 63 "section: " sec
2180: 74 69 6f 6e 20 22 20 76 61 72 73 3a 20 22 20 76 tion " vars: " v
2190: 61 72 73 20 22 20 73 61 6d 65 2d 73 65 63 74 69 ars " same-secti
21a0: 6f 6e 3a 20 22 20 73 61 6d 65 2d 73 65 63 74 69 on: " same-secti
21b0: 6f 6e 20 22 20 72 78 2d 6d 61 74 63 68 3a 20 22 on " rx-match: "
21c0: 20 72 78 2d 6d 61 74 63 68 29 0a 09 09 20 28 69 rx-match)... (i
21d0: 66 20 28 61 6e 64 20 28 6e 6f 74 20 73 61 6d 65 f (and (not same
21e0: 2d 73 65 63 74 69 6f 6e 29 20 72 78 2d 6d 61 74 -section) rx-mat
21f0: 63 68 29 0a 09 09 20 20 20 20 20 28 66 6f 72 2d ch)... (for-
2200: 65 61 63 68 0a 09 09 20 20 20 20 20 20 28 6c 61 each... (la
2210: 6d 62 64 61 20 28 62 75 6e 64 6c 65 29 0a 09 09 mbda (bundle)...
2220: 09 3b 3b 20 28 70 72 69 6e 74 20 22 62 75 6e 64 .;; (print "bund
2230: 6c 65 3a 20 22 20 62 75 6e 64 6c 65 29 0a 09 09 le: " bundle)...
2240: 09 28 6c 65 74 20 28 28 6b 65 79 20 20 28 63 61 .(let ((key (ca
2250: 72 20 62 75 6e 64 6c 65 29 29 0a 09 09 09 20 20 r bundle))....
2260: 20 20 20 20 28 76 61 6c 20 20 28 63 61 64 72 20 (val (cadr
2270: 62 75 6e 64 6c 65 29 29 0a 09 09 09 20 20 20 20 bundle))....
2280: 20 20 28 6d 65 74 61 20 28 69 66 20 28 3e 20 28 (meta (if (> (
2290: 6c 65 6e 67 74 68 20 62 75 6e 64 6c 65 29 20 32 length bundle) 2
22a0: 29 28 63 61 64 64 72 20 62 75 6e 64 6c 65 29 20 )(caddr bundle)
22b0: 23 66 29 29 29 0a 09 09 09 20 20 28 68 61 73 68 #f))).... (hash
22c0: 2d 74 61 62 6c 65 2d 73 65 74 21 20 68 74 20 73 -table-set! ht s
22d0: 65 63 74 69 6f 6e 20 28 63 6f 6e 66 69 67 3a 61 ection (config:a
22e0: 73 73 6f 63 2d 73 61 66 65 2d 61 64 64 20 28 68 ssoc-safe-add (h
22f0: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 68 74 ash-table-ref ht
2300: 20 73 65 63 74 69 6f 6e 29 20 6b 65 79 20 76 61 section) key va
2310: 6c 20 6d 65 74 61 64 61 74 61 3a 20 6d 65 74 61 l metadata: meta
2320: 29 29 29 29 0a 09 09 20 20 20 20 20 20 76 61 72 ))))... var
2330: 73 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 s))))).
2340: 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 (hash-table-keys
2350: 20 68 74 29 29 29 29 0a 20 20 68 74 29 0a 0a 3b ht)))). ht)..;
2360: 3b 20 72 65 61 64 20 61 20 63 6f 6e 66 69 67 20 ; read a config
2370: 66 69 6c 65 2c 20 72 65 74 75 72 6e 73 20 68 61 file, returns ha
2380: 73 68 20 74 61 62 6c 65 20 6f 66 20 61 6c 69 73 sh table of alis
2390: 74 73 0a 0a 3b 3b 20 72 65 61 64 20 61 20 63 6f ts..;; read a co
23a0: 6e 66 69 67 20 66 69 6c 65 2c 20 72 65 74 75 72 nfig file, retur
23b0: 6e 73 20 68 61 73 68 20 74 61 62 6c 65 20 6f 66 ns hash table of
23c0: 20 61 6c 69 73 74 73 0a 3b 3b 20 61 64 64 73 20 alists.;; adds
23d0: 74 6f 20 68 74 20 69 66 20 67 69 76 65 6e 20 28 to ht if given (
23e0: 6d 75 73 74 20 62 65 20 23 66 20 6f 74 68 65 72 must be #f other
23f0: 77 69 73 65 29 0a 3b 3b 20 65 6e 76 69 6f 6e 2d wise).;; envion-
2400: 70 61 74 74 20 69 73 20 61 20 72 65 67 65 78 20 patt is a regex
2410: 73 70 65 63 20 74 68 61 74 20 69 64 65 6e 74 69 spec that identi
2420: 66 69 65 73 20 73 65 63 74 69 6f 6e 73 20 74 68 fies sections th
2430: 61 74 20 77 69 6c 6c 20 62 65 20 65 76 61 6c 27 at will be eval'
2440: 64 0a 3b 3b 20 69 6e 20 74 68 65 20 65 6e 76 69 d.;; in the envi
2450: 72 6f 6e 6d 65 6e 74 20 6f 6e 20 74 68 65 20 66 ronment on the f
2460: 6c 79 0a 3b 3b 20 73 65 63 74 69 6f 6e 73 3a 20 ly.;; sections:
2470: 23 66 20 3d 3e 20 67 65 74 20 61 6c 6c 2c 20 65 #f => get all, e
2480: 6c 73 65 20 6c 69 73 74 20 6f 66 20 73 65 63 74 lse list of sect
2490: 69 6f 6e 73 20 74 6f 20 67 61 74 68 65 72 0a 3b ions to gather.;
24a0: 3b 20 70 6f 73 74 2d 73 65 63 74 69 6f 6e 2d 70 ; post-section-p
24b0: 72 6f 63 73 20 61 6c 69 73 74 20 6f 66 20 73 65 rocs alist of se
24c0: 63 74 69 6f 6e 2d 70 61 74 74 65 72 6e 20 3d 3e ction-pattern =>
24d0: 20 70 72 6f 63 2c 20 77 68 65 72 65 3a 20 28 70 proc, where: (p
24e0: 72 6f 63 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 roc section-name
24f0: 20 6e 65 78 74 2d 73 65 63 74 69 6f 6e 2d 6e 61 next-section-na
2500: 6d 65 20 68 74 20 63 75 72 72 2d 70 61 74 68 29 me ht curr-path)
2510: 0a 3b 3b 20 61 70 70 6c 79 2d 77 69 6c 64 63 61 .;; apply-wildca
2520: 72 64 73 3a 20 23 74 2f 23 66 20 2d 20 61 70 70 rds: #t/#f - app
2530: 6c 79 20 76 61 72 73 20 66 72 6f 6d 20 74 61 72 ly vars from tar
2540: 67 65 74 73 20 77 69 74 68 20 25 20 77 69 6c 64 gets with % wild
2550: 63 61 72 64 73 20 74 6f 20 61 6c 6c 20 6d 61 74 cards to all mat
2560: 63 68 69 6e 67 20 73 65 63 74 69 6f 6e 73 0a 3b ching sections.;
2570: 3b 0a 28 64 65 66 69 6e 65 20 28 72 65 61 64 2d ;.(define (read-
2580: 63 6f 6e 66 69 67 20 70 61 74 68 20 68 74 20 61 config path ht a
2590: 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 23 21 6b 65 llow-system #!ke
25a0: 79 20 28 65 6e 76 69 72 6f 6e 2d 70 61 74 74 20 y (environ-patt
25b0: 23 66 29 20 20 20 20 20 20 20 20 20 20 20 20 28 #f) (
25c0: 63 75 72 72 2d 73 65 63 74 69 6f 6e 20 23 66 29 curr-section #f)
25d0: 0a 09 09 20 20 20 20 20 28 73 65 63 74 69 6f 6e ... (section
25e0: 73 20 23 66 29 20 20 20 20 20 20 20 20 20 20 20 s #f)
25f0: 20 20 20 28 73 65 74 74 69 6e 67 73 20 28 6d 61 (settings (ma
2600: 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 20 ke-hash-table))
2610: 28 6b 65 65 70 2d 66 69 6c 65 6e 61 6d 65 73 20 (keep-filenames
2620: 23 66 29 0a 09 09 20 20 20 20 20 28 70 6f 73 74 #f)... (post
2630: 2d 73 65 63 74 69 6f 6e 2d 70 72 6f 63 73 20 27 -section-procs '
2640: 28 29 29 20 20 20 28 61 70 70 6c 79 2d 77 69 6c ()) (apply-wil
2650: 64 63 61 72 64 73 20 23 74 29 29 0a 20 20 28 64 dcards #t)). (d
2660: 65 62 75 67 3a 70 72 69 6e 74 20 39 20 2a 64 65 ebug:print 9 *de
2670: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
2680: 22 53 54 41 52 54 3a 20 22 20 70 61 74 68 29 0a "START: " path).
2690: 20 20 28 69 66 20 28 61 6e 64 20 28 6e 6f 74 20 (if (and (not
26a0: 28 70 6f 72 74 3f 20 70 61 74 68 29 29 0a 09 20 (port? path))..
26b0: 20 20 28 6e 6f 74 20 28 66 69 6c 65 2d 65 78 69 (not (file-exi
26c0: 73 74 73 3f 20 70 61 74 68 29 29 29 20 3b 3b 20 sts? path))) ;;
26d0: 66 6f 72 20 63 61 73 65 20 77 68 65 72 65 20 77 for case where w
26e0: 65 20 61 72 65 20 68 61 6e 64 65 64 20 61 20 70 e are handed a p
26f0: 6f 72 74 0a 20 20 20 20 20 20 28 62 65 67 69 6e ort. (begin
2700: 20 0a 09 28 64 65 62 75 67 3a 70 72 69 6e 74 2d ..(debug:print-
2710: 69 6e 66 6f 20 31 20 2a 64 65 66 61 75 6c 74 2d info 1 *default-
2720: 6c 6f 67 2d 70 6f 72 74 2a 20 22 72 65 61 64 2d log-port* "read-
2730: 63 6f 6e 66 69 67 20 2d 20 66 69 6c 65 20 6e 6f config - file no
2740: 74 20 66 6f 75 6e 64 20 22 20 70 61 74 68 20 22 t found " path "
2750: 20 63 75 72 72 65 6e 74 20 70 61 74 68 3a 20 22 current path: "
2760: 20 28 63 75 72 72 65 6e 74 2d 64 69 72 65 63 74 (current-direct
2770: 6f 72 79 29 29 0a 09 3b 3b 20 57 41 52 4e 49 4e ory))..;; WARNIN
2780: 47 3a 20 54 68 69 73 20 69 73 20 61 20 72 69 73 G: This is a ris
2790: 6b 79 20 63 68 61 6e 67 65 20 62 75 74 20 72 65 ky change but re
27a0: 61 6c 6c 79 2c 20 77 65 20 73 68 6f 75 6c 64 20 ally, we should
27b0: 6e 6f 74 20 72 65 74 75 72 6e 20 61 6e 20 65 6d not return an em
27c0: 70 74 79 20 68 61 73 68 20 74 61 62 6c 65 20 69 pty hash table i
27d0: 66 20 6e 6f 20 66 69 6c 65 20 72 65 61 64 3f 0a f no file read?.
27e0: 09 23 66 29 20 3b 3b 20 28 69 66 20 28 6e 6f 74 .#f) ;; (if (not
27f0: 20 68 74 29 28 6d 61 6b 65 2d 68 61 73 68 2d 74 ht)(make-hash-t
2800: 61 62 6c 65 29 20 68 74 29 29 0a 20 20 20 20 20 able) ht)).
2810: 20 28 6c 65 74 20 28 28 69 6e 70 20 20 20 20 20 (let ((inp
2820: 20 20 20 28 69 66 20 28 73 74 72 69 6e 67 3f 20 (if (string?
2830: 70 61 74 68 29 0a 09 09 09 20 20 20 20 28 6f 70 path).... (op
2840: 65 6e 2d 69 6e 70 75 74 2d 66 69 6c 65 20 70 61 en-input-file pa
2850: 74 68 29 0a 09 09 09 20 20 20 20 20 20 70 61 74 th).... pat
2860: 68 29 29 20 3b 3b 20 77 65 20 63 61 6e 20 62 65 h)) ;; we can be
2870: 20 68 61 6e 64 65 64 20 61 20 70 6f 72 74 0a 09 handed a port..
2880: 20 20 20 20 28 72 65 73 20 20 20 20 20 20 20 20 (res
2890: 28 69 66 20 28 6e 6f 74 20 68 74 29 28 6d 61 6b (if (not ht)(mak
28a0: 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 20 68 74 e-hash-table) ht
28b0: 29 29 0a 09 20 20 20 20 28 6d 65 74 61 70 61 74 )).. (metapat
28c0: 68 20 20 20 28 69 66 20 28 6f 72 20 28 64 65 62 h (if (or (deb
28d0: 75 67 3a 64 65 62 75 67 2d 6d 6f 64 65 20 39 29 ug:debug-mode 9)
28e0: 0a 09 09 09 09 6b 65 65 70 2d 66 69 6c 65 6e 61 .....keep-filena
28f0: 6d 65 73 29 0a 09 09 09 20 20 20 20 70 61 74 68 mes).... path
2900: 20 23 66 29 29 0a 20 20 20 20 20 20 20 20 20 20 #f)).
2910: 20 20 28 70 72 6f 63 65 73 73 2d 77 69 6c 64 63 (process-wildc
2920: 61 72 64 73 20 20 28 6c 61 6d 62 64 61 20 28 72 ards (lambda (r
2930: 65 73 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d es curr-section-
2940: 6e 61 6d 65 29 0a 20 20 20 20 20 20 20 20 20 20 name).
2950: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2960: 20 20 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 (if (and
2970: 20 61 70 70 6c 79 2d 77 69 6c 64 63 61 72 64 73 apply-wildcards
2980: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2990: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
29a0: 20 20 20 20 20 20 20 20 20 20 20 20 28 6f 72 20 (or
29b0: 28 73 74 72 69 6e 67 2d 63 6f 6e 74 61 69 6e 73 (string-contains
29c0: 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 curr-section-na
29d0: 6d 65 20 22 25 22 29 20 20 20 3b 3b 20 77 69 6c me "%") ;; wil
29e0: 64 63 61 72 64 0a 20 20 20 20 20 20 20 20 20 20 dcard.
29f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2a00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2a10: 20 20 20 20 20 28 73 74 72 69 6e 67 2d 6d 61 74 (string-mat
2a20: 63 68 20 22 2f 2e 2a 2f 22 20 63 75 72 72 2d 73 ch "/.*/" curr-s
2a30: 65 63 74 69 6f 6e 2d 6e 61 6d 65 29 29 29 20 3b ection-name))) ;
2a40: 3b 20 72 65 67 65 78 0a 20 20 20 20 20 20 20 20 ; regex.
2a50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2a60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 62 (b
2a70: 65 67 69 6e 0a 20 20 20 20 20 20 20 20 20 20 20 egin.
2a80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2a90: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f (co
2aa0: 6e 66 69 67 66 3a 61 70 70 6c 79 2d 77 69 6c 64 nfigf:apply-wild
2ab0: 63 61 72 64 73 20 72 65 73 20 63 75 72 72 2d 73 cards res curr-s
2ac0: 65 63 74 69 6f 6e 2d 6e 61 6d 65 29 0a 20 20 20 ection-name).
2ad0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2ae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2af0: 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 (hash-table
2b00: 2d 64 65 6c 65 74 65 21 20 72 65 73 20 63 75 72 -delete! res cur
2b10: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 29 29 r-section-name))
2b20: 29 29 29 29 20 20 3b 3b 20 4e 4f 54 45 3a 20 69 )))) ;; NOTE: i
2b30: 66 20 74 68 65 20 73 65 63 74 69 6f 6e 20 69 73 f the section is
2b40: 20 61 20 77 69 6c 64 20 63 61 72 64 20 69 74 20 a wild card it
2b50: 77 69 6c 6c 20 62 65 20 52 45 4d 4f 56 45 44 20 will be REMOVED
2b60: 66 72 6f 6d 20 72 65 73 20 0a 09 28 6c 65 74 20 from res ..(let
2b70: 6c 6f 6f 70 20 28 28 69 6e 6c 20 20 20 20 20 20 loop ((inl
2b80: 20 20 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 (config
2b90: 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 20 f:read-line inp
2ba0: 72 65 73 20 28 63 61 6c 63 2d 61 6c 6c 6f 77 2d res (calc-allow-
2bb0: 73 79 73 74 65 6d 20 61 6c 6c 6f 77 2d 73 79 73 system allow-sys
2bc0: 74 65 6d 20 63 75 72 72 2d 73 65 63 74 69 6f 6e tem curr-section
2bd0: 20 73 65 63 74 69 6f 6e 73 29 20 73 65 74 74 69 sections) setti
2be0: 6e 67 73 29 29 20 3b 3b 20 28 72 65 61 64 2d 6c ngs)) ;; (read-l
2bf0: 69 6e 65 20 69 6e 70 29 29 0a 09 09 20 20 20 28 ine inp))... (
2c00: 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d curr-section-nam
2c10: 65 20 28 69 66 20 63 75 72 72 2d 73 65 63 74 69 e (if curr-secti
2c20: 6f 6e 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 20 on curr-section
2c30: 22 64 65 66 61 75 6c 74 22 29 29 0a 09 09 20 20 "default"))...
2c40: 20 28 76 61 72 2d 66 6c 61 67 20 23 66 29 3b 3b (var-flag #f);;
2c50: 20 74 75 72 6e 20 6f 6e 20 66 6f 72 20 6b 65 79 turn on for key
2c60: 2d 76 61 72 2d 70 72 20 61 6e 64 20 63 6f 6e 74 -var-pr and cont
2c70: 2d 6c 6e 2d 72 78 2c 20 74 75 72 6e 20 6f 66 66 -ln-rx, turn off
2c80: 20 65 6c 73 65 77 68 65 72 65 0a 09 09 20 20 20 elsewhere...
2c90: 28 6c 65 61 64 20 20 20 20 20 23 66 29 29 0a 09 (lead #f))..
2ca0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 (debug:print-i
2cb0: 6e 66 6f 20 38 20 2a 64 65 66 61 75 6c 74 2d 6c nfo 8 *default-l
2cc0: 6f 67 2d 70 6f 72 74 2a 20 22 63 75 72 72 2d 73 og-port* "curr-s
2cd0: 65 63 74 69 6f 6e 2d 6e 61 6d 65 3a 20 22 20 63 ection-name: " c
2ce0: 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 urr-section-name
2cf0: 20 22 20 76 61 72 2d 66 6c 61 67 3a 20 22 20 76 " var-flag: " v
2d00: 61 72 2d 66 6c 61 67 20 22 5c 6e 20 20 20 69 6e ar-flag "\n in
2d10: 6c 3a 20 5c 22 22 20 69 6e 6c 20 22 5c 22 22 29 l: \"" inl "\"")
2d20: 0a 09 20 20 28 69 66 20 28 65 6f 66 2d 6f 62 6a .. (if (eof-obj
2d30: 65 63 74 3f 20 69 6e 6c 29 20 0a 09 20 20 20 20 ect? inl) ..
2d40: 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 (begin.
2d50: 20 20 20 20 20 20 20 20 20 3b 3b 20 70 72 6f 63 ;; proc
2d60: 65 73 73 20 6c 61 73 74 20 73 65 63 74 69 6f 6e ess last section
2d70: 20 66 6f 72 20 77 69 6c 64 63 61 72 64 73 0a 20 for wildcards.
2d80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
2d90: 70 72 6f 63 65 73 73 2d 77 69 6c 64 63 61 72 64 process-wildcard
2da0: 73 20 72 65 73 20 63 75 72 72 2d 73 65 63 74 69 s res curr-secti
2db0: 6f 6e 2d 6e 61 6d 65 29 0a 09 09 28 69 66 20 28 on-name)...(if (
2dc0: 73 74 72 69 6e 67 3f 20 70 61 74 68 29 20 3b 3b string? path) ;;
2dd0: 20 77 65 20 72 65 63 65 69 76 65 64 20 61 20 70 we received a p
2de0: 61 74 68 2c 20 6e 6f 74 20 61 20 70 6f 72 74 2c ath, not a port,
2df0: 20 74 68 75 73 20 77 65 20 61 72 65 20 72 65 73 thus we are res
2e00: 70 6f 6e 73 69 62 6c 65 20 66 6f 72 20 63 6c 6f ponsible for clo
2e10: 73 69 6e 67 20 69 74 2e 0a 09 09 20 20 20 20 28 sing it.... (
2e20: 63 6c 6f 73 65 2d 69 6e 70 75 74 2d 70 6f 72 74 close-input-port
2e30: 20 69 6e 70 29 29 0a 09 09 28 69 66 20 28 6c 69 inp))...(if (li
2e40: 73 74 3f 20 73 65 63 74 69 6f 6e 73 29 20 3b 3b st? sections) ;;
2e50: 20 64 65 6c 65 74 65 20 61 6c 6c 20 73 65 63 74 delete all sect
2e60: 69 6f 6e 73 20 65 78 63 65 70 74 20 67 69 76 65 ions except give
2e70: 6e 20 77 68 65 6e 20 73 65 63 74 69 6f 6e 73 20 n when sections
2e80: 69 73 20 70 72 6f 76 69 64 65 64 0a 09 09 20 20 is provided...
2e90: 20 20 28 66 6f 72 2d 65 61 63 68 0a 09 09 20 20 (for-each...
2ea0: 20 20 20 28 6c 61 6d 62 64 61 20 28 73 65 63 74 (lambda (sect
2eb0: 69 6f 6e 29 0a 09 09 20 20 20 20 20 20 20 28 69 ion)... (i
2ec0: 66 20 28 6e 6f 74 20 28 6d 65 6d 62 65 72 20 73 f (not (member s
2ed0: 65 63 74 69 6f 6e 20 73 65 63 74 69 6f 6e 73 29 ection sections)
2ee0: 29 0a 09 09 09 20 20 20 28 68 61 73 68 2d 74 61 ).... (hash-ta
2ef0: 62 6c 65 2d 64 65 6c 65 74 65 21 20 72 65 73 20 ble-delete! res
2f00: 73 65 63 74 69 6f 6e 29 29 29 20 3b 3b 20 77 65 section))) ;; we
2f10: 20 61 72 65 20 75 73 69 6e 67 20 22 22 20 61 73 are using "" as
2f20: 20 61 20 64 75 6d 70 69 6e 67 20 67 72 6f 75 6e a dumping groun
2f30: 64 20 61 6e 64 20 6d 75 73 74 20 72 65 6d 6f 76 d and must remov
2f40: 65 20 69 74 20 62 65 66 6f 72 65 20 72 65 74 75 e it before retu
2f50: 72 6e 69 6e 67 20 74 68 65 20 68 74 0a 09 09 20 rning the ht...
2f60: 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (hash-table-
2f70: 6b 65 79 73 20 72 65 73 29 29 29 0a 09 09 28 64 keys res)))...(d
2f80: 65 62 75 67 3a 70 72 69 6e 74 20 39 20 2a 64 65 ebug:print 9 *de
2f90: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
2fa0: 22 45 4e 44 3a 20 22 20 70 61 74 68 29 0a 09 09 "END: " path)...
2fb0: 72 65 73 29 0a 09 20 20 20 20 20 20 28 72 65 67 res).. (reg
2fc0: 65 78 2d 63 61 73 65 20 0a 09 20 20 20 20 20 20 ex-case ..
2fd0: 20 69 6e 6c 20 0a 09 20 20 20 20 20 20 20 28 63 inl .. (c
2fe0: 6f 6e 66 69 67 66 3a 63 6f 6d 6d 65 6e 74 2d 72 onfigf:comment-r
2ff0: 78 20 5f 20 20 20 20 20 20 20 20 20 20 20 20 20 x _
3000: 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 6f 6e 66 (loop (conf
3010: 69 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e igf:read-line in
3020: 70 20 72 65 73 20 28 63 61 6c 63 2d 61 6c 6c 6f p res (calc-allo
3030: 77 2d 73 79 73 74 65 6d 20 61 6c 6c 6f 77 2d 73 w-system allow-s
3040: 79 73 74 65 6d 20 63 75 72 72 2d 73 65 63 74 69 ystem curr-secti
3050: 6f 6e 2d 6e 61 6d 65 20 73 65 63 74 69 6f 6e 73 on-name sections
3060: 29 20 73 65 74 74 69 6e 67 73 29 20 63 75 72 72 ) settings) curr
3070: 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 -section-name #f
3080: 20 23 66 29 29 0a 09 20 20 20 20 20 20 20 28 63 #f)).. (c
3090: 6f 6e 66 69 67 66 3a 62 6c 61 6e 6b 2d 6c 2d 72 onfigf:blank-l-r
30a0: 78 20 5f 20 20 20 20 20 20 20 20 20 20 20 20 20 x _
30b0: 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 6f 6e 66 (loop (conf
30c0: 69 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e igf:read-line in
30d0: 70 20 72 65 73 20 28 63 61 6c 63 2d 61 6c 6c 6f p res (calc-allo
30e0: 77 2d 73 79 73 74 65 6d 20 61 6c 6c 6f 77 2d 73 w-system allow-s
30f0: 79 73 74 65 6d 20 63 75 72 72 2d 73 65 63 74 69 ystem curr-secti
3100: 6f 6e 2d 6e 61 6d 65 20 73 65 63 74 69 6f 6e 73 on-name sections
3110: 29 20 73 65 74 74 69 6e 67 73 29 20 63 75 72 72 ) settings) curr
3120: 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 -section-name #f
3130: 20 23 66 29 29 0a 09 20 20 20 20 20 20 20 28 63 #f)).. (c
3140: 6f 6e 66 69 67 66 3a 73 65 74 74 69 6e 67 73 20 onfigf:settings
3150: 20 20 28 20 78 20 73 65 74 74 69 6e 67 20 76 61 ( x setting va
3160: 6c 20 20 29 20 28 62 65 67 69 6e 0a 09 09 09 09 l ) (begin.....
3170: 09 09 09 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 ...(hash-table-s
3180: 65 74 21 20 73 65 74 74 69 6e 67 73 20 73 65 74 et! settings set
3190: 74 69 6e 67 20 76 61 6c 29 0a 09 09 09 09 09 09 ting val).......
31a0: 09 28 6c 6f 6f 70 20 28 63 6f 6e 66 69 67 66 3a .(loop (configf:
31b0: 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 20 72 65 read-line inp re
31c0: 73 20 28 63 61 6c 63 2d 61 6c 6c 6f 77 2d 73 79 s (calc-allow-sy
31d0: 73 74 65 6d 20 61 6c 6c 6f 77 2d 73 79 73 74 65 stem allow-syste
31e0: 6d 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e m curr-section-n
31f0: 61 6d 65 20 73 65 63 74 69 6f 6e 73 29 20 73 65 ame sections) se
3200: 74 74 69 6e 67 73 29 20 63 75 72 72 2d 73 65 63 ttings) curr-sec
3210: 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 66 29 tion-name #f #f)
3220: 29 29 0a 09 20 20 20 20 20 20 20 28 63 6f 6e 66 )).. (conf
3230: 69 67 66 3a 69 6e 63 6c 75 64 65 2d 72 78 20 28 igf:include-rx (
3240: 20 78 20 69 6e 63 6c 75 64 65 2d 66 69 6c 65 20 x include-file
3250: 29 20 28 6c 65 74 2a 20 28 28 63 75 72 72 2d 63 ) (let* ((curr-c
3260: 6f 6e 66 2d 64 69 72 20 28 70 61 74 68 6e 61 6d onf-dir (pathnam
3270: 65 2d 64 69 72 65 63 74 6f 72 79 20 70 61 74 68 e-directory path
3280: 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 28 ))........ (
3290: 66 75 6c 6c 2d 63 6f 6e 66 20 20 20 20 20 28 69 full-conf (i
32a0: 66 20 28 61 62 73 6f 6c 75 74 65 2d 70 61 74 68 f (absolute-path
32b0: 6e 61 6d 65 3f 20 69 6e 63 6c 75 64 65 2d 66 69 name? include-fi
32c0: 6c 65 29 0a 09 09 09 09 09 09 09 09 09 09 69 6e le)...........in
32d0: 63 6c 75 64 65 2d 66 69 6c 65 0a 09 09 09 09 09 clude-file......
32e0: 09 09 09 09 09 28 63 6f 6d 6d 6f 6e 3a 6e 69 63 .....(common:nic
32f0: 65 2d 70 61 74 68 20 0a 09 09 09 09 09 09 09 09 e-path .........
3300: 09 09 20 28 63 6f 6e 63 20 28 69 66 20 63 75 72 .. (conc (if cur
3310: 72 2d 63 6f 6e 66 2d 64 69 72 0a 09 09 09 09 09 r-conf-dir......
3320: 09 09 09 09 09 09 20 20 20 63 75 72 72 2d 63 6f ...... curr-co
3330: 6e 66 2d 64 69 72 0a 09 09 09 09 09 09 09 09 09 nf-dir..........
3340: 09 09 20 20 20 22 2e 22 29 0a 09 09 09 09 09 09 .. ".").......
3350: 09 09 09 09 20 20 20 20 20 20 20 22 2f 22 20 69 .... "/" i
3360: 6e 63 6c 75 64 65 2d 66 69 6c 65 29 29 29 29 29 nclude-file)))))
3370: 0a 09 09 09 09 09 09 09 28 69 66 20 28 66 69 6c ........(if (fil
3380: 65 2d 65 78 69 73 74 73 3f 20 66 75 6c 6c 2d 63 e-exists? full-c
3390: 6f 6e 66 29 0a 09 09 09 09 09 09 09 20 20 20 20 onf)........
33a0: 28 62 65 67 69 6e 0a 09 09 09 09 09 09 09 20 20 (begin........
33b0: 20 20 20 20 3b 3b 20 28 70 75 73 68 2d 64 69 72 ;; (push-dir
33c0: 65 63 74 6f 72 79 20 63 6f 6e 66 2d 64 69 72 29 ectory conf-dir)
33d0: 0a 09 09 09 09 09 09 09 20 20 20 20 20 20 28 64 ........ (d
33e0: 65 62 75 67 3a 70 72 69 6e 74 20 39 20 2a 64 65 ebug:print 9 *de
33f0: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
3400: 22 49 6e 63 6c 75 64 69 6e 67 3a 20 22 20 66 75 "Including: " fu
3410: 6c 6c 2d 63 6f 6e 66 29 0a 09 09 09 09 09 09 09 ll-conf)........
3420: 20 20 20 20 20 20 28 72 65 61 64 2d 63 6f 6e 66 (read-conf
3430: 69 67 20 66 75 6c 6c 2d 63 6f 6e 66 20 72 65 73 ig full-conf res
3440: 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 65 6e allow-system en
3450: 76 69 72 6f 6e 2d 70 61 74 74 3a 20 65 6e 76 69 viron-patt: envi
3460: 72 6f 6e 2d 70 61 74 74 20 63 75 72 72 2d 73 65 ron-patt curr-se
3470: 63 74 69 6f 6e 3a 20 63 75 72 72 2d 73 65 63 74 ction: curr-sect
3480: 69 6f 6e 2d 6e 61 6d 65 20 73 65 63 74 69 6f 6e ion-name section
3490: 73 3a 20 73 65 63 74 69 6f 6e 73 20 73 65 74 74 s: sections sett
34a0: 69 6e 67 73 3a 20 73 65 74 74 69 6e 67 73 20 6b ings: settings k
34b0: 65 65 70 2d 66 69 6c 65 6e 61 6d 65 73 3a 20 6b eep-filenames: k
34c0: 65 65 70 2d 66 69 6c 65 6e 61 6d 65 73 29 0a 09 eep-filenames)..
34d0: 09 09 09 09 09 09 20 20 20 20 20 20 3b 3b 20 28 ...... ;; (
34e0: 70 6f 70 2d 64 69 72 65 63 74 6f 72 79 29 0a 09 pop-directory)..
34f0: 09 09 09 09 09 09 20 20 20 20 20 20 28 6c 6f 6f ...... (loo
3500: 70 20 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d p (configf:read-
3510: 6c 69 6e 65 20 69 6e 70 20 72 65 73 20 28 63 61 line inp res (ca
3520: 6c 63 2d 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 lc-allow-system
3530: 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 63 75 72 allow-system cur
3540: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 73 r-section-name s
3550: 65 63 74 69 6f 6e 73 29 20 73 65 74 74 69 6e 67 ections) setting
3560: 73 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d s) curr-section-
3570: 6e 61 6d 65 20 23 66 20 23 66 29 29 0a 09 09 09 name #f #f))....
3580: 09 09 09 09 20 20 20 20 28 62 65 67 69 6e 0a 09 .... (begin..
3590: 09 09 09 09 09 09 20 20 20 20 20 20 28 64 65 62 ...... (deb
35a0: 75 67 3a 70 72 69 6e 74 20 27 28 32 20 39 29 20 ug:print '(2 9)
35b0: 23 66 20 22 49 4e 46 4f 3a 20 69 6e 63 6c 75 64 #f "INFO: includ
35c0: 65 20 66 69 6c 65 20 22 20 69 6e 63 6c 75 64 65 e file " include
35d0: 2d 66 69 6c 65 20 22 20 6e 6f 74 20 66 6f 75 6e -file " not foun
35e0: 64 20 28 63 61 6c 6c 65 64 20 66 72 6f 6d 20 22 d (called from "
35f0: 20 70 61 74 68 20 22 29 22 29 0a 09 09 09 09 09 path ")")......
3600: 09 09 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 .. (debug:p
3610: 72 69 6e 74 20 32 20 2a 64 65 66 61 75 6c 74 2d rint 2 *default-
3620: 6c 6f 67 2d 70 6f 72 74 2a 20 22 20 20 20 20 20 log-port* "
3630: 20 20 20 22 20 66 75 6c 6c 2d 63 6f 6e 66 29 0a " full-conf).
3640: 09 09 09 09 09 09 09 20 20 20 20 20 20 28 6c 6f ....... (lo
3650: 6f 70 20 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 op (configf:read
3660: 2d 6c 69 6e 65 20 69 6e 70 20 72 65 73 20 28 63 -line inp res (c
3670: 61 6c 63 2d 61 6c 6c 6f 77 2d 73 79 73 74 65 6d alc-allow-system
3680: 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 63 75 allow-system cu
3690: 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 rr-section-name
36a0: 73 65 63 74 69 6f 6e 73 29 20 73 65 74 74 69 6e sections) settin
36b0: 67 73 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e gs) curr-section
36c0: 2d 6e 61 6d 65 20 23 66 20 23 66 29 29 29 29 29 -name #f #f)))))
36d0: 0a 09 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 .. (config
36e0: 66 3a 73 63 72 69 70 74 2d 72 78 20 28 20 78 20 f:script-rx ( x
36f0: 69 6e 63 6c 75 64 65 2d 73 63 72 69 70 74 20 29 include-script )
3700: 3b 3b 20 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 ;; handle-except
3710: 69 6f 6e 73 0a 09 09 09 09 09 09 20 20 20 20 20 ions.......
3720: 20 3b 3b 20 20 20 20 65 78 6e 0a 09 09 09 09 09 ;; exn......
3730: 09 20 20 20 20 20 20 3b 3b 20 20 20 20 28 62 65 . ;; (be
3740: 67 69 6e 0a 09 09 09 09 09 09 20 20 20 20 20 20 gin.......
3750: 3b 3b 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 ;; (debug:p
3760: 72 69 6e 74 20 27 28 30 20 32 20 39 29 20 23 66 rint '(0 2 9) #f
3770: 20 22 49 4e 46 4f 3a 20 69 6e 63 6c 75 64 65 20 "INFO: include
3780: 66 72 6f 6d 20 73 63 72 69 70 74 20 22 20 69 6e from script " in
3790: 63 6c 75 64 65 2d 73 63 72 69 70 74 20 22 20 66 clude-script " f
37a0: 61 69 6c 65 64 2e 22 29 0a 09 09 09 09 09 09 20 ailed.").......
37b0: 20 20 20 20 20 3b 3b 20 20 20 20 20 20 28 6c 6f ;; (lo
37c0: 6f 70 20 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 op (configf:read
37d0: 2d 6c 69 6e 65 20 69 6e 70 20 72 65 73 20 28 63 -line inp res (c
37e0: 61 6c 63 2d 61 6c 6c 6f 77 2d 73 79 73 74 65 6d alc-allow-system
37f0: 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 63 75 allow-system cu
3800: 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 rr-section-name
3810: 73 65 63 74 69 6f 6e 73 29 20 73 65 74 74 69 6e sections) settin
3820: 67 73 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e gs) curr-section
3830: 2d 6e 61 6d 65 20 23 66 20 23 66 29 29 0a 09 09 -name #f #f))...
3840: 09 09 09 09 09 20 28 69 66 20 28 61 6e 64 20 28 ..... (if (and (
3850: 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 69 6e 63 file-exists? inc
3860: 6c 75 64 65 2d 73 63 72 69 70 74 29 28 66 69 6c lude-script)(fil
3870: 65 2d 65 78 65 63 75 74 65 2d 61 63 63 65 73 73 e-execute-access
3880: 3f 20 69 6e 63 6c 75 64 65 2d 73 63 72 69 70 74 ? include-script
3890: 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 28 ))........ (
38a0: 6c 65 74 2a 20 28 28 6e 65 77 2d 69 6e 70 2d 70 let* ((new-inp-p
38b0: 6f 72 74 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d ort (open-input-
38c0: 70 69 70 65 20 69 6e 63 6c 75 64 65 2d 73 63 72 pipe include-scr
38d0: 69 70 74 29 29 29 0a 09 09 09 09 09 09 09 20 20 ipt)))........
38e0: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
38f0: 74 20 27 28 32 20 39 29 20 2a 64 65 66 61 75 6c t '(2 9) *defaul
3900: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 49 6e 63 t-log-port* "Inc
3910: 6c 75 64 69 6e 67 20 66 72 6f 6d 20 73 63 72 69 luding from scri
3920: 70 74 20 6f 75 74 70 75 74 3a 20 22 20 69 6e 63 pt output: " inc
3930: 6c 75 64 65 2d 73 63 72 69 70 74 29 0a 09 09 09 lude-script)....
3940: 09 09 09 09 20 20 20 20 20 20 3b 3b 20 20 28 70 .... ;; (p
3950: 72 69 6e 74 20 22 57 65 20 67 6f 74 20 68 65 72 rint "We got her
3960: 65 2c 20 63 61 6c 6c 69 6e 67 20 72 65 61 64 2d e, calling read-
3970: 63 6f 6e 66 69 67 20 6e 65 78 74 2e 20 50 6f 72 config next. Por
3980: 74 20 69 73 3a 20 22 20 6e 65 77 2d 69 6e 70 2d t is: " new-inp-
3990: 70 6f 72 74 29 0a 09 09 09 09 09 09 09 20 20 20 port)........
39a0: 20 20 20 20 28 72 65 61 64 2d 63 6f 6e 66 69 67 (read-config
39b0: 20 6e 65 77 2d 69 6e 70 2d 70 6f 72 74 20 72 65 new-inp-port re
39c0: 73 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 65 s allow-system e
39d0: 6e 76 69 72 6f 6e 2d 70 61 74 74 3a 20 65 6e 76 nviron-patt: env
39e0: 69 72 6f 6e 2d 70 61 74 74 20 63 75 72 72 2d 73 iron-patt curr-s
39f0: 65 63 74 69 6f 6e 3a 20 63 75 72 72 2d 73 65 63 ection: curr-sec
3a00: 74 69 6f 6e 2d 6e 61 6d 65 20 73 65 63 74 69 6f tion-name sectio
3a10: 6e 73 3a 20 73 65 63 74 69 6f 6e 73 20 73 65 74 ns: sections set
3a20: 74 69 6e 67 73 3a 20 73 65 74 74 69 6e 67 73 20 tings: settings
3a30: 6b 65 65 70 2d 66 69 6c 65 6e 61 6d 65 73 3a 20 keep-filenames:
3a40: 6b 65 65 70 2d 66 69 6c 65 6e 61 6d 65 73 29 0a keep-filenames).
3a50: 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 63 ....... (c
3a60: 6c 6f 73 65 2d 69 6e 70 75 74 2d 70 6f 72 74 20 lose-input-port
3a70: 6e 65 77 2d 69 6e 70 2d 70 6f 72 74 29 0a 09 09 new-inp-port)...
3a80: 09 09 09 09 09 20 20 20 20 20 20 20 28 6c 6f 6f ..... (loo
3a90: 70 20 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d p (configf:read-
3aa0: 6c 69 6e 65 20 69 6e 70 20 72 65 73 20 28 63 61 line inp res (ca
3ab0: 6c 63 2d 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 lc-allow-system
3ac0: 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 63 75 72 allow-system cur
3ad0: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 73 r-section-name s
3ae0: 65 63 74 69 6f 6e 73 29 20 73 65 74 74 69 6e 67 ections) setting
3af0: 73 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d s) curr-section-
3b00: 6e 61 6d 65 20 23 66 20 23 66 29 29 0a 09 09 09 name #f #f))....
3b10: 09 09 09 09 20 20 20 20 20 28 62 65 67 69 6e 0a .... (begin.
3b20: 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 64 ....... (d
3b30: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 ebug:print 0 *de
3b40: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
3b50: 22 53 63 72 69 70 74 20 6e 6f 74 20 66 6f 75 6e "Script not foun
3b60: 64 20 6f 72 20 6e 6f 74 20 65 78 65 63 74 75 74 d or not exectut
3b70: 61 62 6c 65 3a 20 22 20 69 6e 63 6c 75 64 65 2d able: " include-
3b80: 73 63 72 69 70 74 29 0a 09 09 09 09 09 09 09 20 script)........
3b90: 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 6f 6e (loop (con
3ba0: 66 69 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 figf:read-line i
3bb0: 6e 70 20 72 65 73 20 28 63 61 6c 63 2d 61 6c 6c np res (calc-all
3bc0: 6f 77 2d 73 79 73 74 65 6d 20 61 6c 6c 6f 77 2d ow-system allow-
3bd0: 73 79 73 74 65 6d 20 63 75 72 72 2d 73 65 63 74 system curr-sect
3be0: 69 6f 6e 2d 6e 61 6d 65 20 73 65 63 74 69 6f 6e ion-name section
3bf0: 73 29 20 73 65 74 74 69 6e 67 73 29 20 63 75 72 s) settings) cur
3c00: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 r-section-name #
3c10: 66 20 23 66 29 29 29 0a 09 09 09 09 09 09 09 20 f #f)))........
3c20: 29 20 3b 3b 20 29 0a 09 20 20 20 20 20 20 20 28 ) ;; ).. (
3c30: 63 6f 6e 66 69 67 66 3a 73 65 63 74 69 6f 6e 2d configf:section-
3c40: 72 78 20 28 20 78 20 73 65 63 74 69 6f 6e 2d 6e rx ( x section-n
3c50: 61 6d 65 20 29 20 28 62 65 67 69 6e 0a 09 09 09 ame ) (begin....
3c60: 09 09 09 09 3b 3b 20 63 61 6c 6c 20 70 6f 73 74 ....;; call post
3c70: 2d 73 65 63 74 69 6f 6e 2d 70 72 6f 63 73 0a 09 -section-procs..
3c80: 09 09 09 09 09 09 28 66 6f 72 2d 65 61 63 68 20 ......(for-each
3c90: 0a 09 09 09 09 09 09 09 20 28 6c 61 6d 62 64 61 ........ (lambda
3ca0: 20 28 64 61 74 29 0a 09 09 09 09 09 09 09 20 20 (dat)........
3cb0: 20 28 6c 65 74 20 28 28 70 61 74 74 20 28 63 61 (let ((patt (ca
3cc0: 72 20 64 61 74 29 29 0a 09 09 09 09 09 09 09 09 r dat)).........
3cd0: 20 28 70 72 6f 63 20 28 63 64 72 20 64 61 74 29 (proc (cdr dat)
3ce0: 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 28 ))........ (
3cf0: 69 66 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 if (string-match
3d00: 20 70 61 74 74 20 63 75 72 72 2d 73 65 63 74 69 patt curr-secti
3d10: 6f 6e 2d 6e 61 6d 65 29 0a 09 09 09 09 09 09 09 on-name)........
3d20: 09 20 28 70 72 6f 63 20 63 75 72 72 2d 73 65 63 . (proc curr-sec
3d30: 74 69 6f 6e 2d 6e 61 6d 65 20 73 65 63 74 69 6f tion-name sectio
3d40: 6e 2d 6e 61 6d 65 20 72 65 73 20 70 61 74 68 29 n-name res path)
3d50: 29 29 29 0a 09 09 09 09 09 09 09 20 70 6f 73 74 )))........ post
3d60: 2d 73 65 63 74 69 6f 6e 2d 70 72 6f 63 73 29 0a -section-procs).
3d70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3d80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3d90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3da0: 20 20 20 20 20 20 20 20 3b 3b 20 61 66 74 65 72 ;; after
3db0: 20 67 61 74 68 65 72 69 6e 67 20 74 68 65 20 76 gathering the v
3dc0: 61 72 73 20 66 6f 72 20 61 20 73 65 63 74 69 6f ars for a sectio
3dd0: 6e 20 61 6e 64 20 69 66 20 61 70 70 6c 79 2d 77 n and if apply-w
3de0: 69 6c 64 63 61 72 64 73 20 69 73 20 74 72 75 65 ildcards is true
3df0: 20 61 6e 64 20 69 66 20 74 68 65 72 65 20 69 73 and if there is
3e00: 20 61 20 77 69 6c 64 63 61 72 64 20 69 6e 20 74 a wildcard in t
3e10: 68 65 20 73 65 63 74 69 6f 6e 20 6e 61 6d 65 20 he section name
3e20: 70 72 6f 63 65 73 73 20 77 69 6c 64 63 61 72 64 process wildcard
3e30: 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 s.
3e40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3e50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3e60: 20 20 20 20 20 20 20 20 20 20 3b 3b 20 4e 4f 54 ;; NOT
3e70: 45 3a 20 77 65 20 61 72 65 20 70 72 6f 63 65 73 E: we are proces
3e80: 73 69 6e 67 20 74 68 65 20 63 75 72 72 2d 73 65 sing the curr-se
3e90: 63 74 69 6f 6e 2d 6e 61 6d 65 2c 20 4e 4f 54 20 ction-name, NOT
3ea0: 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 2e 0a 20 20 section-name..
3eb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3ec0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3ed0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3ee0: 20 20 20 20 20 20 28 70 72 6f 63 65 73 73 2d 77 (process-w
3ef0: 69 6c 64 63 61 72 64 73 20 72 65 73 20 63 75 72 ildcards res cur
3f00: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 29 0a r-section-name).
3f10: 09 09 09 09 09 09 09 28 6c 6f 6f 70 20 28 63 6f .......(loop (co
3f20: 6e 66 69 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 nfigf:read-line
3f30: 69 6e 70 20 72 65 73 20 28 63 61 6c 63 2d 61 6c inp res (calc-al
3f40: 6c 6f 77 2d 73 79 73 74 65 6d 20 61 6c 6c 6f 77 low-system allow
3f50: 2d 73 79 73 74 65 6d 20 63 75 72 72 2d 73 65 63 -system curr-sec
3f60: 74 69 6f 6e 2d 6e 61 6d 65 20 73 65 63 74 69 6f tion-name sectio
3f70: 6e 73 29 20 73 65 74 74 69 6e 67 73 29 0a 09 09 ns) settings)...
3f80: 09 09 09 09 09 20 20 20 20 20 20 3b 3b 20 69 66 ..... ;; if
3f90: 20 77 65 20 68 61 76 65 20 74 68 65 20 73 65 63 we have the sec
3fa0: 74 69 6f 6e 73 20 6c 69 73 74 20 74 68 65 6e 20 tions list then
3fb0: 66 6f 72 63 65 20 61 6c 6c 20 73 65 74 74 69 6e force all settin
3fc0: 67 73 20 69 6e 74 6f 20 22 22 20 61 6e 64 20 64 gs into "" and d
3fd0: 65 6c 65 74 65 20 69 74 20 6c 61 74 65 72 3f 0a elete it later?.
3fe0: 09 09 09 09 09 09 09 20 20 20 20 20 20 3b 3b 20 ....... ;;
3ff0: 28 69 66 20 28 6f 72 20 28 6e 6f 74 20 73 65 63 (if (or (not sec
4000: 74 69 6f 6e 73 29 20 0a 09 09 09 09 09 09 09 20 tions) ........
4010: 20 20 20 20 20 3b 3b 09 20 20 20 20 20 20 28 6d ;;. (m
4020: 65 6d 62 65 72 20 73 65 63 74 69 6f 6e 2d 6e 61 ember section-na
4030: 6d 65 20 73 65 63 74 69 6f 6e 73 29 29 0a 09 09 me sections))...
4040: 09 09 09 09 09 20 20 20 20 20 20 3b 3b 09 20 20 ..... ;;.
4050: 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 22 22 29 section-name "")
4060: 20 3b 3b 20 73 74 69 63 6b 20 65 76 65 72 79 74 ;; stick everyt
4070: 68 69 6e 67 20 69 6e 74 6f 20 22 22 2e 20 4e 4f hing into "". NO
4080: 50 45 3a 20 57 65 20 6e 65 65 64 20 6e 65 77 20 PE: We need new
4090: 73 74 72 61 74 65 67 79 2e 20 50 75 74 20 73 74 strategy. Put st
40a0: 75 66 66 20 69 6e 20 63 6f 72 72 65 63 74 20 73 uff in correct s
40b0: 65 63 74 69 6f 6e 73 20 61 6e 64 20 74 68 65 6e ections and then
40c0: 20 64 65 6c 65 74 65 20 61 6c 6c 20 73 65 63 74 delete all sect
40d0: 69 6f 6e 73 20 6c 61 74 65 72 2e 0a 09 09 09 09 ions later......
40e0: 09 09 09 20 20 20 20 20 20 73 65 63 74 69 6f 6e ... section
40f0: 2d 6e 61 6d 65 0a 09 09 09 09 09 09 09 20 20 20 -name........
4100: 20 20 20 23 66 20 23 66 29 29 29 0a 09 20 20 20 #f #f)))..
4110: 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 6b 65 79 (configf:key
4120: 2d 73 79 73 2d 70 72 20 28 20 78 20 6b 65 79 20 -sys-pr ( x key
4130: 63 6d 64 20 20 20 20 20 20 29 20 28 69 66 20 28 cmd ) (if (
4140: 63 61 6c 63 2d 61 6c 6c 6f 77 2d 73 79 73 74 65 calc-allow-syste
4150: 6d 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 63 m allow-system c
4160: 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 urr-section-name
4170: 20 73 65 63 74 69 6f 6e 73 29 0a 09 09 09 09 09 sections)......
4180: 09 09 20 20 28 6c 65 74 20 28 28 61 6c 69 73 74 .. (let ((alist
4190: 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (hash-table-
41a0: 72 65 66 2f 64 65 66 61 75 6c 74 20 72 65 73 20 ref/default res
41b0: 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d curr-section-nam
41c0: 65 20 27 28 29 29 29 0a 09 09 09 09 09 09 09 09 e '())).........
41d0: 28 76 61 6c 2d 70 72 6f 63 20 28 6c 61 6d 62 64 (val-proc (lambd
41e0: 61 20 28 29 0a 09 09 09 09 09 09 09 09 09 20 20 a ()..........
41f0: 20 20 28 6c 65 74 2a 20 28 28 73 74 61 72 74 2d (let* ((start-
4200: 74 69 6d 65 20 28 63 75 72 72 65 6e 74 2d 73 65 time (current-se
4210: 63 6f 6e 64 73 29 29 0a 09 09 09 09 09 09 09 09 conds)).........
4220: 09 09 20 20 20 28 63 6d 64 72 65 73 20 20 20 20 .. (cmdres
4230: 20 28 70 72 6f 63 65 73 73 3a 63 6d 64 2d 72 75 (process:cmd-ru
4240: 6e 2d 3e 6c 69 73 74 20 63 6d 64 29 29 0a 09 09 n->list cmd))...
4250: 09 09 09 09 09 09 09 09 20 20 20 28 64 65 6c 74 ........ (delt
4260: 61 20 20 20 20 20 20 28 2d 20 28 63 75 72 72 65 a (- (curre
4270: 6e 74 2d 73 65 63 6f 6e 64 73 29 20 73 74 61 72 nt-seconds) star
4280: 74 2d 74 69 6d 65 29 29 0a 09 09 09 09 09 09 09 t-time))........
4290: 09 09 09 20 20 20 28 73 74 61 74 75 73 20 20 20 ... (status
42a0: 20 20 28 63 61 64 72 20 63 6d 64 72 65 73 29 29 (cadr cmdres))
42b0: 0a 09 09 09 09 09 09 09 09 09 09 20 20 20 28 72 ........... (r
42c0: 65 73 20 20 20 20 20 20 20 20 28 63 61 72 20 20 es (car
42d0: 63 6d 64 72 65 73 29 29 29 0a 09 09 09 09 09 09 cmdres))).......
42e0: 09 09 09 20 20 20 20 20 20 28 64 65 62 75 67 3a ... (debug:
42f0: 70 72 69 6e 74 2d 69 6e 66 6f 20 34 20 2a 64 65 print-info 4 *de
4300: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
4310: 22 22 20 69 6e 6c 20 22 5c 6e 20 3d 3e 20 22 20 "" inl "\n => "
4320: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
4330: 72 73 65 20 72 65 73 20 22 5c 6e 22 29 29 0a 09 rse res "\n"))..
4340: 09 09 09 09 09 09 09 09 20 20 20 20 20 20 28 69 ........ (i
4350: 66 20 28 6e 6f 74 20 28 65 71 3f 20 73 74 61 74 f (not (eq? stat
4360: 75 73 20 30 29 29 0a 09 09 09 09 09 09 09 09 09 us 0))..........
4370: 09 20 20 28 62 65 67 69 6e 0a 09 09 09 09 09 09 . (begin.......
4380: 09 09 09 09 20 20 20 20 28 64 65 62 75 67 3a 70 .... (debug:p
4390: 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 rint-error 0 *de
43a0: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
43b0: 22 70 72 6f 62 6c 65 6d 20 77 69 74 68 20 22 20 "problem with "
43c0: 69 6e 6c 20 22 2c 20 72 65 74 75 72 6e 20 63 6f inl ", return co
43d0: 64 65 20 22 20 73 74 61 74 75 73 0a 09 09 09 09 de " status.....
43e0: 09 09 09 09 09 09 09 09 20 22 20 6f 75 74 70 75 ........ " outpu
43f0: 74 3a 20 22 20 63 6d 64 72 65 73 29 29 29 0a 09 t: " cmdres)))..
4400: 09 09 09 09 09 09 09 09 20 20 20 20 20 20 28 69 ........ (i
4410: 66 20 28 3e 20 64 65 6c 74 61 20 32 29 0a 09 09 f (> delta 2)...
4420: 09 09 09 09 09 09 09 09 20 20 28 64 65 62 75 67 ........ (debug
4430: 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 :print-info 0 *d
4440: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
4450: 20 22 66 6f 72 20 6c 69 6e 65 20 5c 22 22 20 69 "for line \"" i
4460: 6e 6c 20 22 5c 22 5c 6e 20 20 63 6f 6d 6d 61 6e nl "\"\n comman
4470: 64 3a 20 22 20 63 6d 64 20 22 20 74 6f 6f 6b 20 d: " cmd " took
4480: 22 20 64 65 6c 74 61 20 22 20 73 65 63 6f 6e 64 " delta " second
4490: 73 20 74 6f 20 72 75 6e 20 77 69 74 68 20 6f 75 s to run with ou
44a0: 74 70 75 74 3a 5c 6e 20 20 20 22 20 72 65 73 29 tput:\n " res)
44b0: 0a 09 09 09 09 09 09 09 09 09 09 20 20 28 64 65 ........... (de
44c0: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 39 bug:print-info 9
44d0: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
44e0: 72 74 2a 20 22 66 6f 72 20 6c 69 6e 65 20 5c 22 rt* "for line \"
44f0: 22 20 69 6e 6c 20 22 5c 22 5c 6e 20 20 63 6f 6d " inl "\"\n com
4500: 6d 61 6e 64 3a 20 22 20 63 6d 64 20 22 20 74 6f mand: " cmd " to
4510: 6f 6b 20 22 20 64 65 6c 74 61 20 22 20 73 65 63 ok " delta " sec
4520: 6f 6e 64 73 20 74 6f 20 72 75 6e 20 77 69 74 68 onds to run with
4530: 20 6f 75 74 70 75 74 3a 5c 6e 20 20 20 22 20 72 output:\n " r
4540: 65 73 29 29 0a 09 09 09 09 09 09 09 09 09 20 20 es))..........
4550: 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 72 (if (null? r
4560: 65 73 29 0a 09 09 09 09 09 09 09 09 09 09 20 20 es)...........
4570: 22 22 0a 09 09 09 09 09 09 09 09 09 09 20 20 28 ""........... (
4580: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
4590: 73 65 20 72 65 73 20 22 20 22 29 29 29 29 29 29 se res " "))))))
45a0: 0a 09 09 09 09 09 09 09 20 20 20 20 28 68 61 73 ........ (has
45b0: 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 72 65 73 h-table-set! res
45c0: 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 curr-section-na
45d0: 6d 65 20 0a 09 09 09 09 09 09 09 09 09 20 20 20 me ..........
45e0: 20 20 28 63 6f 6e 66 69 67 3a 61 73 73 6f 63 2d (config:assoc-
45f0: 73 61 66 65 2d 61 64 64 20 61 6c 69 73 74 0a 09 safe-add alist..
4600: 09 09 09 09 09 09 09 09 20 20 20 09 09 09 20 20 ........ ...
4610: 20 20 6b 65 79 20 0a 09 09 09 09 09 09 09 09 09 key ..........
4620: 09 09 09 20 20 20 20 28 63 61 73 65 20 28 63 61 ... (case (ca
4630: 6c 63 2d 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 lc-allow-system
4640: 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 63 75 72 allow-system cur
4650: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 73 r-section-name s
4660: 65 63 74 69 6f 6e 73 29 0a 09 09 09 09 09 09 09 ections)........
4670: 09 09 09 09 09 20 20 20 20 20 20 28 28 72 65 74 ..... ((ret
4680: 75 72 6e 2d 70 72 6f 63 73 29 20 76 61 6c 2d 70 urn-procs) val-p
4690: 72 6f 63 29 0a 09 09 09 09 09 09 09 09 09 09 09 roc)............
46a0: 09 20 20 20 20 20 20 28 28 72 65 74 75 72 6e 2d . ((return-
46b0: 73 74 72 69 6e 67 29 20 63 6d 64 29 0a 09 09 09 string) cmd)....
46c0: 09 09 09 09 09 09 09 09 09 20 20 20 20 20 20 28 ......... (
46d0: 65 6c 73 65 20 28 76 61 6c 2d 70 72 6f 63 29 29 else (val-proc))
46e0: 29 0a 09 09 09 09 09 09 09 09 09 09 09 09 20 20 ).............
46f0: 20 20 6d 65 74 61 64 61 74 61 3a 20 6d 65 74 61 metadata: meta
4700: 70 61 74 68 29 29 0a 09 09 09 09 09 09 09 20 20 path))........
4710: 20 20 28 6c 6f 6f 70 20 28 63 6f 6e 66 69 67 66 (loop (configf
4720: 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 20 72 :read-line inp r
4730: 65 73 20 28 63 61 6c 63 2d 61 6c 6c 6f 77 2d 73 es (calc-allow-s
4740: 79 73 74 65 6d 20 61 6c 6c 6f 77 2d 73 79 73 74 ystem allow-syst
4750: 65 6d 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d em curr-section-
4760: 6e 61 6d 65 20 73 65 63 74 69 6f 6e 73 29 20 73 name sections) s
4770: 65 74 74 69 6e 67 73 29 20 63 75 72 72 2d 73 65 ettings) curr-se
4780: 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 66 ction-name #f #f
4790: 29 29 0a 09 09 09 09 09 09 09 20 20 28 6c 6f 6f ))........ (loo
47a0: 70 20 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d p (configf:read-
47b0: 6c 69 6e 65 20 69 6e 70 20 72 65 73 20 28 63 61 line inp res (ca
47c0: 6c 63 2d 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 lc-allow-system
47d0: 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 63 75 72 allow-system cur
47e0: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 73 r-section-name s
47f0: 65 63 74 69 6f 6e 73 29 20 73 65 74 74 69 6e 67 ections) setting
4800: 73 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d s) curr-section-
4810: 6e 61 6d 65 20 23 66 20 23 66 29 29 29 0a 09 20 name #f #f)))..
4820: 20 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 6b (configf:k
4830: 65 79 2d 6e 6f 2d 76 61 6c 20 28 20 78 20 6b 65 ey-no-val ( x ke
4840: 79 20 76 61 6c 29 20 20 20 20 20 20 20 20 20 20 y val)
4850: 20 20 28 6c 65 74 2a 20 28 28 61 6c 69 73 74 20 (let* ((alist
4860: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 (hash-table-re
4870: 66 2f 64 65 66 61 75 6c 74 20 72 65 73 20 63 75 f/default res cu
4880: 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 rr-section-name
4890: 27 28 29 29 29 0a 09 09 09 09 09 09 09 09 20 20 '())).........
48a0: 28 66 76 61 6c 20 20 20 20 28 6f 72 20 28 69 66 (fval (or (if
48b0: 20 28 73 74 72 69 6e 67 3f 20 76 61 6c 29 20 76 (string? val) v
48c0: 61 6c 20 23 66 29 20 22 22 29 29 29 20 3b 3b 20 al #f) ""))) ;;
48d0: 66 76 61 6c 20 73 68 6f 75 6c 64 20 62 65 20 65 fval should be e
48e0: 69 74 68 65 72 20 22 22 20 6f 72 20 22 20 22 20 ither "" or " "
48f0: 28 6f 6e 65 20 6f 72 20 6d 6f 72 65 20 73 70 61 (one or more spa
4900: 63 65 73 29 0a 09 09 09 09 09 09 09 20 20 20 20 ces)........
4910: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 31 30 (debug:print 10
4920: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
4930: 72 74 2a 20 22 20 20 20 73 65 74 74 69 6e 67 3a rt* " setting:
4940: 20 5b 22 20 63 75 72 72 2d 73 65 63 74 69 6f 6e [" curr-section
4950: 2d 6e 61 6d 65 20 22 5d 20 22 20 6b 65 79 20 22 -name "] " key "
4960: 20 3d 20 23 74 22 29 0a 09 09 09 09 09 09 09 20 = #t")........
4970: 20 20 20 20 28 73 61 66 65 2d 73 65 74 65 6e 76 (safe-setenv
4980: 20 6b 65 79 20 66 76 61 6c 29 0a 09 09 09 09 09 key fval)......
4990: 09 09 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 .. (hash-tab
49a0: 6c 65 2d 73 65 74 21 20 72 65 73 20 63 75 72 72 le-set! res curr
49b0: 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 0a 09 -section-name ..
49c0: 09 09 09 09 09 09 09 09 20 20 20 20 20 20 28 63 ........ (c
49d0: 6f 6e 66 69 67 3a 61 73 73 6f 63 2d 73 61 66 65 onfig:assoc-safe
49e0: 2d 61 64 64 20 61 6c 69 73 74 20 6b 65 79 20 66 -add alist key f
49f0: 76 61 6c 20 6d 65 74 61 64 61 74 61 3a 20 6d 65 val metadata: me
4a00: 74 61 70 61 74 68 29 29 0a 09 09 09 09 09 09 09 tapath))........
4a10: 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 6f 6e 66 (loop (conf
4a20: 69 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e igf:read-line in
4a30: 70 20 72 65 73 20 28 63 61 6c 63 2d 61 6c 6c 6f p res (calc-allo
4a40: 77 2d 73 79 73 74 65 6d 20 61 6c 6c 6f 77 2d 73 w-system allow-s
4a50: 79 73 74 65 6d 20 63 75 72 72 2d 73 65 63 74 69 ystem curr-secti
4a60: 6f 6e 2d 6e 61 6d 65 20 73 65 63 74 69 6f 6e 73 on-name sections
4a70: 29 20 73 65 74 74 69 6e 67 73 29 20 63 75 72 72 ) settings) curr
4a80: 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 6b 65 -section-name ke
4a90: 79 20 23 66 29 29 29 0a 09 20 20 20 20 20 20 20 y #f)))..
4aa0: 28 63 6f 6e 66 69 67 66 3a 6b 65 79 2d 76 61 6c (configf:key-val
4ab0: 2d 70 72 20 28 20 78 20 6b 65 79 20 75 6e 6b 31 -pr ( x key unk1
4ac0: 20 76 61 6c 20 75 6e 6b 32 20 29 20 28 6c 65 74 val unk2 ) (let
4ad0: 2a 20 28 28 61 6c 69 73 74 20 20 20 28 68 61 73 * ((alist (has
4ae0: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
4af0: 75 6c 74 20 72 65 73 20 63 75 72 72 2d 73 65 63 ult res curr-sec
4b00: 74 69 6f 6e 2d 6e 61 6d 65 20 27 28 29 29 29 0a tion-name '())).
4b10: 09 09 09 09 09 09 09 09 20 20 28 65 6e 76 61 72 ........ (envar
4b20: 20 20 20 28 61 6e 64 20 65 6e 76 69 72 6f 6e 2d (and environ-
4b30: 70 61 74 74 20 28 73 74 72 69 6e 67 2d 73 65 61 patt (string-sea
4b40: 72 63 68 20 28 72 65 67 65 78 70 20 65 6e 76 69 rch (regexp envi
4b50: 72 6f 6e 2d 70 61 74 74 29 20 63 75 72 72 2d 73 ron-patt) curr-s
4b60: 65 63 74 69 6f 6e 2d 6e 61 6d 65 29 29 29 0a 09 ection-name)))..
4b70: 09 09 09 09 09 09 09 20 20 28 72 65 61 6c 76 61 ....... (realva
4b80: 6c 20 28 69 66 20 65 6e 76 61 72 0a 09 09 09 09 l (if envar.....
4b90: 09 09 09 09 09 20 20 20 20 20 20 20 28 63 6f 6e ..... (con
4ba0: 66 69 67 3a 65 76 61 6c 2d 73 74 72 69 6e 67 2d fig:eval-string-
4bb0: 69 6e 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 76 in-environment v
4bc0: 61 6c 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 al)..........
4bd0: 20 20 20 20 76 61 6c 29 29 29 0a 09 09 09 09 09 val)))......
4be0: 09 09 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 .. (debug:pr
4bf0: 69 6e 74 2d 69 6e 66 6f 20 36 20 2a 64 65 66 61 int-info 6 *defa
4c00: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 72 ult-log-port* "r
4c10: 65 61 64 2d 63 6f 6e 66 69 67 20 65 6e 76 20 73 ead-config env s
4c20: 65 74 74 69 6e 67 2c 20 65 6e 76 61 72 3a 20 22 etting, envar: "
4c30: 20 65 6e 76 61 72 20 22 20 72 65 61 6c 76 61 6c envar " realval
4c40: 3a 20 22 20 72 65 61 6c 76 61 6c 20 22 20 76 61 : " realval " va
4c50: 6c 3a 20 22 20 76 61 6c 20 22 20 6b 65 79 3a 20 l: " val " key:
4c60: 22 20 6b 65 79 20 22 20 63 75 72 72 2d 73 65 63 " key " curr-sec
4c70: 74 69 6f 6e 2d 6e 61 6d 65 3a 20 22 20 63 75 72 tion-name: " cur
4c80: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 29 0a r-section-name).
4c90: 09 09 09 09 09 09 09 20 20 20 20 20 28 69 66 20 ....... (if
4ca0: 65 6e 76 61 72 20 28 73 61 66 65 2d 73 65 74 65 envar (safe-sete
4cb0: 6e 76 20 6b 65 79 20 72 65 61 6c 76 61 6c 29 29 nv key realval))
4cc0: 0a 09 09 09 09 09 09 09 20 20 20 20 20 28 64 65 ........ (de
4cd0: 62 75 67 3a 70 72 69 6e 74 20 31 30 20 2a 64 65 bug:print 10 *de
4ce0: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
4cf0: 22 20 20 20 73 65 74 74 69 6e 67 3a 20 5b 22 20 " setting: ["
4d00: 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d curr-section-nam
4d10: 65 20 22 5d 20 22 20 6b 65 79 20 22 20 3d 20 22 e "] " key " = "
4d20: 20 76 61 6c 29 0a 09 09 09 09 09 09 09 20 20 20 val)........
4d30: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 (hash-table-se
4d40: 74 21 20 72 65 73 20 63 75 72 72 2d 73 65 63 74 t! res curr-sect
4d50: 69 6f 6e 2d 6e 61 6d 65 20 0a 09 09 09 09 09 09 ion-name .......
4d60: 09 09 09 20 20 20 20 20 20 28 63 6f 6e 66 69 67 ... (config
4d70: 3a 61 73 73 6f 63 2d 73 61 66 65 2d 61 64 64 20 :assoc-safe-add
4d80: 61 6c 69 73 74 20 6b 65 79 20 72 65 61 6c 76 61 alist key realva
4d90: 6c 20 6d 65 74 61 64 61 74 61 3a 20 6d 65 74 61 l metadata: meta
4da0: 70 61 74 68 29 29 0a 09 09 09 09 09 09 09 20 20 path))........
4db0: 20 20 20 28 6c 6f 6f 70 20 28 63 6f 6e 66 69 67 (loop (config
4dc0: 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 20 f:read-line inp
4dd0: 72 65 73 20 28 63 61 6c 63 2d 61 6c 6c 6f 77 2d res (calc-allow-
4de0: 73 79 73 74 65 6d 20 61 6c 6c 6f 77 2d 73 79 73 system allow-sys
4df0: 74 65 6d 20 63 75 72 72 2d 73 65 63 74 69 6f 6e tem curr-section
4e00: 2d 6e 61 6d 65 20 73 65 63 74 69 6f 6e 73 29 20 -name sections)
4e10: 73 65 74 74 69 6e 67 73 29 20 63 75 72 72 2d 73 settings) curr-s
4e20: 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 6b 65 79 20 ection-name key
4e30: 23 66 29 29 29 0a 09 20 20 20 20 20 20 20 3b 3b #f))).. ;;
4e40: 20 69 66 20 61 20 63 6f 6e 74 69 6e 75 65 64 20 if a continued
4e50: 6c 69 6e 65 0a 09 20 20 20 20 20 20 20 28 63 6f line.. (co
4e60: 6e 66 69 67 66 3a 63 6f 6e 74 2d 6c 6e 2d 72 78 nfigf:cont-ln-rx
4e70: 20 28 20 78 20 77 68 73 70 20 76 61 6c 20 20 20 ( x whsp val
4e80: 20 20 29 20 28 6c 65 74 20 28 28 61 6c 69 73 74 ) (let ((alist
4e90: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
4ea0: 2f 64 65 66 61 75 6c 74 20 72 65 73 20 63 75 72 /default res cur
4eb0: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 27 r-section-name '
4ec0: 28 29 29 29 29 0a 09 09 09 09 09 09 28 69 66 20 ()))).......(if
4ed0: 76 61 72 2d 66 6c 61 67 20 20 20 20 20 20 20 20 var-flag
4ee0: 20 20 20 20 20 3b 3b 20 69 66 20 73 65 74 20 74 ;; if set t
4ef0: 6f 20 61 20 73 74 72 69 6e 67 20 74 68 65 6e 20 o a string then
4f00: 77 65 20 68 61 76 65 20 61 20 63 6f 6e 74 69 6e we have a contin
4f10: 75 65 64 20 76 61 72 0a 09 09 09 09 09 09 20 20 ued var.......
4f20: 20 20 28 6c 65 74 20 28 28 6e 65 77 76 61 6c 20 (let ((newval
4f30: 28 63 6f 6e 63 20 0a 09 09 09 09 09 09 09 09 20 (conc .........
4f40: 20 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 (config-lookup
4f50: 20 72 65 73 20 63 75 72 72 2d 73 65 63 74 69 6f res curr-sectio
4f60: 6e 2d 6e 61 6d 65 20 76 61 72 2d 66 6c 61 67 29 n-name var-flag)
4f70: 20 22 5c 6e 22 0a 09 09 09 09 09 09 09 09 20 20 "\n".........
4f80: 20 3b 3b 20 74 72 69 6d 20 6c 65 61 64 20 66 72 ;; trim lead fr
4f90: 6f 6d 20 74 68 65 20 69 6e 63 6f 6d 69 6e 67 20 om the incoming
4fa0: 77 68 73 70 20 74 6f 20 73 75 70 70 6f 72 74 20 whsp to support
4fb0: 73 6f 6d 65 20 69 6e 64 65 6e 74 69 6e 67 2e 0a some indenting..
4fc0: 09 09 09 09 09 09 09 09 20 20 20 28 69 66 20 6c ........ (if l
4fd0: 65 61 64 0a 09 09 09 09 09 09 09 09 20 20 20 20 ead.........
4fe0: 20 20 20 28 73 74 72 69 6e 67 2d 73 75 62 73 74 (string-subst
4ff0: 69 74 75 74 65 20 28 72 65 67 65 78 70 20 6c 65 itute (regexp le
5000: 61 64 29 20 22 22 20 77 68 73 70 29 0a 09 09 09 ad) "" whsp)....
5010: 09 09 09 09 09 20 20 20 20 20 20 20 22 22 29 0a ..... "").
5020: 09 09 09 09 09 09 09 09 20 20 20 76 61 6c 29 29 ........ val))
5030: 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 3b 3b )....... ;;
5040: 20 28 70 72 69 6e 74 20 22 76 61 6c 3a 20 22 20 (print "val: "
5050: 76 61 6c 20 22 5c 6e 6e 65 77 76 61 6c 3a 20 5c val "\nnewval: \
5060: 22 22 20 6e 65 77 76 61 6c 20 22 5c 22 5c 6e 76 "" newval "\"\nv
5070: 61 72 66 6c 61 67 3a 20 22 20 76 61 72 2d 66 6c arflag: " var-fl
5080: 61 67 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 ag).......
5090: 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 (hash-table-set!
50a0: 20 72 65 73 20 63 75 72 72 2d 73 65 63 74 69 6f res curr-sectio
50b0: 6e 2d 6e 61 6d 65 20 0a 09 09 09 09 09 09 09 09 n-name .........
50c0: 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 3a 61 (config:a
50d0: 73 73 6f 63 2d 73 61 66 65 2d 61 64 64 20 61 6c ssoc-safe-add al
50e0: 69 73 74 20 76 61 72 2d 66 6c 61 67 20 6e 65 77 ist var-flag new
50f0: 76 61 6c 20 6d 65 74 61 64 61 74 61 3a 20 6d 65 val metadata: me
5100: 74 61 70 61 74 68 29 29 0a 09 09 09 09 09 09 20 tapath)).......
5110: 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 6f 6e 66 (loop (conf
5120: 69 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e igf:read-line in
5130: 70 20 72 65 73 20 28 63 61 6c 63 2d 61 6c 6c 6f p res (calc-allo
5140: 77 2d 73 79 73 74 65 6d 20 61 6c 6c 6f 77 2d 73 w-system allow-s
5150: 79 73 74 65 6d 20 63 75 72 72 2d 73 65 63 74 69 ystem curr-secti
5160: 6f 6e 2d 6e 61 6d 65 20 73 65 63 74 69 6f 6e 73 on-name sections
5170: 29 20 73 65 74 74 69 6e 67 73 29 20 63 75 72 72 ) settings) curr
5180: 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 76 61 -section-name va
5190: 72 2d 66 6c 61 67 20 28 69 66 20 6c 65 61 64 20 r-flag (if lead
51a0: 6c 65 61 64 20 77 68 73 70 29 29 29 0a 09 09 09 lead whsp)))....
51b0: 09 09 09 20 20 20 20 28 6c 6f 6f 70 20 28 63 6f ... (loop (co
51c0: 6e 66 69 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 nfigf:read-line
51d0: 69 6e 70 20 72 65 73 20 28 63 61 6c 63 2d 61 6c inp res (calc-al
51e0: 6c 6f 77 2d 73 79 73 74 65 6d 20 61 6c 6c 6f 77 low-system allow
51f0: 2d 73 79 73 74 65 6d 20 63 75 72 72 2d 73 65 63 -system curr-sec
5200: 74 69 6f 6e 2d 6e 61 6d 65 20 73 65 63 74 69 6f tion-name sectio
5210: 6e 73 29 20 73 65 74 74 69 6e 67 73 29 20 63 75 ns) settings) cu
5220: 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 rr-section-name
5230: 23 66 20 23 66 29 29 29 29 0a 09 20 20 20 20 20 #f #f))))..
5240: 20 20 28 65 6c 73 65 20 28 64 65 62 75 67 3a 70 (else (debug:p
5250: 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 rint-error 0 *de
5260: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
5270: 22 70 72 6f 62 6c 65 6d 20 70 61 72 73 69 6e 67 "problem parsing
5280: 20 22 20 70 61 74 68 20 22 2c 5c 6e 20 20 20 5c " path ",\n \
5290: 22 22 20 69 6e 6c 20 22 5c 22 22 29 0a 09 09 20 "" inl "\"")...
52a0: 20 20 20 20 28 73 65 74 21 20 76 61 72 2d 66 6c (set! var-fl
52b0: 61 67 20 23 66 29 0a 09 09 20 20 20 20 20 28 6c ag #f)... (l
52c0: 6f 6f 70 20 28 63 6f 6e 66 69 67 66 3a 72 65 61 oop (configf:rea
52d0: 64 2d 6c 69 6e 65 20 69 6e 70 20 72 65 73 20 28 d-line inp res (
52e0: 63 61 6c 63 2d 61 6c 6c 6f 77 2d 73 79 73 74 65 calc-allow-syste
52f0: 6d 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 63 m allow-system c
5300: 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 urr-section-name
5310: 20 73 65 63 74 69 6f 6e 73 29 20 73 65 74 74 69 sections) setti
5320: 6e 67 73 29 20 63 75 72 72 2d 73 65 63 74 69 6f ngs) curr-sectio
5330: 6e 2d 6e 61 6d 65 20 23 66 20 23 66 29 29 29 29 n-name #f #f))))
5340: 29 29 29 29 0a 20 20 0a 3b 3b 20 70 61 74 68 65 )))). .;; pathe
5350: 6e 76 76 61 72 20 77 69 6c 6c 20 73 65 74 20 74 nvvar will set t
5360: 68 65 20 6e 61 6d 65 64 20 76 61 72 20 74 6f 20 he named var to
5370: 74 68 65 20 70 61 74 68 20 6f 66 20 74 68 65 20 the path of the
5380: 63 6f 6e 66 69 67 0a 28 64 65 66 69 6e 65 20 28 config.(define (
5390: 66 69 6e 64 2d 61 6e 64 2d 72 65 61 64 2d 63 6f find-and-read-co
53a0: 6e 66 69 67 20 66 6e 61 6d 65 20 23 21 6b 65 79 nfig fname #!key
53b0: 20 28 65 6e 76 69 72 6f 6e 2d 70 61 74 74 20 23 (environ-patt #
53c0: 66 29 28 67 69 76 65 6e 2d 74 6f 70 70 61 74 68 f)(given-toppath
53d0: 20 23 66 29 28 70 61 74 68 65 6e 76 76 61 72 20 #f)(pathenvvar
53e0: 23 66 29 29 0a 20 20 28 6c 65 74 2a 20 28 28 63 #f)). (let* ((c
53f0: 75 72 72 2d 64 69 72 20 20 20 28 63 75 72 72 65 urr-dir (curre
5400: 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 29 0a 20 nt-directory)).
5410: 20 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 69 (configi
5420: 6e 66 6f 20 28 66 69 6e 64 2d 63 6f 6e 66 69 67 nfo (find-config
5430: 20 66 6e 61 6d 65 20 74 6f 70 70 61 74 68 3a 20 fname toppath:
5440: 67 69 76 65 6e 2d 74 6f 70 70 61 74 68 29 29 0a given-toppath)).
5450: 09 20 28 74 6f 70 70 61 74 68 20 20 20 20 28 63 . (toppath (c
5460: 61 72 20 63 6f 6e 66 69 67 69 6e 66 6f 29 29 0a ar configinfo)).
5470: 09 20 28 63 6f 6e 66 69 67 66 69 6c 65 20 28 63 . (configfile (c
5480: 61 64 72 20 63 6f 6e 66 69 67 69 6e 66 6f 29 29 adr configinfo))
5490: 0a 09 20 28 73 65 74 2d 66 69 65 6c 64 73 20 28 .. (set-fields (
54a0: 6c 61 6d 62 64 61 20 28 63 75 72 72 2d 73 65 63 lambda (curr-sec
54b0: 74 69 6f 6e 20 6e 65 78 74 2d 73 65 63 74 69 6f tion next-sectio
54c0: 6e 20 68 74 20 70 61 74 68 29 0a 09 09 20 20 20 n ht path)...
54d0: 20 20 20 20 28 6c 65 74 20 28 28 66 69 65 6c 64 (let ((field
54e0: 2d 6e 61 6d 65 73 20 28 69 66 20 68 74 20 28 6b -names (if ht (k
54f0: 65 79 73 3a 63 6f 6e 66 69 67 2d 67 65 74 2d 66 eys:config-get-f
5500: 69 65 6c 64 73 20 68 74 29 20 27 28 29 29 29 0a ields ht) '())).
5510: 09 09 09 20 20 20 20 20 28 74 61 72 67 65 74 20 ... (target
5520: 20 20 20 20 20 28 6f 72 20 28 67 65 74 65 6e 76 (or (getenv
5530: 20 22 4d 54 5f 54 41 52 47 45 54 22 29 28 61 72 "MT_TARGET")(ar
5540: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 71 gs:get-arg "-req
5550: 74 61 72 67 22 29 28 61 72 67 73 3a 67 65 74 2d targ")(args:get-
5560: 61 72 67 20 22 2d 74 61 72 67 65 74 22 29 29 29 arg "-target")))
5570: 29 0a 09 09 09 20 28 64 65 62 75 67 3a 70 72 69 ).... (debug:pri
5580: 6e 74 2d 69 6e 66 6f 20 39 20 2a 64 65 66 61 75 nt-info 9 *defau
5590: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 73 65 lt-log-port* "se
55a0: 74 2d 66 69 65 6c 64 73 20 77 69 74 68 20 66 69 t-fields with fi
55b0: 65 6c 64 2d 6e 61 6d 65 73 3d 22 20 66 69 65 6c eld-names=" fiel
55c0: 64 2d 6e 61 6d 65 73 20 22 20 74 61 72 67 65 74 d-names " target
55d0: 3d 22 20 74 61 72 67 65 74 20 22 20 63 75 72 72 =" target " curr
55e0: 2d 73 65 63 74 69 6f 6e 3d 22 20 63 75 72 72 2d -section=" curr-
55f0: 73 65 63 74 69 6f 6e 20 22 20 6e 65 78 74 2d 73 section " next-s
5600: 65 63 74 69 6f 6e 3d 22 20 6e 65 78 74 2d 73 65 ection=" next-se
5610: 63 74 69 6f 6e 20 22 20 70 61 74 68 3d 22 20 70 ction " path=" p
5620: 61 74 68 20 22 20 68 74 3d 22 20 68 74 29 0a 09 ath " ht=" ht)..
5630: 09 09 20 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c .. (if (not (nul
5640: 6c 3f 20 66 69 65 6c 64 2d 6e 61 6d 65 73 29 29 l? field-names))
5650: 28 6b 65 79 73 3a 74 61 72 67 65 74 2d 73 65 74 (keys:target-set
5660: 2d 61 72 67 73 20 66 69 65 6c 64 2d 6e 61 6d 65 -args field-name
5670: 73 20 74 61 72 67 65 74 20 23 66 29 29 29 29 29 s target #f)))))
5680: 29 0a 20 20 20 20 28 69 66 20 74 6f 70 70 61 74 ). (if toppat
5690: 68 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 h (change-direct
56a0: 6f 72 79 20 74 6f 70 70 61 74 68 29 29 20 0a 20 ory toppath)) .
56b0: 20 20 20 28 69 66 20 28 61 6e 64 20 74 6f 70 70 (if (and topp
56c0: 61 74 68 20 70 61 74 68 65 6e 76 76 61 72 29 28 ath pathenvvar)(
56d0: 73 65 74 65 6e 76 20 70 61 74 68 65 6e 76 76 61 setenv pathenvva
56e0: 72 20 74 6f 70 70 61 74 68 29 29 0a 20 20 20 20 r toppath)).
56f0: 28 6c 65 74 20 28 28 63 6f 6e 66 69 67 64 61 74 (let ((configdat
5700: 20 20 28 69 66 20 63 6f 6e 66 69 67 66 69 6c 65 (if configfile
5710: 20 0a 09 09 09 20 20 28 72 65 61 64 2d 63 6f 6e .... (read-con
5720: 66 69 67 20 63 6f 6e 66 69 67 66 69 6c 65 20 23 fig configfile #
5730: 66 20 23 74 20 65 6e 76 69 72 6f 6e 2d 70 61 74 f #t environ-pat
5740: 74 3a 20 65 6e 76 69 72 6f 6e 2d 70 61 74 74 20 t: environ-patt
5750: 70 6f 73 74 2d 73 65 63 74 69 6f 6e 2d 70 72 6f post-section-pro
5760: 63 73 3a 20 28 6c 69 73 74 20 28 63 6f 6e 73 20 cs: (list (cons
5770: 22 5e 66 69 65 6c 64 73 24 22 20 73 65 74 2d 66 "^fields$" set-f
5780: 69 65 6c 64 73 29 29 20 23 66 29 29 29 29 0a 20 ields)) #f)))).
5790: 20 20 20 20 20 28 69 66 20 74 6f 70 70 61 74 68 (if toppath
57a0: 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f (change-directo
57b0: 72 79 20 63 75 72 72 2d 64 69 72 29 29 0a 20 20 ry curr-dir)).
57c0: 20 20 20 20 28 6c 69 73 74 20 63 6f 6e 66 69 67 (list config
57d0: 64 61 74 20 74 6f 70 70 61 74 68 20 63 6f 6e 66 dat toppath conf
57e0: 69 67 66 69 6c 65 20 66 6e 61 6d 65 29 29 29 29 igfile fname))))
57f0: 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 ..(define (confi
5800: 67 2d 6c 6f 6f 6b 75 70 20 63 66 67 64 61 74 20 g-lookup cfgdat
5810: 73 65 63 74 69 6f 6e 20 76 61 72 29 0a 20 20 28 section var). (
5820: 69 66 20 28 68 61 73 68 2d 74 61 62 6c 65 3f 20 if (hash-table?
5830: 63 66 67 64 61 74 29 0a 20 20 20 20 20 20 28 6c cfgdat). (l
5840: 65 74 20 28 28 73 65 63 74 64 61 74 20 28 68 61 et ((sectdat (ha
5850: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def
5860: 61 75 6c 74 20 63 66 67 64 61 74 20 73 65 63 74 ault cfgdat sect
5870: 69 6f 6e 20 27 28 29 29 29 29 0a 09 28 69 66 20 ion '())))..(if
5880: 28 6e 75 6c 6c 3f 20 73 65 63 74 64 61 74 29 0a (null? sectdat).
5890: 09 20 20 20 20 23 66 0a 09 20 20 20 20 28 6c 65 . #f.. (le
58a0: 74 20 28 28 6d 61 74 63 68 20 28 61 73 73 6f 63 t ((match (assoc
58b0: 20 76 61 72 20 73 65 63 74 64 61 74 29 29 29 0a var sectdat))).
58c0: 09 20 20 20 20 20 20 28 69 66 20 6d 61 74 63 68 . (if match
58d0: 20 3b 3b 20 28 61 6e 64 20 6d 61 74 63 68 20 28 ;; (and match (
58e0: 6c 69 73 74 3f 20 6d 61 74 63 68 29 28 3e 20 28 list? match)(> (
58f0: 6c 65 6e 67 74 68 20 6d 61 74 63 68 29 20 31 29 length match) 1)
5900: 29 0a 09 09 20 20 28 63 61 64 72 20 6d 61 74 63 )... (cadr matc
5910: 68 29 0a 09 09 20 20 23 66 29 29 0a 09 20 20 20 h)... #f))..
5920: 20 29 29 0a 20 20 20 20 20 20 23 66 29 29 0a 0a )). #f))..
5930: 28 64 65 66 69 6e 65 20 63 6f 6e 66 69 67 66 3a (define configf:
5940: 6c 6f 6f 6b 75 70 20 63 6f 6e 66 69 67 2d 6c 6f lookup config-lo
5950: 6f 6b 75 70 29 0a 28 64 65 66 69 6e 65 20 63 6f okup).(define co
5960: 6e 66 69 67 66 3a 72 65 61 64 2d 66 69 6c 65 20 nfigf:read-file
5970: 72 65 61 64 2d 63 6f 6e 66 69 67 29 0a 0a 28 64 read-config)..(d
5980: 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a 73 efine (configf:s
5990: 65 63 74 69 6f 6e 2d 76 61 72 73 20 63 66 67 64 ection-vars cfgd
59a0: 61 74 20 73 65 63 74 69 6f 6e 29 0a 20 20 28 6c at section). (l
59b0: 65 74 20 28 28 73 65 63 74 64 61 74 20 28 68 61 et ((sectdat (ha
59c0: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def
59d0: 61 75 6c 74 20 63 66 67 64 61 74 20 73 65 63 74 ault cfgdat sect
59e0: 69 6f 6e 20 27 28 29 29 29 29 0a 20 20 20 20 28 ion '()))). (
59f0: 69 66 20 28 6e 75 6c 6c 3f 20 73 65 63 74 64 61 if (null? sectda
5a00: 74 29 0a 09 27 28 29 0a 09 28 6d 61 70 20 63 61 t)..'()..(map ca
5a10: 72 20 73 65 63 74 64 61 74 29 29 29 29 0a 0a 28 r sectdat))))..(
5a20: 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a define (configf:
5a30: 67 65 74 2d 73 65 63 74 69 6f 6e 20 63 66 67 64 get-section cfgd
5a40: 61 74 20 73 65 63 74 69 6f 6e 29 0a 20 20 28 68 at section). (h
5a50: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
5a60: 66 61 75 6c 74 20 63 66 67 64 61 74 20 73 65 63 fault cfgdat sec
5a70: 74 69 6f 6e 20 27 28 29 29 29 0a 0a 28 64 65 66 tion '()))..(def
5a80: 69 6e 65 20 28 73 65 74 75 70 29 0a 20 20 28 6c ine (setup). (l
5a90: 65 74 2a 20 28 28 63 6f 6e 66 69 67 66 20 28 66 et* ((configf (f
5aa0: 69 6e 64 2d 63 6f 6e 66 69 67 20 22 6d 65 67 61 ind-config "mega
5ab0: 74 65 73 74 2e 63 6f 6e 66 69 67 22 29 29 0a 09 test.config"))..
5ac0: 20 28 63 6f 6e 66 69 67 20 20 28 69 66 20 63 6f (config (if co
5ad0: 6e 66 69 67 66 20 28 72 65 61 64 2d 63 6f 6e 66 nfigf (read-conf
5ae0: 69 67 20 63 6f 6e 66 69 67 66 20 23 66 20 23 74 ig configf #f #t
5af0: 29 20 23 66 29 29 29 0a 20 20 20 20 28 69 66 20 ) #f))). (if
5b00: 63 6f 6e 66 69 67 0a 09 28 73 65 74 65 6e 76 20 config..(setenv
5b10: 22 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 22 20 "RUN_AREA_HOME"
5b20: 28 70 61 74 68 6e 61 6d 65 2d 64 69 72 65 63 74 (pathname-direct
5b30: 6f 72 79 20 63 6f 6e 66 69 67 66 29 29 29 0a 20 ory configf))).
5b40: 20 20 20 63 6f 6e 66 69 67 29 29 0a 0a 3b 3b 3d config))..;;=
5b50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5b60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5b70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5b80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5b90: 3d 3d 3d 3d 3d 0a 3b 3b 20 4e 6f 6e 20 64 65 73 =====.;; Non des
5ba0: 74 72 75 63 74 69 76 65 20 77 72 69 74 69 6e 67 tructive writing
5bb0: 20 6f 66 20 63 6f 6e 66 69 67 20 66 69 6c 65 0a of config file.
5bc0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
5bd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5be0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5bf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5c00: 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e ========..(defin
5c10: 65 20 28 63 6f 6e 66 69 67 66 3a 63 6f 6d 70 72 e (configf:compr
5c20: 65 73 73 2d 6d 75 6c 74 69 2d 6c 69 6e 65 73 20 ess-multi-lines
5c30: 66 64 61 74 29 0a 20 20 3b 3b 20 73 74 65 70 20 fdat). ;; step
5c40: 31 2e 35 20 2d 20 63 6f 6d 70 72 65 73 73 20 61 1.5 - compress a
5c50: 6e 79 20 63 6f 6e 74 69 6e 75 65 64 20 6c 69 6e ny continued lin
5c60: 65 73 0a 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 es. (if (null?
5c70: 66 64 61 74 29 20 66 64 61 74 0a 09 28 6c 65 74 fdat) fdat..(let
5c80: 20 6c 6f 6f 70 20 28 28 68 65 64 20 28 63 61 72 loop ((hed (car
5c90: 20 66 64 61 74 29 29 0a 09 09 20 20 20 28 74 61 fdat))... (ta
5ca0: 6c 20 28 63 64 72 20 66 64 61 74 29 29 0a 09 09 l (cdr fdat))...
5cb0: 20 20 20 28 63 75 72 20 22 22 29 0a 09 09 20 20 (cur "")...
5cc0: 20 28 6c 65 64 20 23 66 29 0a 09 09 20 20 20 28 (led #f)... (
5cd0: 72 65 73 20 27 28 29 29 29 0a 09 20 20 3b 3b 20 res '())).. ;;
5ce0: 41 4c 4c 20 57 48 49 54 45 53 50 41 43 45 20 4c ALL WHITESPACE L
5cf0: 45 41 44 49 4e 47 20 4c 49 4e 45 53 20 41 52 45 EADING LINES ARE
5d00: 20 54 41 43 4b 45 44 20 4f 4e 21 21 0a 09 20 20 TACKED ON!!..
5d10: 3b 3b 20 20 31 2e 20 72 65 6d 6f 76 65 20 6c 65 ;; 1. remove le
5d20: 64 20 77 68 69 74 65 73 70 61 63 65 0a 09 20 20 d whitespace..
5d30: 3b 3b 20 20 32 2e 20 74 61 63 6b 20 6f 6e 20 74 ;; 2. tack on t
5d40: 6f 20 68 65 64 20 77 69 74 68 20 22 5c 6e 22 0a o hed with "\n".
5d50: 09 20 20 28 6c 65 74 20 28 28 6d 61 74 63 68 20 . (let ((match
5d60: 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 63 6f (string-match co
5d70: 6e 66 69 67 66 3a 63 6f 6e 74 2d 6c 6e 2d 72 78 nfigf:cont-ln-rx
5d80: 20 68 65 64 29 29 29 0a 09 20 20 20 20 28 69 66 hed))).. (if
5d90: 20 6d 61 74 63 68 20 3b 3b 20 62 6c 61 73 74 21 match ;; blast!
5da0: 20 68 61 76 65 20 74 6f 20 64 65 61 6c 20 77 69 have to deal wi
5db0: 74 68 20 61 20 6d 75 6c 74 69 6c 69 6e 65 0a 09 th a multiline..
5dc0: 09 28 6c 65 74 2a 20 28 28 6c 65 61 64 20 28 63 .(let* ((lead (c
5dd0: 61 64 72 20 6d 61 74 63 68 29 29 0a 09 09 20 20 adr match))...
5de0: 20 20 20 20 20 28 6c 76 61 6c 20 28 63 61 64 64 (lval (cadd
5df0: 72 20 6d 61 74 63 68 29 29 0a 09 09 20 20 20 20 r match))...
5e00: 20 20 20 28 6e 65 77 6c 20 28 63 6f 6e 63 20 63 (newl (conc c
5e10: 75 72 20 22 5c 6e 22 20 6c 76 61 6c 29 29 29 0a ur "\n" lval))).
5e20: 09 09 20 20 28 69 66 20 28 6e 6f 74 20 6c 65 64 .. (if (not led
5e30: 29 28 73 65 74 21 20 6c 65 64 20 6c 65 61 64 29 )(set! led lead)
5e40: 29 0a 09 09 20 20 28 69 66 20 28 6e 75 6c 6c 3f )... (if (null?
5e50: 20 74 61 6c 29 20 0a 09 09 20 20 20 20 20 20 28 tal) ... (
5e60: 73 65 74 21 20 66 64 61 74 20 28 61 70 70 65 6e set! fdat (appen
5e70: 64 20 66 64 61 74 20 28 6c 69 73 74 20 6e 65 77 d fdat (list new
5e80: 6c 29 29 29 0a 09 09 20 20 20 20 20 20 28 6c 6f l)))... (lo
5e90: 6f 70 20 28 63 61 72 20 74 61 6c 29 28 63 64 72 op (car tal)(cdr
5ea0: 20 74 61 6c 29 20 6e 65 77 6c 20 6c 65 64 20 72 tal) newl led r
5eb0: 65 73 29 29 29 20 3b 3b 20 4e 42 2f 2f 20 6e 6f es))) ;; NB// no
5ec0: 74 20 74 61 63 6b 69 6e 67 20 6e 65 77 6c 20 6f t tacking newl o
5ed0: 6e 74 6f 20 72 65 73 0a 09 09 28 6c 65 74 20 28 nto res...(let (
5ee0: 28 6e 65 77 72 65 73 20 28 69 66 20 6c 65 64 20 (newres (if led
5ef0: 0a 09 09 09 09 20 20 28 61 70 70 65 6e 64 20 72 ..... (append r
5f00: 65 73 20 28 6c 69 73 74 20 63 75 72 20 68 65 64 es (list cur hed
5f10: 29 29 0a 09 09 09 09 20 20 28 61 70 70 65 6e 64 ))..... (append
5f20: 20 72 65 73 20 28 6c 69 73 74 20 68 65 64 29 29 res (list hed))
5f30: 29 29 29 0a 09 09 20 20 3b 3b 20 70 72 65 76 20 )))... ;; prev
5f40: 77 61 73 20 61 20 6d 75 6c 74 69 6c 69 6e 65 0a was a multiline.
5f50: 09 09 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 .. (if (null? t
5f60: 61 6c 29 0a 09 09 20 20 20 20 20 20 6e 65 77 72 al)... newr
5f70: 65 73 0a 09 09 20 20 20 20 20 20 28 6c 6f 6f 70 es... (loop
5f80: 20 28 63 61 72 20 74 61 6c 29 28 63 64 72 20 74 (car tal)(cdr t
5f90: 61 6c 29 20 22 22 20 23 66 20 6e 65 77 72 65 73 al) "" #f newres
5fa0: 29 29 29 29 29 29 29 29 0a 0a 3b 3b 20 6e 6f 74 ))))))))..;; not
5fb0: 65 3a 20 49 27 6d 20 63 68 65 61 74 69 6e 67 20 e: I'm cheating
5fc0: 61 20 6c 69 74 74 6c 65 20 68 65 72 65 2e 20 49 a little here. I
5fd0: 20 6d 65 72 65 6c 79 20 72 65 70 6c 61 63 65 20 merely replace
5fe0: 22 5c 6e 22 20 77 69 74 68 20 22 5c 6e 20 20 20 "\n" with "\n
5ff0: 20 20 20 20 20 20 22 0a 28 64 65 66 69 6e 65 20 ".(define
6000: 28 63 6f 6e 66 69 67 66 3a 65 78 70 61 6e 64 2d (configf:expand-
6010: 6d 75 6c 74 69 2d 6c 69 6e 65 73 20 66 64 61 74 multi-lines fdat
6020: 29 0a 20 20 3b 3b 20 73 74 65 70 20 31 2e 35 20 ). ;; step 1.5
6030: 2d 20 63 6f 6d 70 72 65 73 73 20 61 6e 79 20 63 - compress any c
6040: 6f 6e 74 69 6e 75 65 64 20 6c 69 6e 65 73 0a 20 ontinued lines.
6050: 20 28 69 66 20 28 6e 75 6c 6c 3f 20 66 64 61 74 (if (null? fdat
6060: 29 20 66 64 61 74 0a 20 20 20 20 20 20 28 6c 65 ) fdat. (le
6070: 74 20 6c 6f 6f 70 20 28 28 68 65 64 20 28 63 61 t loop ((hed (ca
6080: 72 20 66 64 61 74 29 29 0a 09 09 20 28 74 61 6c r fdat))... (tal
6090: 20 28 63 64 72 20 66 64 61 74 29 29 0a 09 09 20 (cdr fdat))...
60a0: 28 72 65 73 20 27 28 29 29 29 0a 09 28 6c 65 74 (res '()))..(let
60b0: 20 28 28 6e 65 77 72 65 73 20 28 61 70 70 65 6e ((newres (appen
60c0: 64 20 72 65 73 20 28 6c 69 73 74 20 28 73 74 72 d res (list (str
60d0: 69 6e 67 2d 73 75 62 73 74 69 74 75 74 65 20 28 ing-substitute (
60e0: 72 65 67 65 78 70 20 22 5c 6e 22 29 20 22 5c 6e regexp "\n") "\n
60f0: 20 20 20 20 20 20 20 20 20 22 20 68 65 64 20 23 " hed #
6100: 74 29 29 29 29 29 0a 09 20 20 28 69 66 20 28 6e t))))).. (if (n
6110: 75 6c 6c 3f 20 74 61 6c 29 0a 09 20 20 20 20 20 ull? tal)..
6120: 20 6e 65 77 72 65 73 0a 09 20 20 20 20 20 20 28 newres.. (
6130: 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 28 63 loop (car tal)(c
6140: 64 72 20 74 61 6c 29 20 6e 65 77 72 65 73 29 29 dr tal) newres))
6150: 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 ))))..(define (c
6160: 6f 6e 66 69 67 66 3a 66 69 6c 65 2d 3e 6c 69 73 onfigf:file->lis
6170: 74 20 66 6e 61 6d 65 29 0a 20 20 28 69 66 20 28 t fname). (if (
6180: 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 66 6e 61 file-exists? fna
6190: 6d 65 29 0a 20 20 20 20 20 20 28 6c 65 74 20 28 me). (let (
61a0: 28 69 6e 70 20 28 6f 70 65 6e 2d 69 6e 70 75 74 (inp (open-input
61b0: 2d 66 69 6c 65 20 66 6e 61 6d 65 29 29 29 0a 09 -file fname)))..
61c0: 28 6c 65 74 20 6c 6f 6f 70 20 28 28 69 6e 6c 20 (let loop ((inl
61d0: 28 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 29 29 (read-line inp))
61e0: 0a 09 09 20 20 20 28 72 65 73 20 27 28 29 29 29 ... (res '()))
61f0: 0a 09 20 20 28 69 66 20 28 65 6f 66 2d 6f 62 6a .. (if (eof-obj
6200: 65 63 74 3f 20 69 6e 6c 29 0a 09 20 20 20 20 20 ect? inl)..
6210: 20 28 62 65 67 69 6e 0a 09 09 28 63 6c 6f 73 65 (begin...(close
6220: 2d 69 6e 70 75 74 2d 70 6f 72 74 20 69 6e 70 29 -input-port inp)
6230: 0a 09 09 28 72 65 76 65 72 73 65 20 72 65 73 29 ...(reverse res)
6240: 29 0a 09 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 ).. (loop (
6250: 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 29 28 63 read-line inp)(c
6260: 6f 6e 73 20 69 6e 6c 20 72 65 73 29 29 29 29 29 ons inl res)))))
6270: 0a 20 20 20 20 20 20 27 28 29 29 29 0a 0a 3b 3b . '()))..;;
6280: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6290: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
62a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
62b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
62c0: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 57 72 69 74 65 20 ======.;; Write
62d0: 61 20 63 6f 6e 66 69 67 0a 3b 3b 20 20 20 30 2e a config.;; 0.
62e0: 20 47 69 76 65 6e 20 61 20 72 65 66 65 72 65 72 Given a referer
62f0: 65 6e 63 65 20 64 61 74 61 20 73 74 72 75 63 74 ence data struct
6300: 75 72 65 20 22 69 6e 64 61 74 22 0a 3b 3b 20 20 ure "indat".;;
6310: 20 31 2e 20 4f 70 65 6e 20 74 68 65 20 6f 75 74 1. Open the out
6320: 70 75 74 20 66 69 6c 65 20 61 6e 64 20 72 65 61 put file and rea
6330: 64 20 69 74 20 69 6e 74 6f 20 61 20 6c 69 73 74 d it into a list
6340: 0a 3b 3b 20 20 20 32 2e 20 46 6c 61 74 74 65 6e .;; 2. Flatten
6350: 20 61 6e 79 20 6d 75 6c 74 69 6c 69 6e 65 20 65 any multiline e
6360: 6e 74 72 69 65 73 0a 3b 3b 20 20 20 33 2e 20 4d ntries.;; 3. M
6370: 6f 64 69 66 79 20 76 61 6c 75 65 73 20 70 65 72 odify values per
6380: 20 63 6f 6e 74 65 6e 74 73 20 6f 66 20 22 69 6e contents of "in
6390: 64 61 74 22 20 61 6e 64 20 72 65 6d 6f 76 65 20 dat" and remove
63a0: 61 62 73 65 6e 74 20 76 61 6c 75 65 73 0a 3b 3b absent values.;;
63b0: 20 20 20 34 2e 20 41 70 70 65 6e 64 20 6e 65 77 4. Append new
63c0: 20 76 61 6c 75 65 73 20 74 6f 20 74 68 65 20 73 values to the s
63d0: 65 63 74 69 6f 6e 20 28 69 6d 6d 65 64 69 61 74 ection (immediat
63e0: 65 6c 79 20 61 66 74 65 72 20 6c 61 73 74 20 6c ely after last l
63f0: 65 67 69 74 20 65 6e 74 72 79 29 0a 3b 3b 20 20 egit entry).;;
6400: 20 35 2e 20 57 72 69 74 65 20 6f 75 74 20 74 68 5. Write out th
6410: 65 20 6e 65 77 20 6c 69 73 74 20 0a 3b 3b 3d 3d e new list .;;==
6420: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6430: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6440: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6450: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6460: 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 63 ====..(define (c
6470: 6f 6e 66 69 67 66 3a 77 72 69 74 65 2d 63 6f 6e onfigf:write-con
6480: 66 69 67 20 69 6e 64 61 74 20 66 6e 61 6d 65 20 fig indat fname
6490: 23 21 6b 65 79 20 28 72 65 71 75 69 72 65 64 2d #!key (required-
64a0: 73 65 63 74 69 6f 6e 73 20 27 28 29 29 29 0a 20 sections '())).
64b0: 20 28 6c 65 74 2a 20 28 3b 3b 20 73 74 65 70 20 (let* (;; step
64c0: 31 3a 20 4f 70 65 6e 20 74 68 65 20 6f 75 74 70 1: Open the outp
64d0: 75 74 20 66 69 6c 65 20 61 6e 64 20 72 65 61 64 ut file and read
64e0: 20 69 74 20 69 6e 74 6f 20 61 20 6c 69 73 74 0a it into a list.
64f0: 09 20 28 66 64 61 74 20 20 20 20 20 20 20 28 63 . (fdat (c
6500: 6f 6e 66 69 67 66 3a 66 69 6c 65 2d 3e 6c 69 73 onfigf:file->lis
6510: 74 20 66 6e 61 6d 65 29 29 0a 09 20 28 72 65 66 t fname)).. (ref
6520: 64 61 74 20 20 28 6d 61 6b 65 2d 68 61 73 68 2d dat (make-hash-
6530: 74 61 62 6c 65 29 29 0a 09 20 28 73 65 63 68 61 table)).. (secha
6540: 73 68 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 sh (make-hash-ta
6550: 62 6c 65 29 29 20 3b 3b 20 63 75 72 72 65 6e 74 ble)) ;; current
6560: 20 73 65 63 74 69 6f 6e 20 68 61 73 68 2c 20 69 section hash, i
6570: 6e 69 74 20 77 69 74 68 20 68 61 73 68 20 66 6f nit with hash fo
6580: 72 20 22 64 65 66 61 75 6c 74 22 20 73 65 63 74 r "default" sect
6590: 69 6f 6e 0a 09 20 28 6e 65 77 20 20 20 20 20 23 ion.. (new #
65a0: 66 29 20 3b 3b 20 70 75 74 20 74 68 65 20 6c 69 f) ;; put the li
65b0: 6e 65 20 74 6f 20 62 65 20 75 73 65 64 20 69 6e ne to be used in
65c0: 20 6e 65 77 2c 20 69 66 20 69 74 20 69 73 20 74 new, if it is t
65d0: 6f 20 62 65 20 64 65 6c 65 74 65 64 20 74 68 65 o be deleted the
65e0: 20 73 65 74 20 6e 65 77 20 74 6f 20 23 66 0a 09 set new to #f..
65f0: 20 28 73 65 63 6e 61 6d 65 20 23 66 29 29 0a 0a (secname #f))..
6600: 20 20 20 20 3b 3b 20 73 74 65 70 20 32 3a 20 46 ;; step 2: F
6610: 6c 61 74 74 65 6e 20 6d 75 6c 74 69 6c 69 6e 65 latten multiline
6620: 20 65 6e 74 72 69 65 73 0a 20 20 20 20 28 69 66 entries. (if
6630: 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 66 64 61 (not (null? fda
6640: 74 29 29 28 73 65 74 21 20 66 64 61 74 20 28 63 t))(set! fdat (c
6650: 6f 6e 66 69 67 66 3a 63 6f 6d 70 72 65 73 73 2d onfigf:compress-
6660: 6d 75 6c 74 69 2d 6c 69 6e 65 20 66 64 61 74 29 multi-line fdat)
6670: 29 29 0a 0a 20 20 20 20 3b 3b 20 73 74 65 70 20 )).. ;; step
6680: 33 3a 20 4d 6f 64 69 66 79 20 76 61 6c 75 65 73 3: Modify values
6690: 20 70 65 72 20 63 6f 6e 74 65 6e 74 73 20 6f 66 per contents of
66a0: 20 22 69 6e 64 61 74 22 20 61 6e 64 20 72 65 6d "indat" and rem
66b0: 6f 76 65 20 61 62 73 65 6e 74 20 76 61 6c 75 65 ove absent value
66c0: 73 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 s. (if (not (
66d0: 6e 75 6c 6c 3f 20 66 64 61 74 29 29 0a 09 28 6c null? fdat))..(l
66e0: 65 74 20 6c 6f 6f 70 20 28 28 68 65 64 20 20 28 et loop ((hed (
66f0: 63 61 72 20 66 64 61 74 29 29 0a 09 09 20 20 20 car fdat))...
6700: 28 74 61 6c 20 20 28 63 61 64 72 20 66 64 61 74 (tal (cadr fdat
6710: 29 29 0a 09 09 20 20 20 28 72 65 73 20 20 27 28 ))... (res '(
6720: 29 29 0a 09 09 20 20 20 28 6c 6e 75 6d 20 30 29 ))... (lnum 0)
6730: 29 0a 09 20 20 28 72 65 67 65 78 2d 63 61 73 65 ).. (regex-case
6740: 20 0a 09 20 20 20 68 65 64 0a 09 20 20 20 28 63 .. hed.. (c
6750: 6f 6e 66 69 67 66 3a 63 6f 6d 6d 65 6e 74 2d 72 onfigf:comment-r
6760: 78 20 5f 20 20 20 20 20 20 20 20 20 20 20 20 20 x _
6770: 20 20 20 20 20 28 73 65 74 21 20 72 65 73 20 28 (set! res (
6780: 61 70 70 65 6e 64 20 72 65 73 20 28 6c 69 73 74 append res (list
6790: 20 68 65 64 29 29 29 29 20 3b 3b 20 28 6c 6f 6f hed)))) ;; (loo
67a0: 70 20 28 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 p (read-line inp
67b0: 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e ) curr-section-n
67c0: 61 6d 65 20 23 66 20 23 66 29 29 0a 09 20 20 20 ame #f #f))..
67d0: 28 63 6f 6e 66 69 67 66 3a 62 6c 61 6e 6b 2d 6c (configf:blank-l
67e0: 2d 72 78 20 5f 20 20 20 20 20 20 20 20 20 20 20 -rx _
67f0: 20 20 20 20 20 20 20 28 73 65 74 21 20 72 65 73 (set! res
6800: 20 28 61 70 70 65 6e 64 20 72 65 73 20 28 6c 69 (append res (li
6810: 73 74 20 68 65 64 29 29 29 29 20 3b 3b 20 28 6c st hed)))) ;; (l
6820: 6f 6f 70 20 28 72 65 61 64 2d 6c 69 6e 65 20 69 oop (read-line i
6830: 6e 70 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e np) curr-section
6840: 2d 6e 61 6d 65 20 23 66 20 23 66 29 29 0a 09 20 -name #f #f))..
6850: 20 20 28 63 6f 6e 66 69 67 66 3a 73 65 63 74 69 (configf:secti
6860: 6f 6e 2d 72 78 20 28 20 78 20 73 65 63 74 69 6f on-rx ( x sectio
6870: 6e 2d 6e 61 6d 65 20 29 20 28 6c 65 74 20 28 28 n-name ) (let ((
6880: 73 65 63 74 69 6f 6e 2d 68 61 73 68 20 28 68 61 section-hash (ha
6890: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def
68a0: 61 75 6c 74 20 72 65 66 64 61 74 20 73 65 63 74 ault refdat sect
68b0: 69 6f 6e 2d 6e 61 6d 65 20 23 66 29 29 29 0a 09 ion-name #f)))..
68c0: 09 09 09 09 20 20 20 20 28 69 66 20 28 6e 6f 74 .... (if (not
68d0: 20 73 65 63 74 69 6f 6e 2d 68 61 73 68 29 0a 09 section-hash)..
68e0: 09 09 09 09 09 28 6c 65 74 20 28 28 6e 65 77 68 .....(let ((newh
68f0: 61 73 68 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 ash (make-hash-t
6900: 61 62 6c 65 29 29 29 0a 09 09 09 09 09 09 20 20 able))).......
6910: 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 (hash-table-set!
6920: 20 72 65 66 68 61 73 68 20 73 65 63 74 69 6f 6e refhash section
6930: 2d 6e 61 6d 65 20 6e 65 77 68 61 73 68 29 0a 09 -name newhash)..
6940: 09 09 09 09 09 20 20 28 73 65 74 21 20 73 65 63 ..... (set! sec
6950: 68 61 73 68 20 6e 65 77 68 61 73 68 29 29 0a 09 hash newhash))..
6960: 09 09 09 09 09 28 73 65 74 21 20 73 65 63 68 61 .....(set! secha
6970: 73 68 20 73 65 63 74 69 6f 6e 2d 68 61 73 68 29 sh section-hash)
6980: 29 0a 09 09 09 09 09 20 20 20 20 28 73 65 74 21 )...... (set!
6990: 20 6e 65 77 20 68 65 64 29 20 3b 3b 20 77 69 6c new hed) ;; wil
69a0: 6c 20 61 70 70 65 6e 64 20 74 68 69 73 20 61 74 l append this at
69b0: 20 74 68 65 20 62 6f 74 74 6f 6d 20 6f 66 20 74 the bottom of t
69c0: 68 65 20 6c 6f 6f 70 0a 09 09 09 09 09 20 20 20 he loop......
69d0: 20 28 73 65 74 21 20 73 65 63 6e 61 6d 65 20 73 (set! secname s
69e0: 65 63 74 69 6f 6e 2d 6e 61 6d 65 29 0a 09 09 09 ection-name)....
69f0: 09 09 20 20 20 20 29 29 0a 09 20 20 20 3b 3b 20 .. )).. ;;
6a00: 4e 6f 20 6e 65 65 64 20 74 6f 20 70 72 6f 63 65 No need to proce
6a10: 73 73 20 6b 65 79 20 63 6d 64 2c 20 6c 65 74 20 ss key cmd, let
6a20: 69 74 20 66 61 6c 6c 20 74 68 6f 75 67 68 20 74 it fall though t
6a30: 6f 20 6b 65 79 20 76 61 6c 0a 09 20 20 20 28 63 o key val.. (c
6a40: 6f 6e 66 69 67 66 3a 6b 65 79 2d 76 61 6c 2d 70 onfigf:key-val-p
6a50: 72 20 28 20 78 20 6b 65 79 20 76 61 6c 20 20 20 r ( x key val
6a60: 20 20 20 29 0a 09 09 20 20 20 20 20 20 20 28 6c )... (l
6a70: 65 74 20 28 28 6e 65 77 76 61 6c 20 28 63 6f 6e et ((newval (con
6a80: 66 69 67 2d 6c 6f 6f 6b 75 70 20 69 6e 64 61 74 fig-lookup indat
6a90: 20 73 65 63 20 6b 65 79 29 29 29 0a 09 09 09 20 sec key)))....
6aa0: 3b 3b 20 63 61 6e 20 68 61 6e 64 6c 65 20 6e 65 ;; can handle ne
6ab0: 77 76 61 6c 20 3d 3d 20 23 66 20 68 65 72 65 20 wval == #f here
6ac0: 3d 3e 20 74 68 61 74 20 6d 65 61 6e 73 20 6b 65 => that means ke
6ad0: 79 20 69 73 20 72 65 6d 6f 76 65 64 0a 09 09 09 y is removed....
6ae0: 20 28 63 6f 6e 64 20 0a 09 09 09 20 20 28 28 65 (cond .... ((e
6af0: 71 75 61 6c 3f 20 6e 65 77 76 61 6c 20 76 61 6c qual? newval val
6b00: 29 0a 09 09 09 20 20 20 28 73 65 74 21 20 72 65 ).... (set! re
6b10: 73 20 28 61 70 70 65 6e 64 20 72 65 73 20 28 6c s (append res (l
6b20: 69 73 74 20 68 65 64 29 29 29 29 0a 09 09 09 20 ist hed))))....
6b30: 20 28 28 6e 6f 74 20 6e 65 77 76 61 6c 29 20 3b ((not newval) ;
6b40: 3b 20 6b 65 79 20 68 61 73 20 62 65 65 6e 20 72 ; key has been r
6b50: 65 6d 6f 76 65 64 0a 09 09 09 20 20 20 28 73 65 emoved.... (se
6b60: 74 21 20 6e 65 77 20 23 66 29 29 0a 09 09 09 20 t! new #f))....
6b70: 20 28 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 6e ((not (equal? n
6b80: 65 77 76 61 6c 20 76 61 6c 29 29 0a 09 09 09 20 ewval val))....
6b90: 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (hash-table-
6ba0: 73 65 74 21 20 73 65 63 68 61 73 68 20 6b 65 79 set! sechash key
6bb0: 20 6e 65 77 76 61 6c 29 0a 09 09 09 20 20 20 20 newval)....
6bc0: 20 28 73 65 74 21 20 6e 65 77 20 28 63 6f 6e 63 (set! new (conc
6bd0: 20 6b 65 79 20 22 20 22 20 6e 65 77 76 61 6c 29 key " " newval)
6be0: 29 29 0a 09 09 09 20 20 28 65 6c 73 65 0a 09 09 )).... (else...
6bf0: 09 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 . (debug:print
6c00: 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c -error 0 *defaul
6c10: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 70 72 6f t-log-port* "pro
6c20: 62 6c 65 6d 20 70 61 72 73 69 6e 67 20 6c 69 6e blem parsing lin
6c30: 65 20 6e 75 6d 62 65 72 20 22 20 6c 6e 75 6d 20 e number " lnum
6c40: 22 5c 22 22 20 68 65 64 20 22 5c 22 22 29 29 29 "\"" hed "\"")))
6c50: 29 29 0a 09 20 20 20 28 65 6c 73 65 0a 09 20 20 )).. (else..
6c60: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 (debug:print-e
6c70: 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d rror 0 *default-
6c80: 6c 6f 67 2d 70 6f 72 74 2a 20 22 50 72 6f 62 6c log-port* "Probl
6c90: 65 6d 20 70 61 72 73 69 6e 67 20 6c 69 6e 65 20 em parsing line
6ca0: 6e 75 6d 20 22 20 6c 6e 75 6d 20 22 20 3a 5c 6e num " lnum " :\n
6cb0: 20 20 20 22 20 68 65 64 20 29 29 29 0a 09 20 20 " hed )))..
6cc0: 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 (if (not (null?
6cd0: 74 61 6c 29 29 0a 09 20 20 20 20 20 20 28 6c 6f tal)).. (lo
6ce0: 6f 70 20 28 63 61 72 20 74 61 6c 29 28 63 64 72 op (car tal)(cdr
6cf0: 20 74 61 6c 29 28 69 66 20 6e 65 77 20 28 61 70 tal)(if new (ap
6d00: 70 65 6e 64 20 72 65 73 20 28 6c 69 73 74 20 6e pend res (list n
6d10: 65 77 29 29 20 72 65 73 29 28 2b 20 6c 6e 75 6d ew)) res)(+ lnum
6d20: 20 31 29 29 29 0a 09 20 20 3b 3b 20 64 72 6f 70 1))).. ;; drop
6d30: 20 74 6f 20 68 65 72 65 20 77 68 65 6e 20 64 6f to here when do
6d40: 6e 65 20 70 72 6f 63 65 73 73 69 6e 67 2c 20 72 ne processing, r
6d50: 65 73 20 63 6f 6e 74 61 69 6e 73 20 6d 6f 64 69 es contains modi
6d60: 66 69 65 64 20 6c 69 73 74 20 6f 66 20 6c 69 6e fied list of lin
6d70: 65 73 0a 09 20 20 28 73 65 74 21 20 66 64 61 74 es.. (set! fdat
6d80: 20 72 65 73 29 29 29 0a 0a 20 20 20 20 3b 3b 20 res))).. ;;
6d90: 73 74 65 70 20 34 3a 20 41 70 70 65 6e 64 20 6e step 4: Append n
6da0: 65 77 20 76 61 6c 75 65 73 20 74 6f 20 74 68 65 ew values to the
6db0: 20 73 65 63 74 69 6f 6e 0a 20 20 20 20 28 66 6f section. (fo
6dc0: 72 2d 65 61 63 68 20 0a 20 20 20 20 20 28 6c 61 r-each . (la
6dd0: 6d 62 64 61 20 28 73 65 63 74 69 6f 6e 29 0a 20 mbda (section).
6de0: 20 20 20 20 20 20 28 6c 65 74 20 28 28 73 64 61 (let ((sda
6df0: 74 20 20 20 27 28 29 29 20 3b 3b 20 61 70 70 65 t '()) ;; appe
6e00: 6e 64 20 6e 65 65 64 65 64 20 62 69 74 73 20 68 nd needed bits h
6e10: 65 72 65 0a 09 20 20 20 20 20 28 73 76 61 72 73 ere.. (svars
6e20: 20 20 28 63 6f 6e 66 69 67 66 3a 73 65 63 74 69 (configf:secti
6e30: 6f 6e 2d 76 61 72 73 20 69 6e 64 61 74 20 73 65 on-vars indat se
6e40: 63 74 69 6f 6e 29 29 29 0a 09 20 28 66 6f 72 2d ction))).. (for-
6e50: 65 61 63 68 20 0a 09 20 20 28 6c 61 6d 62 64 61 each .. (lambda
6e60: 20 28 76 61 72 29 0a 09 20 20 20 20 28 6c 65 74 (var).. (let
6e70: 20 28 28 76 61 6c 20 28 63 6f 6e 66 69 67 2d 6c ((val (config-l
6e80: 6f 6f 6b 75 70 20 72 65 66 64 61 74 20 73 65 63 ookup refdat sec
6e90: 74 69 6f 6e 20 76 61 72 29 29 29 0a 09 20 20 20 tion var)))..
6ea0: 20 20 20 28 69 66 20 28 6e 6f 74 20 76 61 6c 29 (if (not val)
6eb0: 20 3b 3b 20 74 68 69 73 20 6f 6e 65 20 69 73 20 ;; this one is
6ec0: 6e 65 77 0a 09 09 20 20 28 62 65 67 69 6e 0a 09 new... (begin..
6ed0: 09 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 . (if (null?
6ee0: 73 64 61 74 29 28 73 65 74 21 20 73 64 61 74 20 sdat)(set! sdat
6ef0: 28 6c 69 73 74 20 28 63 6f 6e 63 20 22 5b 22 20 (list (conc "["
6f00: 73 65 63 74 69 6f 6e 20 22 5d 22 29 29 29 29 0a section "]")))).
6f10: 09 09 20 20 20 20 28 73 65 74 21 20 73 64 61 74 .. (set! sdat
6f20: 20 28 61 70 70 65 6e 64 20 73 64 61 74 20 28 6c (append sdat (l
6f30: 69 73 74 20 28 63 6f 6e 63 20 76 61 72 20 22 20 ist (conc var "
6f40: 22 20 76 61 6c 29 29 29 29 29 29 29 29 0a 09 20 " val))))))))..
6f50: 20 73 76 61 72 73 29 0a 09 20 28 73 65 74 21 20 svars).. (set!
6f60: 66 64 61 74 20 28 61 70 70 65 6e 64 20 66 64 61 fdat (append fda
6f70: 74 20 73 64 61 74 29 29 29 29 0a 20 20 20 20 20 t sdat)))).
6f80: 28 64 65 6c 65 74 65 2d 64 75 70 6c 69 63 61 74 (delete-duplicat
6f90: 65 73 20 28 61 70 70 65 6e 64 20 72 65 71 75 69 es (append requi
6fa0: 72 65 2d 73 65 63 74 69 6f 6e 73 20 28 68 61 73 re-sections (has
6fb0: 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 69 6e 64 h-table-keys ind
6fc0: 61 74 29 29 29 29 0a 0a 20 20 20 20 3b 3b 20 73 at)))).. ;; s
6fd0: 74 65 70 20 35 3a 20 57 72 69 74 65 20 6f 75 74 tep 5: Write out
6fe0: 20 6e 65 77 20 66 69 6c 65 0a 20 20 20 20 28 77 new file. (w
6ff0: 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 69 ith-output-to-fi
7000: 6c 65 20 66 6e 61 6d 65 20 0a 20 20 20 20 20 20 le fname .
7010: 28 6c 61 6d 62 64 61 20 28 29 0a 09 28 66 6f 72 (lambda ()..(for
7020: 2d 65 61 63 68 20 0a 09 20 28 6c 61 6d 62 64 61 -each .. (lambda
7030: 20 28 6c 69 6e 65 29 0a 09 20 20 20 28 70 72 69 (line).. (pri
7040: 6e 74 20 6c 69 6e 65 29 29 0a 09 20 28 63 6f 6e nt line)).. (con
7050: 66 69 67 66 3a 65 78 70 61 6e 64 2d 6d 75 6c 74 figf:expand-mult
7060: 69 2d 6c 69 6e 65 73 20 66 64 61 74 29 29 29 29 i-lines fdat))))
7070: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
7080: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7090: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
70a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
70b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
70c0: 72 65 66 64 62 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d refdb.;;========
70d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
70e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
70f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7100: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
7110: 3b 3b 20 72 65 61 64 73 20 61 20 72 65 66 64 62 ;; reads a refdb
7120: 20 69 6e 74 6f 20 61 6e 20 61 73 73 6f 63 20 61 into an assoc a
7130: 72 72 61 79 20 6f 66 20 61 73 73 6f 63 20 61 72 rray of assoc ar
7140: 72 61 79 73 0a 3b 3b 20 20 20 72 65 74 75 72 6e rays.;; return
7150: 73 20 28 6c 69 73 74 20 64 61 74 20 6d 73 67 29 s (list dat msg)
7160: 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 .(define (config
7170: 66 3a 72 65 61 64 2d 72 65 66 64 62 20 72 65 66 f:read-refdb ref
7180: 64 62 2d 70 61 74 68 29 0a 20 20 28 6c 65 74 20 db-path). (let
7190: 28 28 73 68 65 65 74 73 2d 66 69 6c 65 20 20 28 ((sheets-file (
71a0: 63 6f 6e 63 20 72 65 66 64 62 2d 70 61 74 68 20 conc refdb-path
71b0: 22 2f 73 68 65 65 74 2d 6e 61 6d 65 73 2e 63 66 "/sheet-names.cf
71c0: 67 22 29 29 29 0a 20 20 20 20 28 69 66 20 28 6e g"))). (if (n
71d0: 6f 74 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f ot (file-exists?
71e0: 20 73 68 65 65 74 73 2d 66 69 6c 65 29 29 0a 09 sheets-file))..
71f0: 28 6c 69 73 74 20 23 66 20 28 63 6f 6e 63 20 22 (list #f (conc "
7200: 45 52 52 4f 52 3a 20 6e 6f 20 72 65 66 64 62 20 ERROR: no refdb
7210: 66 6f 75 6e 64 20 61 74 20 22 20 72 65 66 64 62 found at " refdb
7220: 2d 70 61 74 68 29 29 0a 09 28 69 66 20 28 6e 6f -path))..(if (no
7230: 74 20 28 66 69 6c 65 2d 72 65 61 64 2d 61 63 63 t (file-read-acc
7240: 65 73 73 3f 20 73 68 65 65 74 73 2d 66 69 6c 65 ess? sheets-file
7250: 29 29 0a 09 20 20 20 20 28 6c 69 73 74 20 23 66 )).. (list #f
7260: 20 28 63 6f 6e 63 20 22 45 52 52 4f 52 3a 20 72 (conc "ERROR: r
7270: 65 66 64 62 20 66 69 6c 65 20 6e 6f 74 20 72 65 efdb file not re
7280: 61 64 61 62 6c 65 20 61 74 20 22 20 72 65 66 64 adable at " refd
7290: 62 2d 70 61 74 68 29 29 0a 09 20 20 20 20 28 6c b-path)).. (l
72a0: 65 74 2a 20 28 28 73 68 65 65 74 73 20 28 77 69 et* ((sheets (wi
72b0: 74 68 2d 69 6e 70 75 74 2d 66 72 6f 6d 2d 66 69 th-input-from-fi
72c0: 6c 65 20 73 68 65 65 74 73 2d 66 69 6c 65 0a 09 le sheets-file..
72d0: 09 09 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 .. (lambda (
72e0: 29 0a 09 09 09 20 20 20 20 20 20 20 28 6c 65 74 ).... (let
72f0: 20 6c 6f 6f 70 20 28 28 69 6e 6c 20 28 72 65 61 loop ((inl (rea
7300: 64 2d 6c 69 6e 65 29 29 0a 09 09 09 09 09 20 20 d-line))......
7310: 28 72 65 73 20 27 28 29 29 29 0a 09 09 09 09 20 (res '())).....
7320: 28 69 66 20 28 65 6f 66 2d 6f 62 6a 65 63 74 3f (if (eof-object?
7330: 20 69 6e 6c 29 0a 09 09 09 09 20 20 20 20 20 28 inl)..... (
7340: 72 65 76 65 72 73 65 20 72 65 73 29 0a 09 09 09 reverse res)....
7350: 09 20 20 20 20 20 28 6c 6f 6f 70 20 28 72 65 61 . (loop (rea
7360: 64 2d 6c 69 6e 65 29 28 63 6f 6e 73 20 69 6e 6c d-line)(cons inl
7370: 20 72 65 73 29 29 29 29 29 29 29 0a 09 09 20 20 res)))))))...
7380: 20 28 64 61 74 61 20 20 20 27 28 29 29 29 0a 09 (data '()))..
7390: 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 (for-each
73a0: 0a 09 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 .. (lambda
73b0: 20 28 73 68 65 65 74 2d 6e 61 6d 65 29 0a 09 09 (sheet-name)...
73c0: 20 28 6c 65 74 2a 20 28 28 64 61 74 2d 70 61 74 (let* ((dat-pat
73d0: 68 20 20 28 63 6f 6e 63 20 72 65 66 64 62 2d 70 h (conc refdb-p
73e0: 61 74 68 20 22 2f 22 20 73 68 65 65 74 2d 6e 61 ath "/" sheet-na
73f0: 6d 65 20 22 2e 64 61 74 22 29 29 0a 09 09 09 28 me ".dat"))....(
7400: 72 65 66 2d 64 61 74 20 20 20 28 63 6f 6e 66 69 ref-dat (confi
7410: 67 66 3a 72 65 61 64 2d 66 69 6c 65 20 64 61 74 gf:read-file dat
7420: 2d 70 61 74 68 20 23 66 20 23 74 29 29 0a 09 09 -path #f #t))...
7430: 09 28 72 65 66 2d 61 73 73 6f 63 20 28 6d 61 70 .(ref-assoc (map
7440: 20 28 6c 61 6d 62 64 61 20 28 6b 65 79 29 0a 09 (lambda (key)..
7450: 09 09 09 09 20 20 28 6c 69 73 74 20 6b 65 79 20 .... (list key
7460: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 (hash-table-ref
7470: 72 65 66 2d 64 61 74 20 6b 65 79 29 29 29 0a 09 ref-dat key)))..
7480: 09 09 09 09 28 68 61 73 68 2d 74 61 62 6c 65 2d ....(hash-table-
7490: 6b 65 79 73 20 72 65 66 2d 64 61 74 29 29 29 29 keys ref-dat))))
74a0: 0a 09 09 09 09 20 20 20 3b 3b 20 28 68 61 73 68 ..... ;; (hash
74b0: 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 74 20 72 65 -table->alist re
74c0: 66 2d 64 61 74 29 29 29 0a 09 09 20 20 20 3b 3b f-dat)))... ;;
74d0: 20 28 73 65 74 21 20 64 61 74 61 20 28 61 70 70 (set! data (app
74e0: 65 6e 64 20 64 61 74 61 20 28 6c 69 73 74 20 28 end data (list (
74f0: 6c 69 73 74 20 73 68 65 65 74 2d 6e 61 6d 65 20 list sheet-name
7500: 72 65 66 2d 61 73 73 6f 63 29 29 29 29 29 29 0a ref-assoc)))))).
7510: 09 09 20 20 20 28 73 65 74 21 20 64 61 74 61 20 .. (set! data
7520: 28 63 6f 6e 73 20 28 6c 69 73 74 20 73 68 65 65 (cons (list shee
7530: 74 2d 6e 61 6d 65 20 72 65 66 2d 61 73 73 6f 63 t-name ref-assoc
7540: 29 20 64 61 74 61 29 29 29 29 0a 09 20 20 20 20 ) data))))..
7550: 20 20 20 73 68 65 65 74 73 29 0a 09 20 20 20 20 sheets)..
7560: 20 20 28 6c 69 73 74 20 64 61 74 61 20 22 4e 4f (list data "NO
7570: 20 45 52 52 4f 52 53 22 29 29 29 29 29 29 0a 0a ERRORS"))))))..
7580: 3b 3b 20 6d 61 70 20 6f 76 65 72 20 61 6c 6c 20 ;; map over all
7590: 70 61 69 72 73 20 69 6e 20 61 20 74 68 72 65 65 pairs in a three
75a0: 20 6c 65 76 65 6c 20 68 69 65 72 61 72 63 68 69 level hierarchi
75b0: 61 6c 20 61 6c 69 73 74 20 61 6e 64 20 61 70 70 al alist and app
75c0: 6c 79 20 61 20 66 75 6e 63 74 69 6f 6e 20 74 6f ly a function to
75d0: 20 74 68 65 20 6b 65 79 73 2f 76 61 6c 0a 3b 3b the keys/val.;;
75e0: 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 .(define (config
75f0: 66 3a 6d 61 70 2d 61 6c 6c 2d 68 69 65 72 2d 61 f:map-all-hier-a
7600: 6c 69 73 74 20 64 61 74 61 20 70 72 6f 63 20 23 list data proc #
7610: 21 6b 65 79 20 28 69 6e 69 74 70 72 6f 63 31 20 !key (initproc1
7620: 23 66 29 28 69 6e 69 74 70 72 6f 63 32 20 23 66 #f)(initproc2 #f
7630: 29 28 69 6e 69 74 70 72 6f 63 33 20 23 66 29 29 )(initproc3 #f))
7640: 0a 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 20 20 . (for-each .
7650: 20 28 6c 61 6d 62 64 61 20 28 73 68 65 65 74 6e (lambda (sheetn
7660: 61 6d 65 29 0a 20 20 20 20 20 28 6c 65 74 2a 20 ame). (let*
7670: 28 28 73 68 65 65 74 74 6d 70 20 20 28 61 73 73 ((sheettmp (ass
7680: 6f 63 20 73 68 65 65 74 6e 61 6d 65 20 64 61 74 oc sheetname dat
7690: 61 29 29 0a 09 20 20 20 20 28 73 68 65 65 74 64 a)).. (sheetd
76a0: 61 74 20 20 28 69 66 20 73 68 65 65 74 74 6d 70 at (if sheettmp
76b0: 20 28 63 61 64 72 20 73 68 65 65 74 74 6d 70 29 (cadr sheettmp)
76c0: 20 27 28 29 29 29 29 0a 20 20 20 20 20 20 20 28 '()))). (
76d0: 69 66 20 69 6e 69 74 70 72 6f 63 31 20 28 69 6e if initproc1 (in
76e0: 69 74 70 72 6f 63 31 20 73 68 65 65 74 6e 61 6d itproc1 sheetnam
76f0: 65 29 29 0a 20 20 20 20 20 20 20 28 66 6f 72 2d e)). (for-
7700: 65 61 63 68 20 0a 09 28 6c 61 6d 62 64 61 20 28 each ..(lambda (
7710: 73 65 63 74 69 6f 6e 6e 61 6d 65 29 0a 09 20 20 sectionname)..
7720: 28 6c 65 74 2a 20 28 28 73 65 63 74 69 6f 6e 74 (let* ((sectiont
7730: 6d 70 20 20 28 61 73 73 6f 63 20 73 65 63 74 69 mp (assoc secti
7740: 6f 6e 6e 61 6d 65 20 73 68 65 65 74 64 61 74 29 onname sheetdat)
7750: 29 0a 09 09 20 28 73 65 63 74 69 6f 6e 64 61 74 )... (sectiondat
7760: 20 20 28 69 66 20 73 65 63 74 69 6f 6e 74 6d 70 (if sectiontmp
7770: 20 28 63 61 64 72 20 73 65 63 74 69 6f 6e 74 6d (cadr sectiontm
7780: 70 29 20 27 28 29 29 29 29 0a 09 20 20 20 20 28 p) '()))).. (
7790: 69 66 20 69 6e 69 74 70 72 6f 63 32 20 28 69 6e if initproc2 (in
77a0: 69 74 70 72 6f 63 32 20 73 68 65 65 74 6e 61 6d itproc2 sheetnam
77b0: 65 20 73 65 63 74 69 6f 6e 6e 61 6d 65 29 29 0a e sectionname)).
77c0: 09 20 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 09 . (for-each..
77d0: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 76 61 (lambda (va
77e0: 72 6e 61 6d 65 29 0a 09 20 20 20 20 20 20 20 28 rname).. (
77f0: 6c 65 74 2a 20 28 28 76 61 6c 74 6d 70 20 28 61 let* ((valtmp (a
7800: 73 73 6f 63 20 76 61 72 6e 61 6d 65 20 73 65 63 ssoc varname sec
7810: 74 69 6f 6e 64 61 74 29 29 0a 09 09 20 20 20 20 tiondat))...
7820: 20 20 28 76 61 6c 20 20 20 20 28 69 66 20 76 61 (val (if va
7830: 6c 74 6d 70 20 28 63 61 64 72 20 76 61 6c 74 6d ltmp (cadr valtm
7840: 70 29 20 22 22 29 29 29 0a 09 09 20 28 70 72 6f p) "")))... (pro
7850: 63 20 73 68 65 65 74 6e 61 6d 65 20 73 65 63 74 c sheetname sect
7860: 69 6f 6e 6e 61 6d 65 20 76 61 72 6e 61 6d 65 20 ionname varname
7870: 76 61 6c 29 29 29 0a 09 20 20 20 20 20 28 6d 61 val))).. (ma
7880: 70 20 63 61 72 20 73 65 63 74 69 6f 6e 64 61 74 p car sectiondat
7890: 29 29 29 29 0a 09 28 6d 61 70 20 63 61 72 20 73 ))))..(map car s
78a0: 68 65 65 74 64 61 74 29 29 29 29 0a 20 20 20 28 heetdat)))). (
78b0: 6d 61 70 20 63 61 72 20 64 61 74 61 29 29 0a 20 map car data)).
78c0: 20 64 61 74 61 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d data)..;;======
78d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
78e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
78f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7900: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7910: 0a 3b 3b 20 20 43 20 4f 20 4e 20 46 20 49 20 47 .;; C O N F I G
7920: 20 20 20 54 20 4f 20 2f 20 46 20 52 20 4f 20 4d T O / F R O M
7930: 20 20 20 41 20 4c 20 49 20 53 20 54 0a 3b 3b 3d A L I S T.;;=
7940: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7950: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7960: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7970: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7980: 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 =====..(define (
7990: 63 6f 6e 66 69 67 66 3a 63 6f 6e 66 69 67 2d 3e configf:config->
79a0: 61 6c 69 73 74 20 63 66 67 64 61 74 29 0a 20 20 alist cfgdat).
79b0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 (hash-table->ali
79c0: 73 74 20 63 66 67 64 61 74 29 29 0a 0a 28 64 65 st cfgdat))..(de
79d0: 66 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a 61 6c fine (configf:al
79e0: 69 73 74 2d 3e 63 6f 6e 66 69 67 20 61 64 61 74 ist->config adat
79f0: 29 0a 20 20 28 6c 65 74 20 28 28 68 74 20 28 6d ). (let ((ht (m
7a00: 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 ake-hash-table))
7a10: 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 68 0a ). (for-each.
7a20: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 73 65 (lambda (se
7a30: 63 74 69 6f 6e 29 0a 20 20 20 20 20 20 20 28 68 ction). (h
7a40: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 68 ash-table-set! h
7a50: 74 20 28 63 61 72 20 73 65 63 74 69 6f 6e 29 28 t (car section)(
7a60: 63 64 72 20 73 65 63 74 69 6f 6e 29 29 29 0a 20 cdr section))).
7a70: 20 20 20 20 61 64 61 74 29 0a 20 20 20 20 68 74 adat). ht
7a80: 29 29 0a 0a 3b 3b 20 69 66 20 0a 28 64 65 66 69 ))..;; if .(defi
7a90: 6e 65 20 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 ne (configf:read
7aa0: 2d 61 6c 69 73 74 20 66 6e 61 6d 65 29 0a 20 20 -alist fname).
7ab0: 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f (handle-exceptio
7ac0: 6e 73 0a 20 20 20 20 20 20 65 78 6e 0a 20 20 20 ns. exn.
7ad0: 20 20 20 23 66 0a 20 20 20 20 28 63 6f 6e 66 69 #f. (confi
7ae0: 67 66 3a 61 6c 69 73 74 2d 3e 63 6f 6e 66 69 67 gf:alist->config
7af0: 0a 20 20 20 20 20 28 77 69 74 68 2d 69 6e 70 75 . (with-inpu
7b00: 74 2d 66 72 6f 6d 2d 66 69 6c 65 20 66 6e 61 6d t-from-file fnam
7b10: 65 20 72 65 61 64 29 29 29 29 0a 0a 28 64 65 66 e read))))..(def
7b20: 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a 77 72 69 ine (configf:wri
7b30: 74 65 2d 61 6c 69 73 74 20 63 64 61 74 20 66 6e te-alist cdat fn
7b40: 61 6d 65 29 0a 20 20 28 6c 65 74 20 28 28 64 61 ame). (let ((da
7b50: 74 20 20 28 63 6f 6e 66 69 67 66 3a 63 6f 6e 66 t (configf:conf
7b60: 69 67 2d 3e 61 6c 69 73 74 20 63 64 61 74 29 29 ig->alist cdat))
7b70: 29 0a 20 20 20 20 28 77 69 74 68 2d 6f 75 74 70 ). (with-outp
7b80: 75 74 2d 74 6f 2d 66 69 6c 65 20 66 6e 61 6d 65 ut-to-file fname
7b90: 20 3b 3b 20 66 69 72 73 74 20 77 72 69 74 65 20 ;; first write
7ba0: 6f 75 74 20 74 68 65 20 66 69 6c 65 0a 20 20 20 out the file.
7bb0: 20 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 28 (lambda ()..(
7bc0: 70 70 20 64 61 74 29 29 29 0a 20 20 20 20 28 69 pp dat))). (i
7bd0: 66 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 f (file-exists?
7be0: 66 6e 61 6d 65 29 20 20 20 3b 3b 20 6e 6f 77 20 fname) ;; now
7bf0: 76 65 72 69 66 79 20 69 74 20 69 73 20 72 65 61 verify it is rea
7c00: 64 61 62 6c 65 0a 09 28 69 66 20 28 63 6f 6e 66 dable..(if (conf
7c10: 69 67 66 3a 72 65 61 64 2d 61 6c 69 73 74 20 66 igf:read-alist f
7c20: 6e 61 6d 65 29 0a 09 20 20 20 20 23 74 20 3b 3b name).. #t ;;
7c30: 20 64 61 74 61 20 69 73 20 67 6f 6f 64 2e 0a 09 data is good...
7c40: 20 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 (begin..
7c50: 20 20 28 64 65 6c 65 74 65 2d 66 69 6c 65 20 66 (delete-file f
7c60: 6e 61 6d 65 29 0a 09 20 20 20 20 20 20 28 64 65 name).. (de
7c70: 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 bug:print 0 *def
7c80: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
7c90: 57 41 52 4e 49 4e 47 3a 20 63 6f 6e 74 65 6e 74 WARNING: content
7ca0: 20 22 20 64 61 74 20 22 20 66 6f 72 20 63 61 63 " dat " for cac
7cb0: 68 65 20 22 20 66 6e 61 6d 65 20 22 20 69 73 20 he " fname " is
7cc0: 6e 6f 74 20 72 65 61 64 61 62 6c 65 2e 20 44 65 not readable. De
7cd0: 6c 65 74 69 6e 67 20 67 65 6e 65 72 61 74 65 64 leting generated
7ce0: 20 66 69 6c 65 2e 22 29 0a 09 20 20 20 20 20 20 file.")..
7cf0: 23 66 29 29 0a 09 23 66 29 29 29 0a 0a 3b 3b 20 #f))..#f)))..;;
7d00: 63 6f 6e 76 65 72 74 20 68 69 65 72 61 72 63 68 convert hierarch
7d10: 69 61 6c 20 6c 69 73 74 20 74 6f 20 69 6e 69 20 ial list to ini
7d20: 66 6f 72 6d 61 74 0a 3b 3b 0a 28 64 65 66 69 6e format.;;.(defin
7d30: 65 20 28 63 6f 6e 66 69 67 66 3a 63 6f 6e 66 69 e (configf:confi
7d40: 67 2d 3e 69 6e 69 20 64 61 74 61 29 0a 20 20 28 g->ini data). (
7d50: 6d 61 70 20 0a 20 20 20 28 6c 61 6d 62 64 61 20 map . (lambda
7d60: 28 73 65 63 74 69 6f 6e 29 0a 20 20 20 20 20 28 (section). (
7d70: 6c 65 74 20 28 28 73 65 63 74 69 6f 6e 2d 6e 61 let ((section-na
7d80: 6d 65 20 28 63 61 72 20 73 65 63 74 69 6f 6e 29 me (car section)
7d90: 29 0a 09 20 20 20 28 73 65 63 74 69 6f 6e 2d 64 ).. (section-d
7da0: 61 74 20 20 28 63 64 72 20 73 65 63 74 69 6f 6e at (cdr section
7db0: 29 29 29 0a 20 20 20 20 20 20 20 28 70 72 69 6e ))). (prin
7dc0: 74 20 22 5c 6e 5b 22 20 73 65 63 74 69 6f 6e 2d t "\n[" section-
7dd0: 6e 61 6d 65 20 22 5d 22 29 0a 20 20 20 20 20 20 name "]").
7de0: 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 64 (map (lambda (d
7df0: 61 74 2d 70 61 69 72 29 0a 09 20 20 20 20 20 20 at-pair)..
7e00: 28 6c 65 74 2a 20 28 28 76 61 72 20 28 63 61 72 (let* ((var (car
7e10: 20 64 61 74 2d 70 61 69 72 29 29 0a 09 09 20 20 dat-pair))...
7e20: 20 20 20 28 76 61 6c 20 28 63 61 64 72 20 64 61 (val (cadr da
7e30: 74 2d 70 61 69 72 29 29 0a 09 09 20 20 20 20 20 t-pair))...
7e40: 28 66 6e 61 6d 65 20 28 69 66 20 28 3e 20 28 6c (fname (if (> (l
7e50: 65 6e 67 74 68 20 64 61 74 2d 70 61 69 72 29 20 ength dat-pair)
7e60: 32 29 28 63 61 64 64 72 20 64 61 74 2d 70 61 69 2)(caddr dat-pai
7e70: 72 29 20 23 66 29 29 29 0a 09 09 28 69 66 20 66 r) #f)))...(if f
7e80: 6e 61 6d 65 20 28 70 72 69 6e 74 20 22 23 20 22 name (print "# "
7e90: 20 76 61 72 20 22 3d 3e 22 20 66 6e 61 6d 65 29 var "=>" fname)
7ea0: 29 0a 09 09 28 70 72 69 6e 74 20 76 61 72 20 22 )...(print var "
7eb0: 20 22 20 76 61 6c 29 29 29 0a 09 20 20 20 20 73 " val))).. s
7ec0: 65 63 74 69 6f 6e 2d 64 61 74 29 29 29 20 3b 3b ection-dat))) ;;
7ed0: 20 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 73 (print "s
7ee0: 65 63 74 69 6f 6e 2d 64 61 74 3a 20 22 20 73 65 ection-dat: " se
7ef0: 63 74 69 6f 6e 2d 64 61 74 29 29 0a 20 20 20 28 ction-dat)). (
7f00: 68 61 73 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 hash-table->alis
7f10: 74 20 64 61 74 61 29 29 29 0a t data))).