Artifact
16328a4b96855ff258b737450c8ca6e628435f5d:
0000: 0a 3b 3b 20 43 6f 70 79 72 69 67 68 74 20 32 30 .;; Copyright 20
0010: 30 36 2d 32 30 31 32 2c 20 4d 61 74 74 68 65 77 06-2012, Matthew
0020: 20 57 65 6c 6c 61 6e 64 2e 0a 3b 3b 20 0a 3b 3b Welland..;; .;;
0030: 20 54 68 69 73 20 66 69 6c 65 20 69 73 20 70 61 This file is pa
0040: 72 74 20 6f 66 20 4d 65 67 61 74 65 73 74 2e 0a rt of Megatest..
0050: 3b 3b 20 0a 3b 3b 20 20 20 20 20 4d 65 67 61 74 ;; .;; Megat
0060: 65 73 74 20 69 73 20 66 72 65 65 20 73 6f 66 74 est is free soft
0070: 77 61 72 65 3a 20 79 6f 75 20 63 61 6e 20 72 65 ware: you can re
0080: 64 69 73 74 72 69 62 75 74 65 20 69 74 20 61 6e distribute it an
0090: 64 2f 6f 72 20 6d 6f 64 69 66 79 0a 3b 3b 20 20 d/or modify.;;
00a0: 20 20 20 69 74 20 75 6e 64 65 72 20 74 68 65 20 it under the
00b0: 74 65 72 6d 73 20 6f 66 20 74 68 65 20 47 4e 55 terms of the GNU
00c0: 20 47 65 6e 65 72 61 6c 20 50 75 62 6c 69 63 20 General Public
00d0: 4c 69 63 65 6e 73 65 20 61 73 20 70 75 62 6c 69 License as publi
00e0: 73 68 65 64 20 62 79 0a 3b 3b 20 20 20 20 20 74 shed by.;; t
00f0: 68 65 20 46 72 65 65 20 53 6f 66 74 77 61 72 65 he Free Software
0100: 20 46 6f 75 6e 64 61 74 69 6f 6e 2c 20 65 69 74 Foundation, eit
0110: 68 65 72 20 76 65 72 73 69 6f 6e 20 33 20 6f 66 her version 3 of
0120: 20 74 68 65 20 4c 69 63 65 6e 73 65 2c 20 6f 72 the License, or
0130: 0a 3b 3b 20 20 20 20 20 28 61 74 20 79 6f 75 72 .;; (at your
0140: 20 6f 70 74 69 6f 6e 29 20 61 6e 79 20 6c 61 74 option) any lat
0150: 65 72 20 76 65 72 73 69 6f 6e 2e 0a 3b 3b 20 0a er version..;; .
0160: 3b 3b 20 20 20 20 20 4d 65 67 61 74 65 73 74 20 ;; Megatest
0170: 69 73 20 64 69 73 74 72 69 62 75 74 65 64 20 69 is distributed i
0180: 6e 20 74 68 65 20 68 6f 70 65 20 74 68 61 74 20 n the hope that
0190: 69 74 20 77 69 6c 6c 20 62 65 20 75 73 65 66 75 it will be usefu
01a0: 6c 2c 0a 3b 3b 20 20 20 20 20 62 75 74 20 57 49 l,.;; but WI
01b0: 54 48 4f 55 54 20 41 4e 59 20 57 41 52 52 41 4e THOUT ANY WARRAN
01c0: 54 59 3b 20 77 69 74 68 6f 75 74 20 65 76 65 6e TY; without even
01d0: 20 74 68 65 20 69 6d 70 6c 69 65 64 20 77 61 72 the implied war
01e0: 72 61 6e 74 79 20 6f 66 0a 3b 3b 20 20 20 20 20 ranty of.;;
01f0: 4d 45 52 43 48 41 4e 54 41 42 49 4c 49 54 59 20 MERCHANTABILITY
0200: 6f 72 20 46 49 54 4e 45 53 53 20 46 4f 52 20 41 or FITNESS FOR A
0210: 20 50 41 52 54 49 43 55 4c 41 52 20 50 55 52 50 PARTICULAR PURP
0220: 4f 53 45 2e 20 20 53 65 65 20 74 68 65 0a 3b 3b OSE. See the.;;
0230: 20 20 20 20 20 47 4e 55 20 47 65 6e 65 72 61 6c GNU General
0240: 20 50 75 62 6c 69 63 20 4c 69 63 65 6e 73 65 20 Public License
0250: 66 6f 72 20 6d 6f 72 65 20 64 65 74 61 69 6c 73 for more details
0260: 2e 0a 3b 3b 20 0a 3b 3b 20 20 20 20 20 59 6f 75 ..;; .;; You
0270: 20 73 68 6f 75 6c 64 20 68 61 76 65 20 72 65 63 should have rec
0280: 65 69 76 65 64 20 61 20 63 6f 70 79 20 6f 66 20 eived a copy of
0290: 74 68 65 20 47 4e 55 20 47 65 6e 65 72 61 6c 20 the GNU General
02a0: 50 75 62 6c 69 63 20 4c 69 63 65 6e 73 65 0a 3b Public License.;
02b0: 3b 20 20 20 20 20 61 6c 6f 6e 67 20 77 69 74 68 ; along with
02c0: 20 4d 65 67 61 74 65 73 74 2e 20 20 49 66 20 6e Megatest. If n
02d0: 6f 74 2c 20 73 65 65 20 3c 68 74 74 70 3a 2f 2f ot, see <http://
02e0: 77 77 77 2e 67 6e 75 2e 6f 72 67 2f 6c 69 63 65 www.gnu.org/lice
02f0: 6e 73 65 73 2f 3e 2e 0a 0a 0a 3b 3b 20 28 64 65 nses/>....;; (de
0300: 66 69 6e 65 20 69 74 65 6d 64 61 74 20 27 28 28 fine itemdat '((
0310: 72 69 70 65 6e 65 73 73 20 20 20 20 22 67 72 65 ripeness "gre
0320: 65 6e 20 72 69 70 65 20 6f 76 65 72 72 69 70 65 en ripe overripe
0330: 22 29 0a 3b 3b 20 09 09 20 20 20 20 20 28 74 65 ").;; .. (te
0340: 6d 70 65 72 61 74 75 72 65 20 22 63 6f 6f 6c 20 mperature "cool
0350: 6d 65 64 69 75 6d 20 68 6f 74 22 29 0a 3b 3b 20 medium hot").;;
0360: 09 09 20 20 20 20 20 28 73 65 61 73 6f 6e 20 20 .. (season
0370: 20 20 20 20 22 73 75 6d 6d 65 72 20 77 69 6e 74 "summer wint
0380: 65 72 20 66 61 6c 6c 20 73 70 72 69 6e 67 22 29 er fall spring")
0390: 29 29 0a 0a 28 64 65 63 6c 61 72 65 20 28 75 6e ))..(declare (un
03a0: 69 74 20 69 74 65 6d 73 29 29 0a 28 64 65 63 6c it items)).(decl
03b0: 61 72 65 20 28 75 73 65 73 20 63 6f 6d 6d 6f 6e are (uses common
03c0: 29 29 0a 0a 28 69 6e 63 6c 75 64 65 20 22 63 6f ))..(include "co
03d0: 6d 6d 6f 6e 5f 72 65 63 6f 72 64 73 2e 73 63 6d mmon_records.scm
03e0: 22 29 0a 0a 3b 3b 20 50 75 74 73 20 6f 75 74 20 ")..;; Puts out
03f0: 61 6c 6c 20 63 6f 6d 62 69 6e 61 74 69 6f 6e 73 all combinations
0400: 0a 28 64 65 66 69 6e 65 20 28 70 72 6f 63 65 73 .(define (proces
0410: 73 2d 69 74 65 6d 6c 69 73 74 20 68 69 65 72 64 s-itemlist hierd
0420: 65 70 74 68 20 63 75 72 72 69 74 65 6d 6b 65 79 epth curritemkey
0430: 20 69 74 65 6d 6c 69 73 74 29 0a 20 20 28 6c 65 itemlist). (le
0440: 74 20 28 28 72 65 73 20 27 28 29 29 29 0a 20 20 t ((res '())).
0450: 20 20 28 69 66 20 28 6e 6f 74 20 68 69 65 72 64 (if (not hierd
0460: 65 70 74 68 29 0a 09 28 73 65 74 21 20 68 69 65 epth)..(set! hie
0470: 72 64 65 70 74 68 20 28 6c 65 6e 67 74 68 20 69 rdepth (length i
0480: 74 65 6d 6c 69 73 74 29 29 29 0a 20 20 20 20 28 temlist))). (
0490: 6c 65 74 20 6c 6f 6f 70 20 28 28 68 65 64 20 28 let loop ((hed (
04a0: 63 61 72 20 69 74 65 6d 6c 69 73 74 29 29 0a 09 car itemlist))..
04b0: 20 20 20 20 20 20 20 28 74 61 6c 20 28 63 64 72 (tal (cdr
04c0: 20 69 74 65 6d 6c 69 73 74 29 29 29 0a 20 20 20 itemlist))).
04d0: 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 61 (if (null? ta
04e0: 6c 29 0a 09 20 20 28 66 6f 72 2d 65 61 63 68 20 l).. (for-each
04f0: 28 6c 61 6d 62 64 61 20 28 69 74 65 6d 29 0a 09 (lambda (item)..
0500: 09 20 20 20 20 20 20 28 69 66 20 28 3e 20 28 6c . (if (> (l
0510: 65 6e 67 74 68 20 63 75 72 72 69 74 65 6d 6b 65 ength curritemke
0520: 79 29 20 28 2d 20 68 69 65 72 64 65 70 74 68 20 y) (- hierdepth
0530: 32 29 29 0a 09 09 09 20 20 28 73 65 74 21 20 72 2)).... (set! r
0540: 65 73 20 28 61 70 70 65 6e 64 20 72 65 73 20 28 es (append res (
0550: 6c 69 73 74 20 28 61 70 70 65 6e 64 20 63 75 72 list (append cur
0560: 72 69 74 65 6d 6b 65 79 20 28 6c 69 73 74 20 28 ritemkey (list (
0570: 6c 69 73 74 20 28 63 61 72 20 68 65 64 29 20 69 list (car hed) i
0580: 74 65 6d 29 29 29 29 29 29 29 29 0a 09 09 20 20 tem))))))))...
0590: 20 20 28 63 61 64 72 20 68 65 64 29 29 0a 09 20 (cadr hed))..
05a0: 20 28 62 65 67 69 6e 0a 09 20 20 20 20 28 66 6f (begin.. (fo
05b0: 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 r-each (lambda (
05c0: 69 74 65 6d 29 0a 09 09 09 28 73 65 74 21 20 72 item)....(set! r
05d0: 65 73 20 28 61 70 70 65 6e 64 20 72 65 73 20 28 es (append res (
05e0: 70 72 6f 63 65 73 73 2d 69 74 65 6d 6c 69 73 74 process-itemlist
05f0: 20 68 69 65 72 64 65 70 74 68 20 28 61 70 70 65 hierdepth (appe
0600: 6e 64 20 63 75 72 72 69 74 65 6d 6b 65 79 20 28 nd curritemkey (
0610: 6c 69 73 74 20 28 6c 69 73 74 20 28 63 61 72 20 list (list (car
0620: 68 65 64 29 20 69 74 65 6d 29 29 29 20 74 61 6c hed) item))) tal
0630: 29 29 29 29 0a 09 09 20 20 20 20 20 20 28 63 61 ))))... (ca
0640: 64 72 20 68 65 64 29 29 0a 09 20 20 20 20 28 6c dr hed)).. (l
0650: 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 28 63 64 oop (car tal)(cd
0660: 72 20 74 61 6c 29 29 29 29 29 0a 20 20 20 20 72 r tal))))). r
0670: 65 73 29 29 0a 0a 3b 3b 20 28 69 74 65 6d 2d 61 es))..;; (item-a
0680: 73 73 6f 63 2d 3e 69 74 65 6d 2d 6c 69 73 74 20 ssoc->item-list
0690: 27 28 28 22 41 4e 49 4d 41 4c 22 20 22 45 6c 65 '(("ANIMAL" "Ele
06a0: 70 68 61 6e 74 20 4c 69 6f 6e 22 29 28 22 53 45 phant Lion")("SE
06b0: 41 53 4f 4e 22 20 22 53 70 72 69 6e 67 20 46 61 ASON" "Spring Fa
06c0: 6c 6c 22 29 29 29 0a 3b 3b 20 20 20 3d 3e 20 28 ll"))).;; => (
06d0: 28 28 22 41 4e 49 4d 41 4c 22 20 22 45 6c 65 70 (("ANIMAL" "Elep
06e0: 68 61 6e 74 22 29 20 28 22 53 45 41 53 4f 4e 22 hant") ("SEASON"
06f0: 20 22 53 70 72 69 6e 67 22 29 29 20 0a 3b 3b 20 "Spring")) .;;
0700: 20 20 20 20 20 20 28 28 22 41 4e 49 4d 41 4c 22 (("ANIMAL"
0710: 20 22 45 6c 65 70 68 61 6e 74 22 29 20 28 22 53 "Elephant") ("S
0720: 45 41 53 4f 4e 22 20 22 46 61 6c 6c 22 29 29 20 EASON" "Fall"))
0730: 0a 3b 3b 20 20 20 20 20 20 20 28 28 22 41 4e 49 .;; (("ANI
0740: 4d 41 4c 22 20 22 4c 69 6f 6e 22 29 20 20 20 20 MAL" "Lion")
0750: 20 28 22 53 45 41 53 4f 4e 22 20 22 53 70 72 69 ("SEASON" "Spri
0760: 6e 67 22 29 29 0a 3b 3b 20 20 20 20 20 20 20 28 ng")).;; (
0770: 28 22 41 4e 49 4d 41 4c 22 20 22 4c 69 6f 6e 22 ("ANIMAL" "Lion"
0780: 29 20 20 20 20 20 28 22 53 45 41 53 4f 4e 22 20 ) ("SEASON"
0790: 22 46 61 6c 6c 22 29 29 29 0a 28 64 65 66 69 6e "Fall"))).(defin
07a0: 65 20 28 69 74 65 6d 2d 61 73 73 6f 63 2d 3e 69 e (item-assoc->i
07b0: 74 65 6d 2d 6c 69 73 74 20 69 74 65 6d 73 64 61 tem-list itemsda
07c0: 74 29 0a 20 20 28 69 66 20 28 61 6e 64 20 69 74 t). (if (and it
07d0: 65 6d 73 64 61 74 20 28 6e 6f 74 20 28 6e 75 6c emsdat (not (nul
07e0: 6c 3f 20 69 74 65 6d 73 64 61 74 29 29 29 0a 20 l? itemsdat))).
07f0: 20 20 20 20 20 28 6c 65 74 20 28 28 69 74 65 6d (let ((item
0800: 6c 73 74 20 28 66 69 6c 74 65 72 20 28 6c 61 6d lst (filter (lam
0810: 62 64 61 20 28 78 29 0a 09 09 09 20 20 20 20 20 bda (x)....
0820: 20 20 28 6c 69 73 74 3f 20 78 29 29 0a 09 09 09 (list? x))....
0830: 20 20 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 (map (lambd
0840: 61 20 28 78 29 0a 09 09 09 09 20 20 20 20 28 64 a (x)..... (d
0850: 65 62 75 67 3a 70 72 69 6e 74 20 36 20 2a 64 65 ebug:print 6 *de
0860: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
0870: 22 69 74 65 6d 2d 61 73 73 6f 63 2d 3e 69 74 65 "item-assoc->ite
0880: 6d 2d 6c 69 73 74 20 78 3a 20 22 20 78 29 0a 09 m-list x: " x)..
0890: 09 09 09 20 20 20 20 28 69 66 20 28 3c 20 28 6c ... (if (< (l
08a0: 65 6e 67 74 68 20 78 29 20 32 29 0a 09 09 09 09 ength x) 2).....
08b0: 09 28 62 65 67 69 6e 0a 09 09 09 09 09 20 20 28 .(begin...... (
08c0: 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f debug:print-erro
08d0: 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 r 0 *default-log
08e0: 2d 70 6f 72 74 2a 20 22 6d 61 6c 66 6f 72 6d 65 -port* "malforme
08f0: 64 20 69 74 65 6d 73 20 73 70 65 63 20 22 20 28 d items spec " (
0900: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
0910: 73 65 20 78 20 22 20 22 29 29 0a 09 09 09 09 09 se x " "))......
0920: 20 20 28 6c 69 73 74 20 28 63 61 72 20 78 29 27 (list (car x)'
0930: 28 29 29 29 0a 09 09 09 09 09 28 6c 65 74 2a 20 ()))......(let*
0940: 28 28 6e 61 6d 65 20 28 63 61 72 20 78 29 29 0a ((name (car x)).
0950: 09 09 09 09 09 20 20 20 20 20 20 20 28 69 74 65 ..... (ite
0960: 6d 73 20 28 63 61 64 72 20 78 29 29 0a 09 09 09 ms (cadr x))....
0970: 09 09 20 20 20 20 20 20 20 28 69 6c 69 73 74 20 .. (ilist
0980: 28 6c 69 73 74 20 6e 61 6d 65 20 28 69 66 20 28 (list name (if (
0990: 73 74 72 69 6e 67 3f 20 69 74 65 6d 73 29 0a 09 string? items)..
09a0: 09 09 09 09 09 09 09 20 20 20 20 20 28 73 74 72 ....... (str
09b0: 69 6e 67 2d 73 70 6c 69 74 20 69 74 65 6d 73 29 ing-split items)
09c0: 0a 09 09 09 09 09 09 09 09 20 20 20 20 20 27 28 ......... '(
09d0: 29 29 29 29 29 0a 09 09 09 09 09 20 20 28 69 66 )))))...... (if
09e0: 20 28 6e 75 6c 6c 3f 20 69 6c 69 73 74 29 0a 09 (null? ilist)..
09f0: 09 09 09 09 20 20 20 20 20 20 28 64 65 62 75 67 .... (debug
0a00: 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a :print-error 0 *
0a10: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
0a20: 2a 20 22 4e 6f 20 69 74 65 6d 73 20 73 70 65 63 * "No items spec
0a30: 69 66 69 65 64 20 66 6f 72 20 22 20 6e 61 6d 65 ified for " name
0a40: 29 29 0a 09 09 09 09 09 20 20 69 6c 69 73 74 29 ))...... ilist)
0a50: 29 29 0a 09 09 09 09 20 20 69 74 65 6d 73 64 61 ))..... itemsda
0a60: 74 29 29 29 29 0a 09 28 6c 65 74 20 28 28 64 65 t))))..(let ((de
0a70: 62 75 67 6c 65 76 65 6c 20 35 29 29 0a 09 20 20 buglevel 5))..
0a80: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 35 20 2a (debug:print 5 *
0a90: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
0aa0: 2a 20 22 69 74 65 6d 2d 61 73 73 6f 63 2d 3e 69 * "item-assoc->i
0ab0: 74 65 6d 2d 6c 69 73 74 3a 20 69 74 65 6d 73 64 tem-list: itemsd
0ac0: 61 74 20 3d 3e 20 69 74 65 6d 6c 73 74 20 22 29 at => itemlst ")
0ad0: 0a 09 20 20 28 69 66 20 28 64 65 62 75 67 3a 64 .. (if (debug:d
0ae0: 65 62 75 67 2d 6d 6f 64 65 20 35 29 0a 09 20 20 ebug-mode 5)..
0af0: 20 20 20 20 28 62 65 67 69 6e 0a 09 09 28 70 70 (begin...(pp
0b00: 20 69 74 65 6d 73 64 61 74 29 0a 09 09 28 70 72 itemsdat)...(pr
0b10: 69 6e 74 20 22 20 3d 3e 20 22 29 0a 09 09 28 70 int " => ")...(p
0b20: 70 20 69 74 65 6d 6c 73 74 29 29 29 29 0a 09 28 p itemlst))))..(
0b30: 69 66 20 28 3e 20 28 6c 65 6e 67 74 68 20 69 74 if (> (length it
0b40: 65 6d 6c 73 74 29 20 30 29 0a 09 20 20 20 20 28 emlst) 0).. (
0b50: 70 72 6f 63 65 73 73 2d 69 74 65 6d 6c 69 73 74 process-itemlist
0b60: 20 23 66 20 27 28 29 20 69 74 65 6d 6c 73 74 29 #f '() itemlst)
0b70: 0a 09 20 20 20 20 27 28 29 29 29 0a 20 20 20 20 .. '())).
0b80: 20 20 27 28 29 29 29 20 3b 3b 20 72 65 74 75 72 '())) ;; retur
0b90: 6e 20 61 20 6c 69 73 74 20 63 6f 6e 73 69 73 74 n a list consist
0ba0: 69 6e 67 20 6f 6e 20 61 20 73 69 6e 67 6c 65 20 ing on a single
0bb0: 6e 75 6c 6c 20 6c 69 73 74 20 66 6f 72 20 6e 6f null list for no
0bc0: 6e 2d 69 74 65 6d 20 72 75 6e 73 0a 20 20 20 20 n-item runs.
0bd0: 20 20 20 20 20 20 20 20 3b 3b 20 4e 6f 70 65 2c ;; Nope,
0be0: 20 6e 6f 74 20 6e 6f 77 2c 20 72 65 74 75 72 6e not now, return
0bf0: 20 6e 75 6c 6c 20 61 73 20 6f 66 20 36 2f 36 2f null as of 6/6/
0c00: 32 30 31 31 0a 0a 3b 3b 20 28 69 74 65 6d 2d 74 2011..;; (item-t
0c10: 61 62 6c 65 2d 3e 69 74 65 6d 2d 6c 69 73 74 20 able->item-list
0c20: 27 28 28 22 41 4e 49 4d 41 4c 22 20 22 45 6c 65 '(("ANIMAL" "Ele
0c30: 70 68 61 6e 74 20 4c 69 6f 6e 22 29 28 22 53 45 phant Lion")("SE
0c40: 41 53 4f 4e 22 20 22 53 70 72 69 6e 67 20 57 69 ASON" "Spring Wi
0c50: 6e 74 65 72 22 29 29 29 0a 3b 3b 20 20 20 3d 3e nter"))).;; =>
0c60: 20 28 28 28 22 41 4e 49 4d 41 4c 22 20 22 45 6c ((("ANIMAL" "El
0c70: 65 70 68 61 6e 74 22 29 28 22 53 45 41 53 4f 4e ephant")("SEASON
0c80: 22 20 22 53 70 72 69 6e 67 22 29 29 0a 3b 3b 20 " "Spring")).;;
0c90: 20 20 20 20 20 20 28 28 22 41 4e 49 4d 41 4c 22 (("ANIMAL"
0ca0: 20 22 4c 69 6f 6e 22 29 20 20 20 20 28 22 53 45 "Lion") ("SE
0cb0: 41 53 4f 4e 22 20 22 57 69 6e 74 65 72 22 29 29 ASON" "Winter"))
0cc0: 29 0a 28 64 65 66 69 6e 65 20 28 69 74 65 6d 2d ).(define (item-
0cd0: 74 61 62 6c 65 2d 3e 69 74 65 6d 2d 6c 69 73 74 table->item-list
0ce0: 20 69 74 65 6d 74 61 62 6c 65 29 0a 20 20 28 6c itemtable). (l
0cf0: 65 74 20 28 28 6e 65 77 6c 73 74 20 28 6d 61 70 et ((newlst (map
0d00: 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 20 (lambda (x)...
0d10: 20 20 20 20 20 20 28 69 66 20 28 3e 20 28 6c 65 (if (> (le
0d20: 6e 67 74 68 20 78 29 20 31 29 0a 09 09 09 20 20 ngth x) 1)....
0d30: 20 28 6c 69 73 74 20 28 63 61 72 20 78 29 0a 09 (list (car x)..
0d40: 09 09 09 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 ... (string-spli
0d50: 74 20 28 63 61 64 72 20 78 29 29 29 0a 09 09 09 t (cadr x)))....
0d60: 20 20 20 28 6c 69 73 74 20 78 20 27 28 29 29 29 (list x '()))
0d70: 29 0a 09 09 20 20 20 20 20 69 74 65 6d 74 61 62 )... itemtab
0d80: 6c 65 29 29 0a 09 28 72 65 73 20 20 20 20 20 27 le))..(res '
0d90: 28 29 29 29 20 3b 3b 20 61 20 6c 69 73 74 20 6f ())) ;; a list o
0da0: 66 20 69 74 65 6d 73 0a 20 20 20 20 28 6c 65 74 f items. (let
0db0: 20 6c 6f 6f 70 20 28 28 69 6e 64 78 20 20 20 20 loop ((indx
0dc0: 30 29 0a 09 20 20 20 20 20 20 20 28 69 74 65 6d 0).. (item
0dd0: 20 20 20 27 28 29 29 20 3b 3b 20 61 6e 20 69 74 '()) ;; an it
0de0: 65 6d 20 77 69 6c 6c 20 62 65 20 28 28 4b 45 59 em will be ((KEY
0df0: 4e 41 4d 45 31 20 56 41 4c 31 29 28 4b 45 59 4e NAME1 VAL1)(KEYN
0e00: 41 4d 45 32 20 56 41 4c 32 29 20 2e 2e 2e 29 0a AME2 VAL2) ...).
0e10: 09 20 20 20 20 20 20 20 28 65 6c 66 6c 61 67 20 . (elflag
0e20: 20 23 66 29 29 0a 20 20 20 20 20 20 28 66 6f 72 #f)). (for
0e30: 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 72 -each (lambda (r
0e40: 6f 77 29 0a 09 09 20 20 28 6c 65 74 20 28 28 72 ow)... (let ((r
0e50: 6f 77 6e 61 6d 65 20 28 63 61 72 20 72 6f 77 29 owname (car row)
0e60: 29 0a 09 09 09 28 72 6f 77 64 61 74 20 20 28 63 )....(rowdat (c
0e70: 61 64 72 20 72 6f 77 29 29 29 0a 09 09 20 20 20 adr row)))...
0e80: 20 28 73 65 74 21 20 69 74 65 6d 20 28 61 70 70 (set! item (app
0e90: 65 6e 64 20 69 74 65 6d 20 0a 09 09 09 09 20 20 end item .....
0ea0: 20 20 20 20 20 28 6c 69 73 74 20 0a 09 09 09 09 (list .....
0eb0: 09 28 69 66 20 28 3c 20 69 6e 64 78 20 28 6c 65 .(if (< indx (le
0ec0: 6e 67 74 68 20 72 6f 77 64 61 74 29 29 0a 09 09 ngth rowdat))...
0ed0: 09 09 09 20 20 20 20 28 6c 65 74 20 28 28 6e 65 ... (let ((ne
0ee0: 77 20 28 6c 69 73 74 20 72 6f 77 6e 61 6d 65 20 w (list rowname
0ef0: 28 6c 69 73 74 2d 72 65 66 20 72 6f 77 64 61 74 (list-ref rowdat
0f00: 20 69 6e 64 78 29 29 29 29 0a 09 09 09 09 09 20 indx))))......
0f10: 20 20 20 20 20 3b 3b 20 28 64 65 62 75 67 3a 70 ;; (debug:p
0f20: 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d rint 0 *default-
0f30: 6c 6f 67 2d 70 6f 72 74 2a 20 22 4e 65 77 3a 20 log-port* "New:
0f40: 22 20 6e 65 77 29 0a 09 09 09 09 09 20 20 20 20 " new)......
0f50: 20 20 28 73 65 74 21 20 65 6c 66 6c 61 67 20 23 (set! elflag #
0f60: 74 29 0a 09 09 09 09 09 20 20 20 20 20 20 6e 65 t)...... ne
0f70: 77 0a 09 09 09 09 09 20 20 20 20 20 20 29 20 3b w...... ) ;
0f80: 3b 20 69 2e 65 2e 20 68 61 64 20 61 74 20 6c 65 ; i.e. had at le
0f90: 61 73 74 20 6f 6e 20 6c 65 67 69 74 20 76 61 6c ast on legit val
0fa0: 75 65 20 74 6f 20 75 73 65 0a 09 09 09 09 09 20 ue to use......
0fb0: 20 20 20 28 6c 69 73 74 20 72 6f 77 6e 61 6d 65 (list rowname
0fc0: 20 22 2d 22 29 29 29 29 29 29 29 0a 09 09 6e 65 "-")))))))...ne
0fd0: 77 6c 73 74 29 0a 20 20 20 20 20 20 28 69 66 20 wlst). (if
0fe0: 65 6c 66 6c 61 67 0a 09 20 20 28 62 65 67 69 6e elflag.. (begin
0ff0: 0a 09 20 20 20 20 28 73 65 74 21 20 72 65 73 20 .. (set! res
1000: 28 61 70 70 65 6e 64 20 72 65 73 20 28 6c 69 73 (append res (lis
1010: 74 20 69 74 65 6d 29 29 29 0a 09 20 20 20 20 28 t item))).. (
1020: 6c 6f 6f 70 20 28 2b 20 69 6e 64 78 20 31 29 0a loop (+ indx 1).
1030: 09 09 20 20 27 28 29 0a 09 09 20 20 23 66 29 29 .. '()... #f))
1040: 29 0a 20 20 20 20 20 20 72 65 73 29 29 29 0a 20 ). res))).
1050: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 4e 6f ;; No
1060: 70 65 2c 20 6e 6f 74 20 6e 6f 77 2c 20 72 65 74 pe, not now, ret
1070: 75 72 6e 20 6e 75 6c 6c 20 61 73 20 6f 66 20 36 urn null as of 6
1080: 2f 36 2f 32 30 31 31 0a 09 09 0a 28 64 65 66 69 /6/2011....(defi
1090: 6e 65 20 28 69 74 65 6d 73 3a 63 68 65 63 6b 2d ne (items:check-
10a0: 76 61 6c 69 64 2d 69 74 65 6d 73 20 63 6c 61 73 valid-items clas
10b0: 73 20 69 74 65 6d 29 0a 20 20 28 6c 65 74 20 28 s item). (let (
10c0: 28 76 61 6c 69 64 2d 76 61 6c 75 65 73 20 28 6c (valid-values (l
10d0: 65 74 20 28 28 73 20 28 63 6f 6e 66 69 67 66 3a et ((s (configf:
10e0: 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 lookup *configda
10f0: 74 2a 20 22 76 61 6c 69 64 76 61 6c 75 65 73 22 t* "validvalues"
1100: 20 63 6c 61 73 73 29 29 29 0a 09 09 09 28 69 66 class)))....(if
1110: 20 73 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 s (string-split
1120: 20 73 29 20 23 66 29 29 29 29 0a 20 20 20 20 28 s) #f)))). (
1130: 69 66 20 76 61 6c 69 64 2d 76 61 6c 75 65 73 0a if valid-values.
1140: 09 28 69 66 20 28 6d 65 6d 62 65 72 20 69 74 65 .(if (member ite
1150: 6d 20 76 61 6c 69 64 2d 76 61 6c 75 65 73 29 0a m valid-values).
1160: 09 20 20 20 20 69 74 65 6d 20 23 66 29 0a 09 69 . item #f)..i
1170: 74 65 6d 29 29 29 0a 0a 3b 3b 20 20 27 28 28 22 tem)))..;; '(("
1180: 6b 31 22 20 22 6b 32 22 20 22 6b 33 22 29 0a 3b k1" "k2" "k3").;
1190: 3b 20 20 20 20 28 22 61 22 20 22 62 22 20 22 63 ; ("a" "b" "c
11a0: 22 29 0a 3b 3b 20 20 20 20 28 22 64 22 20 22 65 ").;; ("d" "e
11b0: 22 20 22 66 22 29 29 0a 3b 3b 0a 3b 3b 20 20 20 " "f")).;;.;;
11c0: 20 3d 3e 20 27 28 28 28 22 6b 31 22 20 22 61 22 => '((("k1" "a"
11d0: 29 28 22 6b 32 22 20 22 62 22 29 28 22 6b 33 22 )("k2" "b")("k3"
11e0: 20 22 63 22 29 29 0a 3b 3b 20 20 20 20 20 20 20 "c")).;;
11f0: 20 20 28 28 22 6b 31 22 20 22 64 22 29 28 22 6b (("k1" "d")("k
1200: 32 22 20 22 65 22 29 28 22 6b 33 22 20 22 66 22 2" "e")("k3" "f"
1210: 29 29 29 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 ))).;;.(define (
1220: 69 74 65 6d 73 3a 66 69 72 73 74 2d 72 6f 77 2d items:first-row-
1230: 69 6e 74 65 72 73 70 65 72 73 65 20 64 61 74 61 intersperse data
1240: 29 0a 20 20 28 69 66 20 28 3c 20 28 6c 65 6e 67 ). (if (< (leng
1250: 74 68 20 64 61 74 61 29 20 32 29 0a 20 20 20 20 th data) 2).
1260: 20 20 27 28 29 0a 20 20 20 20 20 20 28 6c 65 74 '(). (let
1270: 20 28 28 68 65 61 64 65 72 20 28 63 61 72 20 64 ((header (car d
1280: 61 74 61 29 29 0a 09 20 20 20 20 28 72 6f 77 73 ata)).. (rows
1290: 20 20 20 28 63 64 72 20 64 61 74 61 29 29 29 0a (cdr data))).
12a0: 09 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 72 .(map (lambda (r
12b0: 6f 77 29 0a 09 20 20 20 20 20 20 20 28 6d 61 70 ow).. (map
12c0: 20 6c 69 73 74 20 68 65 61 64 65 72 20 72 6f 77 list header row
12d0: 29 29 0a 09 20 20 20 20 20 72 6f 77 73 29 29 29 )).. rows)))
12e0: 29 0a 0a 3b 3b 20 6b 31 2f 6b 32 2f 6b 33 0a 3b )..;; k1/k2/k3.;
12f0: 3b 20 61 2f 62 2f 63 0a 3b 3b 20 64 2f 65 2f 66 ; a/b/c.;; d/e/f
1300: 0a 3b 3b 20 20 20 20 3d 3e 20 27 28 28 22 6b 31 .;; => '(("k1
1310: 22 20 22 6b 32 22 20 22 6b 33 22 29 0a 3b 3b 20 " "k2" "k3").;;
1320: 20 20 20 20 20 20 20 20 28 22 61 22 20 22 62 22 ("a" "b"
1330: 20 22 63 22 29 0a 3b 3b 20 20 20 20 20 20 20 20 "c").;;
1340: 20 28 22 64 22 20 22 65 22 20 22 66 22 29 29 0a ("d" "e" "f")).
1350: 3b 3b 0a 3b 3b 20 20 20 20 3d 3e 20 27 28 28 28 ;;.;; => '(((
1360: 22 6b 31 22 20 22 61 22 29 28 22 6b 32 22 20 22 "k1" "a")("k2" "
1370: 62 22 29 28 22 6b 33 22 20 22 63 22 29 29 0a 3b b")("k3" "c")).;
1380: 3b 20 20 20 20 20 20 20 20 20 28 28 22 6b 31 22 ; (("k1"
1390: 20 22 64 22 29 28 22 6b 32 22 20 22 65 22 29 28 "d")("k2" "e")(
13a0: 22 6b 33 22 20 22 66 22 29 29 29 0a 3b 3b 0a 28 "k3" "f"))).;;.(
13b0: 64 65 66 69 6e 65 20 28 69 74 65 6d 73 3a 72 65 define (items:re
13c0: 61 64 2d 69 74 65 6d 73 2d 66 69 6c 65 20 66 6e ad-items-file fn
13d0: 61 6d 65 20 66 74 79 70 65 29 20 3b 3b 20 27 73 ame ftype) ;; 's
13e0: 78 6d 6c 20 27 73 6c 61 73 68 20 27 73 70 61 63 xml 'slash 'spac
13f0: 65 20 0a 20 20 28 69 66 20 28 61 6e 64 20 66 6e e . (if (and fn
1400: 61 6d 65 20 28 66 69 6c 65 2d 65 78 69 73 74 73 ame (file-exists
1410: 3f 20 66 6e 61 6d 65 29 29 0a 20 20 20 20 20 20 ? fname)).
1420: 28 69 74 65 6d 73 3a 66 69 72 73 74 2d 72 6f 77 (items:first-row
1430: 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 63 61 -intersperse (ca
1440: 73 65 20 66 74 79 70 65 0a 09 09 09 09 20 20 20 se ftype.....
1450: 20 20 28 28 73 6c 61 73 68 20 73 70 61 63 65 29 ((slash space)
1460: 0a 09 09 09 09 20 20 20 20 20 20 28 6c 65 74 20 ..... (let
1470: 28 28 73 70 6c 69 74 74 65 72 20 28 63 61 73 65 ((splitter (case
1480: 20 66 74 79 70 65 0a 09 09 09 09 09 09 09 28 28 ftype........((
1490: 73 6c 61 73 68 29 20 28 6c 61 6d 62 64 61 20 28 slash) (lambda (
14a0: 78 29 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 x)(string-split
14b0: 78 20 22 2f 22 29 29 29 0a 09 09 09 09 09 09 09 x "/")))........
14c0: 28 65 6c 73 65 20 20 20 20 73 74 72 69 6e 67 2d (else string-
14d0: 73 70 6c 69 74 29 29 29 29 0a 09 09 09 09 09 28 split))))......(
14e0: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
14f0: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
1500: 20 22 52 65 61 64 69 6e 67 20 22 20 66 6e 61 6d "Reading " fnam
1510: 65 20 22 20 6f 66 20 74 79 70 65 20 22 20 66 74 e " of type " ft
1520: 79 70 65 29 0a 09 09 09 09 09 28 77 69 74 68 2d ype)......(with-
1530: 69 6e 70 75 74 2d 66 72 6f 6d 2d 66 69 6c 65 20 input-from-file
1540: 66 6e 61 6d 65 0a 09 09 09 09 09 20 20 28 6c 61 fname...... (la
1550: 6d 62 64 61 20 28 29 0a 09 09 09 09 09 20 20 20 mbda ()......
1560: 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 69 6e 6c (let loop ((inl
1570: 20 28 72 65 61 64 2d 6c 69 6e 65 29 29 0a 09 09 (read-line))...
1580: 09 09 09 09 20 20 20 20 20 20 20 28 72 65 73 20 .... (res
1590: 27 28 29 29 29 0a 09 09 09 09 09 20 20 20 20 20 '()))......
15a0: 20 28 69 66 20 28 65 6f 66 2d 6f 62 6a 65 63 74 (if (eof-object
15b0: 3f 20 69 6e 6c 29 0a 09 09 09 09 09 09 20 20 72 ? inl)....... r
15c0: 65 73 0a 09 09 09 09 09 09 20 20 28 6c 6f 6f 70 es....... (loop
15d0: 20 28 72 65 61 64 2d 6c 69 6e 65 29 28 63 6f 6e (read-line)(con
15e0: 73 20 28 73 70 6c 69 74 74 65 72 20 69 6e 6c 29 s (splitter inl)
15f0: 20 72 65 73 29 29 29 29 29 29 29 29 0a 09 09 09 res))))))))....
1600: 09 20 20 20 20 20 28 28 73 78 6d 6c 29 28 77 69 . ((sxml)(wi
1610: 74 68 2d 69 6e 70 75 74 2d 66 72 6f 6d 2d 66 69 th-input-from-fi
1620: 6c 65 20 66 6e 61 6d 65 20 72 65 61 64 29 29 0a le fname read)).
1630: 09 09 09 09 20 20 20 20 20 28 65 6c 73 65 20 28 .... (else (
1640: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
1650: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
1660: 20 22 69 74 65 6d 73 20 66 69 6c 65 20 74 79 70 "items file typ
1670: 65 20 22 20 66 74 79 70 65 20 22 20 6e 6f 74 20 e " ftype " not
1680: 72 65 63 6f 67 6e 69 73 65 64 22 29 29 29 29 0a recognised")))).
1690: 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 28 69 (begin..(i
16a0: 66 20 66 6e 61 6d 65 20 28 64 65 62 75 67 3a 70 f fname (debug:p
16b0: 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d rint 0 *default-
16c0: 6c 6f 67 2d 70 6f 72 74 2a 20 22 6e 6f 20 69 74 log-port* "no it
16d0: 65 6d 73 20 66 69 6c 65 20 22 20 66 6e 61 6d 65 ems file " fname
16e0: 20 22 20 66 6f 75 6e 64 22 29 29 0a 09 27 28 29 " found"))..'()
16f0: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 69 74 )))..(define (it
1700: 65 6d 73 3a 67 65 74 2d 69 74 65 6d 73 2d 66 72 ems:get-items-fr
1710: 6f 6d 2d 63 6f 6e 66 69 67 20 74 63 6f 6e 66 69 om-config tconfi
1720: 67 29 0a 20 20 28 6c 65 74 2a 20 28 28 73 6c 61 g). (let* ((sla
1730: 73 68 66 20 20 20 20 20 20 28 63 6f 6e 66 69 67 shf (config
1740: 66 3a 6c 6f 6f 6b 75 70 20 74 63 6f 6e 66 69 67 f:lookup tconfig
1750: 20 22 69 74 65 6d 6f 70 74 73 22 20 22 73 6c 61 "itemopts" "sla
1760: 73 68 22 29 29 20 3b 3b 20 61 2f 62 2f 63 5c 6e sh")) ;; a/b/c\n
1770: 64 2f 65 2f 66 5c 6e 20 2e 2e 2e 0a 09 20 28 73 d/e/f\n ..... (s
1780: 78 6d 6c 66 20 20 20 20 20 20 20 28 63 6f 6e 66 xmlf (conf
1790: 69 67 66 3a 6c 6f 6f 6b 75 70 20 74 63 6f 6e 66 igf:lookup tconf
17a0: 69 67 20 22 69 74 65 6d 6f 70 74 73 22 20 22 73 ig "itemopts" "s
17b0: 78 6d 6c 22 29 29 20 20 3b 3b 20 27 28 28 22 61 xml")) ;; '(("a
17c0: 22 20 22 62 22 20 22 63 22 29 28 22 64 22 20 22 " "b" "c")("d" "
17d0: 65 22 20 22 66 22 29 20 2e 2e 2e 29 0a 09 20 28 e" "f") ...).. (
17e0: 73 70 61 63 65 66 20 20 20 20 20 20 28 63 6f 6e spacef (con
17f0: 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 74 63 6f 6e figf:lookup tcon
1800: 66 69 67 20 22 69 74 65 6d 6f 70 74 73 22 20 22 fig "itemopts" "
1810: 73 70 61 63 65 22 29 29 20 3b 3b 20 61 20 62 20 space")) ;; a b
1820: 63 5c 6e 64 20 65 20 66 5c 6e 20 2e 2e 2e 0a 09 c\nd e f\n .....
1830: 20 28 68 61 76 65 2d 69 74 65 6d 73 20 20 28 68 (have-items (h
1840: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
1850: 66 61 75 6c 74 20 74 63 6f 6e 66 69 67 20 22 69 fault tconfig "i
1860: 74 65 6d 73 22 20 20 20 20 20 20 23 66 29 29 0a tems" #f)).
1870: 09 20 28 68 61 76 65 2d 69 74 61 62 6c 65 20 28 . (have-itable (
1880: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d
1890: 65 66 61 75 6c 74 20 74 63 6f 6e 66 69 67 20 22 efault tconfig "
18a0: 69 74 65 6d 73 74 61 62 6c 65 22 20 23 66 29 29 itemstable" #f))
18b0: 0a 09 20 28 69 74 65 6d 73 20 20 20 20 20 20 20 .. (items
18c0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/
18d0: 64 65 66 61 75 6c 74 20 74 63 6f 6e 66 69 67 20 default tconfig
18e0: 22 69 74 65 6d 73 22 20 20 20 20 20 20 27 28 29 "items" '()
18f0: 29 29 0a 09 20 28 69 74 65 6d 73 74 61 62 6c 65 )).. (itemstable
1900: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 (hash-table-re
1910: 66 2f 64 65 66 61 75 6c 74 20 74 63 6f 6e 66 69 f/default tconfi
1920: 67 20 22 69 74 65 6d 73 74 61 62 6c 65 22 20 27 g "itemstable" '
1930: 28 29 29 29 29 0a 20 20 20 20 28 64 65 62 75 67 ()))). (debug
1940: 3a 70 72 69 6e 74 20 35 20 2a 64 65 66 61 75 6c :print 5 *defaul
1950: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 69 74 65 t-log-port* "ite
1960: 6d 73 3a 20 22 20 69 74 65 6d 73 20 22 20 69 74 ms: " items " it
1970: 65 6d 73 74 61 62 6c 65 3a 20 22 20 69 74 65 6d emstable: " item
1980: 73 74 61 62 6c 65 29 0a 20 20 20 20 28 73 65 74 stable). (set
1990: 21 20 69 74 65 6d 73 20 28 6d 61 70 20 28 6c 61 ! items (map (la
19a0: 6d 62 64 61 20 28 69 74 65 6d 29 0a 09 09 20 20 mbda (item)...
19b0: 20 20 20 20 20 28 69 66 20 28 70 72 6f 63 65 64 (if (proced
19c0: 75 72 65 3f 20 28 63 61 64 72 20 69 74 65 6d 29 ure? (cadr item)
19d0: 29 0a 09 09 09 20 20 20 28 6c 69 73 74 20 28 63 ).... (list (c
19e0: 61 72 20 69 74 65 6d 29 28 28 63 61 64 72 20 69 ar item)((cadr i
19f0: 74 65 6d 29 29 29 20 20 3b 3b 20 65 76 61 6c 75 tem))) ;; evalu
1a00: 61 74 65 20 74 68 65 20 70 72 6f 63 0a 09 09 09 ate the proc....
1a10: 20 20 20 69 74 65 6d 29 29 0a 09 09 20 20 20 20 item))...
1a20: 20 69 74 65 6d 73 29 29 0a 20 20 20 20 28 73 65 items)). (se
1a30: 74 21 20 69 74 65 6d 73 74 61 62 6c 65 20 28 6d t! itemstable (m
1a40: 61 70 20 28 6c 61 6d 62 64 61 20 28 69 74 65 6d ap (lambda (item
1a50: 29 0a 09 09 09 20 20 20 20 28 69 66 20 28 70 72 ).... (if (pr
1a60: 6f 63 65 64 75 72 65 3f 20 28 63 61 64 72 20 69 ocedure? (cadr i
1a70: 74 65 6d 29 29 0a 09 09 09 09 28 6c 69 73 74 20 tem)).....(list
1a80: 28 63 61 72 20 69 74 65 6d 29 28 28 63 61 64 72 (car item)((cadr
1a90: 20 69 74 65 6d 29 29 29 20 20 3b 3b 20 65 76 61 item))) ;; eva
1aa0: 6c 75 61 74 65 20 74 68 65 20 70 72 6f 63 0a 09 luate the proc..
1ab0: 09 09 09 69 74 65 6d 29 29 0a 09 09 09 20 20 69 ...item)).... i
1ac0: 74 65 6d 73 74 61 62 6c 65 29 29 0a 20 20 20 20 temstable)).
1ad0: 28 69 66 20 28 61 6e 64 20 68 61 76 65 2d 69 74 (if (and have-it
1ae0: 65 6d 73 20 20 28 6e 75 6c 6c 3f 20 69 74 65 6d ems (null? item
1af0: 73 29 29 20 20 20 20 20 28 64 65 62 75 67 3a 70 s)) (debug:p
1b00: 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d rint 0 *default-
1b10: 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 41 52 4e 49 log-port* "WARNI
1b20: 4e 47 3a 5b 69 74 65 6d 73 5d 20 73 65 63 74 69 NG:[items] secti
1b30: 6f 6e 20 69 6e 20 74 65 73 74 63 6f 6e 66 69 67 on in testconfig
1b40: 20 62 75 74 20 6e 6f 20 65 6e 74 72 69 65 73 20 but no entries
1b50: 64 65 66 69 6e 65 64 22 29 29 0a 20 20 20 20 28 defined")). (
1b60: 69 66 20 28 61 6e 64 20 68 61 76 65 2d 69 74 61 if (and have-ita
1b70: 62 6c 65 20 28 6e 75 6c 6c 3f 20 69 74 65 6d 73 ble (null? items
1b80: 74 61 62 6c 65 29 29 28 64 65 62 75 67 3a 70 72 table))(debug:pr
1b90: 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c int 0 *default-l
1ba0: 6f 67 2d 70 6f 72 74 2a 20 22 57 41 52 4e 4e 47 og-port* "WARNNG
1bb0: 3a 5b 69 74 65 6d 73 74 61 62 6c 65 5d 20 73 65 :[itemstable] se
1bc0: 63 74 69 6f 6e 20 69 6e 20 74 65 73 74 63 6f 6e ction in testcon
1bd0: 66 69 67 20 62 75 74 20 6e 6f 20 65 6e 74 72 69 fig but no entri
1be0: 65 73 20 64 65 66 69 6e 65 64 22 29 29 0a 20 20 es defined")).
1bf0: 20 20 28 69 66 20 28 6f 72 20 28 6e 6f 74 20 28 (if (or (not (
1c00: 6e 75 6c 6c 3f 20 69 74 65 6d 73 29 29 0a 09 20 null? items))..
1c10: 20 20 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 69 (not (null? i
1c20: 74 65 6d 73 74 61 62 6c 65 29 29 0a 09 20 20 20 temstable))..
1c30: 20 73 6c 61 73 68 66 0a 09 20 20 20 20 73 78 6d slashf.. sxm
1c40: 6c 66 0a 09 20 20 20 20 73 70 61 63 65 66 29 0a lf.. spacef).
1c50: 09 28 61 70 70 65 6e 64 20 28 69 74 65 6d 2d 61 .(append (item-a
1c60: 73 73 6f 63 2d 3e 69 74 65 6d 2d 6c 69 73 74 20 ssoc->item-list
1c70: 69 74 65 6d 73 29 0a 09 09 28 69 74 65 6d 2d 74 items)...(item-t
1c80: 61 62 6c 65 2d 3e 69 74 65 6d 2d 6c 69 73 74 20 able->item-list
1c90: 69 74 65 6d 73 74 61 62 6c 65 29 0a 09 09 28 69 itemstable)...(i
1ca0: 74 65 6d 73 3a 72 65 61 64 2d 69 74 65 6d 73 2d tems:read-items-
1cb0: 66 69 6c 65 20 73 6c 61 73 68 66 20 27 73 6c 61 file slashf 'sla
1cc0: 73 68 29 0a 09 09 28 69 74 65 6d 73 3a 72 65 61 sh)...(items:rea
1cd0: 64 2d 69 74 65 6d 73 2d 66 69 6c 65 20 73 78 6d d-items-file sxm
1ce0: 6c 66 20 20 27 73 78 6d 6c 29 0a 09 09 28 69 74 lf 'sxml)...(it
1cf0: 65 6d 73 3a 72 65 61 64 2d 69 74 65 6d 73 2d 66 ems:read-items-f
1d00: 69 6c 65 20 73 70 61 63 65 66 20 27 73 70 61 63 ile spacef 'spac
1d10: 65 29 29 0a 09 27 28 28 29 29 29 29 29 0a 0a 3b e))..'(()))))..;
1d20: 3b 20 28 70 70 20 28 69 74 65 6d 2d 61 73 73 6f ; (pp (item-asso
1d30: 63 2d 3e 69 74 65 6d 2d 6c 69 73 74 20 69 74 65 c->item-list ite
1d40: 6d 64 61 74 29 29 0a 0a 0a 09 0a mdat)).....