Megatest

Hex Artifact Content
Login

Artifact 9312ee9e64d758d165f41f377e418e5e277e325c:


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 31 2c  right 2006-2011,
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 3b 3b 20 72 65 74 75 72 6e  =====..;; return
0290: 20 6c 69 73 74 20 28 70 61 74 68 20 66 75 6c 6c   list (path full
02a0: 70 61 74 68 20 63 6f 6e 66 69 67 6e 61 6d 65 29  path configname)
02b0: 0a 28 64 65 66 69 6e 65 20 28 66 69 6e 64 2d 63  .(define (find-c
02c0: 6f 6e 66 69 67 20 63 6f 6e 66 69 67 6e 61 6d 65  onfig configname
02d0: 29 0a 20 20 28 6c 65 74 2a 20 28 28 63 77 64 20  ).  (let* ((cwd 
02e0: 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 28 63  (string-split (c
02f0: 75 72 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 79  urrent-directory
0300: 29 20 22 2f 22 29 29 29 0a 20 20 20 20 28 6c 65  ) "/"))).    (le
0310: 74 20 6c 6f 6f 70 20 28 28 64 69 72 20 63 77 64  t loop ((dir cwd
0320: 29 29 0a 20 20 20 20 20 20 28 6c 65 74 2a 20 28  )).      (let* (
0330: 28 70 61 74 68 20 20 20 20 20 28 63 6f 6e 63 20  (path     (conc 
0340: 22 2f 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 65  "/" (string-inte
0350: 72 73 70 65 72 73 65 20 64 69 72 20 22 2f 22 29  rsperse dir "/")
0360: 29 29 0a 09 20 20 20 20 20 28 66 75 6c 6c 70 61  ))..     (fullpa
0370: 74 68 20 28 63 6f 6e 63 20 70 61 74 68 20 22 2f  th (conc path "/
0380: 22 20 63 6f 6e 66 69 67 6e 61 6d 65 29 29 29 0a  " configname))).
0390: 09 28 69 66 20 28 66 69 6c 65 2d 65 78 69 73 74  .(if (file-exist
03a0: 73 3f 20 66 75 6c 6c 70 61 74 68 29 0a 09 20 20  s? fullpath)..  
03b0: 20 20 28 6c 69 73 74 20 70 61 74 68 20 66 75 6c    (list path ful
03c0: 6c 70 61 74 68 20 63 6f 6e 66 69 67 6e 61 6d 65  lpath configname
03d0: 29 0a 09 20 20 20 20 28 6c 65 74 20 28 28 72 65  )..    (let ((re
03e0: 6d 63 77 64 20 28 74 61 6b 65 20 64 69 72 20 28  mcwd (take dir (
03f0: 2d 20 28 6c 65 6e 67 74 68 20 64 69 72 29 20 31  - (length dir) 1
0400: 29 29 29 29 0a 09 20 20 20 20 20 20 28 69 66 20  ))))..      (if 
0410: 28 6e 75 6c 6c 3f 20 72 65 6d 63 77 64 29 0a 09  (null? remcwd)..
0420: 09 20 20 28 6c 69 73 74 20 23 66 20 23 66 20 23  .  (list #f #f #
0430: 66 29 20 3b 3b 20 20 23 66 20 23 66 29 20 0a 09  f) ;;  #f #f) ..
0440: 09 20 20 28 6c 6f 6f 70 20 72 65 6d 63 77 64 29  .  (loop remcwd)
0450: 29 29 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65  )))))))..(define
0460: 20 28 63 6f 6e 66 69 67 3a 61 73 73 6f 63 2d 73   (config:assoc-s
0470: 61 66 65 2d 61 64 64 20 61 6c 69 73 74 20 6b 65  afe-add alist ke
0480: 79 20 76 61 6c 29 0a 20 20 28 6c 65 74 20 28 28  y val).  (let ((
0490: 6e 65 77 61 6c 69 73 74 20 28 66 69 6c 74 65 72  newalist (filter
04a0: 20 28 6c 61 6d 62 64 61 20 28 78 29 28 6e 6f 74   (lambda (x)(not
04b0: 20 28 65 71 75 61 6c 3f 20 6b 65 79 20 78 29 29   (equal? key x))
04c0: 29 20 61 6c 69 73 74 29 29 29 0a 20 20 20 20 28  ) alist))).    (
04d0: 61 70 70 65 6e 64 20 61 6c 69 73 74 20 28 6c 69  append alist (li
04e0: 73 74 20 28 6c 69 73 74 20 6b 65 79 20 76 61 6c  st (list key val
04f0: 29 29 29 29 29 0a 0a 3b 3b 20 72 65 61 64 20 61  )))))..;; read a
0500: 20 63 6f 6e 66 69 67 20 66 69 6c 65 2c 20 72 65   config file, re
0510: 74 75 72 6e 73 20 74 77 6f 20 6c 65 76 65 6c 20  turns two level 
0520: 68 69 65 72 61 72 63 68 69 61 6c 20 68 61 73 68  hierarchial hash
0530: 2d 74 61 62 6c 65 2c 0a 3b 3b 20 61 64 64 73 20  -table,.;; adds 
0540: 74 6f 20 68 74 20 69 66 20 67 69 76 65 6e 20 28  to ht if given (
0550: 6d 75 73 74 20 62 65 20 23 66 20 6f 74 68 65 72  must be #f other
0560: 77 69 73 65 29 0a 28 64 65 66 69 6e 65 20 28 72  wise).(define (r
0570: 65 61 64 2d 63 6f 6e 66 69 67 20 70 61 74 68 20  ead-config path 
0580: 2e 20 68 74 29 0a 20 20 28 69 66 20 28 6e 6f 74  . ht).  (if (not
0590: 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 70   (file-exists? p
05a0: 61 74 68 29 29 0a 20 20 20 20 20 20 28 69 66 20  ath)).      (if 
05b0: 28 6e 75 6c 6c 3f 20 68 74 29 28 6d 61 6b 65 2d  (null? ht)(make-
05c0: 68 61 73 68 2d 74 61 62 6c 65 29 20 28 63 61 72  hash-table) (car
05d0: 20 68 74 29 29 0a 20 20 20 20 20 20 28 6c 65 74   ht)).      (let
05e0: 20 28 28 69 6e 70 20 20 20 20 20 20 20 20 28 6f   ((inp        (o
05f0: 70 65 6e 2d 69 6e 70 75 74 2d 66 69 6c 65 20 70  pen-input-file p
0600: 61 74 68 29 29 0a 09 20 20 20 20 28 72 65 73 20  ath))..    (res 
0610: 20 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c         (if (null
0620: 3f 20 68 74 29 28 6d 61 6b 65 2d 68 61 73 68 2d  ? ht)(make-hash-
0630: 74 61 62 6c 65 29 28 63 61 72 20 68 74 29 29 29  table)(car ht)))
0640: 0a 09 20 20 20 20 28 69 6e 63 6c 75 64 65 2d 72  ..    (include-r
0650: 78 20 28 72 65 67 65 78 70 20 22 5e 5c 5c 5b 69  x (regexp "^\\[i
0660: 6e 63 6c 75 64 65 5c 5c 73 2b 28 2e 2a 29 5c 5c  nclude\\s+(.*)\\
0670: 5d 5c 5c 73 2a 24 22 29 29 0a 09 20 20 20 20 28  ]\\s*$"))..    (
0680: 73 65 63 74 69 6f 6e 2d 72 78 20 28 72 65 67 65  section-rx (rege
0690: 78 70 20 22 5e 5c 5c 5b 28 2e 2a 29 5c 5c 5d 5c  xp "^\\[(.*)\\]\
06a0: 5c 73 2a 24 22 29 29 0a 09 20 20 20 20 28 62 6c  \s*$"))..    (bl
06b0: 61 6e 6b 2d 6c 2d 72 78 20 28 72 65 67 65 78 70  ank-l-rx (regexp
06c0: 20 22 5e 5c 5c 73 2a 24 22 29 29 0a 09 20 20 20   "^\\s*$"))..   
06d0: 20 28 6b 65 79 2d 73 79 73 2d 70 72 20 28 72 65   (key-sys-pr (re
06e0: 67 65 78 70 20 22 5e 28 5c 5c 53 2b 29 5c 5c 73  gexp "^(\\S+)\\s
06f0: 2b 5c 5c 5b 73 79 73 74 65 6d 5c 5c 73 2b 28 5c  +\\[system\\s+(\
0700: 5c 53 2b 2e 2a 29 5c 5c 5d 5c 5c 73 2a 24 22 29  \S+.*)\\]\\s*$")
0710: 29 0a 09 20 20 20 20 28 6b 65 79 2d 76 61 6c 2d  )..    (key-val-
0720: 70 72 20 28 72 65 67 65 78 70 20 22 5e 28 5c 5c  pr (regexp "^(\\
0730: 53 2b 29 5c 5c 73 2b 28 2e 2a 29 24 22 29 29 0a  S+)\\s+(.*)$")).
0740: 09 20 20 20 20 28 63 6f 6d 6d 65 6e 74 2d 72 78  .    (comment-rx
0750: 20 28 72 65 67 65 78 70 20 22 5e 5c 5c 73 2a 23   (regexp "^\\s*#
0760: 2e 2a 22 29 29 29 0a 09 28 6c 65 74 20 6c 6f 6f  .*")))..(let loo
0770: 70 20 28 28 69 6e 6c 20 20 20 20 20 20 20 20 20  p ((inl         
0780: 20 20 20 20 20 20 28 72 65 61 64 2d 6c 69 6e 65        (read-line
0790: 20 69 6e 70 29 29 0a 09 09 20 20 20 28 63 75 72   inp))...   (cur
07a0: 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 22  r-section-name "
07b0: 64 65 66 61 75 6c 74 22 29 29 0a 09 20 20 28 69  default"))..  (i
07c0: 66 20 28 65 6f 66 2d 6f 62 6a 65 63 74 3f 20 69  f (eof-object? i
07d0: 6e 6c 29 20 72 65 73 0a 09 20 20 20 20 20 20 28  nl) res..      (
07e0: 72 65 67 65 78 2d 63 61 73 65 20 0a 09 20 20 20  regex-case ..   
07f0: 20 20 20 20 69 6e 6c 20 0a 09 20 20 20 20 20 20      inl ..      
0800: 20 28 63 6f 6d 6d 65 6e 74 2d 72 78 20 5f 20 20   (comment-rx _  
0810: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
0820: 28 6c 6f 6f 70 20 28 72 65 61 64 2d 6c 69 6e 65  (loop (read-line
0830: 20 69 6e 70 29 20 63 75 72 72 2d 73 65 63 74 69   inp) curr-secti
0840: 6f 6e 2d 6e 61 6d 65 29 29 0a 09 20 20 20 20 20  on-name))..     
0850: 20 20 28 62 6c 61 6e 6b 2d 6c 2d 72 78 20 5f 20    (blank-l-rx _ 
0860: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
0870: 20 28 6c 6f 6f 70 20 28 72 65 61 64 2d 6c 69 6e   (loop (read-lin
0880: 65 20 69 6e 70 29 20 63 75 72 72 2d 73 65 63 74  e inp) curr-sect
0890: 69 6f 6e 2d 6e 61 6d 65 29 29 0a 09 20 20 20 20  ion-name))..    
08a0: 20 20 20 28 69 6e 63 6c 75 64 65 2d 72 78 20 28     (include-rx (
08b0: 20 78 20 69 6e 63 6c 75 64 65 2d 66 69 6c 65 20   x include-file 
08c0: 29 20 28 62 65 67 69 6e 0a 09 09 09 09 09 09 28  ) (begin.......(
08d0: 72 65 61 64 2d 63 6f 6e 66 69 67 20 69 6e 63 6c  read-config incl
08e0: 75 64 65 2d 66 69 6c 65 20 72 65 73 29 0a 09 09  ude-file res)...
08f0: 09 09 09 09 28 6c 6f 6f 70 20 28 72 65 61 64 2d  ....(loop (read-
0900: 6c 69 6e 65 20 69 6e 70 29 20 63 75 72 72 2d 73  line inp) curr-s
0910: 65 63 74 69 6f 6e 2d 6e 61 6d 65 29 29 29 0a 09  ection-name)))..
0920: 20 20 20 20 20 20 20 28 73 65 63 74 69 6f 6e 2d         (section-
0930: 72 78 20 28 20 78 20 73 65 63 74 69 6f 6e 2d 6e  rx ( x section-n
0940: 61 6d 65 20 29 20 28 6c 6f 6f 70 20 28 72 65 61  ame ) (loop (rea
0950: 64 2d 6c 69 6e 65 20 69 6e 70 29 20 73 65 63 74  d-line inp) sect
0960: 69 6f 6e 2d 6e 61 6d 65 29 29 0a 09 20 20 20 20  ion-name))..    
0970: 20 20 20 28 6b 65 79 2d 73 79 73 2d 70 72 20 28     (key-sys-pr (
0980: 20 78 20 6b 65 79 20 63 6d 64 20 20 20 20 20 20   x key cmd      
0990: 29 20 28 6c 65 74 20 28 28 61 6c 69 73 74 20 28  ) (let ((alist (
09a0: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64  hash-table-ref/d
09b0: 65 66 61 75 6c 74 20 72 65 73 20 63 75 72 72 2d  efault res curr-
09c0: 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20 27 28 29  section-name '()
09d0: 29 29 0a 09 09 09 09 09 09 20 20 20 20 28 76 61  )).......    (va
09e0: 6c 20 20 20 28 6c 65 74 20 28 28 72 65 73 20 28  l   (let ((res (
09f0: 63 61 72 20 28 63 6d 64 2d 72 75 6e 2d 3e 6c 69  car (cmd-run->li
0a00: 73 74 20 63 6d 64 29 29 29 29 0a 09 09 09 09 09  st cmd))))......
0a10: 09 09 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c  ..     (if (null
0a20: 3f 20 72 65 73 29 0a 09 09 09 09 09 09 09 09 20  ? res)......... 
0a30: 22 22 0a 09 09 09 09 09 09 09 09 20 28 73 74 72  ""......... (str
0a40: 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20  ing-intersperse 
0a50: 72 65 73 20 22 20 22 29 29 29 29 29 0a 09 09 09  res " ")))))....
0a60: 09 09 09 28 68 61 73 68 2d 74 61 62 6c 65 2d 73  ...(hash-table-s
0a70: 65 74 21 20 72 65 73 20 63 75 72 72 2d 73 65 63  et! res curr-sec
0a80: 74 69 6f 6e 2d 6e 61 6d 65 20 0a 09 09 09 09 09  tion-name ......
0a90: 09 09 09 20 28 63 6f 6e 66 69 67 3a 61 73 73 6f  ... (config:asso
0aa0: 63 2d 73 61 66 65 2d 61 64 64 20 61 6c 69 73 74  c-safe-add alist
0ab0: 20 6b 65 79 20 76 61 6c 29 29 0a 09 09 09 09 09   key val))......
0ac0: 09 09 09 20 3b 3b 20 28 61 70 70 65 6e 64 20 61  ... ;; (append a
0ad0: 6c 69 73 74 20 28 6c 69 73 74 20 28 6c 69 73 74  list (list (list
0ae0: 20 6b 65 79 20 76 61 6c 29 29 29 29 0a 09 09 09   key val))))....
0af0: 09 09 09 28 6c 6f 6f 70 20 28 72 65 61 64 2d 6c  ...(loop (read-l
0b00: 69 6e 65 20 69 6e 70 29 20 63 75 72 72 2d 73 65  ine inp) curr-se
0b10: 63 74 69 6f 6e 2d 6e 61 6d 65 29 29 29 0a 09 20  ction-name))).. 
0b20: 20 20 20 20 20 20 28 6b 65 79 2d 76 61 6c 2d 70        (key-val-p
0b30: 72 20 28 20 78 20 6b 65 79 20 76 61 6c 20 20 20  r ( x key val   
0b40: 20 20 20 29 20 28 6c 65 74 20 28 28 61 6c 69 73     ) (let ((alis
0b50: 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65  t (hash-table-re
0b60: 66 2f 64 65 66 61 75 6c 74 20 72 65 73 20 63 75  f/default res cu
0b70: 72 72 2d 73 65 63 74 69 6f 6e 2d 6e 61 6d 65 20  rr-section-name 
0b80: 27 28 29 29 29 29 0a 09 09 09 09 09 09 28 68 61  '()))).......(ha
0b90: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 72 65  sh-table-set! re
0ba0: 73 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d 6e  s curr-section-n
0bb0: 61 6d 65 20 0a 09 09 09 09 09 09 09 09 20 28 63  ame ......... (c
0bc0: 6f 6e 66 69 67 3a 61 73 73 6f 63 2d 73 61 66 65  onfig:assoc-safe
0bd0: 2d 61 64 64 20 61 6c 69 73 74 20 6b 65 79 20 76  -add alist key v
0be0: 61 6c 29 29 0a 09 09 09 09 09 09 09 09 20 3b 3b  al))......... ;;
0bf0: 20 28 61 70 70 65 6e 64 20 61 6c 69 73 74 20 28   (append alist (
0c00: 6c 69 73 74 20 28 6c 69 73 74 20 6b 65 79 20 76  list (list key v
0c10: 61 6c 29 29 29 29 0a 09 09 09 09 09 09 28 6c 6f  al)))).......(lo
0c20: 6f 70 20 28 72 65 61 64 2d 6c 69 6e 65 20 69 6e  op (read-line in
0c30: 70 29 20 63 75 72 72 2d 73 65 63 74 69 6f 6e 2d  p) curr-section-
0c40: 6e 61 6d 65 29 29 29 0a 09 20 20 20 20 20 20 20  name)))..       
0c50: 28 65 6c 73 65 20 28 70 72 69 6e 74 20 22 45 52  (else (print "ER
0c60: 52 4f 52 3a 20 53 68 6f 75 6c 64 20 6e 6f 74 20  ROR: Should not 
0c70: 67 65 74 20 68 65 72 65 2c 5c 6e 20 20 20 5c 22  get here,\n   \"
0c80: 22 20 69 6e 6c 20 22 5c 22 22 29 0a 09 09 20 20  " inl "\"")...  
0c90: 20 20 20 28 6c 6f 6f 70 20 28 72 65 61 64 2d 6c     (loop (read-l
0ca0: 69 6e 65 20 69 6e 70 29 20 63 75 72 72 2d 73 65  ine inp) curr-se
0cb0: 63 74 69 6f 6e 2d 6e 61 6d 65 29 29 29 29 29 29  ction-name))))))
0cc0: 29 29 0a 20 20 0a 28 64 65 66 69 6e 65 20 28 66  )).  .(define (f
0cd0: 69 6e 64 2d 61 6e 64 2d 72 65 61 64 2d 63 6f 6e  ind-and-read-con
0ce0: 66 69 67 20 66 6e 61 6d 65 29 0a 20 20 28 6c 65  fig fname).  (le
0cf0: 74 2a 20 28 28 63 6f 6e 66 69 67 69 6e 66 6f 20  t* ((configinfo 
0d00: 28 66 69 6e 64 2d 63 6f 6e 66 69 67 20 66 6e 61  (find-config fna
0d10: 6d 65 29 29 0a 09 20 28 74 6f 70 70 61 74 68 20  me)).. (toppath 
0d20: 20 20 20 28 63 61 72 20 63 6f 6e 66 69 67 69 6e     (car configin
0d30: 66 6f 29 29 0a 09 20 28 63 6f 6e 66 69 67 66 69  fo)).. (configfi
0d40: 6c 65 20 28 63 61 64 72 20 63 6f 6e 66 69 67 69  le (cadr configi
0d50: 6e 66 6f 29 29 0a 09 20 28 63 6f 6e 66 69 67 64  nfo)).. (configd
0d60: 61 74 20 20 28 69 66 20 63 6f 6e 66 69 67 66 69  at  (if configfi
0d70: 6c 65 20 28 72 65 61 64 2d 63 6f 6e 66 69 67 20  le (read-config 
0d80: 63 6f 6e 66 69 67 66 69 6c 65 29 20 23 66 29 29  configfile) #f))
0d90: 29 20 3b 3b 20 28 6d 61 6b 65 2d 68 61 73 68 2d  ) ;; (make-hash-
0da0: 74 61 62 6c 65 29 29 29 29 0a 20 20 20 20 28 6c  table)))).    (l
0db0: 69 73 74 20 63 6f 6e 66 69 67 64 61 74 20 74 6f  ist configdat to
0dc0: 70 70 61 74 68 20 63 6f 6e 66 69 67 66 69 6c 65  ppath configfile
0dd0: 20 66 6e 61 6d 65 29 29 29 0a 0a 28 64 65 66 69   fname)))..(defi
0de0: 6e 65 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75  ne (config-looku
0df0: 70 20 63 66 67 64 61 74 20 73 65 63 74 69 6f 6e  p cfgdat section
0e00: 20 76 61 72 29 0a 20 20 28 6c 65 74 20 28 28 73   var).  (let ((s
0e10: 65 63 74 64 61 74 20 28 68 61 73 68 2d 74 61 62  ectdat (hash-tab
0e20: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 63  le-ref/default c
0e30: 66 67 64 61 74 20 73 65 63 74 69 6f 6e 20 27 28  fgdat section '(
0e40: 29 29 29 29 0a 20 20 20 20 28 69 66 20 28 6e 75  )))).    (if (nu
0e50: 6c 6c 3f 20 73 65 63 74 64 61 74 29 0a 09 23 66  ll? sectdat)..#f
0e60: 0a 09 28 6c 65 74 20 28 28 6d 61 74 63 68 20 28  ..(let ((match (
0e70: 61 73 73 6f 63 20 76 61 72 20 73 65 63 74 64 61  assoc var sectda
0e80: 74 29 29 29 0a 09 20 20 28 69 66 20 6d 61 74 63  t)))..  (if matc
0e90: 68 0a 09 20 20 20 20 20 20 28 63 61 64 72 20 6d  h..      (cadr m
0ea0: 61 74 63 68 29 0a 09 20 20 20 20 20 20 23 66 29  atch)..      #f)
0eb0: 29 0a 09 29 29 29 0a 0a 28 64 65 66 69 6e 65 20  )..)))..(define 
0ec0: 28 73 65 74 75 70 29 0a 20 20 28 6c 65 74 2a 20  (setup).  (let* 
0ed0: 28 28 63 6f 6e 66 69 67 66 20 28 66 69 6e 64 2d  ((configf (find-
0ee0: 63 6f 6e 66 69 67 29 29 0a 09 20 28 63 6f 6e 66  config)).. (conf
0ef0: 69 67 20 20 28 69 66 20 63 6f 6e 66 69 67 66 20  ig  (if configf 
0f00: 28 72 65 61 64 2d 63 6f 6e 66 69 67 20 63 6f 6e  (read-config con
0f10: 66 69 67 66 29 20 23 66 29 29 29 0a 20 20 20 20  figf) #f))).    
0f20: 28 69 66 20 63 6f 6e 66 69 67 0a 09 28 73 65 74  (if config..(set
0f30: 65 6e 76 20 22 52 55 4e 5f 41 52 45 41 5f 48 4f  env "RUN_AREA_HO
0f40: 4d 45 22 20 28 70 61 74 68 6e 61 6d 65 2d 64 69  ME" (pathname-di
0f50: 72 65 63 74 6f 72 79 20 63 6f 6e 66 69 67 66 29  rectory configf)
0f60: 29 29 0a 20 20 20 20 63 6f 6e 66 69 67 29 29 0a  )).    config)).
0f70: 0a                                               .