File
configf.scm
— part of check-in
[86bc7cc36f]
at
2012-04-19 23:05:51
on branch runconfigs-fix-irrelevant-vars
— Fix for runconfigs reading - picking up irrelevant variables
(user:
matt
size: 15908)
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 0a 28 64 x regex-case).(d
02a0: 65 63 6c 61 72 65 20 28 75 6e 69 74 20 63 6f 6e eclare (unit con
02b0: 66 69 67 66 29 29 0a 28 64 65 63 6c 61 72 65 20 figf)).(declare
02c0: 28 75 73 65 73 20 63 6f 6d 6d 6f 6e 29 29 0a 28 (uses common)).(
02d0: 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 70 72 declare (uses pr
02e0: 6f 63 65 73 73 29 29 0a 0a 28 69 6e 63 6c 75 64 ocess))..(includ
02f0: 65 20 22 63 6f 6d 6d 6f 6e 5f 72 65 63 6f 72 64 e "common_record
0300: 73 2e 73 63 6d 22 29 0a 0a 3b 3b 20 72 65 74 75 s.scm")..;; retu
0310: 72 6e 20 6c 69 73 74 20 28 70 61 74 68 20 66 75 rn list (path fu
0320: 6c 6c 70 61 74 68 20 63 6f 6e 66 69 67 6e 61 6d llpath confignam
0330: 65 29 0a 28 64 65 66 69 6e 65 20 28 66 69 6e 64 e).(define (find
0340: 2d 63 6f 6e 66 69 67 20 63 6f 6e 66 69 67 6e 61 -config configna
0350: 6d 65 29 0a 20 20 28 6c 65 74 2a 20 28 28 63 77 me). (let* ((cw
0360: 64 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 d (string-split
0370: 28 63 75 72 72 65 6e 74 2d 64 69 72 65 63 74 6f (current-directo
0380: 72 79 29 20 22 2f 22 29 29 29 0a 20 20 20 20 28 ry) "/"))). (
0390: 6c 65 74 20 6c 6f 6f 70 20 28 28 64 69 72 20 63 let loop ((dir c
03a0: 77 64 29 29 0a 20 20 20 20 20 20 28 6c 65 74 2a wd)). (let*
03b0: 20 28 28 70 61 74 68 20 20 20 20 20 28 63 6f 6e ((path (con
03c0: 63 20 22 2f 22 20 28 73 74 72 69 6e 67 2d 69 6e c "/" (string-in
03d0: 74 65 72 73 70 65 72 73 65 20 64 69 72 20 22 2f tersperse dir "/
03e0: 22 29 29 29 0a 09 20 20 20 20 20 28 66 75 6c 6c "))).. (full
03f0: 70 61 74 68 20 28 63 6f 6e 63 20 70 61 74 68 20 path (conc path
0400: 22 2f 22 20 63 6f 6e 66 69 67 6e 61 6d 65 29 29 "/" configname))
0410: 29 0a 09 28 69 66 20 28 66 69 6c 65 2d 65 78 69 )..(if (file-exi
0420: 73 74 73 3f 20 66 75 6c 6c 70 61 74 68 29 0a 09 sts? fullpath)..
0430: 20 20 20 20 28 6c 69 73 74 20 70 61 74 68 20 66 (list path f
0440: 75 6c 6c 70 61 74 68 20 63 6f 6e 66 69 67 6e 61 ullpath configna
0450: 6d 65 29 0a 09 20 20 20 20 28 6c 65 74 20 28 28 me).. (let ((
0460: 72 65 6d 63 77 64 20 28 74 61 6b 65 20 64 69 72 remcwd (take dir
0470: 20 28 2d 20 28 6c 65 6e 67 74 68 20 64 69 72 29 (- (length dir)
0480: 20 31 29 29 29 29 0a 09 20 20 20 20 20 20 28 69 1)))).. (i
0490: 66 20 28 6e 75 6c 6c 3f 20 72 65 6d 63 77 64 29 f (null? remcwd)
04a0: 0a 09 09 20 20 28 6c 69 73 74 20 23 66 20 23 66 ... (list #f #f
04b0: 20 23 66 29 20 3b 3b 20 20 23 66 20 23 66 29 20 #f) ;; #f #f)
04c0: 0a 09 09 20 20 28 6c 6f 6f 70 20 72 65 6d 63 77 ... (loop remcw
04d0: 64 29 29 29 29 29 29 29 29 0a 0a 28 64 65 66 69 d))))))))..(defi
04e0: 6e 65 20 28 63 6f 6e 66 69 67 3a 61 73 73 6f 63 ne (config:assoc
04f0: 2d 73 61 66 65 2d 61 64 64 20 61 6c 69 73 74 20 -safe-add alist
0500: 6b 65 79 20 76 61 6c 29 0a 20 20 28 6c 65 74 20 key val). (let
0510: 28 28 6e 65 77 61 6c 69 73 74 20 28 66 69 6c 74 ((newalist (filt
0520: 65 72 20 28 6c 61 6d 62 64 61 20 28 78 29 28 6e er (lambda (x)(n
0530: 6f 74 20 28 65 71 75 61 6c 3f 20 6b 65 79 20 28 ot (equal? key (
0540: 63 61 72 20 78 29 29 29 29 20 61 6c 69 73 74 29 car x)))) alist)
0550: 29 29 0a 20 20 20 20 28 61 70 70 65 6e 64 20 6e )). (append n
0560: 65 77 61 6c 69 73 74 20 28 6c 69 73 74 20 28 6c ewalist (list (l
0570: 69 73 74 20 6b 65 79 20 76 61 6c 29 29 29 29 29 ist key val)))))
0580: 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 ..(define (confi
0590: 67 3a 65 76 61 6c 2d 73 74 72 69 6e 67 2d 69 6e g:eval-string-in
05a0: 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 73 74 72 -environment str
05b0: 29 0a 20 20 28 6c 65 74 20 28 28 63 6d 64 72 65 ). (let ((cmdre
05c0: 73 20 28 63 6d 64 2d 72 75 6e 2d 3e 6c 69 73 74 s (cmd-run->list
05d0: 20 28 63 6f 6e 63 20 22 65 63 68 6f 20 22 20 73 (conc "echo " s
05e0: 74 72 29 29 29 29 0a 20 20 20 20 28 69 66 20 28 tr)))). (if (
05f0: 6e 75 6c 6c 3f 20 63 6d 64 72 65 73 29 20 22 22 null? cmdres) ""
0600: 0a 09 28 63 61 61 72 20 63 6d 64 72 65 73 29 29 ..(caar cmdres))
0610: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
0620: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0630: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0640: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0650: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
0660: 4d 61 6b 65 20 74 68 65 20 72 65 67 65 78 70 27 Make the regexp'
0670: 73 20 6e 65 65 64 65 64 20 67 6c 6f 62 61 6c 6c s needed globall
0680: 79 20 61 76 61 69 6c 61 62 6c 65 0a 3b 3b 3d 3d y available.;;==
0690: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
06a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
06b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
06c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
06d0: 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 63 6f ====..(define co
06e0: 6e 66 69 67 66 3a 69 6e 63 6c 75 64 65 2d 72 78 nfigf:include-rx
06f0: 20 28 72 65 67 65 78 70 20 22 5e 5c 5c 5b 69 6e (regexp "^\\[in
0700: 63 6c 75 64 65 5c 5c 73 2b 28 2e 2a 29 5c 5c 5d clude\\s+(.*)\\]
0710: 5c 5c 73 2a 24 22 29 29 0a 28 64 65 66 69 6e 65 \\s*$")).(define
0720: 20 63 6f 6e 66 69 67 66 3a 73 65 63 74 69 6f 6e configf:section
0730: 2d 72 78 20 28 72 65 67 65 78 70 20 22 5e 5c 5c -rx (regexp "^\\
0740: 5b 28 2e 2a 29 5c 5c 5d 5c 5c 73 2a 24 22 29 29 [(.*)\\]\\s*$"))
0750: 0a 28 64 65 66 69 6e 65 20 63 6f 6e 66 69 67 66 .(define configf
0760: 3a 62 6c 61 6e 6b 2d 6c 2d 72 78 20 28 72 65 67 :blank-l-rx (reg
0770: 65 78 70 20 22 5e 5c 5c 73 2a 24 22 29 29 0a 28 exp "^\\s*$")).(
0780: 64 65 66 69 6e 65 20 63 6f 6e 66 69 67 66 3a 6b define configf:k
0790: 65 79 2d 73 79 73 2d 70 72 20 28 72 65 67 65 78 ey-sys-pr (regex
07a0: 70 20 22 5e 28 5c 5c 53 2b 29 5c 5c 73 2b 5c 5c p "^(\\S+)\\s+\\
07b0: 5b 73 79 73 74 65 6d 5c 5c 73 2b 28 5c 5c 53 2b [system\\s+(\\S+
07c0: 2e 2a 29 5c 5c 5d 5c 5c 73 2a 24 22 29 29 0a 28 .*)\\]\\s*$")).(
07d0: 64 65 66 69 6e 65 20 63 6f 6e 66 69 67 66 3a 6b define configf:k
07e0: 65 79 2d 76 61 6c 2d 70 72 20 28 72 65 67 65 78 ey-val-pr (regex
07f0: 70 20 22 5e 28 5c 5c 53 2b 29 5c 5c 73 2b 28 2e p "^(\\S+)\\s+(.
0800: 2a 29 24 22 29 29 0a 28 64 65 66 69 6e 65 20 63 *)$")).(define c
0810: 6f 6e 66 69 67 66 3a 63 6f 6d 6d 65 6e 74 2d 72 onfigf:comment-r
0820: 78 20 28 72 65 67 65 78 70 20 22 5e 5c 5c 73 2a x (regexp "^\\s*
0830: 23 2e 2a 22 29 29 0a 28 64 65 66 69 6e 65 20 63 #.*")).(define c
0840: 6f 6e 66 69 67 66 3a 63 6f 6e 74 2d 6c 6e 2d 72 onfigf:cont-ln-r
0850: 78 20 28 72 65 67 65 78 70 20 22 5e 28 5c 5c 73 x (regexp "^(\\s
0860: 2b 29 28 5c 5c 53 2b 2e 2a 29 24 22 29 29 0a 0a +)(\\S+.*)$"))..
0870: 3b 3b 20 72 65 61 64 20 61 20 6c 69 6e 65 20 61 ;; read a line a
0880: 6e 64 20 70 72 6f 63 65 73 73 20 61 6e 79 20 23 nd process any #
0890: 7b 20 2e 2e 2e 20 7d 20 63 6f 6e 73 74 72 75 63 { ... } construc
08a0: 74 73 0a 0a 28 64 65 66 69 6e 65 20 63 6f 6e 66 ts..(define conf
08b0: 69 67 66 3a 76 61 72 2d 65 78 70 61 6e 64 2d 72 igf:var-expand-r
08c0: 65 67 65 78 20 28 72 65 67 65 78 70 20 22 5e 28 egex (regexp "^(
08d0: 2e 2a 29 23 5c 5c 7b 28 73 63 68 65 6d 65 7c 73 .*)#\\{(scheme|s
08e0: 79 73 74 65 6d 7c 73 68 65 6c 6c 7c 67 65 74 65 ystem|shell|gete
08f0: 6e 76 7c 67 65 74 7c 72 75 6e 63 6f 6e 66 69 67 nv|get|runconfig
0900: 73 2d 67 65 74 29 5c 5c 73 2b 28 5b 5e 5c 5c 7d s-get)\\s+([^\\}
0910: 5c 5c 7b 5d 2a 29 5c 5c 7d 28 2e 2a 29 22 29 29 \\{]*)\\}(.*)"))
0920: 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 .(define (config
0930: 66 3a 70 72 6f 63 65 73 73 2d 6c 69 6e 65 20 6c f:process-line l
0940: 20 68 74 29 0a 20 20 28 6c 65 74 20 6c 6f 6f 70 ht). (let loop
0950: 20 28 28 72 65 73 20 6c 29 29 0a 20 20 20 20 28 ((res l)). (
0960: 69 66 20 28 73 74 72 69 6e 67 3f 20 72 65 73 29 if (string? res)
0970: 0a 09 28 6c 65 74 20 28 28 6d 61 74 63 68 64 61 ..(let ((matchda
0980: 74 20 28 73 74 72 69 6e 67 2d 73 65 61 72 63 68 t (string-search
0990: 20 63 6f 6e 66 69 67 66 3a 76 61 72 2d 65 78 70 configf:var-exp
09a0: 61 6e 64 2d 72 65 67 65 78 20 72 65 73 29 29 29 and-regex res)))
09b0: 0a 09 20 20 28 69 66 20 6d 61 74 63 68 64 61 74 .. (if matchdat
09c0: 0a 09 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 .. (let* ((
09d0: 70 72 65 73 74 72 20 20 28 6c 69 73 74 2d 72 65 prestr (list-re
09e0: 66 20 6d 61 74 63 68 64 61 74 20 31 29 29 0a 09 f matchdat 1))..
09f0: 09 20 20 20 20 20 28 63 6d 64 74 79 70 65 20 28 . (cmdtype (
0a00: 6c 69 73 74 2d 72 65 66 20 6d 61 74 63 68 64 61 list-ref matchda
0a10: 74 20 32 29 29 20 3b 3b 20 65 76 61 6c 2c 20 73 t 2)) ;; eval, s
0a20: 79 73 74 65 6d 2c 20 73 68 65 6c 6c 2c 20 67 65 ystem, shell, ge
0a30: 74 65 6e 76 0a 09 09 20 20 20 20 20 28 63 6d 64 tenv... (cmd
0a40: 20 20 20 20 20 28 6c 69 73 74 2d 72 65 66 20 6d (list-ref m
0a50: 61 74 63 68 64 61 74 20 33 29 29 0a 09 09 20 20 atchdat 3))...
0a60: 20 20 20 28 70 6f 73 74 73 74 72 20 28 6c 69 73 (poststr (lis
0a70: 74 2d 72 65 66 20 6d 61 74 63 68 64 61 74 20 34 t-ref matchdat 4
0a80: 29 29 0a 09 09 20 20 20 20 20 28 72 65 73 75 6c ))... (resul
0a90: 74 20 20 23 66 29 0a 09 09 20 20 20 20 20 28 66 t #f)... (f
0aa0: 75 6c 6c 63 6d 64 20 28 63 61 73 65 20 28 73 74 ullcmd (case (st
0ab0: 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 63 6d 64 ring->symbol cmd
0ac0: 74 79 70 65 29 0a 09 09 09 09 28 28 73 63 68 65 type).....((sche
0ad0: 6d 65 29 28 63 6f 6e 63 20 22 28 6c 61 6d 62 64 me)(conc "(lambd
0ae0: 61 20 28 68 74 29 22 20 63 6d 64 20 22 29 22 29 a (ht)" cmd ")")
0af0: 29 0a 09 09 09 09 28 28 73 79 73 74 65 6d 29 28 ).....((system)(
0b00: 63 6f 6e 63 20 22 28 6c 61 6d 62 64 61 20 28 68 conc "(lambda (h
0b10: 74 29 28 73 79 73 74 65 6d 20 5c 22 22 20 63 6d t)(system \"" cm
0b20: 64 20 22 5c 22 29 29 22 29 29 0a 09 09 09 09 28 d "\"))")).....(
0b30: 28 73 68 65 6c 6c 29 20 28 63 6f 6e 63 20 22 28 (shell) (conc "(
0b40: 6c 61 6d 62 64 61 20 28 68 74 29 28 73 68 65 6c lambda (ht)(shel
0b50: 6c 20 5c 22 22 20 20 63 6d 64 20 22 5c 22 29 29 l \"" cmd "\"))
0b60: 22 29 29 0a 09 09 09 09 28 28 67 65 74 65 6e 76 ")).....((getenv
0b70: 29 28 63 6f 6e 63 20 22 28 6c 61 6d 62 64 61 20 )(conc "(lambda
0b80: 28 68 74 29 28 67 65 74 2d 65 6e 76 69 72 6f 6e (ht)(get-environ
0b90: 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 5c 22 ment-variable \"
0ba0: 22 20 63 6d 64 20 22 5c 22 29 29 22 29 29 0a 09 " cmd "\"))"))..
0bb0: 09 09 09 28 28 67 65 74 29 20 20 20 0a 09 09 09 ...((get) ....
0bc0: 09 20 28 6c 65 74 2a 20 28 28 70 61 72 74 73 20 . (let* ((parts
0bd0: 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 63 6d (string-split cm
0be0: 64 29 29 0a 09 09 09 09 09 28 73 65 63 74 20 20 d))......(sect
0bf0: 28 63 61 72 20 70 61 72 74 73 29 29 0a 09 09 09 (car parts))....
0c00: 09 09 28 76 61 72 20 20 20 28 63 61 64 72 20 70 ..(var (cadr p
0c10: 61 72 74 73 29 29 29 0a 09 09 09 09 20 20 20 28 arts)))..... (
0c20: 63 6f 6e 63 20 22 28 6c 61 6d 62 64 61 20 28 68 conc "(lambda (h
0c30: 74 29 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 t)(config-lookup
0c40: 20 68 74 20 5c 22 22 20 73 65 63 74 20 22 5c 22 ht \"" sect "\"
0c50: 20 5c 22 22 20 76 61 72 20 22 5c 22 29 29 22 29 \"" var "\"))")
0c60: 29 29 0a 09 09 09 09 28 28 72 75 6e 63 6f 6e 66 )).....((runconf
0c70: 69 67 73 2d 67 65 74 29 20 28 63 6f 6e 63 20 22 igs-get) (conc "
0c80: 28 6c 61 6d 62 64 61 20 28 68 74 29 28 72 75 6e (lambda (ht)(run
0c90: 63 6f 6e 66 69 67 73 2d 67 65 74 20 68 74 20 5c configs-get ht \
0ca0: 22 22 20 63 6d 64 20 22 5c 22 29 29 22 29 29 0a "" cmd "\"))")).
0cb0: 09 09 09 09 28 65 6c 73 65 20 22 28 6c 61 6d 62 ....(else "(lamb
0cc0: 64 61 20 28 68 74 29 28 70 72 69 6e 74 20 5c 22 da (ht)(print \"
0cd0: 45 52 52 4f 52 5c 22 29 20 5c 22 45 52 52 4f 52 ERROR\") \"ERROR
0ce0: 5c 22 29 22 29 29 29 29 0a 09 09 3b 3b 20 28 70 \")"))))...;; (p
0cf0: 72 69 6e 74 20 22 66 75 6c 6c 63 6d 64 3d 22 20 rint "fullcmd="
0d00: 66 75 6c 6c 63 6d 64 29 0a 09 09 28 77 69 74 68 fullcmd)...(with
0d10: 2d 69 6e 70 75 74 2d 66 72 6f 6d 2d 73 74 72 69 -input-from-stri
0d20: 6e 67 20 66 75 6c 6c 63 6d 64 0a 09 09 20 20 28 ng fullcmd... (
0d30: 6c 61 6d 62 64 61 20 28 29 0a 09 09 20 20 20 20 lambda ()...
0d40: 28 73 65 74 21 20 72 65 73 75 6c 74 20 28 28 65 (set! result ((e
0d50: 76 61 6c 20 28 72 65 61 64 29 29 20 68 74 29 29 val (read)) ht))
0d60: 29 29 0a 09 09 28 6c 6f 6f 70 20 28 63 6f 6e 63 ))...(loop (conc
0d70: 20 70 72 65 73 74 72 20 72 65 73 75 6c 74 20 70 prestr result p
0d80: 6f 73 74 73 74 72 29 29 29 0a 09 20 20 20 20 20 oststr)))..
0d90: 20 72 65 73 29 29 0a 09 72 65 73 29 29 29 0a 0a res))..res)))..
0da0: 3b 3b 20 52 75 6e 20 61 20 73 68 65 6c 6c 20 63 ;; Run a shell c
0db0: 6f 6d 6d 61 6e 64 20 61 6e 64 20 72 65 74 75 72 ommand and retur
0dc0: 6e 20 74 68 65 20 6f 75 74 70 75 74 20 61 73 20 n the output as
0dd0: 61 20 73 74 72 69 6e 67 0a 28 64 65 66 69 6e 65 a string.(define
0de0: 20 28 73 68 65 6c 6c 20 63 6d 64 29 0a 20 20 28 (shell cmd). (
0df0: 6c 65 74 2a 20 28 28 6f 75 74 70 75 74 20 28 63 let* ((output (c
0e00: 6d 64 2d 72 75 6e 2d 3e 6c 69 73 74 20 63 6d 64 md-run->list cmd
0e10: 29 29 0a 09 20 28 72 65 73 20 20 20 20 28 63 61 )).. (res (ca
0e20: 72 20 6f 75 74 70 75 74 29 29 0a 09 20 28 73 74 r output)).. (st
0e30: 61 74 75 73 20 28 63 61 64 72 20 6f 75 74 70 75 atus (cadr outpu
0e40: 74 29 29 29 0a 20 20 20 20 28 69 66 20 28 65 71 t))). (if (eq
0e50: 75 61 6c 3f 20 73 74 61 74 75 73 20 30 29 0a 09 ual? status 0)..
0e60: 28 6c 65 74 20 28 28 6f 75 74 72 65 73 20 28 73 (let ((outres (s
0e70: 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 tring-interspers
0e80: 65 20 0a 09 09 20 20 20 20 20 20 20 72 65 73 0a e ... res.
0e90: 09 09 20 20 20 20 20 20 20 22 5c 6e 22 29 29 29 .. "\n")))
0ea0: 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 .. (debug:print
0eb0: 20 34 20 22 49 4e 46 4f 3a 20 73 68 65 6c 6c 20 4 "INFO: shell
0ec0: 72 65 73 75 6c 74 3a 5c 6e 22 20 6f 75 74 72 65 result:\n" outre
0ed0: 73 29 0a 09 20 20 6f 75 74 72 65 73 29 0a 09 28 s).. outres)..(
0ee0: 62 65 67 69 6e 0a 09 20 20 28 77 69 74 68 2d 6f begin.. (with-o
0ef0: 75 74 70 75 74 2d 74 6f 2d 70 6f 72 74 20 28 63 utput-to-port (c
0f00: 75 72 72 65 6e 74 2d 65 72 72 6f 72 2d 70 6f 72 urrent-error-por
0f10: 74 29 0a 09 20 20 20 20 28 70 72 69 6e 74 20 22 t).. (print "
0f20: 45 52 52 4f 52 3a 20 22 20 63 6d 64 20 22 20 72 ERROR: " cmd " r
0f30: 65 74 75 72 6e 65 64 20 62 61 64 20 65 78 69 74 eturned bad exit
0f40: 20 63 6f 64 65 20 22 20 73 74 61 74 75 73 29 29 code " status))
0f50: 0a 09 20 20 22 22 29 29 29 29 0a 0a 3b 3b 20 4c .. ""))))..;; L
0f60: 6f 6f 6b 75 70 20 61 20 76 61 6c 75 65 20 69 6e ookup a value in
0f70: 20 72 75 6e 63 6f 6e 66 69 67 73 20 62 61 73 65 runconfigs base
0f80: 64 20 6f 6e 20 2d 72 65 71 74 61 72 67 20 6f 72 d on -reqtarg or
0f90: 20 2d 74 61 72 67 65 74 0a 28 64 65 66 69 6e 65 -target.(define
0fa0: 20 28 72 75 6e 63 6f 6e 66 69 67 73 2d 67 65 74 (runconfigs-get
0fb0: 20 63 6f 6e 66 69 67 20 76 61 72 29 0a 20 20 28 config var). (
0fc0: 6c 65 74 20 28 28 74 61 72 67 20 28 6f 72 20 28 let ((targ (or (
0fd0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
0fe0: 65 71 74 61 72 67 22 29 28 61 72 67 73 3a 67 65 eqtarg")(args:ge
0ff0: 74 2d 61 72 67 20 22 2d 74 61 72 67 65 74 22 29 t-arg "-target")
1000: 29 29 29 0a 20 20 20 20 28 69 66 20 74 61 72 67 ))). (if targ
1010: 0a 09 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 ..(config-lookup
1020: 20 63 6f 6e 66 69 67 20 74 61 72 67 20 76 61 72 config targ var
1030: 29 0a 09 23 66 29 29 29 0a 0a 28 64 65 66 69 6e )..#f)))..(defin
1040: 65 2d 69 6e 6c 69 6e 65 20 28 63 6f 6e 66 69 67 e-inline (config
1050: 66 3a 72 65 61 64 2d 6c 69 6e 65 20 70 20 68 74 f:read-line p ht
1060: 29 0a 20 20 28 63 6f 6e 66 69 67 66 3a 70 72 6f ). (configf:pro
1070: 63 65 73 73 2d 6c 69 6e 65 20 28 72 65 61 64 2d cess-line (read-
1080: 6c 69 6e 65 20 70 29 20 68 74 29 29 0a 0a 3b 3b line p) ht))..;;
1090: 20 72 65 61 64 20 61 20 63 6f 6e 66 69 67 20 66 read a config f
10a0: 69 6c 65 2c 20 72 65 74 75 72 6e 73 20 68 61 73 ile, returns has
10b0: 68 20 74 61 62 6c 65 20 6f 66 20 61 6c 69 73 74 h table of alist
10c0: 73 0a 0a 3b 3b 20 72 65 61 64 20 61 20 63 6f 6e s..;; read a con
10d0: 66 69 67 20 66 69 6c 65 2c 20 72 65 74 75 72 6e fig file, return
10e0: 73 20 68 61 73 68 20 74 61 62 6c 65 20 6f 66 20 s hash table of
10f0: 61 6c 69 73 74 73 0a 3b 3b 20 61 64 64 73 20 74 alists.;; adds t
1100: 6f 20 68 74 20 69 66 20 67 69 76 65 6e 20 28 6d o ht if given (m
1110: 75 73 74 20 62 65 20 23 66 20 6f 74 68 65 72 77 ust be #f otherw
1120: 69 73 65 29 0a 3b 3b 20 65 6e 76 69 6f 6e 2d 70 ise).;; envion-p
1130: 61 74 74 20 69 73 20 61 20 72 65 67 65 78 20 73 att is a regex s
1140: 70 65 63 20 74 68 61 74 20 69 64 65 6e 74 69 66 pec that identif
1150: 69 65 73 20 73 65 63 74 69 6f 6e 73 20 74 68 61 ies sections tha
1160: 74 20 77 69 6c 6c 20 62 65 20 65 76 61 6c 27 64 t will be eval'd
1170: 0a 3b 3b 20 69 6e 20 74 68 65 20 65 6e 76 69 72 .;; in the envir
1180: 6f 6e 6d 65 6e 74 20 6f 6e 20 74 68 65 20 66 6c onment on the fl
1190: 79 0a 3b 3b 20 73 65 63 74 69 6f 6e 73 3a 20 23 y.;; sections: #
11a0: 66 20 3d 3e 20 67 65 74 20 61 6c 6c 2c 20 65 6c f => get all, el
11b0: 73 65 20 6c 69 73 74 20 6f 66 20 73 65 63 74 69 se list of secti
11c0: 6f 6e 73 20 74 6f 20 67 61 74 68 65 72 0a 28 64 ons to gather.(d
11d0: 65 66 69 6e 65 20 28 72 65 61 64 2d 63 6f 6e 66 efine (read-conf
11e0: 69 67 20 70 61 74 68 20 68 74 20 61 6c 6c 6f 77 ig path ht allow
11f0: 2d 73 79 73 74 65 6d 20 23 21 6b 65 79 20 28 65 -system #!key (e
1200: 6e 76 69 72 6f 6e 2d 70 61 74 74 20 23 66 29 28 nviron-patt #f)(
1210: 63 75 72 72 2d 73 65 63 74 69 6f 6e 20 23 66 29 curr-section #f)
1220: 28 73 65 63 74 69 6f 6e 73 20 23 66 29 29 0a 20 (sections #f)).
1230: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 (debug:print 4
1240: 22 49 4e 46 4f 3a 20 72 65 61 64 2d 63 6f 6e 66 "INFO: read-conf
1250: 69 67 20 22 20 70 61 74 68 20 22 20 61 6c 6c 6f ig " path " allo
1260: 77 2d 73 79 73 74 65 6d 20 22 20 61 6c 6c 6f 77 w-system " allow
1270: 2d 73 79 73 74 65 6d 20 22 20 65 6e 76 69 72 6f -system " enviro
1280: 6e 2d 70 61 74 74 20 22 20 65 6e 76 69 72 6f 6e n-patt " environ
1290: 2d 70 61 74 74 20 22 20 63 75 72 72 2d 73 65 63 -patt " curr-sec
12a0: 74 69 6f 6e 3a 20 22 20 63 75 72 72 2d 73 65 63 tion: " curr-sec
12b0: 74 69 6f 6e 20 22 20 73 65 63 74 69 6f 6e 73 3a tion " sections:
12c0: 20 22 20 73 65 63 74 69 6f 6e 73 29 0a 20 20 28 " sections). (
12d0: 69 66 20 28 6e 6f 74 20 28 66 69 6c 65 2d 65 78 if (not (file-ex
12e0: 69 73 74 73 3f 20 70 61 74 68 29 29 0a 20 20 20 ists? path)).
12f0: 20 20 20 28 62 65 67 69 6e 20 0a 09 28 64 65 62 (begin ..(deb
1300: 75 67 3a 70 72 69 6e 74 20 34 20 22 49 4e 46 4f ug:print 4 "INFO
1310: 3a 20 72 65 61 64 2d 63 6f 6e 66 69 67 20 2d 20 : read-config -
1320: 66 69 6c 65 20 6e 6f 74 20 66 6f 75 6e 64 20 22 file not found "
1330: 20 70 61 74 68 20 22 20 63 75 72 72 65 6e 74 20 path " current
1340: 70 61 74 68 3a 20 22 20 28 63 75 72 72 65 6e 74 path: " (current
1350: 2d 64 69 72 65 63 74 6f 72 79 29 29 0a 09 28 69 -directory))..(i
1360: 66 20 28 6e 6f 74 20 68 74 29 28 6d 61 6b 65 2d f (not ht)(make-
1370: 68 61 73 68 2d 74 61 62 6c 65 29 20 68 74 29 29 hash-table) ht))
1380: 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 69 6e . (let ((in
1390: 70 20 20 20 20 20 20 20 20 28 6f 70 65 6e 2d 69 p (open-i
13a0: 6e 70 75 74 2d 66 69 6c 65 20 70 61 74 68 29 29 nput-file path))
13b0: 0a 09 20 20 20 20 28 72 65 73 20 20 20 20 20 20 .. (res
13c0: 20 20 28 69 66 20 28 6e 6f 74 20 68 74 29 28 6d (if (not ht)(m
13d0: 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 20 ake-hash-table)
13e0: 68 74 29 29 29 0a 09 28 6c 65 74 20 6c 6f 6f 70 ht)))..(let loop
13f0: 20 28 28 69 6e 6c 20 20 20 20 20 20 20 20 20 20 ((inl
1400: 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 72 65 (configf:re
1410: 61 64 2d 6c 69 6e 65 20 69 6e 70 20 72 65 73 29 ad-line inp res)
1420: 29 20 3b 3b 20 28 72 65 61 64 2d 6c 69 6e 65 20 ) ;; (read-line
1430: 69 6e 70 29 29 0a 09 09 20 20 20 28 63 75 72 72 inp))... (curr
1440: 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 28 69 -section-name (i
1450: 66 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 20 63 f curr-section c
1460: 75 72 72 2d 73 65 63 74 69 6f 6e 20 22 64 65 66 urr-section "def
1470: 61 75 6c 74 22 29 29 0a 09 09 20 20 20 28 76 61 ault"))... (va
1480: 72 2d 66 6c 61 67 20 23 66 29 3b 3b 20 74 75 72 r-flag #f);; tur
1490: 6e 20 6f 6e 20 66 6f 72 20 6b 65 79 2d 76 61 72 n on for key-var
14a0: 2d 70 72 20 61 6e 64 20 63 6f 6e 74 2d 6c 6e 2d -pr and cont-ln-
14b0: 72 78 2c 20 74 75 72 6e 20 6f 66 66 20 65 6c 73 rx, turn off els
14c0: 65 77 68 65 72 65 0a 09 09 20 20 20 28 6c 65 61 ewhere... (lea
14d0: 64 20 20 20 20 20 23 66 29 29 0a 09 20 20 28 69 d #f)).. (i
14e0: 66 20 28 65 6f 66 2d 6f 62 6a 65 63 74 3f 20 69 f (eof-object? i
14f0: 6e 6c 29 20 0a 09 20 20 20 20 20 20 28 62 65 67 nl) .. (beg
1500: 69 6e 0a 09 09 28 63 6c 6f 73 65 2d 69 6e 70 75 in...(close-inpu
1510: 74 2d 70 6f 72 74 20 69 6e 70 29 0a 09 09 28 68 t-port inp)...(h
1520: 61 73 68 2d 74 61 62 6c 65 2d 64 65 6c 65 74 65 ash-table-delete
1530: 21 20 72 65 73 20 22 22 29 20 3b 3b 20 77 65 20 ! res "") ;; we
1540: 61 72 65 20 75 73 69 6e 67 20 22 22 20 61 73 20 are using "" as
1550: 61 20 64 75 6d 70 69 6e 67 20 67 72 6f 75 6e 64 a dumping ground
1560: 20 61 6e 64 20 6d 75 73 74 20 72 65 6d 6f 76 65 and must remove
1570: 20 69 74 20 62 65 66 6f 72 65 20 72 65 74 75 72 it before retur
1580: 6e 69 6e 67 20 74 68 65 20 68 74 0a 09 09 72 65 ning the ht...re
1590: 73 29 0a 09 20 20 20 20 20 20 28 72 65 67 65 78 s).. (regex
15a0: 2d 63 61 73 65 20 0a 09 20 20 20 20 20 20 20 69 -case .. i
15b0: 6e 6c 20 0a 09 20 20 20 20 20 20 20 28 63 6f 6e nl .. (con
15c0: 66 69 67 66 3a 63 6f 6d 6d 65 6e 74 2d 72 78 20 figf:comment-rx
15d0: 5f 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 _
15e0: 20 20 20 28 6c 6f 6f 70 20 28 63 6f 6e 66 69 67 (loop (config
15f0: 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 20 f:read-line inp
1600: 72 65 73 29 20 63 75 72 72 2d 73 65 63 74 69 6f res) curr-sectio
1610: 6e 2d 6e 61 6d 65 20 23 66 20 23 66 29 29 0a 09 n-name #f #f))..
1620: 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a (configf:
1630: 62 6c 61 6e 6b 2d 6c 2d 72 78 20 5f 20 20 20 20 blank-l-rx _
1640: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
1650: 6f 6f 70 20 28 63 6f 6e 66 69 67 66 3a 72 65 61 oop (configf:rea
1660: 64 2d 6c 69 6e 65 20 69 6e 70 20 72 65 73 29 20 d-line inp res)
1670: 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d curr-section-nam
1680: 65 20 23 66 20 23 66 29 29 0a 09 20 20 20 20 20 e #f #f))..
1690: 20 20 28 63 6f 6e 66 69 67 66 3a 69 6e 63 6c 75 (configf:inclu
16a0: 64 65 2d 72 78 20 28 20 78 20 69 6e 63 6c 75 64 de-rx ( x includ
16b0: 65 2d 66 69 6c 65 20 29 20 28 6c 65 74 20 28 28 e-file ) (let ((
16c0: 63 75 72 72 2d 64 69 72 20 28 63 75 72 72 65 6e curr-dir (curren
16d0: 74 2d 64 69 72 65 63 74 6f 72 79 29 29 0a 09 09 t-directory))...
16e0: 09 09 09 09 09 20 20 20 20 28 63 6f 6e 66 2d 64 ..... (conf-d
16f0: 69 72 20 20 28 70 61 74 68 6e 61 6d 65 2d 64 69 ir (pathname-di
1700: 72 65 63 74 6f 72 79 20 70 61 74 68 29 29 29 0a rectory path))).
1710: 09 09 09 09 09 09 09 28 69 66 20 63 6f 6e 66 2d .......(if conf-
1720: 64 69 72 20 28 63 68 61 6e 67 65 2d 64 69 72 65 dir (change-dire
1730: 63 74 6f 72 79 20 63 6f 6e 66 2d 64 69 72 29 29 ctory conf-dir))
1740: 0a 09 09 09 09 09 09 09 28 72 65 61 64 2d 63 6f ........(read-co
1750: 6e 66 69 67 20 69 6e 63 6c 75 64 65 2d 66 69 6c nfig include-fil
1760: 65 20 72 65 73 20 61 6c 6c 6f 77 2d 73 79 73 74 e res allow-syst
1770: 65 6d 20 65 6e 76 69 72 6f 6e 2d 70 61 74 74 3a em environ-patt:
1780: 20 65 6e 76 69 72 6f 6e 2d 70 61 74 74 20 63 75 environ-patt cu
1790: 72 72 2d 73 65 63 74 69 6f 6e 3a 20 63 75 72 72 rr-section: curr
17a0: 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 29 0a 09 -section-name)..
17b0: 09 09 09 09 09 09 28 63 68 61 6e 67 65 2d 64 69 ......(change-di
17c0: 72 65 63 74 6f 72 79 20 63 75 72 72 2d 64 69 72 rectory curr-dir
17d0: 29 0a 09 09 09 09 09 09 09 28 6c 6f 6f 70 20 28 )........(loop (
17e0: 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d 6c 69 6e configf:read-lin
17f0: 65 20 69 6e 70 20 72 65 73 29 20 63 75 72 72 2d e inp res) curr-
1800: 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 section-name #f
1810: 23 66 29 29 29 0a 09 20 20 20 20 20 20 20 28 63 #f))).. (c
1820: 6f 6e 66 69 67 66 3a 73 65 63 74 69 6f 6e 2d 72 onfigf:section-r
1830: 78 20 28 20 78 20 73 65 63 74 69 6f 6e 2d 6e 61 x ( x section-na
1840: 6d 65 20 29 20 28 6c 6f 6f 70 20 28 63 6f 6e 66 me ) (loop (conf
1850: 69 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e igf:read-line in
1860: 70 20 72 65 73 29 0a 09 09 09 09 09 09 09 20 20 p res)........
1870: 20 20 3b 3b 20 69 66 20 77 65 20 68 61 76 65 20 ;; if we have
1880: 74 68 65 20 73 65 63 74 69 6f 6e 73 20 6c 69 73 the sections lis
1890: 74 20 74 68 65 6e 20 66 6f 72 63 65 20 61 6c 6c t then force all
18a0: 20 73 65 74 74 69 6e 67 73 20 69 6e 74 6f 20 22 settings into "
18b0: 22 20 61 6e 64 20 64 65 6c 65 74 65 20 69 74 20 " and delete it
18c0: 6c 61 74 65 72 3f 0a 09 09 09 09 09 09 09 20 20 later?........
18d0: 20 20 28 69 66 20 28 6f 72 20 28 6e 6f 74 20 73 (if (or (not s
18e0: 65 63 74 69 6f 6e 73 29 20 0a 09 09 09 09 09 09 ections) .......
18f0: 09 09 20 20 20 20 28 6d 65 6d 62 65 72 20 73 65 .. (member se
1900: 63 74 69 6f 6e 2d 6e 61 6d 65 20 73 65 63 74 69 ction-name secti
1910: 6f 6e 73 29 29 0a 09 09 09 09 09 09 09 09 73 65 ons)).........se
1920: 63 74 69 6f 6e 2d 6e 61 6d 65 20 22 22 29 20 3b ction-name "") ;
1930: 3b 20 73 74 69 63 6b 20 65 76 65 72 79 74 68 69 ; stick everythi
1940: 6e 67 20 69 6e 74 6f 20 22 22 0a 09 09 09 09 09 ng into ""......
1950: 09 09 20 20 20 20 23 66 20 23 66 29 29 0a 09 20 .. #f #f))..
1960: 20 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 6b (configf:k
1970: 65 79 2d 73 79 73 2d 70 72 20 28 20 78 20 6b 65 ey-sys-pr ( x ke
1980: 79 20 63 6d 64 20 20 20 20 20 20 29 20 28 69 66 y cmd ) (if
1990: 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 0a 09 09 allow-system...
19a0: 09 09 09 09 09 20 20 28 6c 65 74 20 28 28 61 6c ..... (let ((al
19b0: 69 73 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d ist (hash-table-
19c0: 72 65 66 2f 64 65 66 61 75 6c 74 20 72 65 73 20 ref/default res
19d0: 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d curr-section-nam
19e0: 65 20 27 28 29 29 29 0a 09 09 09 09 09 09 09 09 e '())).........
19f0: 28 76 61 6c 2d 70 72 6f 63 20 28 6c 61 6d 62 64 (val-proc (lambd
1a00: 61 20 28 29 0a 09 09 09 09 09 09 09 09 09 20 20 a ()..........
1a10: 20 20 28 6c 65 74 2a 20 28 28 63 6d 64 72 65 73 (let* ((cmdres
1a20: 20 20 28 63 6d 64 2d 72 75 6e 2d 3e 6c 69 73 74 (cmd-run->list
1a30: 20 63 6d 64 29 29 0a 09 09 09 09 09 09 09 09 09 cmd))..........
1a40: 09 20 20 20 28 73 74 61 74 75 73 20 20 28 63 61 . (status (ca
1a50: 64 72 20 63 6d 64 72 65 73 29 29 0a 09 09 09 09 dr cmdres)).....
1a60: 09 09 09 09 09 09 20 20 20 28 72 65 73 20 20 20 ...... (res
1a70: 20 20 28 63 61 72 20 20 63 6d 64 72 65 73 29 29 (car cmdres))
1a80: 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 20 )..........
1a90: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 (debug:print 4
1aa0: 22 49 4e 46 4f 3a 20 22 20 69 6e 6c 20 22 5c 6e "INFO: " inl "\n
1ab0: 20 3d 3e 20 22 20 28 73 74 72 69 6e 67 2d 69 6e => " (string-in
1ac0: 74 65 72 73 70 65 72 73 65 20 72 65 73 20 22 5c tersperse res "\
1ad0: 6e 22 29 29 0a 09 09 09 09 09 09 09 09 09 20 20 n"))..........
1ae0: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 65 71 (if (not (eq
1af0: 3f 20 73 74 61 74 75 73 20 30 29 29 0a 09 09 09 ? status 0))....
1b00: 09 09 09 09 09 09 09 20 20 28 62 65 67 69 6e 0a ....... (begin.
1b10: 09 09 09 09 09 09 09 09 09 09 20 20 20 20 28 64 .......... (d
1b20: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 ebug:print 0 "ER
1b30: 52 4f 52 3a 20 70 72 6f 62 6c 65 6d 20 77 69 74 ROR: problem wit
1b40: 68 20 22 20 69 6e 6c 20 22 2c 20 72 65 74 75 72 h " inl ", retur
1b50: 6e 20 63 6f 64 65 20 22 20 73 74 61 74 75 73 0a n code " status.
1b60: 09 09 09 09 09 09 09 09 09 09 09 09 20 22 20 6f ............ " o
1b70: 75 74 70 75 74 3a 20 22 20 63 6d 64 72 65 73 29 utput: " cmdres)
1b80: 0a 09 09 09 09 09 09 09 09 09 09 20 20 20 20 28 ........... (
1b90: 65 78 69 74 20 31 29 29 29 0a 09 09 09 09 09 09 exit 1))).......
1ba0: 09 09 09 20 20 20 20 20 20 28 69 66 20 28 6e 75 ... (if (nu
1bb0: 6c 6c 3f 20 72 65 73 29 0a 09 09 09 09 09 09 09 ll? res)........
1bc0: 09 09 09 20 20 22 22 0a 09 09 09 09 09 09 09 09 ... "".........
1bd0: 09 09 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 .. (string-inte
1be0: 72 73 70 65 72 73 65 20 72 65 73 20 22 20 22 29 rsperse res " ")
1bf0: 29 29 29 29 29 0a 09 09 09 09 09 09 09 20 20 20 )))))........
1c00: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 (hash-table-set
1c10: 21 20 72 65 73 20 63 75 72 72 2d 73 65 63 74 69 ! res curr-secti
1c20: 6f 6e 2d 6e 61 6d 65 20 0a 09 09 09 09 09 09 09 on-name ........
1c30: 09 09 20 20 20 20 20 28 63 6f 6e 66 69 67 3a 61 .. (config:a
1c40: 73 73 6f 63 2d 73 61 66 65 2d 61 64 64 20 61 6c ssoc-safe-add al
1c50: 69 73 74 0a 09 09 09 09 09 09 09 09 09 09 09 09 ist.............
1c60: 20 20 20 20 6b 65 79 20 0a 09 09 09 09 09 09 09 key ........
1c70: 09 09 09 09 09 20 20 20 20 28 63 61 73 65 20 61 ..... (case a
1c80: 6c 6c 6f 77 2d 73 79 73 74 65 6d 0a 09 09 09 09 llow-system.....
1c90: 09 09 09 09 09 09 09 09 20 20 20 20 20 20 28 28 ........ ((
1ca0: 72 65 74 75 72 6e 2d 70 72 6f 63 73 29 20 76 61 return-procs) va
1cb0: 6c 2d 70 72 6f 63 29 0a 09 09 09 09 09 09 09 09 l-proc).........
1cc0: 09 09 09 09 20 20 20 20 20 20 28 28 72 65 74 75 .... ((retu
1cd0: 72 6e 2d 73 74 72 69 6e 67 29 20 63 6d 64 29 0a rn-string) cmd).
1ce0: 09 09 09 09 09 09 09 09 09 09 09 09 20 20 20 20 ............
1cf0: 20 20 28 65 6c 73 65 20 28 76 61 6c 2d 70 72 6f (else (val-pro
1d00: 63 29 29 29 29 29 0a 09 09 09 09 09 09 09 20 20 c)))))........
1d10: 20 20 28 6c 6f 6f 70 20 28 63 6f 6e 66 69 67 66 (loop (configf
1d20: 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 20 72 :read-line inp r
1d30: 65 73 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e es) curr-section
1d40: 2d 6e 61 6d 65 20 23 66 20 23 66 29 29 0a 09 09 -name #f #f))...
1d50: 09 09 09 09 09 20 20 28 6c 6f 6f 70 20 28 63 6f ..... (loop (co
1d60: 6e 66 69 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 nfigf:read-line
1d70: 69 6e 70 20 72 65 73 29 20 63 75 72 72 2d 73 65 inp res) curr-se
1d80: 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 66 ction-name #f #f
1d90: 29 29 29 0a 09 20 20 20 20 20 20 20 28 63 6f 6e ))).. (con
1da0: 66 69 67 66 3a 6b 65 79 2d 76 61 6c 2d 70 72 20 figf:key-val-pr
1db0: 28 20 78 20 6b 65 79 20 76 61 6c 20 20 20 20 20 ( x key val
1dc0: 20 29 20 28 6c 65 74 2a 20 28 28 61 6c 69 73 74 ) (let* ((alist
1dd0: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 (hash-table-r
1de0: 65 66 2f 64 65 66 61 75 6c 74 20 72 65 73 20 63 ef/default res c
1df0: 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 urr-section-name
1e00: 20 27 28 29 29 29 0a 09 09 09 09 09 09 09 20 20 '()))........
1e10: 20 20 20 28 65 6e 76 61 72 20 20 20 28 61 6e 64 (envar (and
1e20: 20 65 6e 76 69 72 6f 6e 2d 70 61 74 74 20 28 73 environ-patt (s
1e30: 74 72 69 6e 67 2d 73 65 61 72 63 68 20 28 72 65 tring-search (re
1e40: 67 65 78 70 20 65 6e 76 69 72 6f 6e 2d 70 61 74 gexp environ-pat
1e50: 74 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d t) curr-section-
1e60: 6e 61 6d 65 29 29 29 0a 09 09 09 09 09 09 09 20 name)))........
1e70: 20 20 20 20 28 72 65 61 6c 76 61 6c 20 28 69 66 (realval (if
1e80: 20 65 6e 76 61 72 0a 09 09 09 09 09 09 09 09 09 envar..........
1e90: 20 20 28 63 6f 6e 66 69 67 3a 65 76 61 6c 2d 73 (config:eval-s
1ea0: 74 72 69 6e 67 2d 69 6e 2d 65 6e 76 69 72 6f 6e tring-in-environ
1eb0: 6d 65 6e 74 20 76 61 6c 29 0a 09 09 09 09 09 09 ment val).......
1ec0: 09 09 09 20 20 76 61 6c 29 29 29 0a 09 09 09 09 ... val))).....
1ed0: 09 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 ...(debug:print
1ee0: 36 20 22 49 4e 46 4f 3a 20 72 65 61 64 2d 63 6f 6 "INFO: read-co
1ef0: 6e 66 69 67 20 65 6e 76 20 73 65 74 74 69 6e 67 nfig env setting
1f00: 2c 20 65 6e 76 61 72 3a 20 22 20 65 6e 76 61 72 , envar: " envar
1f10: 20 22 20 72 65 61 6c 76 61 6c 3a 20 22 20 72 65 " realval: " re
1f20: 61 6c 76 61 6c 20 22 20 76 61 6c 3a 20 22 20 76 alval " val: " v
1f30: 61 6c 20 22 20 6b 65 79 3a 20 22 20 6b 65 79 20 al " key: " key
1f40: 22 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e " curr-section-n
1f50: 61 6d 65 3a 20 22 20 63 75 72 72 2d 73 65 63 74 ame: " curr-sect
1f60: 69 6f 6e 2d 6e 61 6d 65 29 0a 09 09 09 09 09 09 ion-name).......
1f70: 09 28 69 66 20 65 6e 76 61 72 0a 09 09 09 09 09 .(if envar......
1f80: 09 09 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 .. (begin....
1f90: 09 09 09 09 20 20 20 20 20 20 3b 3b 20 28 64 65 .... ;; (de
1fa0: 62 75 67 3a 70 72 69 6e 74 20 34 20 22 49 4e 46 bug:print 4 "INF
1fb0: 4f 3a 20 72 65 61 64 2d 63 6f 6e 66 69 67 20 6b O: read-config k
1fc0: 65 79 3d 22 20 6b 65 79 20 22 2c 20 76 61 6c 3d ey=" key ", val=
1fd0: 22 20 76 61 6c 20 22 2c 20 72 65 61 6c 76 61 6c " val ", realval
1fe0: 3d 22 20 72 65 61 6c 76 61 6c 29 0a 09 09 09 09 =" realval).....
1ff0: 09 09 09 20 20 20 20 20 20 28 73 65 74 65 6e 76 ... (setenv
2000: 20 6b 65 79 20 72 65 61 6c 76 61 6c 29 29 29 0a key realval))).
2010: 09 09 09 09 09 09 09 28 68 61 73 68 2d 74 61 62 .......(hash-tab
2020: 6c 65 2d 73 65 74 21 20 72 65 73 20 63 75 72 72 le-set! res curr
2030: 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 0a 09 -section-name ..
2040: 09 09 09 09 09 09 09 09 20 28 63 6f 6e 66 69 67 ........ (config
2050: 3a 61 73 73 6f 63 2d 73 61 66 65 2d 61 64 64 20 :assoc-safe-add
2060: 61 6c 69 73 74 20 6b 65 79 20 72 65 61 6c 76 61 alist key realva
2070: 6c 29 29 0a 09 09 09 09 09 09 09 28 6c 6f 6f 70 l))........(loop
2080: 20 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d 6c (configf:read-l
2090: 69 6e 65 20 69 6e 70 20 72 65 73 29 20 63 75 72 ine inp res) cur
20a0: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 6b r-section-name k
20b0: 65 79 20 23 66 29 29 29 0a 09 20 20 20 20 20 20 ey #f)))..
20c0: 20 3b 3b 20 69 66 20 61 20 63 6f 6e 74 69 6e 75 ;; if a continu
20d0: 65 64 20 6c 69 6e 65 0a 09 20 20 20 20 20 20 20 ed line..
20e0: 28 63 6f 6e 66 69 67 66 3a 63 6f 6e 74 2d 6c 6e (configf:cont-ln
20f0: 2d 72 78 20 28 20 78 20 77 68 73 70 20 76 61 6c -rx ( x whsp val
2100: 20 20 20 20 20 29 20 28 6c 65 74 20 28 28 61 6c ) (let ((al
2110: 69 73 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d ist (hash-table-
2120: 72 65 66 2f 64 65 66 61 75 6c 74 20 72 65 73 20 ref/default res
2130: 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d curr-section-nam
2140: 65 20 27 28 29 29 29 29 0a 09 09 09 09 09 09 28 e '()))).......(
2150: 69 66 20 76 61 72 2d 66 6c 61 67 20 20 20 20 20 if var-flag
2160: 20 20 20 20 20 20 20 20 3b 3b 20 69 66 20 73 65 ;; if se
2170: 74 20 74 6f 20 61 20 73 74 72 69 6e 67 20 74 68 t to a string th
2180: 65 6e 20 77 65 20 68 61 76 65 20 61 20 63 6f 6e en we have a con
2190: 74 69 6e 75 65 64 20 76 61 72 0a 09 09 09 09 09 tinued var......
21a0: 09 20 20 20 20 28 6c 65 74 20 28 28 6e 65 77 76 . (let ((newv
21b0: 61 6c 20 28 63 6f 6e 63 20 0a 09 09 09 09 09 09 al (conc .......
21c0: 09 09 20 20 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f .. (config-loo
21d0: 6b 75 70 20 72 65 73 20 63 75 72 72 2d 73 65 63 kup res curr-sec
21e0: 74 69 6f 6e 2d 6e 61 6d 65 20 76 61 72 2d 66 6c tion-name var-fl
21f0: 61 67 29 20 22 5c 6e 22 0a 09 09 09 09 09 09 09 ag) "\n"........
2200: 09 20 20 20 3b 3b 20 74 72 69 6d 20 6c 65 61 64 . ;; trim lead
2210: 20 66 72 6f 6d 20 74 68 65 20 69 6e 63 6f 6d 69 from the incomi
2220: 6e 67 20 77 68 73 70 20 74 6f 20 73 75 70 70 6f ng whsp to suppo
2230: 72 74 20 73 6f 6d 65 20 69 6e 64 65 6e 74 69 6e rt some indentin
2240: 67 2e 0a 09 09 09 09 09 09 09 09 20 20 20 28 69 g.......... (i
2250: 66 20 6c 65 61 64 0a 09 09 09 09 09 09 09 09 20 f lead.........
2260: 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d 73 75 (string-su
2270: 62 73 74 69 74 75 74 65 20 28 72 65 67 65 78 70 bstitute (regexp
2280: 20 6c 65 61 64 29 20 22 22 20 77 68 73 70 29 0a lead) "" whsp).
2290: 09 09 09 09 09 09 09 09 20 20 20 20 20 20 20 22 ........ "
22a0: 22 29 0a 09 09 09 09 09 09 09 09 20 20 20 76 61 ")......... va
22b0: 6c 29 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 l))).......
22c0: 20 3b 3b 20 28 70 72 69 6e 74 20 22 76 61 6c 3a ;; (print "val:
22d0: 20 22 20 76 61 6c 20 22 5c 6e 6e 65 77 76 61 6c " val "\nnewval
22e0: 3a 20 5c 22 22 20 6e 65 77 76 61 6c 20 22 5c 22 : \"" newval "\"
22f0: 5c 6e 76 61 72 66 6c 61 67 3a 20 22 20 76 61 72 \nvarflag: " var
2300: 2d 66 6c 61 67 29 0a 09 09 09 09 09 09 20 20 20 -flag).......
2310: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 (hash-table-s
2320: 65 74 21 20 72 65 73 20 63 75 72 72 2d 73 65 63 et! res curr-sec
2330: 74 69 6f 6e 2d 6e 61 6d 65 20 0a 09 09 09 09 09 tion-name ......
2340: 09 09 09 20 20 20 20 20 20 20 28 63 6f 6e 66 69 ... (confi
2350: 67 3a 61 73 73 6f 63 2d 73 61 66 65 2d 61 64 64 g:assoc-safe-add
2360: 20 61 6c 69 73 74 20 76 61 72 2d 66 6c 61 67 20 alist var-flag
2370: 6e 65 77 76 61 6c 29 29 0a 09 09 09 09 09 09 20 newval)).......
2380: 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 6f 6e 66 (loop (conf
2390: 69 67 66 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e igf:read-line in
23a0: 70 20 72 65 73 29 20 63 75 72 72 2d 73 65 63 74 p res) curr-sect
23b0: 69 6f 6e 2d 6e 61 6d 65 20 76 61 72 2d 66 6c 61 ion-name var-fla
23c0: 67 20 28 69 66 20 6c 65 61 64 20 6c 65 61 64 20 g (if lead lead
23d0: 77 68 73 70 29 29 29 0a 09 09 09 09 09 09 20 20 whsp))).......
23e0: 20 20 28 6c 6f 6f 70 20 28 63 6f 6e 66 69 67 66 (loop (configf
23f0: 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 20 72 :read-line inp r
2400: 65 73 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e es) curr-section
2410: 2d 6e 61 6d 65 20 23 66 20 23 66 29 29 29 29 0a -name #f #f)))).
2420: 09 20 20 20 20 20 20 20 28 65 6c 73 65 20 28 64 . (else (d
2430: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 ebug:print 0 "ER
2440: 52 4f 52 3a 20 70 72 6f 62 6c 65 6d 20 70 61 72 ROR: problem par
2450: 73 69 6e 67 20 22 20 70 61 74 68 20 22 2c 5c 6e sing " path ",\n
2460: 20 20 20 5c 22 22 20 69 6e 6c 20 22 5c 22 22 29 \"" inl "\"")
2470: 0a 09 09 20 20 20 20 20 28 73 65 74 21 20 76 61 ... (set! va
2480: 72 2d 66 6c 61 67 20 23 66 29 0a 09 09 20 20 20 r-flag #f)...
2490: 20 20 28 6c 6f 6f 70 20 28 63 6f 6e 66 69 67 66 (loop (configf
24a0: 3a 72 65 61 64 2d 6c 69 6e 65 20 69 6e 70 20 72 :read-line inp r
24b0: 65 73 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e es) curr-section
24c0: 2d 6e 61 6d 65 20 23 66 20 23 66 29 29 29 29 29 -name #f #f)))))
24d0: 29 29 29 0a 20 20 0a 28 64 65 66 69 6e 65 20 28 ))). .(define (
24e0: 66 69 6e 64 2d 61 6e 64 2d 72 65 61 64 2d 63 6f find-and-read-co
24f0: 6e 66 69 67 20 66 6e 61 6d 65 20 23 21 6b 65 79 nfig fname #!key
2500: 20 28 65 6e 76 69 72 6f 6e 2d 70 61 74 74 20 23 (environ-patt #
2510: 66 29 29 0a 20 20 28 6c 65 74 2a 20 28 28 63 75 f)). (let* ((cu
2520: 72 72 2d 64 69 72 20 20 20 28 63 75 72 72 65 6e rr-dir (curren
2530: 74 2d 64 69 72 65 63 74 6f 72 79 29 29 0a 20 20 t-directory)).
2540: 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 69 6e (configin
2550: 66 6f 20 28 66 69 6e 64 2d 63 6f 6e 66 69 67 20 fo (find-config
2560: 66 6e 61 6d 65 29 29 0a 09 20 28 74 6f 70 70 61 fname)).. (toppa
2570: 74 68 20 20 20 20 28 63 61 72 20 63 6f 6e 66 69 th (car confi
2580: 67 69 6e 66 6f 29 29 0a 09 20 28 63 6f 6e 66 69 ginfo)).. (confi
2590: 67 66 69 6c 65 20 28 63 61 64 72 20 63 6f 6e 66 gfile (cadr conf
25a0: 69 67 69 6e 66 6f 29 29 29 0a 20 20 20 20 28 69 iginfo))). (i
25b0: 66 20 74 6f 70 70 61 74 68 20 28 63 68 61 6e 67 f toppath (chang
25c0: 65 2d 64 69 72 65 63 74 6f 72 79 20 74 6f 70 70 e-directory topp
25d0: 61 74 68 29 29 20 0a 20 20 20 20 28 6c 65 74 20 ath)) . (let
25e0: 28 28 63 6f 6e 66 69 67 64 61 74 20 20 28 69 66 ((configdat (if
25f0: 20 63 6f 6e 66 69 67 66 69 6c 65 20 28 72 65 61 configfile (rea
2600: 64 2d 63 6f 6e 66 69 67 20 63 6f 6e 66 69 67 66 d-config configf
2610: 69 6c 65 20 23 66 20 23 74 20 65 6e 76 69 72 6f ile #f #t enviro
2620: 6e 2d 70 61 74 74 3a 20 65 6e 76 69 72 6f 6e 2d n-patt: environ-
2630: 70 61 74 74 29 20 23 66 29 29 29 20 3b 3b 20 28 patt) #f))) ;; (
2640: 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 make-hash-table)
2650: 29 29 29 0a 20 20 20 20 20 20 28 69 66 20 74 6f ))). (if to
2660: 70 70 61 74 68 20 28 63 68 61 6e 67 65 2d 64 69 ppath (change-di
2670: 72 65 63 74 6f 72 79 20 63 75 72 72 2d 64 69 72 rectory curr-dir
2680: 29 29 0a 20 20 20 20 20 20 28 6c 69 73 74 20 63 )). (list c
2690: 6f 6e 66 69 67 64 61 74 20 74 6f 70 70 61 74 68 onfigdat toppath
26a0: 20 63 6f 6e 66 69 67 66 69 6c 65 20 66 6e 61 6d configfile fnam
26b0: 65 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 e))))..(define (
26c0: 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 63 66 config-lookup cf
26d0: 67 64 61 74 20 73 65 63 74 69 6f 6e 20 76 61 72 gdat section var
26e0: 29 0a 20 20 28 6c 65 74 20 28 28 73 65 63 74 64 ). (let ((sectd
26f0: 61 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 at (hash-table-r
2700: 65 66 2f 64 65 66 61 75 6c 74 20 63 66 67 64 61 ef/default cfgda
2710: 74 20 73 65 63 74 69 6f 6e 20 27 28 29 29 29 29 t section '())))
2720: 0a 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 . (if (null?
2730: 73 65 63 74 64 61 74 29 0a 09 23 66 0a 09 28 6c sectdat)..#f..(l
2740: 65 74 20 28 28 6d 61 74 63 68 20 28 61 73 73 6f et ((match (asso
2750: 63 20 76 61 72 20 73 65 63 74 64 61 74 29 29 29 c var sectdat)))
2760: 0a 09 20 20 28 69 66 20 6d 61 74 63 68 20 3b 3b .. (if match ;;
2770: 20 28 61 6e 64 20 6d 61 74 63 68 20 28 6c 69 73 (and match (lis
2780: 74 3f 20 6d 61 74 63 68 29 28 3e 20 28 6c 65 6e t? match)(> (len
2790: 67 74 68 20 6d 61 74 63 68 29 20 31 29 29 0a 09 gth match) 1))..
27a0: 20 20 20 20 20 20 28 63 61 64 72 20 6d 61 74 63 (cadr matc
27b0: 68 29 0a 09 20 20 20 20 20 20 23 66 29 29 0a 09 h).. #f))..
27c0: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f )))..(define (co
27d0: 6e 66 69 67 66 3a 73 65 63 74 69 6f 6e 2d 76 61 nfigf:section-va
27e0: 72 73 20 63 66 67 64 61 74 20 73 65 63 74 69 6f rs cfgdat sectio
27f0: 6e 29 0a 20 20 28 6c 65 74 20 28 28 73 65 63 74 n). (let ((sect
2800: 64 61 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d dat (hash-table-
2810: 72 65 66 2f 64 65 66 61 75 6c 74 20 63 66 67 64 ref/default cfgd
2820: 61 74 20 73 65 63 74 69 6f 6e 20 27 28 29 29 29 at section '()))
2830: 29 0a 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f ). (if (null?
2840: 20 73 65 63 74 64 61 74 29 0a 09 27 28 29 0a 09 sectdat)..'()..
2850: 28 6d 61 70 20 63 61 72 20 73 65 63 74 64 61 74 (map car sectdat
2860: 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 73 ))))..(define (s
2870: 65 74 75 70 29 0a 20 20 28 6c 65 74 2a 20 28 28 etup). (let* ((
2880: 63 6f 6e 66 69 67 66 20 28 66 69 6e 64 2d 63 6f configf (find-co
2890: 6e 66 69 67 29 29 0a 09 20 28 63 6f 6e 66 69 67 nfig)).. (config
28a0: 20 20 28 69 66 20 63 6f 6e 66 69 67 66 20 28 72 (if configf (r
28b0: 65 61 64 2d 63 6f 6e 66 69 67 20 63 6f 6e 66 69 ead-config confi
28c0: 67 66 20 23 66 20 23 74 29 20 23 66 29 29 29 0a gf #f #t) #f))).
28d0: 20 20 20 20 28 69 66 20 63 6f 6e 66 69 67 0a 09 (if config..
28e0: 28 73 65 74 65 6e 76 20 22 52 55 4e 5f 41 52 45 (setenv "RUN_ARE
28f0: 41 5f 48 4f 4d 45 22 20 28 70 61 74 68 6e 61 6d A_HOME" (pathnam
2900: 65 2d 64 69 72 65 63 74 6f 72 79 20 63 6f 6e 66 e-directory conf
2910: 69 67 66 29 29 29 0a 20 20 20 20 63 6f 6e 66 69 igf))). confi
2920: 67 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d g))..;;=========
2930: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2940: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2950: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2960: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
2970: 20 4e 6f 6e 20 64 65 73 74 72 75 63 74 69 76 65 Non destructive
2980: 20 77 72 69 74 69 6e 67 20 6f 66 20 63 6f 6e 66 writing of conf
2990: 69 67 20 66 69 6c 65 0a 3b 3b 3d 3d 3d 3d 3d 3d ig file.;;======
29a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
29b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
29c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
29d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
29e0: 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 ..(define (confi
29f0: 67 66 3a 63 6f 6d 70 72 65 73 73 2d 6d 75 6c 74 gf:compress-mult
2a00: 69 2d 6c 69 6e 65 73 20 66 64 61 74 29 0a 20 20 i-lines fdat).
2a10: 3b 3b 20 73 74 65 70 20 31 2e 35 20 2d 20 63 6f ;; step 1.5 - co
2a20: 6d 70 72 65 73 73 20 61 6e 79 20 63 6f 6e 74 69 mpress any conti
2a30: 6e 75 65 64 20 6c 69 6e 65 73 0a 20 20 28 69 66 nued lines. (if
2a40: 20 28 6e 75 6c 6c 3f 20 66 64 61 74 29 20 66 64 (null? fdat) fd
2a50: 61 74 0a 09 28 6c 65 74 20 6c 6f 6f 70 20 28 28 at..(let loop ((
2a60: 68 65 64 20 28 63 61 72 20 66 64 61 74 29 29 0a hed (car fdat)).
2a70: 09 09 20 20 20 28 74 61 6c 20 28 63 64 72 20 66 .. (tal (cdr f
2a80: 64 61 74 29 29 0a 09 09 20 20 20 28 63 75 72 20 dat))... (cur
2a90: 22 22 29 0a 09 09 20 20 20 28 6c 65 64 20 23 66 "")... (led #f
2aa0: 29 0a 09 09 20 20 20 28 72 65 73 20 27 28 29 29 )... (res '())
2ab0: 29 0a 09 20 20 3b 3b 20 41 4c 4c 20 57 48 49 54 ).. ;; ALL WHIT
2ac0: 45 53 50 41 43 45 20 4c 45 41 44 49 4e 47 20 4c ESPACE LEADING L
2ad0: 49 4e 45 53 20 41 52 45 20 54 41 43 4b 45 44 20 INES ARE TACKED
2ae0: 4f 4e 21 21 0a 09 20 20 3b 3b 20 20 31 2e 20 72 ON!!.. ;; 1. r
2af0: 65 6d 6f 76 65 20 6c 65 64 20 77 68 69 74 65 73 emove led whites
2b00: 70 61 63 65 0a 09 20 20 3b 3b 20 20 32 2e 20 74 pace.. ;; 2. t
2b10: 61 63 6b 20 6f 6e 20 74 6f 20 68 65 64 20 77 69 ack on to hed wi
2b20: 74 68 20 22 5c 6e 22 0a 09 20 20 28 6c 65 74 20 th "\n".. (let
2b30: 28 28 6d 61 74 63 68 20 28 73 74 72 69 6e 67 2d ((match (string-
2b40: 6d 61 74 63 68 20 63 6f 6e 66 69 67 66 3a 63 6f match configf:co
2b50: 6e 74 2d 6c 6e 2d 72 78 20 68 65 64 29 29 29 0a nt-ln-rx hed))).
2b60: 09 20 20 20 20 28 69 66 20 6d 61 74 63 68 20 3b . (if match ;
2b70: 3b 20 62 6c 61 73 74 21 20 68 61 76 65 20 74 6f ; blast! have to
2b80: 20 64 65 61 6c 20 77 69 74 68 20 61 20 6d 75 6c deal with a mul
2b90: 74 69 6c 69 6e 65 0a 09 09 28 6c 65 74 2a 20 28 tiline...(let* (
2ba0: 28 6c 65 61 64 20 28 63 61 64 72 20 6d 61 74 63 (lead (cadr matc
2bb0: 68 29 29 0a 09 09 20 20 20 20 20 20 20 28 6c 76 h))... (lv
2bc0: 61 6c 20 28 63 61 64 64 72 20 6d 61 74 63 68 29 al (caddr match)
2bd0: 29 0a 09 09 20 20 20 20 20 20 20 28 6e 65 77 6c )... (newl
2be0: 20 28 63 6f 6e 63 20 63 75 72 20 22 5c 6e 22 20 (conc cur "\n"
2bf0: 6c 76 61 6c 29 29 29 0a 09 09 20 20 28 69 66 20 lval)))... (if
2c00: 28 6e 6f 74 20 6c 65 64 29 28 73 65 74 21 20 6c (not led)(set! l
2c10: 65 64 20 6c 65 61 64 29 29 0a 09 09 20 20 28 69 ed lead))... (i
2c20: 66 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 20 0a 09 f (null? tal) ..
2c30: 09 20 20 20 20 20 20 28 73 65 74 21 20 66 64 61 . (set! fda
2c40: 74 20 28 61 70 70 65 6e 64 20 66 64 61 74 20 28 t (append fdat (
2c50: 6c 69 73 74 20 6e 65 77 6c 29 29 29 0a 09 09 20 list newl)))...
2c60: 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 (loop (car
2c70: 74 61 6c 29 28 63 64 72 20 74 61 6c 29 20 6e 65 tal)(cdr tal) ne
2c80: 77 6c 20 6c 65 64 20 72 65 73 29 29 29 20 3b 3b wl led res))) ;;
2c90: 20 4e 42 2f 2f 20 6e 6f 74 20 74 61 63 6b 69 6e NB// not tackin
2ca0: 67 20 6e 65 77 6c 20 6f 6e 74 6f 20 72 65 73 0a g newl onto res.
2cb0: 09 09 28 6c 65 74 20 28 28 6e 65 77 72 65 73 20 ..(let ((newres
2cc0: 28 69 66 20 6c 65 64 20 0a 09 09 09 09 20 20 28 (if led ..... (
2cd0: 61 70 70 65 6e 64 20 72 65 73 20 28 6c 69 73 74 append res (list
2ce0: 20 63 75 72 20 68 65 64 29 29 0a 09 09 09 09 20 cur hed)).....
2cf0: 20 28 61 70 70 65 6e 64 20 72 65 73 20 28 6c 69 (append res (li
2d00: 73 74 20 68 65 64 29 29 29 29 29 0a 09 09 20 20 st hed)))))...
2d10: 3b 3b 20 70 72 65 76 20 77 61 73 20 61 20 6d 75 ;; prev was a mu
2d20: 6c 74 69 6c 69 6e 65 0a 09 09 20 20 28 69 66 20 ltiline... (if
2d30: 28 6e 75 6c 6c 3f 20 74 61 6c 29 0a 09 09 20 20 (null? tal)...
2d40: 20 20 20 20 6e 65 77 72 65 73 0a 09 09 20 20 20 newres...
2d50: 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 (loop (car ta
2d60: 6c 29 28 63 64 72 20 74 61 6c 29 20 22 22 20 23 l)(cdr tal) "" #
2d70: 66 20 6e 65 77 72 65 73 29 29 29 29 29 29 29 29 f newres))))))))
2d80: 0a 0a 3b 3b 20 6e 6f 74 65 3a 20 49 27 6d 20 63 ..;; note: I'm c
2d90: 68 65 61 74 69 6e 67 20 61 20 6c 69 74 74 6c 65 heating a little
2da0: 20 68 65 72 65 2e 20 49 20 6d 65 72 65 6c 79 20 here. I merely
2db0: 72 65 70 6c 61 63 65 20 22 5c 6e 22 20 77 69 74 replace "\n" wit
2dc0: 68 20 22 5c 6e 20 20 20 20 20 20 20 20 20 22 0a h "\n ".
2dd0: 28 64 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 66 (define (configf
2de0: 3a 65 78 70 61 6e 64 2d 6d 75 6c 74 69 2d 6c 69 :expand-multi-li
2df0: 6e 65 73 20 66 64 61 74 29 0a 20 20 3b 3b 20 73 nes fdat). ;; s
2e00: 74 65 70 20 31 2e 35 20 2d 20 63 6f 6d 70 72 65 tep 1.5 - compre
2e10: 73 73 20 61 6e 79 20 63 6f 6e 74 69 6e 75 65 64 ss any continued
2e20: 20 6c 69 6e 65 73 0a 20 20 28 69 66 20 28 6e 75 lines. (if (nu
2e30: 6c 6c 3f 20 66 64 61 74 29 20 66 64 61 74 0a 20 ll? fdat) fdat.
2e40: 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 (let loop (
2e50: 28 68 65 64 20 28 63 61 72 20 66 64 61 74 29 29 (hed (car fdat))
2e60: 0a 09 09 20 28 74 61 6c 20 28 63 64 72 20 66 64 ... (tal (cdr fd
2e70: 61 74 29 29 0a 09 09 20 28 72 65 73 20 27 28 29 at))... (res '()
2e80: 29 29 0a 09 28 6c 65 74 20 28 28 6e 65 77 72 65 ))..(let ((newre
2e90: 73 20 28 61 70 70 65 6e 64 20 72 65 73 20 28 6c s (append res (l
2ea0: 69 73 74 20 28 73 74 72 69 6e 67 2d 73 75 62 73 ist (string-subs
2eb0: 74 69 74 75 74 65 20 28 72 65 67 65 78 70 20 22 titute (regexp "
2ec0: 5c 6e 22 29 20 22 5c 6e 20 20 20 20 20 20 20 20 \n") "\n
2ed0: 20 22 20 68 65 64 20 23 74 29 29 29 29 29 0a 09 " hed #t)))))..
2ee0: 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 61 6c (if (null? tal
2ef0: 29 0a 09 20 20 20 20 20 20 6e 65 77 72 65 73 0a ).. newres.
2f00: 09 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 . (loop (ca
2f10: 72 20 74 61 6c 29 28 63 64 72 20 74 61 6c 29 20 r tal)(cdr tal)
2f20: 6e 65 77 72 65 73 29 29 29 29 29 29 0a 0a 28 64 newres))))))..(d
2f30: 65 66 69 6e 65 20 28 63 6f 6e 66 69 67 66 3a 66 efine (configf:f
2f40: 69 6c 65 2d 3e 6c 69 73 74 20 66 6e 61 6d 65 29 ile->list fname)
2f50: 0a 20 20 28 69 66 20 28 66 69 6c 65 2d 65 78 69 . (if (file-exi
2f60: 73 74 73 3f 20 66 6e 61 6d 65 29 0a 20 20 20 20 sts? fname).
2f70: 20 20 28 6c 65 74 20 28 28 69 6e 70 20 28 6f 70 (let ((inp (op
2f80: 65 6e 2d 69 6e 70 75 74 2d 66 69 6c 65 20 66 6e en-input-file fn
2f90: 61 6d 65 29 29 29 0a 09 28 6c 65 74 20 6c 6f 6f ame)))..(let loo
2fa0: 70 20 28 28 69 6e 6c 20 28 72 65 61 64 2d 6c 69 p ((inl (read-li
2fb0: 6e 65 20 69 6e 70 29 29 0a 09 09 20 20 20 28 72 ne inp))... (r
2fc0: 65 73 20 27 28 29 29 29 0a 09 20 20 28 69 66 20 es '())).. (if
2fd0: 28 65 6f 66 2d 6f 62 6a 65 63 74 3f 20 69 6e 6c (eof-object? inl
2fe0: 29 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a ).. (begin.
2ff0: 09 09 28 63 6c 6f 73 65 2d 69 6e 70 75 74 2d 70 ..(close-input-p
3000: 6f 72 74 20 69 6e 70 29 0a 09 09 28 72 65 76 65 ort inp)...(reve
3010: 72 73 65 20 72 65 73 29 29 0a 09 20 20 20 20 20 rse res))..
3020: 20 28 6c 6f 6f 70 20 28 72 65 61 64 2d 6c 69 6e (loop (read-lin
3030: 65 20 69 6e 70 29 28 63 6f 6e 73 20 69 6e 6c 29 e inp)(cons inl)
3040: 29 29 29 29 0a 20 20 20 20 20 20 27 28 29 29 29 )))). '()))
3050: 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
3060: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3070: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3080: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3090: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 57 72 ==========.;; Wr
30a0: 69 74 65 20 61 20 63 6f 6e 66 69 67 0a 3b 3b 20 ite a config.;;
30b0: 20 20 30 2e 20 47 69 76 65 6e 20 61 20 72 65 66 0. Given a ref
30c0: 65 72 65 72 65 6e 63 65 20 64 61 74 61 20 73 74 ererence data st
30d0: 72 75 63 74 75 72 65 20 22 69 6e 64 61 74 22 0a ructure "indat".
30e0: 3b 3b 20 20 20 31 2e 20 4f 70 65 6e 20 74 68 65 ;; 1. Open the
30f0: 20 6f 75 74 70 75 74 20 66 69 6c 65 20 61 6e 64 output file and
3100: 20 72 65 61 64 20 69 74 20 69 6e 74 6f 20 61 20 read it into a
3110: 6c 69 73 74 0a 3b 3b 20 20 20 32 2e 20 46 6c 61 list.;; 2. Fla
3120: 74 74 65 6e 20 61 6e 79 20 6d 75 6c 74 69 6c 69 tten any multili
3130: 6e 65 20 65 6e 74 72 69 65 73 0a 3b 3b 20 20 20 ne entries.;;
3140: 33 2e 20 4d 6f 64 69 66 79 20 76 61 6c 75 65 73 3. Modify values
3150: 20 70 65 72 20 63 6f 6e 74 65 6e 74 73 20 6f 66 per contents of
3160: 20 22 69 6e 64 61 74 22 20 61 6e 64 20 72 65 6d "indat" and rem
3170: 6f 76 65 20 61 62 73 65 6e 74 20 76 61 6c 75 65 ove absent value
3180: 73 0a 3b 3b 20 20 20 34 2e 20 41 70 70 65 6e 64 s.;; 4. Append
3190: 20 6e 65 77 20 76 61 6c 75 65 73 20 74 6f 20 74 new values to t
31a0: 68 65 20 73 65 63 74 69 6f 6e 20 28 69 6d 6d 65 he section (imme
31b0: 64 69 61 74 65 6c 79 20 61 66 74 65 72 20 6c 61 diately after la
31c0: 73 74 20 6c 65 67 69 74 20 65 6e 74 72 79 29 0a st legit entry).
31d0: 3b 3b 20 20 20 35 2e 20 57 72 69 74 65 20 6f 75 ;; 5. Write ou
31e0: 74 20 74 68 65 20 6e 65 77 20 6c 69 73 74 20 0a t the new list .
31f0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
3200: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3210: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3220: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3230: 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e ========..(defin
3240: 65 20 28 63 6f 6e 66 69 67 66 3a 77 72 69 74 65 e (configf:write
3250: 2d 63 6f 6e 66 69 67 20 69 6e 64 61 74 20 66 6e -config indat fn
3260: 61 6d 65 20 23 21 6b 65 79 20 28 72 65 71 75 69 ame #!key (requi
3270: 72 65 64 2d 73 65 63 74 69 6f 6e 73 20 27 28 29 red-sections '()
3280: 29 29 0a 20 20 28 6c 65 74 2a 20 28 3b 3b 20 73 )). (let* (;; s
3290: 74 65 70 20 31 3a 20 4f 70 65 6e 20 74 68 65 20 tep 1: Open the
32a0: 6f 75 74 70 75 74 20 66 69 6c 65 20 61 6e 64 20 output file and
32b0: 72 65 61 64 20 69 74 20 69 6e 74 6f 20 61 20 6c read it into a l
32c0: 69 73 74 0a 09 20 28 66 64 61 74 20 20 20 20 20 ist.. (fdat
32d0: 20 20 28 63 6f 6e 66 69 67 66 3a 66 69 6c 65 2d (configf:file-
32e0: 3e 6c 69 73 74 20 66 6e 61 6d 65 29 29 0a 09 20 >list fname))..
32f0: 28 72 65 66 64 61 74 20 20 28 6d 61 6b 65 2d 68 (refdat (make-h
3300: 61 73 68 2d 74 61 62 6c 65 29 29 0a 09 20 28 73 ash-table)).. (s
3310: 65 63 68 61 73 68 20 28 6d 61 6b 65 2d 68 61 73 echash (make-has
3320: 68 2d 74 61 62 6c 65 29 29 20 3b 3b 20 63 75 72 h-table)) ;; cur
3330: 72 65 6e 74 20 73 65 63 74 69 6f 6e 20 68 61 73 rent section has
3340: 68 2c 20 69 6e 69 74 20 77 69 74 68 20 68 61 73 h, init with has
3350: 68 20 66 6f 72 20 22 64 65 66 61 75 6c 74 22 20 h for "default"
3360: 73 65 63 74 69 6f 6e 0a 09 20 28 6e 65 77 20 20 section.. (new
3370: 20 20 20 23 66 29 20 3b 3b 20 70 75 74 20 74 68 #f) ;; put th
3380: 65 20 6c 69 6e 65 20 74 6f 20 62 65 20 75 73 65 e line to be use
3390: 64 20 69 6e 20 6e 65 77 2c 20 69 66 20 69 74 20 d in new, if it
33a0: 69 73 20 74 6f 20 62 65 20 64 65 6c 65 74 65 64 is to be deleted
33b0: 20 74 68 65 20 73 65 74 20 6e 65 77 20 74 6f 20 the set new to
33c0: 23 66 0a 09 20 28 73 65 63 6e 61 6d 65 20 23 66 #f.. (secname #f
33d0: 29 29 0a 0a 20 20 20 20 3b 3b 20 73 74 65 70 20 )).. ;; step
33e0: 32 3a 20 46 6c 61 74 74 65 6e 20 6d 75 6c 74 69 2: Flatten multi
33f0: 6c 69 6e 65 20 65 6e 74 72 69 65 73 0a 20 20 20 line entries.
3400: 20 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f (if (not (null?
3410: 20 66 64 61 74 29 29 28 73 65 74 21 20 66 64 61 fdat))(set! fda
3420: 74 20 28 63 6f 6e 66 69 67 66 3a 63 6f 6d 70 72 t (configf:compr
3430: 65 73 73 2d 6d 75 6c 74 69 2d 6c 69 6e 65 20 66 ess-multi-line f
3440: 64 61 74 29 29 29 0a 0a 20 20 20 20 3b 3b 20 73 dat))).. ;; s
3450: 74 65 70 20 33 3a 20 4d 6f 64 69 66 79 20 76 61 tep 3: Modify va
3460: 6c 75 65 73 20 70 65 72 20 63 6f 6e 74 65 6e 74 lues per content
3470: 73 20 6f 66 20 22 69 6e 64 61 74 22 20 61 6e 64 s of "indat" and
3480: 20 72 65 6d 6f 76 65 20 61 62 73 65 6e 74 20 76 remove absent v
3490: 61 6c 75 65 73 0a 20 20 20 20 28 69 66 20 28 6e alues. (if (n
34a0: 6f 74 20 28 6e 75 6c 6c 3f 20 66 64 61 74 29 29 ot (null? fdat))
34b0: 0a 09 28 6c 65 74 20 6c 6f 6f 70 20 28 28 68 65 ..(let loop ((he
34c0: 64 20 20 28 63 61 72 20 66 64 61 74 29 29 0a 09 d (car fdat))..
34d0: 09 20 20 20 28 74 61 6c 20 20 28 63 61 64 72 20 . (tal (cadr
34e0: 66 64 61 74 29 29 0a 09 09 20 20 20 28 72 65 73 fdat))... (res
34f0: 20 20 27 28 29 29 0a 09 09 20 20 20 28 6c 6e 75 '())... (lnu
3500: 6d 20 30 29 29 0a 09 20 20 28 72 65 67 65 78 2d m 0)).. (regex-
3510: 63 61 73 65 20 0a 09 20 20 20 68 65 64 0a 09 20 case .. hed..
3520: 20 20 28 63 6f 6e 66 69 67 66 3a 63 6f 6d 6d 65 (configf:comme
3530: 6e 74 2d 72 78 20 5f 20 20 20 20 20 20 20 20 20 nt-rx _
3540: 20 20 20 20 20 20 20 20 20 28 73 65 74 21 20 72 (set! r
3550: 65 73 20 28 61 70 70 65 6e 64 20 72 65 73 20 28 es (append res (
3560: 6c 69 73 74 20 68 65 64 29 29 29 29 20 3b 3b 20 list hed)))) ;;
3570: 28 6c 6f 6f 70 20 28 72 65 61 64 2d 6c 69 6e 65 (loop (read-line
3580: 20 69 6e 70 29 20 63 75 72 72 2d 73 65 63 74 69 inp) curr-secti
3590: 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 66 29 29 0a on-name #f #f)).
35a0: 09 20 20 20 28 63 6f 6e 66 69 67 66 3a 62 6c 61 . (configf:bla
35b0: 6e 6b 2d 6c 2d 72 78 20 5f 20 20 20 20 20 20 20 nk-l-rx _
35c0: 20 20 20 20 20 20 20 20 20 20 20 28 73 65 74 21 (set!
35d0: 20 72 65 73 20 28 61 70 70 65 6e 64 20 72 65 73 res (append res
35e0: 20 28 6c 69 73 74 20 68 65 64 29 29 29 29 20 3b (list hed)))) ;
35f0: 3b 20 28 6c 6f 6f 70 20 28 72 65 61 64 2d 6c 69 ; (loop (read-li
3600: 6e 65 20 69 6e 70 29 20 63 75 72 72 2d 73 65 63 ne inp) curr-sec
3610: 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 20 23 66 29 tion-name #f #f)
3620: 29 0a 09 20 20 20 28 63 6f 6e 66 69 67 66 3a 73 ).. (configf:s
3630: 65 63 74 69 6f 6e 2d 72 78 20 28 20 78 20 73 65 ection-rx ( x se
3640: 63 74 69 6f 6e 2d 6e 61 6d 65 20 29 20 28 6c 65 ction-name ) (le
3650: 74 20 28 28 73 65 63 74 69 6f 6e 2d 68 61 73 68 t ((section-hash
3660: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
3670: 2f 64 65 66 61 75 6c 74 20 72 65 66 64 61 74 20 /default refdat
3680: 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 23 66 29 section-name #f)
3690: 29 29 0a 09 09 09 09 09 20 20 20 20 28 69 66 20 ))...... (if
36a0: 28 6e 6f 74 20 73 65 63 74 69 6f 6e 2d 68 61 73 (not section-has
36b0: 68 29 0a 09 09 09 09 09 09 28 6c 65 74 20 28 28 h).......(let ((
36c0: 6e 65 77 68 61 73 68 20 28 6d 61 6b 65 2d 68 61 newhash (make-ha
36d0: 73 68 2d 74 61 62 6c 65 29 29 29 0a 09 09 09 09 sh-table))).....
36e0: 09 09 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d .. (hash-table-
36f0: 73 65 74 21 20 72 65 66 68 61 73 68 20 73 65 63 set! refhash sec
3700: 74 69 6f 6e 2d 6e 61 6d 65 20 6e 65 77 68 61 73 tion-name newhas
3710: 68 29 0a 09 09 09 09 09 09 20 20 28 73 65 74 21 h)....... (set!
3720: 20 73 65 63 68 61 73 68 20 6e 65 77 68 61 73 68 sechash newhash
3730: 29 29 0a 09 09 09 09 09 09 28 73 65 74 21 20 73 )).......(set! s
3740: 65 63 68 61 73 68 20 73 65 63 74 69 6f 6e 2d 68 echash section-h
3750: 61 73 68 29 29 0a 09 09 09 09 09 20 20 20 20 28 ash))...... (
3760: 73 65 74 21 20 6e 65 77 20 68 65 64 29 20 3b 3b set! new hed) ;;
3770: 20 77 69 6c 6c 20 61 70 70 65 6e 64 20 74 68 69 will append thi
3780: 73 20 61 74 20 74 68 65 20 62 6f 74 74 6f 6d 20 s at the bottom
3790: 6f 66 20 74 68 65 20 6c 6f 6f 70 0a 09 09 09 09 of the loop.....
37a0: 09 20 20 20 20 28 73 65 74 21 20 73 65 63 6e 61 . (set! secna
37b0: 6d 65 20 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 29 me section-name)
37c0: 0a 09 09 09 09 09 20 20 20 20 29 29 0a 09 20 20 ...... ))..
37d0: 20 3b 3b 20 4e 6f 20 6e 65 65 64 20 74 6f 20 70 ;; No need to p
37e0: 72 6f 63 65 73 73 20 6b 65 79 20 63 6d 64 2c 20 rocess key cmd,
37f0: 6c 65 74 20 69 74 20 66 61 6c 6c 20 74 68 6f 75 let it fall thou
3800: 67 68 20 74 6f 20 6b 65 79 20 76 61 6c 0a 09 20 gh to key val..
3810: 20 20 28 63 6f 6e 66 69 67 66 3a 6b 65 79 2d 76 (configf:key-v
3820: 61 6c 2d 70 72 20 28 20 78 20 6b 65 79 20 76 61 al-pr ( x key va
3830: 6c 20 20 20 20 20 20 29 0a 09 09 20 20 20 20 20 l )...
3840: 20 20 28 6c 65 74 20 28 28 6e 65 77 76 61 6c 20 (let ((newval
3850: 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 69 (config-lookup i
3860: 6e 64 61 74 20 73 65 63 20 6b 65 79 29 29 29 0a ndat sec key))).
3870: 09 09 09 20 3b 3b 20 63 61 6e 20 68 61 6e 64 6c ... ;; can handl
3880: 65 20 6e 65 77 76 61 6c 20 3d 3d 20 23 66 20 68 e newval == #f h
3890: 65 72 65 20 3d 3e 20 74 68 61 74 20 6d 65 61 6e ere => that mean
38a0: 73 20 6b 65 79 20 69 73 20 72 65 6d 6f 76 65 64 s key is removed
38b0: 0a 09 09 09 20 28 63 6f 6e 64 20 0a 09 09 09 20 .... (cond ....
38c0: 20 28 28 65 71 75 61 6c 3f 20 6e 65 77 76 61 6c ((equal? newval
38d0: 20 76 61 6c 29 0a 09 09 09 20 20 20 28 73 65 74 val).... (set
38e0: 21 20 72 65 73 20 28 61 70 70 65 6e 64 20 72 65 ! res (append re
38f0: 73 20 28 6c 69 73 74 20 68 65 64 29 29 29 29 0a s (list hed)))).
3900: 09 09 09 20 20 28 28 6e 6f 74 20 6e 65 77 76 61 ... ((not newva
3910: 6c 29 20 3b 3b 20 6b 65 79 20 68 61 73 20 62 65 l) ;; key has be
3920: 65 6e 20 72 65 6d 6f 76 65 64 0a 09 09 09 20 20 en removed....
3930: 20 28 73 65 74 21 20 6e 65 77 20 23 66 29 29 0a (set! new #f)).
3940: 09 09 09 20 20 28 28 6e 6f 74 20 28 65 71 75 61 ... ((not (equa
3950: 6c 3f 20 6e 65 77 76 61 6c 20 76 61 6c 29 29 0a l? newval val)).
3960: 09 09 09 20 20 20 20 20 28 68 61 73 68 2d 74 61 ... (hash-ta
3970: 62 6c 65 2d 73 65 74 21 20 73 65 63 68 61 73 68 ble-set! sechash
3980: 20 6b 65 79 20 6e 65 77 76 61 6c 29 0a 09 09 09 key newval)....
3990: 20 20 20 20 20 28 73 65 74 21 20 6e 65 77 20 28 (set! new (
39a0: 63 6f 6e 63 20 6b 65 79 20 22 20 22 20 6e 65 77 conc key " " new
39b0: 76 61 6c 29 29 29 0a 09 09 09 20 20 28 65 6c 73 val))).... (els
39c0: 65 0a 09 09 09 20 20 20 28 64 65 62 75 67 3a 70 e.... (debug:p
39d0: 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 70 rint 0 "ERROR: p
39e0: 72 6f 62 6c 65 6d 20 70 61 72 73 69 6e 67 20 6c roblem parsing l
39f0: 69 6e 65 20 6e 75 6d 62 65 72 20 22 20 6c 6e 75 ine number " lnu
3a00: 6d 20 22 5c 22 22 20 68 65 64 20 22 5c 22 22 29 m "\"" hed "\"")
3a10: 29 29 29 29 0a 09 20 20 20 28 65 6c 73 65 0a 09 )))).. (else..
3a20: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
3a30: 20 30 20 22 45 52 52 4f 52 3a 20 50 72 6f 62 6c 0 "ERROR: Probl
3a40: 65 6d 20 70 61 72 73 69 6e 67 20 6c 69 6e 65 20 em parsing line
3a50: 6e 75 6d 20 22 20 6c 6e 75 6d 20 22 20 3a 5c 6e num " lnum " :\n
3a60: 20 20 20 22 20 68 65 64 20 29 29 29 0a 09 20 20 " hed )))..
3a70: 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 (if (not (null?
3a80: 74 61 6c 29 29 0a 09 20 20 20 20 20 20 28 6c 6f tal)).. (lo
3a90: 6f 70 20 28 63 61 72 20 74 61 6c 29 28 63 64 72 op (car tal)(cdr
3aa0: 20 74 61 6c 29 28 69 66 20 6e 65 77 20 28 61 70 tal)(if new (ap
3ab0: 70 65 6e 64 20 72 65 73 20 28 6c 69 73 74 20 6e pend res (list n
3ac0: 65 77 29 29 20 72 65 73 29 28 2b 20 6c 6e 75 6d ew)) res)(+ lnum
3ad0: 20 31 29 29 29 0a 09 20 20 3b 3b 20 64 72 6f 70 1))).. ;; drop
3ae0: 20 74 6f 20 68 65 72 65 20 77 68 65 6e 20 64 6f to here when do
3af0: 6e 65 20 70 72 6f 63 65 73 73 69 6e 67 2c 20 72 ne processing, r
3b00: 65 73 20 63 6f 6e 74 61 69 6e 73 20 6d 6f 64 69 es contains modi
3b10: 66 69 65 64 20 6c 69 73 74 20 6f 66 20 6c 69 6e fied list of lin
3b20: 65 73 0a 09 20 20 28 73 65 74 21 20 66 64 61 74 es.. (set! fdat
3b30: 20 72 65 73 29 29 29 0a 0a 20 20 20 20 3b 3b 20 res))).. ;;
3b40: 73 74 65 70 20 34 3a 20 41 70 70 65 6e 64 20 6e step 4: Append n
3b50: 65 77 20 76 61 6c 75 65 73 20 74 6f 20 74 68 65 ew values to the
3b60: 20 73 65 63 74 69 6f 6e 0a 20 20 20 20 28 66 6f section. (fo
3b70: 72 2d 65 61 63 68 20 0a 20 20 20 20 20 28 6c 61 r-each . (la
3b80: 6d 62 64 61 20 28 73 65 63 74 69 6f 6e 29 0a 20 mbda (section).
3b90: 20 20 20 20 20 20 28 6c 65 74 20 28 28 73 64 61 (let ((sda
3ba0: 74 20 20 20 27 28 29 29 20 3b 3b 20 61 70 70 65 t '()) ;; appe
3bb0: 6e 64 20 6e 65 65 64 65 64 20 62 69 74 73 20 68 nd needed bits h
3bc0: 65 72 65 0a 09 20 20 20 20 20 28 73 76 61 72 73 ere.. (svars
3bd0: 20 20 28 63 6f 6e 66 69 67 66 3a 73 65 63 74 69 (configf:secti
3be0: 6f 6e 2d 76 61 72 73 20 69 6e 64 61 74 20 73 65 on-vars indat se
3bf0: 63 74 69 6f 6e 29 29 29 0a 09 20 28 66 6f 72 2d ction))).. (for-
3c00: 65 61 63 68 20 0a 09 20 20 28 6c 61 6d 62 64 61 each .. (lambda
3c10: 20 28 76 61 72 29 0a 09 20 20 20 20 28 6c 65 74 (var).. (let
3c20: 20 28 28 76 61 6c 20 28 63 6f 6e 66 69 67 2d 6c ((val (config-l
3c30: 6f 6f 6b 75 70 20 72 65 66 64 61 74 20 73 65 63 ookup refdat sec
3c40: 74 69 6f 6e 20 76 61 72 29 29 29 0a 09 20 20 20 tion var)))..
3c50: 20 20 20 28 69 66 20 28 6e 6f 74 20 76 61 6c 29 (if (not val)
3c60: 20 3b 3b 20 74 68 69 73 20 6f 6e 65 20 69 73 20 ;; this one is
3c70: 6e 65 77 0a 09 09 20 20 28 62 65 67 69 6e 0a 09 new... (begin..
3c80: 09 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 . (if (null?
3c90: 73 64 61 74 29 28 73 65 74 21 20 73 64 61 74 20 sdat)(set! sdat
3ca0: 28 6c 69 73 74 20 28 63 6f 6e 63 20 22 5b 22 20 (list (conc "["
3cb0: 73 65 63 74 69 6f 6e 20 22 5d 22 29 29 29 29 0a section "]")))).
3cc0: 09 09 20 20 20 20 28 73 65 74 21 20 73 64 61 74 .. (set! sdat
3cd0: 20 28 61 70 70 65 6e 64 20 73 64 61 74 20 28 6c (append sdat (l
3ce0: 69 73 74 20 28 63 6f 6e 63 20 76 61 72 20 22 20 ist (conc var "
3cf0: 22 20 76 61 6c 29 29 29 29 29 29 29 29 0a 09 20 " val))))))))..
3d00: 20 73 76 61 72 73 29 0a 09 20 28 73 65 74 21 20 svars).. (set!
3d10: 66 64 61 74 20 28 61 70 70 65 6e 64 20 66 64 61 fdat (append fda
3d20: 74 20 73 64 61 74 29 29 29 29 0a 20 20 20 20 20 t sdat)))).
3d30: 28 64 65 6c 65 74 65 2d 64 75 70 6c 69 63 61 74 (delete-duplicat
3d40: 65 73 20 28 61 70 70 65 6e 64 20 72 65 71 75 69 es (append requi
3d50: 72 65 2d 73 65 63 74 69 6f 6e 73 20 28 68 61 73 re-sections (has
3d60: 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 69 6e 64 h-table-keys ind
3d70: 61 74 29 29 29 29 0a 0a 20 20 20 20 3b 3b 20 73 at)))).. ;; s
3d80: 74 65 70 20 35 3a 20 57 72 69 74 65 20 6f 75 74 tep 5: Write out
3d90: 20 6e 65 77 20 66 69 6c 65 0a 20 20 20 20 28 77 new file. (w
3da0: 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 69 ith-output-to-fi
3db0: 6c 65 20 66 6e 61 6d 65 20 0a 20 20 20 20 20 20 le fname .
3dc0: 28 6c 61 6d 62 64 61 20 28 29 0a 09 28 66 6f 72 (lambda ()..(for
3dd0: 2d 65 61 63 68 20 0a 09 20 28 6c 61 6d 62 64 61 -each .. (lambda
3de0: 20 28 6c 69 6e 65 29 0a 09 20 20 20 28 70 72 69 (line).. (pri
3df0: 6e 74 20 6c 69 6e 65 29 29 0a 09 20 28 63 6f 6e nt line)).. (con
3e00: 66 69 67 66 3a 65 78 70 61 6e 64 2d 6d 75 6c 74 figf:expand-mult
3e10: 69 2d 6c 69 6e 65 73 20 66 64 61 74 29 29 29 29 i-lines fdat))))
3e20: 29 29 0a 0a ))..