Artifact
952a067a4b3baaaa3dfb8aef77ff1fb164c07aeb:
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 36 2c right 2006-2016,
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 28 75 73 65 ==========..(use
01e0: 20 66 6f 72 6d 61 74 29 0a 28 72 65 71 75 69 72 format).(requir
01f0: 65 2d 6c 69 62 72 61 72 79 20 69 75 70 29 0a 28 e-library iup).(
0200: 69 6d 70 6f 72 74 20 28 70 72 65 66 69 78 20 69 import (prefix i
0210: 75 70 20 69 75 70 3a 29 29 0a 0a 28 75 73 65 20 up iup:))..(use
0220: 63 61 6e 76 61 73 2d 64 72 61 77 29 0a 28 69 6d canvas-draw).(im
0230: 70 6f 72 74 20 63 61 6e 76 61 73 2d 64 72 61 77 port canvas-draw
0240: 2d 69 75 70 29 0a 0a 28 75 73 65 20 73 71 6c 69 -iup)..(use sqli
0250: 74 65 33 20 73 72 66 69 2d 31 20 70 6f 73 69 78 te3 srfi-1 posix
0260: 20 72 65 67 65 78 20 72 65 67 65 78 2d 63 61 73 regex regex-cas
0270: 65 20 73 72 66 69 2d 36 39 20 64 65 66 73 74 72 e srfi-69 defstr
0280: 75 63 74 20 73 70 61 72 73 65 2d 76 65 63 74 6f uct sparse-vecto
0290: 72 73 29 0a 28 69 6d 70 6f 72 74 20 28 70 72 65 rs).(import (pre
02a0: 66 69 78 20 73 71 6c 69 74 65 33 20 73 71 6c 69 fix sqlite3 sqli
02b0: 74 65 33 3a 29 29 0a 0a 28 64 65 63 6c 61 72 65 te3:))..(declare
02c0: 20 28 75 73 65 73 20 63 6f 6d 6d 6f 6e 29 29 0a (uses common)).
02d0: 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 6d (declare (uses m
02e0: 61 72 67 73 29 29 0a 28 64 65 63 6c 61 72 65 20 args)).(declare
02f0: 28 75 73 65 73 20 6b 65 79 73 29 29 0a 28 64 65 (uses keys)).(de
0300: 63 6c 61 72 65 20 28 75 73 65 73 20 69 74 65 6d clare (uses item
0310: 73 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 s)).(declare (us
0320: 65 73 20 64 62 29 29 0a 28 64 65 63 6c 61 72 65 es db)).(declare
0330: 20 28 75 73 65 73 20 63 6f 6e 66 69 67 66 29 29 (uses configf))
0340: 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 .(declare (uses
0350: 70 72 6f 63 65 73 73 29 29 0a 28 64 65 63 6c 61 process)).(decla
0360: 72 65 20 28 75 73 65 73 20 6c 61 75 6e 63 68 29 re (uses launch)
0370: 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 ).(declare (uses
0380: 20 72 75 6e 73 29 29 0a 28 64 65 63 6c 61 72 65 runs)).(declare
0390: 20 28 75 73 65 73 20 64 61 73 68 62 6f 61 72 64 (uses dashboard
03a0: 2d 74 65 73 74 73 29 29 0a 28 64 65 63 6c 61 72 -tests)).(declar
03b0: 65 20 28 75 73 65 73 20 64 61 73 68 62 6f 61 72 e (uses dashboar
03c0: 64 2d 67 75 69 6d 6f 6e 69 74 6f 72 29 29 0a 28 d-guimonitor)).(
03d0: 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 74 72 declare (uses tr
03e0: 65 65 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 ee)).(declare (u
03f0: 73 65 73 20 64 63 6f 6d 6d 6f 6e 29 29 0a 0a 3b ses dcommon))..;
0400: 3b 20 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 ; (declare (uses
0410: 20 64 61 73 68 62 6f 61 72 64 2d 6d 61 69 6e 29 dashboard-main)
0420: 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 ).(declare (uses
0430: 20 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f megatest-versio
0440: 6e 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 n)).(declare (us
0450: 65 73 20 6d 74 29 29 0a 0a 28 69 6e 63 6c 75 64 es mt))..(includ
0460: 65 20 22 63 6f 6d 6d 6f 6e 5f 72 65 63 6f 72 64 e "common_record
0470: 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 s.scm").(include
0480: 20 22 64 62 5f 72 65 63 6f 72 64 73 2e 73 63 6d "db_records.scm
0490: 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 72 75 6e ").(include "run
04a0: 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 28 _records.scm").(
04b0: 69 6e 63 6c 75 64 65 20 22 6d 65 67 61 74 65 73 include "megates
04c0: 74 2d 66 6f 73 73 69 6c 2d 68 61 73 68 2e 73 63 t-fossil-hash.sc
04d0: 6d 22 29 0a 0a 28 64 65 66 69 6e 65 20 68 65 6c m")..(define hel
04e0: 70 20 28 63 6f 6e 63 20 0a 09 20 20 20 20 20 20 p (conc ..
04f0: 22 4d 65 67 61 74 65 73 74 20 44 61 73 68 62 6f "Megatest Dashbo
0500: 61 72 64 2c 20 64 6f 63 75 6d 65 6e 74 61 74 69 ard, documentati
0510: 6f 6e 20 61 74 20 68 74 74 70 3a 2f 2f 77 77 77 on at http://www
0520: 2e 6b 69 61 74 6f 61 2e 63 6f 6d 2f 66 6f 73 73 .kiatoa.com/foss
0530: 69 6c 73 2f 6d 65 67 61 74 65 73 74 0a 20 20 76 ils/megatest. v
0540: 65 72 73 69 6f 6e 20 22 20 6d 65 67 61 74 65 73 ersion " megates
0550: 74 2d 76 65 72 73 69 6f 6e 20 22 0a 20 20 6c 69 t-version ". li
0560: 63 65 6e 73 65 20 47 50 4c 2c 20 43 6f 70 79 72 cense GPL, Copyr
0570: 69 67 68 74 20 28 43 29 20 4d 61 74 74 20 57 65 ight (C) Matt We
0580: 6c 6c 61 6e 64 20 32 30 31 32 2d 32 30 31 36 0a lland 2012-2016.
0590: 0a 55 73 61 67 65 3a 20 64 61 73 68 62 6f 61 72 .Usage: dashboar
05a0: 64 20 5b 6f 70 74 69 6f 6e 73 5d 0a 20 20 2d 68 d [options]. -h
05b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
05c0: 20 20 20 3a 20 74 68 69 73 20 68 65 6c 70 0a 20 : this help.
05d0: 20 2d 73 65 72 76 65 72 20 68 6f 73 74 3a 70 6f -server host:po
05e0: 72 74 20 20 20 20 3a 20 63 6f 6e 6e 65 63 74 20 rt : connect
05f0: 74 6f 20 68 6f 73 74 3a 70 6f 72 74 20 69 6e 73 to host:port ins
0600: 74 65 61 64 20 6f 66 20 64 62 20 61 63 63 65 73 tead of db acces
0610: 73 0a 20 20 2d 74 65 73 74 20 72 75 6e 2d 69 64 s. -test run-id
0620: 2c 74 65 73 74 2d 69 64 20 3a 20 63 6f 6e 74 72 ,test-id : contr
0630: 6f 6c 20 74 65 73 74 20 69 64 65 6e 74 69 66 69 ol test identifi
0640: 65 64 20 62 79 20 74 65 73 74 69 64 0a 20 20 2d ed by testid. -
0650: 67 75 69 6d 6f 6e 69 74 6f 72 20 20 20 20 20 20 guimonitor
0660: 20 20 20 20 3a 20 63 6f 6e 74 72 6f 6c 20 70 61 : control pa
0670: 6e 65 6c 20 66 6f 72 20 72 75 6e 73 0a 0a 4d 69 nel for runs..Mi
0680: 73 63 0a 20 20 2d 72 6f 77 73 20 4e 20 20 20 20 sc. -rows N
0690: 20 20 20 20 20 3a 20 73 65 74 20 6e 75 6d 62 65 : set numbe
06a0: 72 20 6f 66 20 72 6f 77 73 0a 22 29 29 0a 0a 3b r of rows."))..;
06b0: 3b 20 70 72 6f 63 65 73 73 20 61 72 67 73 0a 28 ; process args.(
06c0: 64 65 66 69 6e 65 20 72 65 6d 61 72 67 73 20 28 define remargs (
06d0: 61 72 67 73 3a 67 65 74 2d 61 72 67 73 20 0a 09 args:get-args ..
06e0: 09 20 28 61 72 67 76 29 0a 09 09 20 28 6c 69 73 . (argv)... (lis
06f0: 74 20 20 22 2d 72 6f 77 73 22 0a 09 09 09 22 2d t "-rows"...."-
0700: 72 75 6e 22 0a 09 09 09 22 2d 74 65 73 74 22 0a run"...."-test".
0710: 09 09 09 22 2d 64 65 62 75 67 22 0a 09 09 09 22 ..."-debug"...."
0720: 2d 68 6f 73 74 22 20 0a 09 09 09 22 2d 74 72 61 -host" ...."-tra
0730: 6e 73 70 6f 72 74 22 0a 09 09 09 29 20 0a 09 09 nsport"....) ...
0740: 20 28 6c 69 73 74 20 20 22 2d 68 22 0a 09 09 09 (list "-h"....
0750: 22 2d 75 73 65 2d 73 65 72 76 65 72 22 0a 09 09 "-use-server"...
0760: 09 22 2d 67 75 69 6d 6f 6e 69 74 6f 72 22 0a 09 ."-guimonitor"..
0770: 09 09 22 2d 6d 61 69 6e 22 0a 09 09 09 22 2d 76 .."-main"...."-v
0780: 22 0a 09 09 09 22 2d 71 22 0a 09 09 09 22 2d 75 "...."-q"...."-u
0790: 73 65 2d 6c 6f 63 61 6c 22 0a 09 09 09 29 0a 09 se-local"....)..
07a0: 09 20 61 72 67 73 3a 61 72 67 2d 68 61 73 68 0a . args:arg-hash.
07b0: 09 09 20 30 29 29 0a 0a 28 69 66 20 28 61 72 67 .. 0))..(if (arg
07c0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 68 22 29 0a s:get-arg "-h").
07d0: 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 (begin.
07e0: 20 28 70 72 69 6e 74 20 68 65 6c 70 29 0a 20 20 (print help).
07f0: 20 20 20 20 28 65 78 69 74 29 29 29 0a 0a 28 69 (exit)))..(i
0800: 66 20 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 73 f (not (launch:s
0810: 65 74 75 70 29 29 0a 20 20 20 20 28 62 65 67 69 etup)). (begi
0820: 6e 0a 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 n. (print "
0830: 46 61 69 6c 65 64 20 74 6f 20 66 69 6e 64 20 6d Failed to find m
0840: 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 2c 20 egatest.config,
0850: 65 78 69 74 69 6e 67 22 29 20 0a 20 20 20 20 20 exiting") .
0860: 20 28 65 78 69 74 20 31 29 29 29 0a 0a 3b 3b 20 (exit 1)))..;;
0870: 63 72 65 61 74 65 20 61 20 73 74 75 63 74 20 66 create a stuct f
0880: 6f 72 20 61 6c 6c 20 74 68 65 20 6d 69 73 63 65 or all the misce
0890: 6c 6c 61 6e 65 6f 75 73 20 73 74 61 74 65 0a 3b llaneous state.;
08a0: 3b 0a 28 64 65 66 73 74 72 75 63 74 20 64 3a 61 ;.(defstruct d:a
08b0: 6c 6c 64 61 74 20 0a 20 20 61 6c 6c 72 75 6e 73 lldat . allruns
08c0: 20 0a 20 20 61 6c 6c 72 75 6e 73 2d 62 79 2d 69 . allruns-by-i
08d0: 64 0a 20 20 62 75 74 74 6f 6e 64 61 74 20 0a 20 d. buttondat .
08e0: 20 63 75 72 72 2d 74 61 62 2d 6e 75 6d 0a 20 20 curr-tab-num.
08f0: 64 62 64 69 72 0a 20 20 64 62 66 70 61 74 68 0a dbdir. dbfpath.
0900: 20 20 64 62 6b 65 79 73 20 0a 20 20 64 62 6c 6f dbkeys . dblo
0910: 63 61 6c 0a 20 20 66 69 6c 74 65 72 73 2d 63 68 cal. filters-ch
0920: 61 6e 67 65 64 0a 20 20 68 65 61 64 65 72 20 20 anged. header
0930: 20 20 20 20 0a 20 20 68 69 64 65 2d 65 6d 70 74 . hide-empt
0940: 79 2d 72 75 6e 73 0a 20 20 68 69 64 65 2d 6e 6f y-runs. hide-no
0950: 74 2d 68 69 64 65 20 20 3b 3b 20 74 6f 67 67 6c t-hide ;; toggl
0960: 65 20 66 6f 72 20 68 69 64 65 2f 6e 6f 74 20 68 e for hide/not h
0970: 69 64 65 0a 20 20 68 69 64 65 2d 6e 6f 74 2d 68 ide. hide-not-h
0980: 69 64 65 2d 62 75 74 74 6f 6e 0a 20 20 68 69 64 ide-button. hid
0990: 65 2d 6e 6f 74 2d 68 69 64 65 2d 74 61 62 73 0a e-not-hide-tabs.
09a0: 20 20 69 74 65 6d 2d 74 65 73 74 2d 6e 61 6d 65 item-test-name
09b0: 73 0a 20 20 6b 65 79 73 0a 20 20 6c 61 73 74 2d s. keys. last-
09c0: 64 62 2d 75 70 64 61 74 65 20 0a 20 20 6e 75 6d db-update . num
09d0: 2d 74 65 73 74 73 0a 20 20 6e 75 6d 72 75 6e 73 -tests. numruns
09e0: 0a 20 20 70 6c 65 61 73 65 2d 75 70 64 61 74 65 . please-update
09f0: 20 20 0a 20 20 72 6f 0a 20 20 73 65 61 72 63 68 . ro. search
0a00: 70 61 74 74 73 0a 20 20 73 74 61 72 74 2d 72 75 patts. start-ru
0a10: 6e 2d 6f 66 66 73 65 74 0a 20 20 73 74 61 72 74 n-offset. start
0a20: 2d 74 65 73 74 2d 6f 66 66 73 65 74 0a 20 20 73 -test-offset. s
0a30: 74 61 74 65 2d 69 67 6e 6f 72 65 2d 68 61 73 68 tate-ignore-hash
0a40: 0a 20 20 73 74 61 74 75 73 2d 69 67 6e 6f 72 65 . status-ignore
0a50: 2d 68 61 73 68 0a 20 20 74 6f 74 2d 72 75 6e 73 -hash. tot-runs
0a60: 20 20 20 0a 20 20 75 70 64 61 74 65 2d 6d 75 74 . update-mut
0a70: 65 78 0a 20 20 75 70 64 61 74 65 72 73 0a 20 20 ex. updaters.
0a80: 75 70 64 61 74 69 6e 67 0a 20 20 75 73 65 73 65 updating. usese
0a90: 72 76 65 72 20 20 0a 20 20 29 0a 0a 28 64 65 66 rver . )..(def
0aa0: 69 6e 65 20 2a 61 6c 6c 64 61 74 2a 20 28 6d 61 ine *alldat* (ma
0ab0: 6b 65 2d 64 3a 61 6c 6c 64 61 74 0a 09 09 20 20 ke-d:alldat...
0ac0: 68 65 61 64 65 72 3a 20 23 66 20 0a 09 09 20 20 header: #f ...
0ad0: 61 6c 6c 72 75 6e 73 3a 20 27 28 29 0a 09 09 20 allruns: '()...
0ae0: 20 61 6c 6c 72 75 6e 73 2d 62 79 2d 69 64 3a 20 allruns-by-id:
0af0: 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 (make-hash-table
0b00: 29 0a 09 09 20 20 62 75 74 74 6f 6e 64 61 74 3a )... buttondat:
0b10: 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c (make-hash-tabl
0b20: 65 29 0a 09 09 20 20 73 65 61 72 63 68 70 61 74 e)... searchpat
0b30: 74 73 3a 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 ts: (make-hash-t
0b40: 61 62 6c 65 29 0a 09 09 20 20 6e 75 6d 72 75 6e able)... numrun
0b50: 73 3a 20 31 36 0a 09 09 20 20 6c 61 73 74 2d 64 s: 16... last-d
0b60: 62 2d 75 70 64 61 74 65 3a 20 30 0a 09 09 20 20 b-update: 0...
0b70: 70 6c 65 61 73 65 2d 75 70 64 61 74 65 3a 20 23 please-update: #
0b80: 74 0a 09 09 20 20 75 70 64 61 74 69 6e 67 3a 20 t... updating:
0b90: 23 66 0a 09 09 20 20 75 70 64 61 74 65 2d 6d 75 #f... update-mu
0ba0: 74 65 78 3a 20 28 6d 61 6b 65 2d 6d 75 74 65 78 tex: (make-mutex
0bb0: 29 0a 09 09 20 20 69 74 65 6d 2d 74 65 73 74 2d )... item-test-
0bc0: 6e 61 6d 65 73 3a 20 27 28 29 0a 09 09 20 20 6e names: '()... n
0bd0: 75 6d 2d 74 65 73 74 73 3a 20 31 35 0a 09 09 20 um-tests: 15...
0be0: 20 73 74 61 72 74 2d 72 75 6e 2d 6f 66 66 73 65 start-run-offse
0bf0: 74 3a 20 30 0a 09 09 20 20 73 74 61 72 74 2d 74 t: 0... start-t
0c00: 65 73 74 2d 6f 66 66 73 65 74 3a 20 30 0a 09 09 est-offset: 0...
0c10: 20 20 73 74 61 74 75 73 2d 69 67 6e 6f 72 65 2d status-ignore-
0c20: 68 61 73 68 3a 20 28 6d 61 6b 65 2d 68 61 73 68 hash: (make-hash
0c30: 2d 74 61 62 6c 65 29 0a 09 09 20 20 73 74 61 74 -table)... stat
0c40: 65 2d 69 67 6e 6f 72 65 2d 68 61 73 68 3a 20 28 e-ignore-hash: (
0c50: 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 make-hash-table)
0c60: 0a 09 09 20 20 68 69 64 65 2d 65 6d 70 74 79 2d ... hide-empty-
0c70: 72 75 6e 73 3a 20 23 66 0a 09 09 20 20 68 69 64 runs: #f... hid
0c80: 65 2d 6e 6f 74 2d 68 69 64 65 3a 20 23 74 0a 09 e-not-hide: #t..
0c90: 09 20 20 68 69 64 65 2d 6e 6f 74 2d 68 69 64 65 . hide-not-hide
0ca0: 2d 62 75 74 74 6f 6e 3a 20 23 66 0a 09 09 20 20 -button: #f...
0cb0: 68 69 64 65 2d 6e 6f 74 2d 68 69 64 65 2d 74 61 hide-not-hide-ta
0cc0: 62 73 3a 20 23 66 0a 09 09 20 20 63 75 72 72 2d bs: #f... curr-
0cd0: 74 61 62 2d 6e 75 6d 3a 20 30 0a 09 09 20 20 75 tab-num: 0... u
0ce0: 70 64 61 74 65 72 73 3a 20 28 6d 61 6b 65 2d 68 pdaters: (make-h
0cf0: 61 73 68 2d 74 61 62 6c 65 29 0a 09 09 20 20 66 ash-table)... f
0d00: 69 6c 74 65 72 73 2d 63 68 61 6e 67 65 64 3a 20 ilters-changed:
0d10: 23 66 0a 09 09 20 20 29 29 0a 0a 3b 3b 20 64 61 #f... ))..;; da
0d20: 74 61 20 66 6f 72 20 72 75 6e 73 2c 20 74 65 73 ta for runs, tes
0d30: 74 73 20 65 74 63 0a 3b 3b 0a 28 64 65 66 73 74 ts etc.;;.(defst
0d40: 72 75 63 74 20 64 3a 72 75 6e 64 61 74 0a 20 20 ruct d:rundat.
0d50: 3b 3b 20 6e 65 77 20 73 79 73 74 65 6d 0a 20 20 ;; new system.
0d60: 72 75 6e 73 2d 69 6e 64 65 78 20 20 20 20 3b 3b runs-index ;;
0d70: 20 74 61 72 67 65 74 2f 72 75 6e 6e 61 6d 65 20 target/runname
0d80: 3d 3e 20 63 6f 6c 6e 75 6d 0a 20 20 74 65 73 74 => colnum. test
0d90: 73 2d 69 6e 64 65 78 20 20 20 3b 3b 20 74 65 73 s-index ;; tes
0da0: 74 6e 61 6d 65 2f 69 74 65 6d 70 61 74 68 20 3d tname/itempath =
0db0: 3e 20 72 6f 77 6e 75 6d 0a 20 20 6d 61 74 72 69 > rownum. matri
0dc0: 78 2d 64 61 74 20 20 20 20 3b 3b 20 76 65 63 74 x-dat ;; vect
0dd0: 6f 72 20 6f 66 20 76 65 63 74 6f 72 73 20 72 6f or of vectors ro
0de0: 77 73 2f 63 6f 6c 73 0a 20 20 29 0a 0a 28 64 65 ws/cols. )..(de
0df0: 66 69 6e 65 20 28 64 3a 72 75 6e 64 61 74 2d 6d fine (d:rundat-m
0e00: 61 6b 65 2d 69 6e 69 74 29 0a 20 20 28 6d 61 6b ake-init). (mak
0e10: 65 2d 64 3a 72 75 6e 64 61 74 0a 20 20 20 72 75 e-d:rundat. ru
0e20: 6e 73 2d 69 6e 64 65 78 3a 20 28 6d 61 6b 65 2d ns-index: (make-
0e30: 68 61 73 68 2d 74 61 62 6c 65 29 0a 20 20 20 74 hash-table). t
0e40: 65 73 74 73 2d 69 6e 64 65 78 3a 20 28 6d 61 6b ests-index: (mak
0e50: 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 0a 20 20 e-hash-table).
0e60: 20 6d 61 74 72 69 78 2d 64 61 74 3a 20 28 6d 61 matrix-dat: (ma
0e70: 6b 65 2d 73 70 61 72 73 65 2d 61 72 72 61 79 29 ke-sparse-array)
0e80: 29 29 0a 0a 28 64 65 66 73 74 72 75 63 74 20 64 ))..(defstruct d
0e90: 3a 74 65 73 74 64 61 74 0a 20 20 69 64 20 20 20 :testdat. id
0ea0: 20 20 20 20 3b 3b 20 74 65 73 74 69 64 0a 20 20 ;; testid.
0eb0: 73 74 61 74 65 20 20 20 20 3b 3b 20 74 65 73 74 state ;; test
0ec0: 20 73 74 61 74 65 0a 20 20 73 74 61 74 75 73 20 state. status
0ed0: 20 20 3b 3b 20 74 65 73 74 20 73 74 61 74 75 73 ;; test status
0ee0: 0a 20 20 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 . )..(define (d
0ef0: 3a 72 75 6e 64 61 74 2d 67 65 74 2d 63 6f 6c 2d :rundat-get-col-
0f00: 6e 75 6d 20 64 61 74 20 74 61 72 67 65 74 20 72 num dat target r
0f10: 75 6e 6e 61 6d 65 20 66 6f 72 63 65 2d 73 65 74 unname force-set
0f20: 29 0a 20 20 28 6c 65 74 2a 20 28 28 72 75 6e 73 ). (let* ((runs
0f30: 2d 69 6e 64 65 78 20 28 64 3a 72 75 6e 64 61 74 -index (d:rundat
0f40: 2d 72 75 6e 73 2d 69 6e 64 65 78 20 64 61 74 29 -runs-index dat)
0f50: 29 0a 09 20 28 63 6f 6c 2d 6e 61 6d 65 20 20 20 ).. (col-name
0f60: 28 63 6f 6e 63 20 74 61 72 67 65 74 20 22 2f 22 (conc target "/"
0f70: 20 72 75 6e 6e 61 6d 65 29 29 0a 09 20 28 72 65 runname)).. (re
0f80: 73 20 20 20 20 20 20 20 20 28 68 61 73 68 2d 74 s (hash-t
0f90: 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 able-ref/default
0fa0: 20 72 75 6e 73 2d 69 6e 64 65 78 20 63 6f 6c 2d runs-index col-
0fb0: 6e 61 6d 65 20 23 66 29 29 29 0a 20 20 20 20 28 name #f))). (
0fc0: 69 66 20 72 65 73 0a 09 72 65 73 0a 09 28 69 66 if res..res..(if
0fd0: 20 66 6f 72 63 65 2d 73 65 74 0a 09 20 20 20 20 force-set..
0fe0: 28 6c 65 74 20 28 28 6d 61 78 2d 63 6f 6c 2d 6e (let ((max-col-n
0ff0: 75 6d 20 28 2b 20 31 20 28 61 70 70 6c 79 20 6d um (+ 1 (apply m
1000: 61 78 20 2d 31 20 28 68 61 73 68 2d 74 61 62 6c ax -1 (hash-tabl
1010: 65 2d 76 61 6c 75 65 73 20 72 75 6e 73 2d 69 6e e-values runs-in
1020: 64 65 78 29 29 29 29 29 0a 09 20 20 20 20 20 20 dex)))))..
1030: 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 (hash-table-set!
1040: 20 72 75 6e 73 2d 69 6e 64 65 78 20 63 6f 6c 2d runs-index col-
1050: 6e 61 6d 65 20 6d 61 78 2d 63 6f 6c 2d 6e 75 6d name max-col-num
1060: 29 0a 09 20 20 20 20 20 20 6d 61 78 2d 63 6f 6c ).. max-col
1070: 2d 6e 75 6d 29 29 29 29 29 0a 0a 28 64 65 66 69 -num)))))..(defi
1080: 6e 65 20 28 64 3a 72 75 6e 64 61 74 2d 67 65 74 ne (d:rundat-get
1090: 2d 72 6f 77 2d 6e 75 6d 20 64 61 74 20 74 65 73 -row-num dat tes
10a0: 74 6e 61 6d 65 20 69 74 65 6d 70 61 74 68 20 66 tname itempath f
10b0: 6f 72 63 65 2d 73 65 74 29 0a 20 20 28 6c 65 74 orce-set). (let
10c0: 2a 20 28 28 74 65 73 74 73 2d 69 6e 64 65 78 20 * ((tests-index
10d0: 28 64 3a 72 75 6e 64 61 74 2d 72 75 6e 73 2d 69 (d:rundat-runs-i
10e0: 6e 64 65 78 20 64 61 74 29 29 0a 09 20 28 72 6f ndex dat)).. (ro
10f0: 77 2d 6e 61 6d 65 20 20 20 20 28 63 6f 6e 63 20 w-name (conc
1100: 74 65 73 74 6e 61 6d 65 20 22 2f 22 20 69 74 65 testname "/" ite
1110: 6d 70 61 74 68 29 29 0a 09 20 28 72 65 73 20 20 mpath)).. (res
1120: 20 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 (hash-tab
1130: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 72 le-ref/default r
1140: 75 6e 73 2d 69 6e 64 65 78 20 72 6f 77 2d 6e 61 uns-index row-na
1150: 6d 65 20 23 66 29 29 29 0a 20 20 20 20 28 69 66 me #f))). (if
1160: 20 72 65 73 0a 09 72 65 73 0a 09 28 69 66 20 66 res..res..(if f
1170: 6f 72 63 65 2d 73 65 74 0a 09 20 20 20 20 28 6c orce-set.. (l
1180: 65 74 20 28 28 6d 61 78 2d 72 6f 77 2d 6e 75 6d et ((max-row-num
1190: 20 28 2b 20 31 20 28 61 70 70 6c 79 20 6d 61 78 (+ 1 (apply max
11a0: 20 2d 31 20 28 68 61 73 68 2d 74 61 62 6c 65 2d -1 (hash-table-
11b0: 76 61 6c 75 65 73 20 74 65 73 74 73 2d 69 6e 64 values tests-ind
11c0: 65 78 29 29 29 29 29 0a 09 20 20 20 20 20 20 28 ex))))).. (
11d0: 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 hash-table-set!
11e0: 72 75 6e 73 2d 69 6e 64 65 78 20 72 6f 77 2d 6e runs-index row-n
11f0: 61 6d 65 20 6d 61 78 2d 72 6f 77 2d 6e 75 6d 29 ame max-row-num)
1200: 0a 09 20 20 20 20 20 20 6d 61 78 2d 72 6f 77 2d .. max-row-
1210: 6e 75 6d 29 29 29 29 29 0a 0a 3b 3b 20 64 65 66 num)))))..;; def
1220: 61 75 6c 74 20 69 73 20 74 6f 20 4e 4f 54 20 73 ault is to NOT s
1230: 65 74 20 74 68 65 20 63 65 6c 6c 20 69 66 20 74 et the cell if t
1240: 68 65 20 63 6f 6c 75 6d 6e 20 61 6e 64 20 72 6f he column and ro
1250: 77 20 6e 61 6d 65 73 20 61 72 65 20 6e 6f 74 20 w names are not
1260: 70 72 65 2d 65 78 69 73 74 69 6e 67 0a 3b 3b 0a pre-existing.;;.
1270: 28 64 65 66 69 6e 65 20 28 64 3a 72 75 6e 64 61 (define (d:runda
1280: 74 2d 73 65 74 2d 74 65 73 74 2d 63 65 6c 6c 20 t-set-test-cell
1290: 64 61 74 20 74 61 72 67 65 74 20 72 75 6e 6e 61 dat target runna
12a0: 6d 65 20 74 65 73 74 6e 61 6d 65 20 69 74 65 6d me testname item
12b0: 70 61 74 68 20 74 65 73 74 2d 69 64 20 73 74 61 path test-id sta
12c0: 74 65 20 73 74 61 74 75 73 20 23 21 6b 65 79 20 te status #!key
12d0: 28 66 6f 72 63 65 2d 73 65 74 20 23 66 29 29 0a (force-set #f)).
12e0: 20 20 28 6c 65 74 2a 20 28 28 63 6f 6c 2d 6e 75 (let* ((col-nu
12f0: 6d 20 20 28 64 3a 72 75 6e 64 61 74 2d 67 65 74 m (d:rundat-get
1300: 2d 63 6f 6c 2d 6e 75 6d 20 64 61 74 20 74 61 72 -col-num dat tar
1310: 67 65 74 20 72 75 6e 6e 61 6d 65 20 66 6f 72 63 get runname forc
1320: 65 2d 73 65 74 29 29 0a 09 20 28 72 6f 77 2d 6e e-set)).. (row-n
1330: 75 6d 20 20 28 64 3a 72 75 6e 64 61 74 2d 67 65 um (d:rundat-ge
1340: 74 2d 72 6f 77 2d 6e 75 6d 20 64 61 74 20 74 65 t-row-num dat te
1350: 73 74 6e 61 6d 65 20 69 74 65 6d 70 61 74 68 20 stname itempath
1360: 66 6f 72 63 65 2d 73 65 74 29 29 29 0a 20 20 20 force-set))).
1370: 20 28 69 66 20 28 61 6e 64 20 72 6f 77 2d 6e 75 (if (and row-nu
1380: 6d 20 63 6f 6c 2d 6e 75 6d 29 0a 09 28 6c 65 74 m col-num)..(let
1390: 20 28 28 74 64 61 74 20 28 64 3a 74 65 73 74 64 ((tdat (d:testd
13a0: 61 74 20 0a 09 09 20 20 20 20 20 69 64 3a 20 74 at ... id: t
13b0: 65 73 74 2d 69 64 0a 09 09 20 20 20 20 20 73 74 est-id... st
13c0: 61 74 65 3a 20 73 74 61 74 65 0a 09 09 20 20 20 ate: state...
13d0: 20 20 73 74 61 74 75 73 3a 20 73 74 61 74 75 73 status: status
13e0: 29 29 29 0a 09 20 20 28 73 70 61 72 73 65 2d 61 ))).. (sparse-a
13f0: 72 72 61 79 2d 73 65 74 21 20 28 64 3a 72 75 6e rray-set! (d:run
1400: 64 61 74 2d 6d 61 74 72 69 78 2d 64 61 74 20 64 dat-matrix-dat d
1410: 61 74 29 20 63 6f 6c 2d 6e 75 6d 20 72 6f 77 2d at) col-num row-
1420: 6e 75 6d 20 74 64 61 74 29 0a 09 20 20 74 64 61 num tdat).. tda
1430: 74 29 0a 09 23 66 29 29 29 0a 0a 0a 0a 0a 0a 28 t)..#f)))......(
1440: 64 3a 61 6c 6c 64 61 74 2d 75 73 65 73 65 72 76 d:alldat-useserv
1450: 65 72 2d 73 65 74 21 20 2a 61 6c 6c 64 61 74 2a er-set! *alldat*
1460: 20 28 63 6f 6e 64 0a 09 09 09 09 20 20 20 28 28 (cond..... ((
1470: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 75 args:get-arg "-u
1480: 73 65 2d 6c 6f 63 61 6c 22 29 20 23 66 29 0a 09 se-local") #f)..
1490: 09 09 09 20 20 20 28 28 63 6f 6e 66 69 67 66 3a ... ((configf:
14a0: 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 lookup *configda
14b0: 74 2a 20 22 64 61 73 68 62 6f 61 72 64 22 20 22 t* "dashboard" "
14c0: 75 73 65 2d 73 65 72 76 65 72 22 29 0a 09 09 09 use-server")....
14d0: 09 20 20 20 20 28 6c 65 74 20 28 28 61 6e 73 20 . (let ((ans
14e0: 28 63 6f 6e 66 69 67 3a 6c 6f 6f 6b 75 70 20 2a (config:lookup *
14f0: 63 6f 6e 66 69 67 64 61 74 2a 20 22 64 61 73 68 configdat* "dash
1500: 62 6f 61 72 64 22 20 22 75 73 65 2d 73 65 72 76 board" "use-serv
1510: 65 72 22 29 29 29 0a 09 09 09 09 20 20 20 20 20 er"))).....
1520: 20 28 69 66 20 28 65 71 75 61 6c 3f 20 61 6e 73 (if (equal? ans
1530: 20 22 79 65 73 22 29 20 23 74 20 23 66 29 29 29 "yes") #t #f)))
1540: 0a 09 09 09 09 20 20 20 28 65 6c 73 65 20 23 74 ..... (else #t
1550: 29 29 29 0a 28 64 65 66 69 6e 65 20 2a 64 61 73 ))).(define *das
1560: 68 62 6f 61 72 64 2d 6d 6f 64 65 2a 20 28 73 74 hboard-mode* (st
1570: 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 28 6f 72 ring->symbol (or
1580: 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 (configf:lookup
1590: 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 64 61 *configdat* "da
15a0: 73 68 62 6f 61 72 64 22 20 22 6d 6f 64 65 22 29 shboard" "mode")
15b0: 20 22 64 61 73 68 62 6f 61 72 64 22 29 29 29 0a "dashboard"))).
15c0: 0a 28 64 3a 61 6c 6c 64 61 74 2d 64 62 64 69 72 .(d:alldat-dbdir
15d0: 2d 73 65 74 21 20 2a 61 6c 6c 64 61 74 2a 20 28 -set! *alldat* (
15e0: 64 62 3a 64 62 66 69 6c 65 2d 70 61 74 68 20 23 db:dbfile-path #
15f0: 66 29 29 20 3b 3b 20 28 63 6f 6e 63 20 28 63 6f f)) ;; (conc (co
1600: 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f nfigf:lookup *co
1610: 6e 66 69 67 64 61 74 2a 20 22 73 65 74 75 70 22 nfigdat* "setup"
1620: 20 22 6c 69 6e 6b 74 72 65 65 22 29 20 22 2f 2e "linktree") "/.
1630: 64 62 22 29 29 0a 28 64 3a 61 6c 6c 64 61 74 2d db")).(d:alldat-
1640: 64 62 6c 6f 63 61 6c 2d 73 65 74 21 20 2a 61 6c dblocal-set! *al
1650: 6c 64 61 74 2a 20 28 6d 61 6b 65 2d 64 62 72 3a ldat* (make-dbr:
1660: 64 62 73 74 72 75 63 74 20 70 61 74 68 3a 20 20 dbstruct path:
1670: 28 64 3a 61 6c 6c 64 61 74 2d 64 62 64 69 72 20 (d:alldat-dbdir
1680: 2a 61 6c 6c 64 61 74 2a 29 0a 09 09 09 09 09 09 *alldat*).......
1690: 20 20 20 6c 6f 63 61 6c 3a 20 23 74 29 29 0a 28 local: #t)).(
16a0: 64 3a 61 6c 6c 64 61 74 2d 64 62 66 70 61 74 68 d:alldat-dbfpath
16b0: 2d 73 65 74 21 20 2a 61 6c 6c 64 61 74 2a 20 28 -set! *alldat* (
16c0: 64 62 3a 64 62 66 69 6c 65 2d 70 61 74 68 20 30 db:dbfile-path 0
16d0: 29 29 0a 0a 3b 3b 20 48 41 43 4b 20 41 4c 45 52 ))..;; HACK ALER
16e0: 54 3a 20 74 68 69 73 20 69 73 20 61 20 68 61 63 T: this is a hac
16f0: 6b 2c 20 70 6c 65 61 73 65 20 66 69 78 2e 0a 28 k, please fix..(
1700: 64 3a 61 6c 6c 64 61 74 2d 72 6f 2d 73 65 74 21 d:alldat-ro-set!
1710: 20 2a 61 6c 6c 64 61 74 2a 20 28 6e 6f 74 20 28 *alldat* (not (
1720: 66 69 6c 65 2d 72 65 61 64 2d 61 63 63 65 73 73 file-read-access
1730: 3f 20 28 64 3a 61 6c 6c 64 61 74 2d 64 62 66 70 ? (d:alldat-dbfp
1740: 61 74 68 20 2a 61 6c 6c 64 61 74 2a 29 29 29 29 ath *alldat*))))
1750: 0a 0a 28 64 3a 61 6c 6c 64 61 74 2d 6b 65 79 73 ..(d:alldat-keys
1760: 2d 73 65 74 21 20 2a 61 6c 6c 64 61 74 2a 20 28 -set! *alldat* (
1770: 69 66 20 28 64 3a 61 6c 6c 64 61 74 2d 75 73 65 if (d:alldat-use
1780: 73 65 72 76 65 72 20 2a 61 6c 6c 64 61 74 2a 29 server *alldat*)
1790: 0a 09 09 09 09 20 28 72 6d 74 3a 67 65 74 2d 6b ..... (rmt:get-k
17a0: 65 79 73 29 0a 09 09 09 09 20 28 64 62 3a 67 65 eys)..... (db:ge
17b0: 74 2d 6b 65 79 73 20 28 64 3a 61 6c 6c 64 61 74 t-keys (d:alldat
17c0: 2d 64 62 6c 6f 63 61 6c 20 2a 61 6c 6c 64 61 74 -dblocal *alldat
17d0: 2a 29 29 29 29 0a 28 64 3a 61 6c 6c 64 61 74 2d *)))).(d:alldat-
17e0: 64 62 6b 65 79 73 2d 73 65 74 21 20 2a 61 6c 6c dbkeys-set! *all
17f0: 64 61 74 2a 20 28 61 70 70 65 6e 64 20 28 64 3a dat* (append (d:
1800: 61 6c 6c 64 61 74 2d 6b 65 79 73 20 2a 61 6c 6c alldat-keys *all
1810: 64 61 74 2a 29 20 28 6c 69 73 74 20 22 72 75 6e dat*) (list "run
1820: 6e 61 6d 65 22 29 29 29 0a 28 64 3a 61 6c 6c 64 name"))).(d:alld
1830: 61 74 2d 74 6f 74 2d 72 75 6e 73 2d 73 65 74 21 at-tot-runs-set!
1840: 20 2a 61 6c 6c 64 61 74 2a 20 28 69 66 20 28 64 *alldat* (if (d
1850: 3a 61 6c 6c 64 61 74 2d 75 73 65 73 65 72 76 65 :alldat-useserve
1860: 72 20 2a 61 6c 6c 64 61 74 2a 29 0a 09 09 09 09 r *alldat*).....
1870: 20 20 20 20 20 28 72 6d 74 3a 67 65 74 2d 6e 75 (rmt:get-nu
1880: 6d 2d 72 75 6e 73 20 22 25 22 29 0a 09 09 09 09 m-runs "%").....
1890: 20 20 20 20 20 28 64 62 3a 67 65 74 2d 6e 75 6d (db:get-num
18a0: 2d 72 75 6e 73 20 28 64 3a 61 6c 6c 64 61 74 2d -runs (d:alldat-
18b0: 64 62 6c 6f 63 61 6c 20 2a 61 6c 6c 64 61 74 2a dblocal *alldat*
18c0: 29 20 22 25 22 29 29 29 0a 3b 3b 0a 28 64 65 66 ) "%"))).;;.(def
18d0: 69 6e 65 20 2a 65 78 69 74 2d 73 74 61 72 74 65 ine *exit-starte
18e0: 64 2a 20 23 66 29 0a 3b 3b 20 2a 75 70 64 61 74 d* #f).;; *updat
18f0: 65 72 73 2a 20 28 6d 61 6b 65 2d 68 61 73 68 2d ers* (make-hash-
1900: 74 61 62 6c 65 29 29 0a 0a 3b 3b 20 73 6f 72 74 table))..;; sort
1910: 69 6e 67 20 67 6c 6f 62 61 6c 20 64 61 74 61 20 ing global data
1920: 28 77 6f 75 6c 64 20 61 70 70 6c 79 20 74 6f 20 (would apply to
1930: 6d 61 6e 79 20 74 65 73 74 73 75 69 74 65 73 20 many testsuites
1940: 73 6f 20 6c 65 61 76 65 20 69 74 20 67 6c 6f 62 so leave it glob
1950: 61 6c 20 66 6f 72 20 6e 6f 77 29 0a 3b 3b 0a 28 al for now).;;.(
1960: 64 65 66 69 6e 65 20 2a 74 65 73 74 73 2d 73 6f define *tests-so
1970: 72 74 2d 6f 70 74 69 6f 6e 73 2a 20 28 76 65 63 rt-options* (vec
1980: 74 6f 72 20 28 76 65 63 74 6f 72 20 22 53 6f 72 tor (vector "Sor
1990: 74 20 2b 61 22 20 27 74 65 73 74 6e 61 6d 65 20 t +a" 'testname
19a0: 20 20 22 41 53 43 22 29 0a 09 09 09 09 20 20 20 "ASC").....
19b0: 20 20 28 76 65 63 74 6f 72 20 22 53 6f 72 74 20 (vector "Sort
19c0: 2d 61 22 20 27 74 65 73 74 6e 61 6d 65 20 20 20 -a" 'testname
19d0: 22 44 45 53 43 22 29 0a 09 09 09 09 20 20 20 20 "DESC").....
19e0: 20 28 76 65 63 74 6f 72 20 22 53 6f 72 74 20 2b (vector "Sort +
19f0: 74 22 20 27 65 76 65 6e 74 5f 74 69 6d 65 20 22 t" 'event_time "
1a00: 41 53 43 22 29 0a 09 09 09 09 20 20 20 20 20 28 ASC")..... (
1a10: 76 65 63 74 6f 72 20 22 53 6f 72 74 20 2d 74 22 vector "Sort -t"
1a20: 20 27 65 76 65 6e 74 5f 74 69 6d 65 20 22 44 45 'event_time "DE
1a30: 53 43 22 29 0a 09 09 09 09 20 20 20 20 20 28 76 SC")..... (v
1a40: 65 63 74 6f 72 20 22 53 6f 72 74 20 2b 73 22 20 ector "Sort +s"
1a50: 27 73 74 61 74 65 73 74 61 74 75 73 20 22 41 53 'statestatus "AS
1a60: 43 22 29 0a 09 09 09 09 20 20 20 20 20 28 76 65 C")..... (ve
1a70: 63 74 6f 72 20 22 53 6f 72 74 20 2d 73 22 20 27 ctor "Sort -s" '
1a80: 73 74 61 74 65 73 74 61 74 75 73 20 22 44 45 53 statestatus "DES
1a90: 43 22 29 0a 09 09 09 09 20 20 20 20 20 28 76 65 C")..... (ve
1aa0: 63 74 6f 72 20 22 53 6f 72 74 20 2b 61 22 20 27 ctor "Sort +a" '
1ab0: 74 65 73 74 6e 61 6d 65 20 20 20 22 41 53 43 22 testname "ASC"
1ac0: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 2a 74 65 )))..(define *te
1ad0: 73 74 73 2d 73 6f 72 74 2d 74 79 70 65 2d 69 6e sts-sort-type-in
1ae0: 64 65 78 2a 20 27 28 28 22 2b 74 65 73 74 6e 61 dex* '(("+testna
1af0: 6d 65 22 20 30 29 0a 09 09 09 09 20 20 28 22 2d me" 0)..... ("-
1b00: 74 65 73 74 6e 61 6d 65 22 20 31 29 0a 09 09 09 testname" 1)....
1b10: 09 20 20 28 22 2b 65 76 65 6e 74 5f 74 69 6d 65 . ("+event_time
1b20: 22 20 32 29 0a 09 09 09 09 20 20 28 22 2d 65 76 " 2)..... ("-ev
1b30: 65 6e 74 5f 74 69 6d 65 22 20 33 29 0a 09 09 09 ent_time" 3)....
1b40: 09 20 20 28 22 2b 73 74 61 74 65 73 74 61 74 75 . ("+statestatu
1b50: 73 22 20 34 29 0a 09 09 09 09 20 20 28 22 2d 73 s" 4)..... ("-s
1b60: 74 61 74 65 73 74 61 74 75 73 22 20 35 29 29 29 tatestatus" 5)))
1b70: 0a 0a 3b 3b 20 44 6f 6e 27 74 20 66 6f 72 67 65 ..;; Don't forge
1b80: 74 20 74 6f 20 61 64 6a 75 73 74 20 74 68 65 20 t to adjust the
1b90: 3e 3d 20 62 65 6c 6f 77 20 69 66 20 79 6f 75 20 >= below if you
1ba0: 61 64 64 20 74 6f 20 74 68 65 20 73 6f 72 74 2d add to the sort-
1bb0: 6f 70 74 69 6f 6e 73 20 61 62 6f 76 65 0a 28 64 options above.(d
1bc0: 65 66 69 6e 65 20 28 6e 65 78 74 2d 73 6f 72 74 efine (next-sort
1bd0: 2d 6f 70 74 69 6f 6e 29 0a 20 20 28 69 66 20 28 -option). (if (
1be0: 3e 3d 20 2a 74 65 73 74 73 2d 73 6f 72 74 2d 72 >= *tests-sort-r
1bf0: 65 76 65 72 73 65 2a 20 35 29 0a 20 20 20 20 20 everse* 5).
1c00: 20 28 73 65 74 21 20 2a 74 65 73 74 73 2d 73 6f (set! *tests-so
1c10: 72 74 2d 72 65 76 65 72 73 65 2a 20 30 29 0a 20 rt-reverse* 0).
1c20: 20 20 20 20 20 28 73 65 74 21 20 2a 74 65 73 74 (set! *test
1c30: 73 2d 73 6f 72 74 2d 72 65 76 65 72 73 65 2a 20 s-sort-reverse*
1c40: 28 2b 20 2a 74 65 73 74 73 2d 73 6f 72 74 2d 72 (+ *tests-sort-r
1c50: 65 76 65 72 73 65 2a 20 31 29 29 29 0a 20 20 2a everse* 1))). *
1c60: 74 65 73 74 73 2d 73 6f 72 74 2d 72 65 76 65 72 tests-sort-rever
1c70: 73 65 2a 29 0a 0a 28 64 65 66 69 6e 65 20 2a 74 se*)..(define *t
1c80: 65 73 74 73 2d 73 6f 72 74 2d 72 65 76 65 72 73 ests-sort-revers
1c90: 65 2a 20 0a 20 20 28 6c 65 74 20 28 28 74 2d 73 e* . (let ((t-s
1ca0: 6f 72 74 20 28 61 73 73 6f 63 20 28 63 6f 6e 66 ort (assoc (conf
1cb0: 69 67 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 igf:lookup *conf
1cc0: 69 67 64 61 74 2a 20 22 64 61 73 68 62 6f 61 72 igdat* "dashboar
1cd0: 64 22 20 22 74 65 73 74 73 6f 72 74 22 29 20 2a d" "testsort") *
1ce0: 74 65 73 74 73 2d 73 6f 72 74 2d 74 79 70 65 2d tests-sort-type-
1cf0: 69 6e 64 65 78 2a 29 29 29 0a 20 20 20 20 28 69 index*))). (i
1d00: 66 20 74 2d 73 6f 72 74 0a 09 28 63 61 64 72 20 f t-sort..(cadr
1d10: 74 2d 73 6f 72 74 29 0a 09 33 29 29 29 0a 0a 28 t-sort)..3)))..(
1d20: 64 65 66 69 6e 65 20 28 67 65 74 2d 63 75 72 72 define (get-curr
1d30: 2d 73 6f 72 74 29 0a 20 20 28 76 65 63 74 6f 72 -sort). (vector
1d40: 2d 72 65 66 20 2a 74 65 73 74 73 2d 73 6f 72 74 -ref *tests-sort
1d50: 2d 6f 70 74 69 6f 6e 73 2a 20 2a 74 65 73 74 73 -options* *tests
1d60: 2d 73 6f 72 74 2d 72 65 76 65 72 73 65 2a 29 29 -sort-reverse*))
1d70: 0a 0a 28 64 65 62 75 67 3a 73 65 74 75 70 29 0a ..(debug:setup).
1d80: 0a 28 64 65 66 69 6e 65 20 75 69 64 61 74 20 23 .(define uidat #
1d90: 66 29 0a 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 f)..(define-inli
1da0: 6e 65 20 28 64 62 6f 61 72 64 3a 75 69 64 61 74 ne (dboard:uidat
1db0: 2d 67 65 74 2d 6b 65 79 63 6f 6c 20 20 76 65 63 -get-keycol vec
1dc0: 29 28 76 65 63 74 6f 72 2d 72 65 66 20 76 65 63 )(vector-ref vec
1dd0: 20 30 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 0)).(define-inl
1de0: 69 6e 65 20 28 64 62 6f 61 72 64 3a 75 69 64 61 ine (dboard:uida
1df0: 74 2d 67 65 74 2d 6c 66 74 63 6f 6c 20 20 76 65 t-get-lftcol ve
1e00: 63 29 28 76 65 63 74 6f 72 2d 72 65 66 20 76 65 c)(vector-ref ve
1e10: 63 20 31 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e c 1)).(define-in
1e20: 6c 69 6e 65 20 28 64 62 6f 61 72 64 3a 75 69 64 line (dboard:uid
1e30: 61 74 2d 67 65 74 2d 68 65 61 64 65 72 20 20 76 at-get-header v
1e40: 65 63 29 28 76 65 63 74 6f 72 2d 72 65 66 20 76 ec)(vector-ref v
1e50: 65 63 20 32 29 29 0a 28 64 65 66 69 6e 65 2d 69 ec 2)).(define-i
1e60: 6e 6c 69 6e 65 20 28 64 62 6f 61 72 64 3a 75 69 nline (dboard:ui
1e70: 64 61 74 2d 67 65 74 2d 72 75 6e 73 76 65 63 20 dat-get-runsvec
1e80: 76 65 63 29 28 76 65 63 74 6f 72 2d 72 65 66 20 vec)(vector-ref
1e90: 76 65 63 20 33 29 29 0a 0a 28 69 66 20 28 67 65 vec 3))..(if (ge
1ea0: 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 t-environment-va
1eb0: 72 69 61 62 6c 65 20 22 4d 54 5f 52 55 4e 5f 41 riable "MT_RUN_A
1ec0: 52 45 41 5f 48 4f 4d 45 22 29 28 63 68 61 6e 67 REA_HOME")(chang
1ed0: 65 2d 64 69 72 65 63 74 6f 72 79 20 28 67 65 74 e-directory (get
1ee0: 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 -environment-var
1ef0: 69 61 62 6c 65 20 22 4d 54 5f 52 55 4e 5f 41 52 iable "MT_RUN_AR
1f00: 45 41 5f 48 4f 4d 45 22 29 29 29 0a 0a 28 64 65 EA_HOME")))..(de
1f10: 66 69 6e 65 20 28 6d 65 73 73 61 67 65 2d 77 69 fine (message-wi
1f20: 6e 64 6f 77 20 6d 73 67 29 0a 20 20 28 69 75 70 ndow msg). (iup
1f30: 3a 73 68 6f 77 0a 20 20 20 28 69 75 70 3a 64 69 :show. (iup:di
1f40: 61 6c 6f 67 0a 20 20 20 20 28 69 75 70 3a 76 62 alog. (iup:vb
1f50: 6f 78 20 0a 20 20 20 20 20 28 69 75 70 3a 6c 61 ox . (iup:la
1f60: 62 65 6c 20 6d 73 67 20 23 3a 6d 61 72 67 69 6e bel msg #:margin
1f70: 20 22 34 30 78 34 30 22 29 29 29 29 29 0a 0a 28 "40x40")))))..(
1f80: 64 65 66 69 6e 65 20 28 69 75 70 6c 69 73 74 62 define (iuplistb
1f90: 6f 78 2d 66 69 6c 6c 2d 6c 69 73 74 20 6c 62 20 ox-fill-list lb
1fa0: 69 74 65 6d 73 20 23 21 6b 65 79 20 28 73 65 6c items #!key (sel
1fb0: 65 63 74 65 64 2d 69 74 65 6d 20 23 66 29 29 0a ected-item #f)).
1fc0: 20 20 28 6c 65 74 20 28 28 69 20 31 29 29 0a 20 (let ((i 1)).
1fd0: 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 (for-each (la
1fe0: 6d 62 64 61 20 28 69 74 65 6d 29 0a 09 09 28 69 mbda (item)...(i
1ff0: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 up:attribute-set
2000: 21 20 6c 62 20 28 6e 75 6d 62 65 72 2d 3e 73 74 ! lb (number->st
2010: 72 69 6e 67 20 69 29 20 69 74 65 6d 29 0a 09 09 ring i) item)...
2020: 28 69 66 20 73 65 6c 65 63 74 65 64 2d 69 74 65 (if selected-ite
2030: 6d 0a 09 09 20 20 20 20 28 69 66 20 28 65 71 75 m... (if (equ
2040: 61 6c 3f 20 73 65 6c 65 63 74 65 64 2d 69 74 65 al? selected-ite
2050: 6d 20 69 74 65 6d 29 0a 09 09 09 28 69 75 70 3a m item)....(iup:
2060: 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 6c attribute-set! l
2070: 62 20 22 56 41 4c 55 45 22 20 69 29 29 29 20 3b b "VALUE" i))) ;
2080: 3b 20 28 6e 75 6d 62 65 72 2d 3e 73 74 72 69 6e ; (number->strin
2090: 67 20 69 29 29 29 29 0a 09 09 28 73 65 74 21 20 g i))))...(set!
20a0: 69 20 28 2b 20 69 20 31 29 29 29 0a 09 20 20 20 i (+ i 1)))..
20b0: 20 20 20 69 74 65 6d 73 29 0a 20 20 20 20 3b 3b items). ;;
20c0: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d (iup:attribute-
20d0: 73 65 74 21 20 6c 62 20 22 56 41 4c 55 45 22 20 set! lb "VALUE"
20e0: 28 69 66 20 73 65 6c 65 63 74 65 64 2d 69 74 65 (if selected-ite
20f0: 6d 20 73 65 6c 65 63 74 65 64 2d 69 74 65 6d 20 m selected-item
2100: 22 22 29 29 0a 20 20 20 20 69 29 29 0a 0a 28 64 "")). i))..(d
2110: 65 66 69 6e 65 20 28 70 61 64 2d 6c 69 73 74 20 efine (pad-list
2120: 6c 20 6e 29 28 61 70 70 65 6e 64 20 6c 20 28 6d l n)(append l (m
2130: 61 6b 65 2d 6c 69 73 74 20 28 2d 20 6e 20 28 6c ake-list (- n (l
2140: 65 6e 67 74 68 20 6c 29 29 29 29 29 0a 0a 28 64 ength l)))))..(d
2150: 65 66 69 6e 65 20 28 63 6f 6c 6f 72 73 2d 73 69 efine (colors-si
2160: 6d 69 6c 61 72 3f 20 63 6f 6c 6f 72 31 20 63 6f milar? color1 co
2170: 6c 6f 72 32 29 0a 20 20 28 6c 65 74 2a 20 28 28 lor2). (let* ((
2180: 63 31 20 20 20 20 28 6d 61 70 20 73 74 72 69 6e c1 (map strin
2190: 67 2d 3e 6e 75 6d 62 65 72 20 28 73 74 72 69 6e g->number (strin
21a0: 67 2d 73 70 6c 69 74 20 63 6f 6c 6f 72 31 29 29 g-split color1))
21b0: 29 0a 09 20 28 63 32 20 20 20 20 28 6d 61 70 20 ).. (c2 (map
21c0: 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 string->number (
21d0: 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 63 6f 6c string-split col
21e0: 6f 72 32 29 29 29 0a 09 20 28 64 65 6c 74 61 20 or2))).. (delta
21f0: 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 61 20 (map (lambda (a
2200: 62 29 28 61 62 73 20 28 2d 20 61 20 62 29 29 29 b)(abs (- a b)))
2210: 20 63 31 20 63 32 29 29 29 0a 20 20 20 20 28 6e c1 c2))). (n
2220: 75 6c 6c 3f 20 28 66 69 6c 74 65 72 20 28 6c 61 ull? (filter (la
2230: 6d 62 64 61 20 28 78 29 28 3e 20 78 20 33 29 29 mbda (x)(> x 3))
2240: 20 64 65 6c 74 61 29 29 29 29 0a 0a 28 64 65 66 delta))))..(def
2250: 69 6e 65 20 28 64 62 6f 61 72 64 3a 63 6f 6d 70 ine (dboard:comp
2260: 61 72 65 2d 74 65 73 74 73 20 74 65 73 74 31 20 are-tests test1
2270: 74 65 73 74 32 29 0a 20 20 28 6c 65 74 2a 20 28 test2). (let* (
2280: 28 74 65 73 74 2d 6e 61 6d 65 31 20 20 28 64 62 (test-name1 (db
2290: 3a 74 65 73 74 2d 67 65 74 2d 74 65 73 74 6e 61 :test-get-testna
22a0: 6d 65 20 20 74 65 73 74 31 29 29 0a 09 20 28 69 me test1)).. (i
22b0: 74 65 6d 2d 70 61 74 68 31 20 20 28 64 62 3a 74 tem-path1 (db:t
22c0: 65 73 74 2d 67 65 74 2d 69 74 65 6d 2d 70 61 74 est-get-item-pat
22d0: 68 20 74 65 73 74 31 29 29 0a 09 20 28 65 76 65 h test1)).. (eve
22e0: 6e 74 74 69 6d 65 31 20 20 28 64 62 3a 74 65 73 nttime1 (db:tes
22f0: 74 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 t-get-event_time
2300: 20 74 65 73 74 31 29 29 0a 09 20 28 74 65 73 74 test1)).. (test
2310: 2d 6e 61 6d 65 32 20 20 28 64 62 3a 74 65 73 74 -name2 (db:test
2320: 2d 67 65 74 2d 74 65 73 74 6e 61 6d 65 20 20 74 -get-testname t
2330: 65 73 74 32 29 29 0a 09 20 28 69 74 65 6d 2d 70 est2)).. (item-p
2340: 61 74 68 32 20 20 28 64 62 3a 74 65 73 74 2d 67 ath2 (db:test-g
2350: 65 74 2d 69 74 65 6d 2d 70 61 74 68 20 74 65 73 et-item-path tes
2360: 74 32 29 29 0a 09 20 28 65 76 65 6e 74 74 69 6d t2)).. (eventtim
2370: 65 32 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 e2 (db:test-get
2380: 2d 65 76 65 6e 74 5f 74 69 6d 65 20 74 65 73 74 -event_time test
2390: 32 29 29 0a 09 20 28 73 61 6d 65 2d 6e 61 6d 65 2)).. (same-name
23a0: 20 20 20 28 65 71 75 61 6c 3f 20 74 65 73 74 2d (equal? test-
23b0: 6e 61 6d 65 31 20 74 65 73 74 2d 6e 61 6d 65 32 name1 test-name2
23c0: 29 29 0a 09 20 28 74 65 73 74 31 2d 74 6f 70 20 )).. (test1-top
23d0: 20 20 28 65 71 75 61 6c 3f 20 69 74 65 6d 2d 70 (equal? item-p
23e0: 61 74 68 31 20 22 22 29 29 0a 09 20 28 74 65 73 ath1 "")).. (tes
23f0: 74 32 2d 74 6f 70 20 20 20 28 65 71 75 61 6c 3f t2-top (equal?
2400: 20 69 74 65 6d 2d 70 61 74 68 32 20 22 22 29 29 item-path2 ""))
2410: 0a 09 20 28 74 65 73 74 31 2d 6f 6c 64 65 72 20 .. (test1-older
2420: 28 3e 20 65 76 65 6e 74 74 69 6d 65 31 20 65 76 (> eventtime1 ev
2430: 65 6e 74 74 69 6d 65 32 29 29 0a 09 20 28 73 61 enttime2)).. (sa
2440: 6d 65 2d 74 69 6d 65 20 20 20 28 65 71 75 61 6c me-time (equal
2450: 3f 20 65 76 65 6e 74 74 69 6d 65 31 20 65 76 65 ? eventtime1 eve
2460: 6e 74 74 69 6d 65 32 29 29 29 09 09 09 20 0a 20 nttime2)))... .
2470: 20 20 20 28 69 66 20 73 61 6d 65 2d 6e 61 6d 65 (if same-name
2480: 0a 09 28 69 66 20 73 61 6d 65 2d 74 69 6d 65 0a ..(if same-time.
2490: 09 20 20 20 20 28 73 74 72 69 6e 67 3e 3f 20 69 . (string>? i
24a0: 74 65 6d 2d 70 61 74 68 31 20 69 74 65 6d 2d 70 tem-path1 item-p
24b0: 61 74 68 32 29 0a 09 20 20 20 20 74 65 73 74 31 ath2).. test1
24c0: 2d 6f 6c 64 65 72 29 0a 09 28 69 66 20 73 61 6d -older)..(if sam
24d0: 65 2d 74 69 6d 65 0a 09 20 20 20 20 28 73 74 72 e-time.. (str
24e0: 69 6e 67 3e 3f 20 74 65 73 74 2d 6e 61 6d 65 31 ing>? test-name1
24f0: 20 74 65 73 74 2d 6e 61 6d 65 32 29 0a 09 20 20 test-name2)..
2500: 20 20 74 65 73 74 31 2d 6f 6c 64 65 72 29 29 29 test1-older)))
2510: 29 0a 0a 3b 3b 20 54 68 69 73 20 69 73 20 72 6f )..;; This is ro
2520: 75 67 68 6c 79 20 74 68 65 20 73 61 6d 65 20 61 ughly the same a
2530: 73 20 64 62 6f 61 72 64 3a 67 65 74 2d 74 65 73 s dboard:get-tes
2540: 74 73 2d 64 61 74 2c 20 73 68 6f 75 6c 64 20 6d ts-dat, should m
2550: 65 72 67 65 20 74 68 65 6d 20 69 66 20 70 6f 73 erge them if pos
2560: 73 69 62 6c 65 0a 3b 3b 0a 28 64 65 66 69 6e 65 sible.;;.(define
2570: 20 28 64 62 6f 61 72 64 3a 67 65 74 2d 74 65 73 (dboard:get-tes
2580: 74 73 2d 66 6f 72 2d 72 75 6e 2d 64 75 70 6c 69 ts-for-run-dupli
2590: 63 61 74 65 20 64 61 74 61 20 72 75 6e 2d 69 64 cate data run-id
25a0: 20 72 75 6e 20 74 65 73 74 6e 61 6d 65 70 61 74 run testnamepat
25b0: 74 20 6b 65 79 2d 76 61 6c 73 29 0a 20 20 28 6c t key-vals). (l
25c0: 65 74 2a 20 28 28 73 74 61 74 65 73 20 20 20 20 et* ((states
25d0: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 (hash-table-ke
25e0: 79 73 20 28 64 3a 61 6c 6c 64 61 74 2d 73 74 61 ys (d:alldat-sta
25f0: 74 65 2d 69 67 6e 6f 72 65 2d 68 61 73 68 20 64 te-ignore-hash d
2600: 61 74 61 29 29 29 0a 09 20 28 73 74 61 74 75 73 ata))).. (status
2610: 65 73 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c es (hash-tabl
2620: 65 2d 6b 65 79 73 20 28 64 3a 61 6c 6c 64 61 74 e-keys (d:alldat
2630: 2d 73 74 61 74 75 73 2d 69 67 6e 6f 72 65 2d 68 -status-ignore-h
2640: 61 73 68 20 64 61 74 61 29 29 29 0a 09 20 28 73 ash data))).. (s
2650: 6f 72 74 2d 69 6e 66 6f 20 20 20 28 67 65 74 2d ort-info (get-
2660: 63 75 72 72 2d 73 6f 72 74 29 29 0a 09 20 28 73 curr-sort)).. (s
2670: 6f 72 74 2d 62 79 20 20 20 20 20 28 76 65 63 74 ort-by (vect
2680: 6f 72 2d 72 65 66 20 73 6f 72 74 2d 69 6e 66 6f or-ref sort-info
2690: 20 31 29 29 0a 09 20 28 73 6f 72 74 2d 6f 72 64 1)).. (sort-ord
26a0: 65 72 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 er (vector-ref
26b0: 73 6f 72 74 2d 69 6e 66 6f 20 32 29 29 0a 09 20 sort-info 2))..
26c0: 28 62 75 62 62 6c 65 2d 74 79 70 65 20 28 69 66 (bubble-type (if
26d0: 20 28 6d 65 6d 62 65 72 20 73 6f 72 74 2d 6f 72 (member sort-or
26e0: 64 65 72 20 27 28 74 65 73 74 6e 61 6d 65 29 29 der '(testname))
26f0: 0a 09 09 09 20 20 27 74 65 73 74 6e 61 6d 65 0a .... 'testname.
2700: 09 09 09 20 20 27 69 74 65 6d 70 61 74 68 29 29 ... 'itempath))
2710: 0a 09 20 28 70 72 65 76 2d 64 61 74 20 20 20 20 .. (prev-dat
2720: 28 6c 65 74 20 28 28 72 65 63 20 28 68 61 73 68 (let ((rec (hash
2730: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau
2740: 6c 74 20 28 64 3a 61 6c 6c 64 61 74 2d 61 6c 6c lt (d:alldat-all
2750: 72 75 6e 73 2d 62 79 2d 69 64 20 64 61 74 61 29 runs-by-id data)
2760: 20 72 75 6e 2d 69 64 20 23 66 29 29 29 0a 09 09 run-id #f)))...
2770: 09 28 69 66 20 72 65 63 20 72 65 63 20 28 76 65 .(if rec rec (ve
2780: 63 74 6f 72 20 72 75 6e 20 27 28 29 20 6b 65 79 ctor run '() key
2790: 2d 76 61 6c 73 20 2d 31 30 30 29 29 29 29 20 3b -vals -100)))) ;
27a0: 3b 20 2d 31 30 30 20 69 73 20 62 65 66 6f 72 65 ; -100 is before
27b0: 20 74 69 6d 65 20 62 65 67 61 6e 0a 09 20 28 70 time began.. (p
27c0: 72 65 76 2d 74 65 73 74 73 20 20 28 76 65 63 74 rev-tests (vect
27d0: 6f 72 2d 72 65 66 20 70 72 65 76 2d 64 61 74 20 or-ref prev-dat
27e0: 31 29 29 0a 09 20 28 6c 61 73 74 2d 75 70 64 61 1)).. (last-upda
27f0: 74 65 20 28 76 65 63 74 6f 72 2d 72 65 66 20 70 te (vector-ref p
2800: 72 65 76 2d 64 61 74 20 33 29 29 0a 09 20 28 74 rev-dat 3)).. (t
2810: 6d 70 74 65 73 74 73 20 20 20 20 28 69 66 20 28 mptests (if (
2820: 64 3a 61 6c 6c 64 61 74 2d 75 73 65 73 65 72 76 d:alldat-useserv
2830: 65 72 20 64 61 74 61 29 0a 09 09 09 20 20 28 72 er data).... (r
2840: 6d 74 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 mt:get-tests-for
2850: 2d 72 75 6e 20 72 75 6e 2d 69 64 20 74 65 73 74 -run run-id test
2860: 6e 61 6d 65 70 61 74 74 20 73 74 61 74 65 73 20 namepatt states
2870: 73 74 61 74 75 73 65 73 0a 09 09 09 09 09 09 20 statuses.......
2880: 23 66 20 23 66 0a 09 09 09 09 09 09 20 28 64 3a #f #f....... (d:
2890: 61 6c 6c 64 61 74 2d 68 69 64 65 2d 6e 6f 74 2d alldat-hide-not-
28a0: 68 69 64 65 20 64 61 74 61 29 0a 09 09 09 09 09 hide data)......
28b0: 09 20 73 6f 72 74 2d 62 79 0a 09 09 09 09 09 09 . sort-by.......
28c0: 20 73 6f 72 74 2d 6f 72 64 65 72 0a 09 09 09 09 sort-order.....
28d0: 09 09 20 27 73 68 6f 72 74 6c 69 73 74 0a 09 09 .. 'shortlist...
28e0: 09 09 09 09 20 28 69 66 20 28 64 3a 61 6c 6c 64 .... (if (d:alld
28f0: 61 74 2d 66 69 6c 74 65 72 73 2d 63 68 61 6e 67 at-filters-chang
2900: 65 64 20 64 61 74 61 29 0a 09 09 09 09 09 09 20 ed data).......
2910: 20 20 20 20 30 0a 09 09 09 09 09 09 20 20 20 20 0.......
2920: 20 6c 61 73 74 2d 75 70 64 61 74 65 29 0a 09 09 last-update)...
2930: 09 09 09 09 20 2a 64 61 73 68 62 6f 61 72 64 2d .... *dashboard-
2940: 6d 6f 64 65 2a 29 20 3b 3b 20 75 73 65 20 64 61 mode*) ;; use da
2950: 73 68 62 6f 61 72 64 20 6d 6f 64 65 0a 09 09 09 shboard mode....
2960: 20 20 28 64 62 3a 67 65 74 2d 74 65 73 74 73 2d (db:get-tests-
2970: 66 6f 72 2d 72 75 6e 20 28 64 3a 61 6c 6c 64 61 for-run (d:allda
2980: 74 2d 64 62 6c 6f 63 61 6c 20 64 61 74 61 29 20 t-dblocal data)
2990: 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 70 run-id testnamep
29a0: 61 74 74 20 73 74 61 74 65 73 20 73 74 61 74 75 att states statu
29b0: 73 65 73 0a 09 09 09 09 09 09 23 66 20 23 66 0a ses.......#f #f.
29c0: 09 09 09 09 09 09 28 64 3a 61 6c 6c 64 61 74 2d ......(d:alldat-
29d0: 68 69 64 65 2d 6e 6f 74 2d 68 69 64 65 20 64 61 hide-not-hide da
29e0: 74 61 29 0a 09 09 09 09 09 09 73 6f 72 74 2d 62 ta).......sort-b
29f0: 79 0a 09 09 09 09 09 09 73 6f 72 74 2d 6f 72 64 y.......sort-ord
2a00: 65 72 0a 09 09 09 09 09 09 27 73 68 6f 72 74 6c er.......'shortl
2a10: 69 73 74 0a 09 09 09 09 09 09 28 69 66 20 28 64 ist.......(if (d
2a20: 3a 61 6c 6c 64 61 74 2d 66 69 6c 74 65 72 73 2d :alldat-filters-
2a30: 63 68 61 6e 67 65 64 20 64 61 74 61 29 0a 09 09 changed data)...
2a40: 09 09 09 09 20 20 20 20 30 0a 09 09 09 09 09 09 .... 0.......
2a50: 20 20 20 20 6c 61 73 74 2d 75 70 64 61 74 65 29 last-update)
2a60: 0a 09 09 09 09 09 09 2a 64 61 73 68 62 6f 61 72 .......*dashboar
2a70: 64 2d 6d 6f 64 65 2a 29 29 29 0a 09 20 28 74 65 d-mode*))).. (te
2a80: 73 74 73 20 20 20 20 20 20 20 28 6c 65 74 20 28 sts (let (
2a90: 28 6e 65 77 64 61 74 20 28 66 69 6c 74 65 72 0a (newdat (filter.
2aa0: 09 09 09 09 20 20 20 20 20 28 6c 61 6d 62 64 61 .... (lambda
2ab0: 20 28 78 29 0a 09 09 09 09 20 20 20 20 20 20 20 (x).....
2ac0: 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 28 64 62 (not (equal? (db
2ad0: 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 :test-get-state
2ae0: 78 29 20 22 44 45 4c 45 54 45 44 22 29 29 29 20 x) "DELETED")))
2af0: 3b 3b 20 72 65 6d 6f 76 65 20 64 65 6c 65 74 65 ;; remove delete
2b00: 64 20 74 65 73 74 73 20 62 75 74 20 64 6f 20 69 d tests but do i
2b10: 74 20 61 66 74 65 72 20 6d 65 72 67 69 6e 67 0a t after merging.
2b20: 09 09 09 09 20 20 20 20 20 28 64 65 6c 65 74 65 .... (delete
2b30: 2d 64 75 70 6c 69 63 61 74 65 73 20 28 69 66 20 -duplicates (if
2b40: 28 64 3a 61 6c 6c 64 61 74 2d 66 69 6c 74 65 72 (d:alldat-filter
2b50: 73 2d 63 68 61 6e 67 65 64 20 64 61 74 61 29 0a s-changed data).
2b60: 09 09 09 09 09 09 09 20 20 20 20 74 6d 70 74 65 ....... tmpte
2b70: 73 74 73 0a 09 09 09 09 09 09 09 20 20 20 20 28 sts........ (
2b80: 61 70 70 65 6e 64 20 74 6d 70 74 65 73 74 73 20 append tmptests
2b90: 70 72 65 76 2d 74 65 73 74 73 29 29 0a 09 09 09 prev-tests))....
2ba0: 09 09 09 09 28 6c 61 6d 62 64 61 20 28 61 20 62 ....(lambda (a b
2bb0: 29 0a 09 09 09 09 09 09 09 20 20 28 65 71 3f 20 )........ (eq?
2bc0: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 64 20 (db:test-get-id
2bd0: 61 29 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 a)(db:test-get-i
2be0: 64 20 62 29 29 29 29 29 29 29 0a 09 09 09 28 69 d b)))))))....(i
2bf0: 66 20 28 65 71 3f 20 2a 74 65 73 74 73 2d 73 6f f (eq? *tests-so
2c00: 72 74 2d 72 65 76 65 72 73 65 2a 20 33 29 20 3b rt-reverse* 3) ;
2c10: 3b 20 2b 65 76 65 6e 74 5f 74 69 6d 65 0a 09 09 ; +event_time...
2c20: 09 20 20 20 20 28 73 6f 72 74 20 6e 65 77 64 61 . (sort newda
2c30: 74 20 64 62 6f 61 72 64 3a 63 6f 6d 70 61 72 65 t dboard:compare
2c40: 2d 74 65 73 74 73 29 0a 09 09 09 20 20 20 20 6e -tests).... n
2c50: 65 77 64 61 74 29 29 29 29 0a 20 20 20 20 28 76 ewdat)))). (v
2c60: 65 63 74 6f 72 2d 73 65 74 21 20 70 72 65 76 2d ector-set! prev-
2c70: 64 61 74 20 33 20 28 2d 20 28 63 75 72 72 65 6e dat 3 (- (curren
2c80: 74 2d 73 65 63 6f 6e 64 73 29 20 32 29 29 20 3b t-seconds) 2)) ;
2c90: 3b 20 67 6f 20 62 61 63 6b 20 74 77 6f 20 73 65 ; go back two se
2ca0: 63 6f 6e 64 73 20 69 6e 20 74 69 6d 65 20 74 6f conds in time to
2cb0: 20 65 6e 73 75 72 65 20 61 6c 6c 20 63 68 61 6e ensure all chan
2cc0: 67 65 73 20 61 72 65 20 63 61 70 74 75 72 65 64 ges are captured
2cd0: 2e 0a 20 20 20 20 3b 3b 20 28 64 65 62 75 67 3a .. ;; (debug:
2ce0: 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 print 0 *default
2cf0: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 28 64 62 6f -log-port* "(dbo
2d00: 61 72 64 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f ard:get-tests-fo
2d10: 72 2d 72 75 6e 2d 64 75 70 6c 69 63 61 74 65 3a r-run-duplicate:
2d20: 20 66 69 6c 74 65 72 73 2d 63 68 61 6e 67 65 64 filters-changed
2d30: 3d 22 20 28 64 3a 61 6c 6c 64 61 74 2d 66 69 6c =" (d:alldat-fil
2d40: 74 65 72 73 2d 63 68 61 6e 67 65 64 20 64 61 74 ters-changed dat
2d50: 61 29 20 22 20 6c 61 73 74 2d 75 70 64 61 74 65 a) " last-update
2d60: 3d 22 20 6c 61 73 74 2d 75 70 64 61 74 65 20 22 =" last-update "
2d70: 20 67 6f 74 20 22 20 28 6c 65 6e 67 74 68 20 74 got " (length t
2d80: 6d 70 74 65 73 74 73 29 20 22 20 74 65 73 74 20 mptests) " test
2d90: 72 65 63 6f 72 64 73 20 66 6f 72 20 72 75 6e 20 records for run
2da0: 22 20 72 75 6e 2d 69 64 29 0a 20 20 20 20 74 65 " run-id). te
2db0: 73 74 73 29 29 0a 0a 3b 3b 20 63 72 65 61 74 65 sts))..;; create
2dc0: 20 61 20 76 69 72 74 75 61 6c 20 74 61 62 6c 65 a virtual table
2dd0: 20 6f 66 20 61 6c 6c 20 74 68 65 20 74 65 73 74 of all the test
2de0: 73 0a 3b 3b 20 6b 65 79 70 61 74 74 73 3a 20 28 s.;; keypatts: (
2df0: 20 28 4b 45 59 31 20 22 61 62 63 25 64 65 66 22 (KEY1 "abc%def"
2e00: 29 28 4b 45 59 32 20 22 25 22 29 20 29 0a 28 64 )(KEY2 "%") ).(d
2e10: 65 66 69 6e 65 20 28 75 70 64 61 74 65 2d 72 75 efine (update-ru
2e20: 6e 64 61 74 20 64 61 74 61 20 72 75 6e 6e 61 6d ndat data runnam
2e30: 65 70 61 74 74 20 6e 75 6d 72 75 6e 73 20 74 65 epatt numruns te
2e40: 73 74 6e 61 6d 65 70 61 74 74 20 6b 65 79 70 61 stnamepatt keypa
2e50: 74 74 73 29 0a 20 20 28 6c 65 74 2a 20 28 28 72 tts). (let* ((r
2e60: 65 66 65 72 65 6e 63 65 64 2d 72 75 6e 2d 69 64 eferenced-run-id
2e70: 73 20 27 28 29 29 0a 09 20 28 61 6c 6c 72 75 6e s '()).. (allrun
2e80: 73 20 20 20 20 20 28 69 66 20 28 64 3a 61 6c 6c s (if (d:all
2e90: 64 61 74 2d 75 73 65 73 65 72 76 65 72 20 64 61 dat-useserver da
2ea0: 74 61 29 0a 09 09 09 20 20 28 72 6d 74 3a 67 65 ta).... (rmt:ge
2eb0: 74 2d 72 75 6e 73 20 72 75 6e 6e 61 6d 65 70 61 t-runs runnamepa
2ec0: 74 74 20 6e 75 6d 72 75 6e 73 20 28 64 3a 61 6c tt numruns (d:al
2ed0: 6c 64 61 74 2d 73 74 61 72 74 2d 72 75 6e 2d 6f ldat-start-run-o
2ee0: 66 66 73 65 74 20 64 61 74 61 29 20 6b 65 79 70 ffset data) keyp
2ef0: 61 74 74 73 29 0a 09 09 09 20 20 28 64 62 3a 67 atts).... (db:g
2f00: 65 74 2d 72 75 6e 73 20 28 64 3a 61 6c 6c 64 61 et-runs (d:allda
2f10: 74 2d 64 62 6c 6f 63 61 6c 20 64 61 74 61 29 20 t-dblocal data)
2f20: 72 75 6e 6e 61 6d 65 70 61 74 74 20 6e 75 6d 72 runnamepatt numr
2f30: 75 6e 73 20 3b 3b 20 28 2b 20 6e 75 6d 72 75 6e uns ;; (+ numrun
2f40: 73 20 31 29 20 3b 3b 20 28 2f 20 6e 75 6d 72 75 s 1) ;; (/ numru
2f50: 6e 73 20 32 29 29 0a 09 09 09 09 20 20 20 20 20 ns 2)).....
2f60: 20 20 28 64 3a 61 6c 6c 64 61 74 2d 73 74 61 72 (d:alldat-star
2f70: 74 2d 72 75 6e 2d 6f 66 66 73 65 74 20 64 61 74 t-run-offset dat
2f80: 61 29 20 6b 65 79 70 61 74 74 73 29 29 29 0a 09 a) keypatts)))..
2f90: 20 28 68 65 61 64 65 72 20 20 20 20 20 20 28 64 (header (d
2fa0: 62 3a 67 65 74 2d 68 65 61 64 65 72 20 61 6c 6c b:get-header all
2fb0: 72 75 6e 73 29 29 0a 09 20 28 72 75 6e 73 20 20 runs)).. (runs
2fc0: 20 20 20 20 20 20 28 64 62 3a 67 65 74 2d 72 6f (db:get-ro
2fd0: 77 73 20 20 20 61 6c 6c 72 75 6e 73 29 29 0a 09 ws allruns))..
2fe0: 20 28 72 65 73 75 6c 74 20 20 20 20 20 20 27 28 (result '(
2ff0: 29 29 0a 09 20 28 6d 61 78 74 65 73 74 73 20 20 )).. (maxtests
3000: 20 20 30 29 29 0a 20 20 20 20 3b 3b 20 0a 20 20 0)). ;; .
3010: 20 20 3b 3b 20 74 72 69 6d 20 72 75 6e 73 20 74 ;; trim runs t
3020: 6f 20 6f 6e 6c 79 20 74 68 6f 73 65 20 74 68 61 o only those tha
3030: 74 20 61 72 65 20 63 68 61 6e 67 69 6e 67 20 6f t are changing o
3040: 66 74 65 6e 20 68 65 72 65 0a 20 20 20 20 3b 3b ften here. ;;
3050: 20 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 . (for-each
3060: 28 6c 61 6d 62 64 61 20 28 72 75 6e 29 0a 09 09 (lambda (run)...
3070: 28 6c 65 74 2a 20 28 28 72 75 6e 2d 69 64 20 20 (let* ((run-id
3080: 20 20 20 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 (db:get-valu
3090: 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 e-by-header run
30a0: 68 65 61 64 65 72 20 22 69 64 22 29 29 0a 09 09 header "id"))...
30b0: 20 20 20 20 20 20 20 28 6b 65 79 2d 76 61 6c 73 (key-vals
30c0: 20 20 20 20 28 69 66 20 28 64 3a 61 6c 6c 64 61 (if (d:allda
30d0: 74 2d 75 73 65 73 65 72 76 65 72 20 64 61 74 61 t-useserver data
30e0: 29 20 0a 09 09 09 09 09 28 72 6d 74 3a 67 65 74 ) ......(rmt:get
30f0: 2d 6b 65 79 2d 76 61 6c 73 20 72 75 6e 2d 69 64 -key-vals run-id
3100: 29 0a 09 09 09 09 09 28 64 62 3a 67 65 74 2d 6b )......(db:get-k
3110: 65 79 2d 76 61 6c 73 20 28 64 3a 61 6c 6c 64 61 ey-vals (d:allda
3120: 74 2d 64 62 6c 6f 63 61 6c 20 64 61 74 61 29 20 t-dblocal data)
3130: 72 75 6e 2d 69 64 29 29 29 0a 09 09 20 20 20 20 run-id)))...
3140: 20 20 20 28 74 65 73 74 73 20 20 20 20 20 20 20 (tests
3150: 28 64 62 6f 61 72 64 3a 67 65 74 2d 74 65 73 74 (dboard:get-test
3160: 73 2d 66 6f 72 2d 72 75 6e 2d 64 75 70 6c 69 63 s-for-run-duplic
3170: 61 74 65 20 64 61 74 61 20 72 75 6e 2d 69 64 20 ate data run-id
3180: 72 75 6e 20 74 65 73 74 6e 61 6d 65 70 61 74 74 run testnamepatt
3190: 20 6b 65 79 2d 76 61 6c 73 29 29 29 0a 09 09 20 key-vals)))...
31a0: 20 3b 3b 20 4e 4f 54 45 3a 20 62 75 62 62 6c 65 ;; NOTE: bubble
31b0: 2d 75 70 20 61 6c 73 6f 20 73 65 74 73 20 74 68 -up also sets th
31c0: 65 20 67 6c 6f 62 61 6c 20 28 64 3a 61 6c 6c 64 e global (d:alld
31d0: 61 74 2d 69 74 65 6d 2d 74 65 73 74 2d 6e 61 6d at-item-test-nam
31e0: 65 73 20 64 61 74 61 29 0a 09 09 20 20 3b 3b 20 es data)... ;;
31f0: 28 74 65 73 74 73 20 20 20 20 20 20 20 28 62 75 (tests (bu
3200: 62 62 6c 65 2d 75 70 20 74 6d 70 74 65 73 74 73 bble-up tmptests
3210: 20 70 72 69 6f 72 69 74 79 3a 20 62 75 62 62 6c priority: bubbl
3220: 65 2d 74 79 70 65 29 29 0a 09 09 20 20 3b 3b 20 e-type))... ;;
3230: 4e 4f 54 45 3a 20 31 31 2f 30 31 2f 32 30 31 33 NOTE: 11/01/2013
3240: 20 54 68 69 73 20 72 6f 75 74 69 6e 65 20 69 73 This routine is
3250: 20 2a 4e 4f 54 2a 20 67 65 74 74 69 6e 67 20 63 *NOT* getting c
3260: 61 6c 6c 65 64 20 65 78 63 65 73 73 69 76 65 6c alled excessivel
3270: 79 2e 0a 09 09 20 20 3b 3b 20 28 64 65 62 75 67 y.... ;; (debug
3280: 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
3290: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 47 65 74 t-log-port* "Get
32a0: 74 69 6e 67 20 64 61 74 61 20 66 6f 72 20 72 75 ting data for ru
32b0: 6e 20 22 20 72 75 6e 2d 69 64 20 22 20 77 69 74 n " run-id " wit
32c0: 68 20 6b 65 79 2d 76 61 6c 73 3d 22 20 6b 65 79 h key-vals=" key
32d0: 2d 76 61 6c 73 29 0a 09 09 20 20 3b 3b 20 4e 6f -vals)... ;; No
32e0: 74 20 73 75 72 65 20 74 68 69 73 20 69 73 20 6e t sure this is n
32f0: 65 65 64 65 64 3f 0a 09 09 20 20 28 69 66 20 28 eeded?... (if (
3300: 6e 6f 74 20 28 6e 75 6c 6c 3f 20 74 65 73 74 73 not (null? tests
3310: 29 29 0a 09 09 20 20 20 20 20 20 28 62 65 67 69 ))... (begi
3320: 6e 0a 09 09 09 28 73 65 74 21 20 72 65 66 65 72 n....(set! refer
3330: 65 6e 63 65 64 2d 72 75 6e 2d 69 64 73 20 28 63 enced-run-ids (c
3340: 6f 6e 73 20 72 75 6e 2d 69 64 20 72 65 66 65 72 ons run-id refer
3350: 65 6e 63 65 64 2d 72 75 6e 2d 69 64 73 29 29 0a enced-run-ids)).
3360: 09 09 09 28 69 66 20 28 3e 20 28 6c 65 6e 67 74 ...(if (> (lengt
3370: 68 20 74 65 73 74 73 29 20 6d 61 78 74 65 73 74 h tests) maxtest
3380: 73 29 0a 09 09 09 20 20 20 20 28 73 65 74 21 20 s).... (set!
3390: 6d 61 78 74 65 73 74 73 20 28 6c 65 6e 67 74 68 maxtests (length
33a0: 20 74 65 73 74 73 29 29 29 0a 09 09 09 28 69 66 tests)))....(if
33b0: 20 28 6f 72 20 28 6e 6f 74 20 28 64 3a 61 6c 6c (or (not (d:all
33c0: 64 61 74 2d 68 69 64 65 2d 65 6d 70 74 79 2d 72 dat-hide-empty-r
33d0: 75 6e 73 20 64 61 74 61 29 29 20 3b 3b 20 74 68 uns data)) ;; th
33e0: 69 73 20 72 65 64 75 63 65 73 20 74 68 65 20 64 is reduces the d
33f0: 61 74 61 20 62 75 72 64 65 6e 20 77 68 65 6e 20 ata burden when
3400: 73 65 74 0a 09 09 09 09 28 6e 6f 74 20 28 6e 75 set.....(not (nu
3410: 6c 6c 3f 20 74 65 73 74 73 29 29 29 0a 09 09 09 ll? tests)))....
3420: 20 20 20 20 28 6c 65 74 20 28 28 64 73 74 72 75 (let ((dstru
3430: 63 74 20 28 76 65 63 74 6f 72 20 72 75 6e 20 74 ct (vector run t
3440: 65 73 74 73 20 6b 65 79 2d 76 61 6c 73 20 28 2d ests key-vals (-
3450: 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 (current-second
3460: 73 29 20 31 30 29 29 29 29 0a 09 09 09 20 20 20 s) 10))))....
3470: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 (hash-table-s
3480: 65 74 21 20 28 64 3a 61 6c 6c 64 61 74 2d 61 6c et! (d:alldat-al
3490: 6c 72 75 6e 73 2d 62 79 2d 69 64 20 64 61 74 61 lruns-by-id data
34a0: 29 20 72 75 6e 2d 69 64 20 64 73 74 72 75 63 74 ) run-id dstruct
34b0: 29 0a 09 09 09 20 20 20 20 20 20 28 73 65 74 21 ).... (set!
34c0: 20 72 65 73 75 6c 74 20 28 63 6f 6e 73 20 64 73 result (cons ds
34d0: 74 72 75 63 74 20 72 65 73 75 6c 74 29 29 29 29 truct result))))
34e0: 29 29 29 29 0a 09 20 20 20 20 20 20 72 75 6e 73 )))).. runs
34f0: 29 0a 0a 20 20 20 20 28 64 3a 61 6c 6c 64 61 74 ).. (d:alldat
3500: 2d 68 65 61 64 65 72 2d 73 65 74 21 20 64 61 74 -header-set! dat
3510: 61 20 68 65 61 64 65 72 29 0a 20 20 20 20 28 64 a header). (d
3520: 3a 61 6c 6c 64 61 74 2d 61 6c 6c 72 75 6e 73 2d :alldat-allruns-
3530: 73 65 74 21 20 64 61 74 61 20 72 65 73 75 6c 74 set! data result
3540: 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 ). (debug:pri
3550: 6e 74 2d 69 6e 66 6f 20 36 20 23 66 20 22 28 64 nt-info 6 #f "(d
3560: 3a 61 6c 6c 64 61 74 2d 61 6c 6c 72 75 6e 73 20 :alldat-allruns
3570: 64 61 74 61 29 20 68 61 73 20 22 20 28 6c 65 6e data) has " (len
3580: 67 74 68 20 28 64 3a 61 6c 6c 64 61 74 2d 61 6c gth (d:alldat-al
3590: 6c 72 75 6e 73 20 64 61 74 61 29 29 20 22 20 72 lruns data)) " r
35a0: 75 6e 73 22 29 0a 20 20 20 20 6d 61 78 74 65 73 uns"). maxtes
35b0: 74 73 29 29 0a 0a 28 64 65 66 69 6e 65 20 2a 63 ts))..(define *c
35c0: 6f 6c 6c 61 70 73 65 64 2a 20 28 6d 61 6b 65 2d ollapsed* (make-
35d0: 68 61 73 68 2d 74 61 62 6c 65 29 29 0a 09 09 09 hash-table))....
35e0: 09 09 3b 20 28 64 65 66 69 6e 65 20 2a 72 6f 77 ..; (define *row
35f0: 2d 6c 6f 6f 6b 75 70 2a 20 28 6d 61 6b 65 2d 68 -lookup* (make-h
3600: 61 73 68 2d 74 61 62 6c 65 29 29 20 3b 3b 20 74 ash-table)) ;; t
3610: 65 73 74 6e 61 6d 65 20 3d 3e 20 28 72 6f 77 6e estname => (rown
3620: 75 6d 20 6c 61 62 6c 65 6f 62 6a 29 0a 0a 28 64 um lableobj)..(d
3630: 65 66 69 6e 65 20 28 74 6f 67 67 6c 65 2d 68 69 efine (toggle-hi
3640: 64 65 20 6c 6e 75 6d 29 20 3b 20 66 75 6c 6c 74 de lnum) ; fullt
3650: 65 73 74 6e 61 6d 65 29 0a 20 20 28 6c 65 74 2a estname). (let*
3660: 20 28 28 62 74 6e 20 28 76 65 63 74 6f 72 2d 72 ((btn (vector-r
3670: 65 66 20 28 64 62 6f 61 72 64 3a 75 69 64 61 74 ef (dboard:uidat
3680: 2d 67 65 74 2d 6c 66 74 63 6f 6c 20 75 69 64 61 -get-lftcol uida
3690: 74 29 20 6c 6e 75 6d 29 29 0a 09 20 28 66 75 6c t) lnum)).. (ful
36a0: 6c 74 65 73 74 6e 61 6d 65 20 28 69 75 70 3a 61 ltestname (iup:a
36b0: 74 74 72 69 62 75 74 65 20 62 74 6e 20 22 54 49 ttribute btn "TI
36c0: 54 4c 45 22 29 29 0a 09 20 28 70 61 72 74 73 20 TLE")).. (parts
36d0: 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d 73 (string-s
36e0: 70 6c 69 74 20 66 75 6c 6c 74 65 73 74 6e 61 6d plit fulltestnam
36f0: 65 20 22 28 22 29 29 0a 09 20 28 62 61 73 65 74 e "(")).. (baset
3700: 65 73 74 6e 61 6d 65 20 28 69 66 20 28 6e 75 6c estname (if (nul
3710: 6c 3f 20 70 61 72 74 73 29 20 22 22 20 28 63 61 l? parts) "" (ca
3720: 72 20 70 61 72 74 73 29 29 29 29 0a 09 09 09 09 r parts)))).....
3730: 09 3b 28 70 72 69 6e 74 20 22 54 6f 67 67 6c 69 .;(print "Toggli
3740: 6e 67 20 22 20 62 61 73 65 74 65 73 74 6e 61 6d ng " basetestnam
3750: 65 20 22 20 63 75 72 72 65 6e 74 6c 79 20 22 20 e " currently "
3760: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/
3770: 64 65 66 61 75 6c 74 20 2a 63 6f 6c 6c 61 70 73 default *collaps
3780: 65 64 2a 20 62 61 73 65 74 65 73 74 6e 61 6d 65 ed* basetestname
3790: 20 23 66 29 29 0a 20 20 20 20 28 69 66 20 28 68 #f)). (if (h
37a0: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
37b0: 66 61 75 6c 74 20 2a 63 6f 6c 6c 61 70 73 65 64 fault *collapsed
37c0: 2a 20 62 61 73 65 74 65 73 74 6e 61 6d 65 20 23 * basetestname #
37d0: 66 29 0a 09 28 62 65 67 69 6e 0a 09 09 09 09 09 f)..(begin......
37e0: 3b 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d ;(iup:attribute-
37f0: 73 65 74 21 20 62 74 6e 20 22 46 47 43 4f 4c 4f set! btn "FGCOLO
3800: 52 22 20 22 30 20 30 20 30 22 29 0a 09 20 20 28 R" "0 0 0").. (
3810: 68 61 73 68 2d 74 61 62 6c 65 2d 64 65 6c 65 74 hash-table-delet
3820: 65 21 20 2a 63 6f 6c 6c 61 70 73 65 64 2a 20 62 e! *collapsed* b
3830: 61 73 65 74 65 73 74 6e 61 6d 65 29 29 0a 09 28 asetestname))..(
3840: 62 65 67 69 6e 0a 09 09 09 09 09 3b 28 69 75 70 begin......;(iup
3850: 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 :attribute-set!
3860: 62 74 6e 20 22 46 47 43 4f 4c 4f 52 22 20 22 30 btn "FGCOLOR" "0
3870: 20 31 39 32 20 31 39 32 22 29 0a 09 20 20 28 68 192 192").. (h
3880: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a ash-table-set! *
3890: 63 6f 6c 6c 61 70 73 65 64 2a 20 62 61 73 65 74 collapsed* baset
38a0: 65 73 74 6e 61 6d 65 20 23 74 29 29 29 29 29 0a estname #t))))).
38b0: 0a 28 64 65 66 69 6e 65 20 62 6c 61 6e 6b 2d 6c .(define blank-l
38c0: 69 6e 65 2d 72 78 20 28 72 65 67 65 78 70 20 22 ine-rx (regexp "
38d0: 5e 5c 5c 73 2a 24 22 29 29 0a 0a 28 64 65 66 69 ^\\s*$"))..(defi
38e0: 6e 65 20 28 72 75 6e 2d 69 74 65 6d 2d 6e 61 6d ne (run-item-nam
38f0: 65 2d 3e 76 65 63 74 6f 72 73 20 6c 73 74 29 0a e->vectors lst).
3900: 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 (map (lambda (
3910: 78 29 0a 09 20 28 6c 65 74 20 28 28 73 70 6c 73 x).. (let ((spls
3920: 74 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 t (string-split
3930: 78 20 22 28 22 29 29 0a 09 20 20 20 20 20 20 20 x "("))..
3940: 28 72 65 73 20 20 20 28 76 65 63 74 6f 72 20 22 (res (vector "
3950: 22 20 22 22 29 29 29 0a 09 20 20 20 28 76 65 63 " ""))).. (vec
3960: 74 6f 72 2d 73 65 74 21 20 72 65 73 20 30 20 28 tor-set! res 0 (
3970: 63 61 72 20 73 70 6c 73 74 29 29 0a 09 20 20 20 car splst))..
3980: 28 69 66 20 28 3e 20 28 6c 65 6e 67 74 68 20 73 (if (> (length s
3990: 70 6c 73 74 29 20 31 29 0a 09 20 20 20 20 20 20 plst) 1)..
39a0: 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 72 65 (vector-set! re
39b0: 73 20 31 20 28 63 61 72 20 28 73 74 72 69 6e 67 s 1 (car (string
39c0: 2d 73 70 6c 69 74 20 28 63 61 64 72 20 73 70 6c -split (cadr spl
39d0: 73 74 29 20 22 29 22 29 29 29 29 0a 09 20 20 20 st) ")"))))..
39e0: 72 65 73 29 29 0a 20 20 20 20 20 20 20 6c 73 74 res)). lst
39f0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f 6c ))..(define (col
3a00: 6c 61 70 73 65 2d 72 6f 77 73 20 69 6e 6c 73 74 lapse-rows inlst
3a10: 29 0a 20 20 28 6c 65 74 2a 20 28 28 73 6f 72 74 ). (let* ((sort
3a20: 2d 69 6e 66 6f 20 20 20 28 67 65 74 2d 63 75 72 -info (get-cur
3a30: 72 2d 73 6f 72 74 29 29 0a 09 20 28 73 6f 72 74 r-sort)).. (sort
3a40: 2d 62 79 20 20 20 20 20 28 76 65 63 74 6f 72 2d -by (vector-
3a50: 72 65 66 20 73 6f 72 74 2d 69 6e 66 6f 20 31 29 ref sort-info 1)
3a60: 29 0a 09 20 28 73 6f 72 74 2d 6f 72 64 65 72 20 ).. (sort-order
3a70: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 6f 72 (vector-ref sor
3a80: 74 2d 69 6e 66 6f 20 32 29 29 0a 09 20 28 62 75 t-info 2)).. (bu
3a90: 62 62 6c 65 2d 74 79 70 65 20 28 69 66 20 28 6d bble-type (if (m
3aa0: 65 6d 62 65 72 20 73 6f 72 74 2d 6f 72 64 65 72 ember sort-order
3ab0: 20 27 28 74 65 73 74 6e 61 6d 65 29 29 0a 09 09 '(testname))...
3ac0: 09 20 20 27 74 65 73 74 6e 61 6d 65 0a 09 09 09 . 'testname....
3ad0: 20 20 27 69 74 65 6d 70 61 74 68 29 29 0a 09 20 'itempath))..
3ae0: 28 6e 65 77 6c 73 74 20 20 20 20 20 20 28 66 69 (newlst (fi
3af0: 6c 74 65 72 20 28 6c 61 6d 62 64 61 20 28 78 29 lter (lambda (x)
3b00: 0a 09 09 09 09 28 6c 65 74 2a 20 28 28 74 70 61 .....(let* ((tpa
3b10: 72 74 73 20 20 20 20 28 73 74 72 69 6e 67 2d 73 rts (string-s
3b20: 70 6c 69 74 20 78 20 22 28 22 29 29 0a 09 09 09 plit x "("))....
3b30: 09 20 20 20 20 20 20 20 28 62 61 73 65 74 6e 61 . (basetna
3b40: 6d 65 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 70 me (if (null? tp
3b50: 61 72 74 73 29 20 78 20 28 63 61 72 20 74 70 61 arts) x (car tpa
3b60: 72 74 73 29 29 29 29 0a 09 09 09 09 09 3b 28 70 rts))))......;(p
3b70: 72 69 6e 74 20 22 78 20 22 20 78 20 22 20 74 70 rint "x " x " tp
3b80: 61 72 74 73 3a 20 22 20 74 70 61 72 74 73 20 22 arts: " tparts "
3b90: 20 62 61 73 65 74 6e 61 6d 65 3a 20 22 20 62 61 basetname: " ba
3ba0: 73 65 74 6e 61 6d 65 29 0a 09 09 09 09 20 20 28 setname)..... (
3bb0: 63 6f 6e 64 0a 09 09 09 09 20 20 20 28 28 73 74 cond..... ((st
3bc0: 72 69 6e 67 2d 6d 61 74 63 68 20 62 6c 61 6e 6b ring-match blank
3bd0: 2d 6c 69 6e 65 2d 72 78 20 78 29 20 23 66 29 0a -line-rx x) #f).
3be0: 09 09 09 09 20 20 20 28 28 65 71 75 61 6c 3f 20 .... ((equal?
3bf0: 78 20 62 61 73 65 74 6e 61 6d 65 29 20 23 74 29 x basetname) #t)
3c00: 0a 09 09 09 09 20 20 20 28 28 68 61 73 68 2d 74 ..... ((hash-t
3c10: 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 able-ref/default
3c20: 20 2a 63 6f 6c 6c 61 70 73 65 64 2a 20 62 61 73 *collapsed* bas
3c30: 65 74 6e 61 6d 65 20 23 66 29 20 0a 09 09 09 09 etname #f) .....
3c40: 09 3b 28 70 72 69 6e 74 20 22 52 65 6d 6f 76 69 .;(print "Removi
3c50: 6e 67 20 22 20 62 61 73 65 74 6e 61 6d 65 20 22 ng " basetname "
3c60: 20 66 72 6f 6d 20 69 74 65 6d 73 22 29 0a 09 09 from items")...
3c70: 09 09 20 20 20 20 23 66 29 0a 09 09 09 09 20 20 .. #f).....
3c80: 20 28 65 6c 73 65 20 23 74 29 29 29 29 0a 09 09 (else #t))))...
3c90: 09 20 20 20 20 20 20 69 6e 6c 73 74 29 29 0a 09 . inlst))..
3ca0: 20 28 76 6c 73 74 20 20 20 20 20 20 20 20 20 28 (vlst (
3cb0: 72 75 6e 2d 69 74 65 6d 2d 6e 61 6d 65 2d 3e 76 run-item-name->v
3cc0: 65 63 74 6f 72 73 20 6e 65 77 6c 73 74 29 29 0a ectors newlst)).
3cd0: 09 20 28 76 6c 73 74 32 20 20 20 20 20 20 20 20 . (vlst2
3ce0: 28 62 75 62 62 6c 65 2d 75 70 20 76 6c 73 74 20 (bubble-up vlst
3cf0: 70 72 69 6f 72 69 74 79 3a 20 62 75 62 62 6c 65 priority: bubble
3d00: 2d 74 79 70 65 29 29 29 0a 20 20 20 20 28 6d 61 -type))). (ma
3d10: 70 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 20 p (lambda (x)..
3d20: 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 28 76 (if (equal? (v
3d30: 65 63 74 6f 72 2d 72 65 66 20 78 20 31 29 20 22 ector-ref x 1) "
3d40: 22 29 0a 09 20 20 20 20 20 20 20 28 76 65 63 74 ").. (vect
3d50: 6f 72 2d 72 65 66 20 78 20 30 29 0a 09 20 20 20 or-ref x 0)..
3d60: 20 20 20 20 28 63 6f 6e 63 20 28 76 65 63 74 6f (conc (vecto
3d70: 72 2d 72 65 66 20 78 20 30 29 20 22 28 22 20 28 r-ref x 0) "(" (
3d80: 76 65 63 74 6f 72 2d 72 65 66 20 78 20 31 29 20 vector-ref x 1)
3d90: 22 29 22 29 29 29 0a 09 20 76 6c 73 74 32 29 29 ")"))).. vlst2))
3da0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 75 70 64 61 )..(define (upda
3db0: 74 65 2d 6c 61 62 65 6c 73 20 75 69 64 61 74 29 te-labels uidat)
3dc0: 0a 20 20 28 6c 65 74 2a 20 28 28 72 6f 77 6e 20 . (let* ((rown
3dd0: 20 20 20 30 29 0a 09 20 28 6b 65 79 63 6f 6c 20 0).. (keycol
3de0: 20 28 64 62 6f 61 72 64 3a 75 69 64 61 74 2d 67 (dboard:uidat-g
3df0: 65 74 2d 6b 65 79 63 6f 6c 20 75 69 64 61 74 29 et-keycol uidat)
3e00: 29 0a 09 20 28 6c 66 74 63 6f 6c 20 20 28 64 62 ).. (lftcol (db
3e10: 6f 61 72 64 3a 75 69 64 61 74 2d 67 65 74 2d 6c oard:uidat-get-l
3e20: 66 74 63 6f 6c 20 75 69 64 61 74 29 29 0a 09 20 ftcol uidat))..
3e30: 28 6e 75 6d 63 6f 6c 73 20 28 76 65 63 74 6f 72 (numcols (vector
3e40: 2d 6c 65 6e 67 74 68 20 6c 66 74 63 6f 6c 29 29 -length lftcol))
3e50: 0a 09 20 28 6d 61 78 6e 20 20 20 20 28 2d 20 6e .. (maxn (- n
3e60: 75 6d 63 6f 6c 73 20 31 29 29 0a 09 20 28 61 6c umcols 1)).. (al
3e70: 6c 76 61 6c 73 20 28 6d 61 6b 65 2d 76 65 63 74 lvals (make-vect
3e80: 6f 72 20 6e 75 6d 63 6f 6c 73 20 22 22 29 29 29 or numcols "")))
3e90: 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 . (for-each (
3ea0: 6c 61 6d 62 64 61 20 28 6e 61 6d 65 29 0a 09 09 lambda (name)...
3eb0: 28 69 66 20 28 3c 3d 20 72 6f 77 6e 20 6d 61 78 (if (<= rown max
3ec0: 6e 29 0a 09 09 20 20 20 20 28 76 65 63 74 6f 72 n)... (vector
3ed0: 2d 73 65 74 21 20 61 6c 6c 76 61 6c 73 20 72 6f -set! allvals ro
3ee0: 77 6e 20 6e 61 6d 65 29 29 20 3b 29 0a 09 09 28 wn name)) ;)...(
3ef0: 73 65 74 21 20 72 6f 77 6e 20 28 2b 20 31 20 72 set! rown (+ 1 r
3f00: 6f 77 6e 29 29 29 0a 09 20 20 20 20 20 20 2a 61 own))).. *a
3f10: 6c 6c 74 65 73 74 6e 61 6d 65 6c 73 74 2a 29 0a lltestnamelst*).
3f20: 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 (let loop ((
3f30: 69 20 30 29 29 0a 20 20 20 20 20 20 28 6c 65 74 i 0)). (let
3f40: 2a 20 28 28 6c 62 6c 20 20 20 20 28 76 65 63 74 * ((lbl (vect
3f50: 6f 72 2d 72 65 66 20 6c 66 74 63 6f 6c 20 69 29 or-ref lftcol i)
3f60: 29 0a 09 20 20 20 20 20 28 6b 65 79 76 61 6c 20 ).. (keyval
3f70: 28 76 65 63 74 6f 72 2d 72 65 66 20 6b 65 79 63 (vector-ref keyc
3f80: 6f 6c 20 69 29 29 0a 09 20 20 20 20 20 28 6f 6c ol i)).. (ol
3f90: 64 76 61 6c 20 28 69 75 70 3a 61 74 74 72 69 62 dval (iup:attrib
3fa0: 75 74 65 20 6c 62 6c 20 22 54 49 54 4c 45 22 29 ute lbl "TITLE")
3fb0: 29 0a 09 20 20 20 20 20 28 6e 65 77 76 61 6c 20 ).. (newval
3fc0: 28 76 65 63 74 6f 72 2d 72 65 66 20 61 6c 6c 76 (vector-ref allv
3fd0: 61 6c 73 20 69 29 29 29 0a 09 28 69 66 20 28 6e als i)))..(if (n
3fe0: 6f 74 20 28 65 71 75 61 6c 3f 20 6f 6c 64 76 61 ot (equal? oldva
3ff0: 6c 20 6e 65 77 76 61 6c 29 29 0a 09 20 20 20 20 l newval))..
4000: 28 6c 65 74 20 28 28 6d 75 6e 67 65 64 2d 76 61 (let ((munged-va
4010: 6c 20 28 6c 65 74 20 28 28 70 61 72 74 73 20 28 l (let ((parts (
4020: 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 6e 65 77 string-split new
4030: 76 61 6c 20 22 28 22 29 29 29 0a 09 09 09 09 28 val "("))).....(
4040: 69 66 20 28 3e 20 28 6c 65 6e 67 74 68 20 70 61 if (> (length pa
4050: 72 74 73 29 20 31 29 28 63 6f 6e 63 20 22 20 20 rts) 1)(conc "
4060: 22 20 28 63 61 72 20 28 73 74 72 69 6e 67 2d 73 " (car (string-s
4070: 70 6c 69 74 20 28 63 61 64 72 20 70 61 72 74 73 plit (cadr parts
4080: 29 20 22 29 22 29 29 29 20 6e 65 77 76 61 6c 29 ) ")"))) newval)
4090: 29 29 29 0a 09 20 20 20 20 20 20 28 76 65 63 74 ))).. (vect
40a0: 6f 72 2d 73 65 74 21 20 6b 65 79 63 6f 6c 20 69 or-set! keycol i
40b0: 20 6e 65 77 76 61 6c 29 0a 09 20 20 20 20 20 20 newval)..
40c0: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 (iup:attribute-s
40d0: 65 74 21 20 6c 62 6c 20 22 54 49 54 4c 45 22 20 et! lbl "TITLE"
40e0: 6d 75 6e 67 65 64 2d 76 61 6c 29 29 29 0a 09 28 munged-val)))..(
40f0: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se
4100: 74 21 20 6c 62 6c 20 22 46 47 43 4f 4c 4f 52 22 t! lbl "FGCOLOR"
4110: 20 28 69 66 20 28 68 61 73 68 2d 74 61 62 6c 65 (if (hash-table
4120: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 63 6f -ref/default *co
4130: 6c 6c 61 70 73 65 64 2a 20 6e 65 77 76 61 6c 20 llapsed* newval
4140: 23 66 29 20 22 30 20 31 31 32 20 31 31 32 22 20 #f) "0 112 112"
4150: 22 30 20 30 20 30 22 29 29 0a 09 28 69 66 20 28 "0 0 0"))..(if (
4160: 3c 20 69 20 6d 61 78 6e 29 0a 09 20 20 20 20 28 < i maxn).. (
4170: 6c 6f 6f 70 20 28 2b 20 69 20 31 29 29 29 29 29 loop (+ i 1)))))
4180: 29 29 0a 0a 3b 3b 20 0a 28 64 65 66 69 6e 65 20 ))..;; .(define
4190: 28 67 65 74 2d 69 74 65 6d 69 7a 65 64 2d 74 65 (get-itemized-te
41a0: 73 74 73 20 74 65 73 74 2d 64 61 74 73 29 0a 20 sts test-dats).
41b0: 20 28 6c 65 74 20 28 28 74 6e 61 6d 65 73 20 27 (let ((tnames '
41c0: 28 29 29 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 ())). (for-ea
41d0: 63 68 20 28 6c 61 6d 62 64 61 20 28 74 64 61 74 ch (lambda (tdat
41e0: 29 0a 09 09 28 6c 65 74 20 28 28 74 6e 61 6d 65 )...(let ((tname
41f0: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 74 64 61 (vector-ref tda
4200: 74 20 30 29 29 20 20 3b 3b 20 28 64 62 3a 74 65 t 0)) ;; (db:te
4210: 73 74 2d 67 65 74 2d 74 65 73 74 6e 61 6d 65 20 st-get-testname
4220: 74 64 61 74 29 29 0a 09 09 20 20 20 20 20 20 28 tdat))... (
4230: 69 70 61 74 68 20 28 76 65 63 74 6f 72 2d 72 65 ipath (vector-re
4240: 66 20 74 64 61 74 20 31 29 29 29 20 3b 3b 20 28 f tdat 1))) ;; (
4250: 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 74 65 6d db:test-get-item
4260: 2d 70 61 74 68 20 74 64 61 74 29 29 29 0a 09 09 -path tdat)))...
4270: 20 20 28 69 66 20 28 6e 6f 74 20 28 65 71 75 61 (if (not (equa
4280: 6c 3f 20 69 70 61 74 68 20 22 22 29 29 0a 09 09 l? ipath ""))...
4290: 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 28 (if (and (
42a0: 6c 69 73 74 3f 20 74 6e 61 6d 65 73 29 0a 09 09 list? tnames)...
42b0: 09 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 3f . (string?
42c0: 20 74 6e 61 6d 65 29 0a 09 09 09 20 20 20 20 20 tname)....
42d0: 20 20 28 6e 6f 74 20 28 6d 65 6d 62 65 72 20 74 (not (member t
42e0: 6e 61 6d 65 20 74 6e 61 6d 65 73 29 29 29 0a 09 name tnames)))..
42f0: 09 09 20 20 28 73 65 74 21 20 74 6e 61 6d 65 73 .. (set! tnames
4300: 20 28 61 70 70 65 6e 64 20 74 6e 61 6d 65 73 20 (append tnames
4310: 28 6c 69 73 74 20 74 6e 61 6d 65 29 29 29 29 29 (list tname)))))
4320: 29 29 0a 09 20 20 20 20 20 20 74 65 73 74 2d 64 )).. test-d
4330: 61 74 73 29 0a 20 20 20 20 74 6e 61 6d 65 73 29 ats). tnames)
4340: 29 0a 0a 3b 3b 20 42 75 62 62 6c 65 20 75 70 20 )..;; Bubble up
4350: 74 68 65 20 74 6f 70 20 74 65 73 74 73 20 74 6f the top tests to
4360: 20 61 62 6f 76 65 20 74 68 65 20 69 74 65 6d 73 above the items
4370: 2c 20 63 6f 6c 6c 65 63 74 20 74 68 65 20 69 74 , collect the it
4380: 65 6d 73 20 75 6e 64 65 72 6e 65 61 74 68 0a 3b ems underneath.;
4390: 3b 20 61 6c 6c 20 77 68 69 6c 65 20 70 72 65 73 ; all while pres
43a0: 65 72 76 69 6e 67 20 74 68 65 20 73 6f 72 74 20 erving the sort
43b0: 6f 72 64 65 72 20 66 72 6f 6d 20 74 68 65 20 53 order from the S
43c0: 51 4c 20 71 75 65 72 79 20 61 73 20 62 65 73 74 QL query as best
43d0: 20 61 73 20 70 6f 73 73 69 62 6c 65 2e 0a 3b 3b as possible..;;
43e0: 0a 28 64 65 66 69 6e 65 20 28 62 75 62 62 6c 65 .(define (bubble
43f0: 2d 75 70 20 74 65 73 74 2d 64 61 74 73 20 23 21 -up test-dats #!
4400: 6b 65 79 20 28 70 72 69 6f 72 69 74 79 20 27 69 key (priority 'i
4410: 74 65 6d 70 61 74 68 29 29 0a 20 20 28 69 66 20 tempath)). (if
4420: 28 6e 75 6c 6c 3f 20 74 65 73 74 2d 64 61 74 73 (null? test-dats
4430: 29 0a 20 20 20 20 20 20 74 65 73 74 2d 64 61 74 ). test-dat
4440: 73 0a 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 s. (begin..
4450: 28 6c 65 74 2a 20 28 28 74 6e 61 6d 65 73 20 20 (let* ((tnames
4460: 20 27 28 29 29 20 20 20 20 20 20 20 20 20 20 20 '())
4470: 20 20 20 20 20 3b 3b 20 6c 69 73 74 20 6f 66 20 ;; list of
4480: 6e 61 6d 65 73 20 75 73 65 64 20 74 6f 20 72 65 names used to re
4490: 73 65 72 76 65 20 6f 72 64 65 72 0a 09 20 20 20 serve order..
44a0: 20 20 20 20 28 74 65 73 74 73 20 20 20 20 28 6d (tests (m
44b0: 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 ake-hash-table))
44c0: 20 20 3b 3b 20 68 61 73 68 20 6f 66 20 6c 69 73 ;; hash of lis
44d0: 74 73 2c 20 75 73 65 64 20 74 6f 20 62 75 69 6c ts, used to buil
44e0: 64 20 61 73 20 77 65 20 67 6f 0a 09 20 20 20 20 d as we go..
44f0: 20 20 20 28 69 74 65 6d 69 7a 65 64 20 28 67 65 (itemized (ge
4500: 74 2d 69 74 65 6d 69 7a 65 64 2d 74 65 73 74 73 t-itemized-tests
4510: 20 74 65 73 74 2d 64 61 74 73 29 29 29 0a 09 20 test-dats)))..
4520: 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 20 20 20 (for-each ..
4530: 28 6c 61 6d 62 64 61 20 28 74 65 73 74 64 61 74 (lambda (testdat
4540: 29 0a 09 20 20 20 20 20 28 6c 65 74 2a 20 28 28 ).. (let* ((
4550: 74 6e 61 6d 65 20 28 76 65 63 74 6f 72 2d 72 65 tname (vector-re
4560: 66 20 74 65 73 74 64 61 74 20 30 29 29 20 20 3b f testdat 0)) ;
4570: 3b 20 64 62 3a 74 65 73 74 2d 67 65 74 2d 74 65 ; db:test-get-te
4580: 73 74 6e 61 6d 65 20 74 65 73 74 64 61 74 29 29 stname testdat))
4590: 0a 09 09 20 20 20 20 28 69 70 61 74 68 20 28 76 ... (ipath (v
45a0: 65 63 74 6f 72 2d 72 65 66 20 74 65 73 74 64 61 ector-ref testda
45b0: 74 20 31 29 29 29 20 3b 3b 20 64 62 3a 74 65 73 t 1))) ;; db:tes
45c0: 74 2d 67 65 74 2d 69 74 65 6d 2d 70 61 74 68 20 t-get-item-path
45d0: 74 65 73 74 64 61 74 29 29 29 0a 09 20 20 20 20 testdat)))..
45e0: 20 20 20 3b 3b 20 20 20 28 73 65 65 6e 20 20 28 ;; (seen (
45f0: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d
4600: 65 66 61 75 6c 74 20 74 65 73 74 73 20 74 6e 61 efault tests tna
4610: 6d 65 20 23 66 29 29 29 0a 09 20 20 20 20 20 20 me #f)))..
4620: 20 28 69 66 20 28 6e 6f 74 20 28 6d 65 6d 62 65 (if (not (membe
4630: 72 20 74 6e 61 6d 65 20 74 6e 61 6d 65 73 29 29 r tname tnames))
4640: 0a 09 09 20 20 20 28 69 66 20 28 6f 72 20 28 61 ... (if (or (a
4650: 6e 64 20 28 65 71 3f 20 70 72 69 6f 72 69 74 79 nd (eq? priority
4660: 20 27 69 74 65 6d 70 61 74 68 29 0a 09 09 09 09 'itempath).....
4670: 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 69 70 61 (not (equal? ipa
4680: 74 68 20 22 22 29 29 29 0a 09 09 09 20 20 20 28 th ""))).... (
4690: 61 6e 64 20 28 65 71 3f 20 70 72 69 6f 72 69 74 and (eq? priorit
46a0: 79 20 27 74 65 73 74 6e 61 6d 65 29 0a 09 09 09 y 'testname)....
46b0: 09 28 65 71 75 61 6c 3f 20 69 70 61 74 68 20 22 .(equal? ipath "
46c0: 22 29 29 0a 09 09 09 20 20 20 28 6e 6f 74 20 28 ")).... (not (
46d0: 6d 65 6d 62 65 72 20 74 6e 61 6d 65 20 69 74 65 member tname ite
46e0: 6d 69 7a 65 64 29 29 29 0a 09 09 20 20 20 20 20 mized)))...
46f0: 20 20 28 73 65 74 21 20 74 6e 61 6d 65 73 20 28 (set! tnames (
4700: 61 70 70 65 6e 64 20 74 6e 61 6d 65 73 20 28 6c append tnames (l
4710: 69 73 74 20 74 6e 61 6d 65 29 29 29 29 29 0a 09 ist tname)))))..
4720: 20 20 20 20 20 20 20 28 69 66 20 28 65 71 75 61 (if (equa
4730: 6c 3f 20 69 70 61 74 68 20 22 22 29 0a 09 09 20 l? ipath "")...
4740: 20 20 3b 3b 20 54 68 69 73 20 61 20 74 6f 70 20 ;; This a top
4750: 6c 65 76 65 6c 2c 20 70 72 65 70 65 6e 64 20 69 level, prepend i
4760: 74 0a 09 09 20 20 20 28 68 61 73 68 2d 74 61 62 t... (hash-tab
4770: 6c 65 2d 73 65 74 21 20 74 65 73 74 73 20 74 6e le-set! tests tn
4780: 61 6d 65 20 28 63 6f 6e 73 20 74 65 73 74 64 61 ame (cons testda
4790: 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 t (hash-table-re
47a0: 66 2f 64 65 66 61 75 6c 74 20 74 65 73 74 73 20 f/default tests
47b0: 74 6e 61 6d 65 20 27 28 29 29 29 29 0a 09 09 20 tname '())))...
47c0: 20 20 3b 3b 20 54 68 69 73 20 69 73 20 69 74 65 ;; This is ite
47d0: 6d 2c 20 61 70 70 65 6e 64 20 69 74 0a 09 09 20 m, append it...
47e0: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 (hash-table-se
47f0: 74 21 20 74 65 73 74 73 20 74 6e 61 6d 65 20 28 t! tests tname (
4800: 61 70 70 65 6e 64 20 28 68 61 73 68 2d 74 61 62 append (hash-tab
4810: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 74 le-ref/default t
4820: 65 73 74 73 20 74 6e 61 6d 65 20 27 28 29 29 28 ests tname '())(
4830: 6c 69 73 74 20 74 65 73 74 64 61 74 29 29 29 29 list testdat))))
4840: 29 29 0a 09 20 20 20 74 65 73 74 2d 64 61 74 73 )).. test-dats
4850: 29 0a 09 20 20 3b 3b 20 53 65 74 20 61 6c 6c 20 ).. ;; Set all
4860: 74 65 73 74 73 20 77 69 74 68 20 69 74 65 6d 73 tests with items
4870: 20 0a 09 20 20 28 64 3a 61 6c 6c 64 61 74 2d 69 .. (d:alldat-i
4880: 74 65 6d 2d 74 65 73 74 2d 6e 61 6d 65 73 2d 73 tem-test-names-s
4890: 65 74 21 20 2a 61 6c 6c 64 61 74 2a 20 28 61 70 et! *alldat* (ap
48a0: 70 65 6e 64 20 28 69 66 20 28 6e 75 6c 6c 3f 20 pend (if (null?
48b0: 74 6e 61 6d 65 73 29 0a 09 09 09 09 09 09 09 20 tnames)........
48c0: 20 20 20 20 20 27 28 29 0a 09 09 09 09 09 09 09 '()........
48d0: 20 20 20 20 20 20 28 66 69 6c 74 65 72 20 28 6c (filter (l
48e0: 61 6d 62 64 61 20 28 74 6e 61 6d 65 29 0a 09 09 ambda (tname)...
48f0: 09 09 09 09 09 09 09 28 6c 65 74 20 28 28 74 6c .......(let ((tl
4900: 73 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 st (hash-table-r
4910: 65 66 20 74 65 73 74 73 20 74 6e 61 6d 65 29 29 ef tests tname))
4920: 29 0a 09 09 09 09 09 09 09 09 09 20 20 28 61 6e ).......... (an
4930: 64 20 28 6c 69 73 74 20 74 6c 73 74 29 0a 09 09 d (list tlst)...
4940: 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 3e ....... (>
4950: 20 28 6c 65 6e 67 74 68 20 74 6c 73 74 29 20 31 (length tlst) 1
4960: 29 29 29 29 0a 09 09 09 09 09 09 09 09 20 20 20 )))).........
4970: 20 20 20 74 6e 61 6d 65 73 29 29 0a 09 09 09 09 tnames)).....
4980: 09 09 09 20 20 28 64 3a 61 6c 6c 64 61 74 2d 69 ... (d:alldat-i
4990: 74 65 6d 2d 74 65 73 74 2d 6e 61 6d 65 73 20 2a tem-test-names *
49a0: 61 6c 6c 64 61 74 2a 29 29 29 0a 09 20 20 28 6c alldat*))).. (l
49b0: 65 74 20 6c 6f 6f 70 20 28 28 68 65 64 20 28 63 et loop ((hed (c
49c0: 61 72 20 74 6e 61 6d 65 73 29 29 0a 09 09 20 20 ar tnames))...
49d0: 20 20 20 28 74 61 6c 20 28 63 64 72 20 74 6e 61 (tal (cdr tna
49e0: 6d 65 73 29 29 0a 09 09 20 20 20 20 20 28 72 65 mes))... (re
49f0: 73 20 27 28 29 29 29 0a 09 20 20 20 20 28 6c 65 s '())).. (le
4a00: 74 20 28 28 6e 65 77 72 65 73 20 28 61 70 70 65 t ((newres (appe
4a10: 6e 64 20 72 65 73 20 28 68 61 73 68 2d 74 61 62 nd res (hash-tab
4a20: 6c 65 2d 72 65 66 20 74 65 73 74 73 20 68 65 64 le-ref tests hed
4a30: 29 29 29 29 0a 09 20 20 20 20 20 20 28 69 66 20 )))).. (if
4a40: 28 6e 75 6c 6c 3f 20 74 61 6c 29 0a 09 09 20 20 (null? tal)...
4a50: 6e 65 77 72 65 73 0a 09 09 20 20 28 6c 6f 6f 70 newres... (loop
4a60: 20 28 63 61 72 20 74 61 6c 29 28 63 64 72 20 74 (car tal)(cdr t
4a70: 61 6c 29 20 6e 65 77 72 65 73 29 29 29 29 29 29 al) newres))))))
4a80: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 75 70 64 ))..(define (upd
4a90: 61 74 65 2d 62 75 74 74 6f 6e 73 20 75 69 64 61 ate-buttons uida
4aa0: 74 20 6e 75 6d 72 75 6e 73 20 6e 75 6d 74 65 73 t numruns numtes
4ab0: 74 73 29 0a 20 20 28 6c 65 74 2a 20 28 28 72 75 ts). (let* ((ru
4ac0: 6e 73 20 20 20 20 20 20 20 20 28 69 66 20 28 3e ns (if (>
4ad0: 20 28 6c 65 6e 67 74 68 20 28 64 3a 61 6c 6c 64 (length (d:alld
4ae0: 61 74 2d 61 6c 6c 72 75 6e 73 20 2a 61 6c 6c 64 at-allruns *alld
4af0: 61 74 2a 29 29 20 6e 75 6d 72 75 6e 73 29 0a 09 at*)) numruns)..
4b00: 09 09 20 20 28 74 61 6b 65 2d 72 69 67 68 74 20 .. (take-right
4b10: 28 64 3a 61 6c 6c 64 61 74 2d 61 6c 6c 72 75 6e (d:alldat-allrun
4b20: 73 20 2a 61 6c 6c 64 61 74 2a 29 20 6e 75 6d 72 s *alldat*) numr
4b30: 75 6e 73 29 0a 09 09 09 20 20 28 70 61 64 2d 6c uns).... (pad-l
4b40: 69 73 74 20 28 64 3a 61 6c 6c 64 61 74 2d 61 6c ist (d:alldat-al
4b50: 6c 72 75 6e 73 20 2a 61 6c 6c 64 61 74 2a 29 20 lruns *alldat*)
4b60: 6e 75 6d 72 75 6e 73 29 29 29 0a 09 20 28 6c 66 numruns))).. (lf
4b70: 74 63 6f 6c 20 20 20 20 20 20 28 64 62 6f 61 72 tcol (dboar
4b80: 64 3a 75 69 64 61 74 2d 67 65 74 2d 6c 66 74 63 d:uidat-get-lftc
4b90: 6f 6c 20 75 69 64 61 74 29 29 0a 09 20 28 74 61 ol uidat)).. (ta
4ba0: 62 6c 65 68 65 61 64 65 72 20 28 64 62 6f 61 72 bleheader (dboar
4bb0: 64 3a 75 69 64 61 74 2d 67 65 74 2d 68 65 61 64 d:uidat-get-head
4bc0: 65 72 20 75 69 64 61 74 29 29 0a 09 20 28 74 61 er uidat)).. (ta
4bd0: 62 6c 65 20 20 20 20 20 20 20 28 64 62 6f 61 72 ble (dboar
4be0: 64 3a 75 69 64 61 74 2d 67 65 74 2d 72 75 6e 73 d:uidat-get-runs
4bf0: 76 65 63 20 75 69 64 61 74 29 29 0a 09 20 28 63 vec uidat)).. (c
4c00: 6f 6c 6e 20 20 20 20 20 20 20 20 30 29 29 0a 20 oln 0)).
4c10: 20 20 20 28 73 65 74 21 20 2a 61 6c 6c 74 65 73 (set! *alltes
4c20: 74 6e 61 6d 65 6c 73 74 2a 20 27 28 29 29 0a 20 tnamelst* '()).
4c30: 20 20 20 3b 3b 20 63 72 65 61 74 65 20 61 20 63 ;; create a c
4c40: 6f 6e 63 69 73 65 20 6c 69 73 74 20 6f 66 20 74 oncise list of t
4c50: 65 73 74 20 6e 61 6d 65 73 0a 20 20 20 20 28 66 est names. (f
4c60: 6f 72 2d 65 61 63 68 0a 20 20 20 20 20 28 6c 61 or-each. (la
4c70: 6d 62 64 61 20 28 72 75 6e 64 61 74 29 0a 20 20 mbda (rundat).
4c80: 20 20 20 20 20 28 69 66 20 28 76 65 63 74 6f 72 (if (vector
4c90: 3f 20 72 75 6e 64 61 74 29 0a 09 20 20 20 28 6c ? rundat).. (l
4ca0: 65 74 2a 20 28 28 74 65 73 74 64 61 74 20 20 20 et* ((testdat
4cb0: 28 76 65 63 74 6f 72 2d 72 65 66 20 72 75 6e 64 (vector-ref rund
4cc0: 61 74 20 31 29 29 0a 09 09 20 20 28 74 65 73 74 at 1))... (test
4cd0: 6e 61 6d 65 73 20 28 6d 61 70 20 74 65 73 74 3a names (map test:
4ce0: 74 65 73 74 2d 67 65 74 2d 66 75 6c 6c 6e 61 6d test-get-fullnam
4cf0: 65 20 74 65 73 74 64 61 74 29 29 29 0a 09 20 20 e testdat)))..
4d00: 20 20 20 28 69 66 20 28 6e 6f 74 20 28 61 6e 64 (if (not (and
4d10: 20 28 64 3a 61 6c 6c 64 61 74 2d 68 69 64 65 2d (d:alldat-hide-
4d20: 65 6d 70 74 79 2d 72 75 6e 73 20 2a 61 6c 6c 64 empty-runs *alld
4d30: 61 74 2a 29 0a 09 09 09 20 20 20 28 6e 75 6c 6c at*).... (null
4d40: 3f 20 74 65 73 74 6e 61 6d 65 73 29 29 29 0a 09 ? testnames)))..
4d50: 09 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d . (for-each (lam
4d60: 62 64 61 20 28 74 65 73 74 6e 61 6d 65 29 0a 09 bda (testname)..
4d70: 09 09 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 .. (if (not
4d80: 28 6d 65 6d 62 65 72 20 74 65 73 74 6e 61 6d 65 (member testname
4d90: 20 2a 61 6c 6c 74 65 73 74 6e 61 6d 65 6c 73 74 *alltestnamelst
4da0: 2a 29 29 0a 09 09 09 09 20 28 62 65 67 69 6e 0a *))..... (begin.
4db0: 09 09 09 09 20 20 20 28 73 65 74 21 20 2a 61 6c .... (set! *al
4dc0: 6c 74 65 73 74 6e 61 6d 65 6c 73 74 2a 20 28 61 ltestnamelst* (a
4dd0: 70 70 65 6e 64 20 2a 61 6c 6c 74 65 73 74 6e 61 ppend *alltestna
4de0: 6d 65 6c 73 74 2a 20 28 6c 69 73 74 20 74 65 73 melst* (list tes
4df0: 74 6e 61 6d 65 29 29 29 29 29 29 0a 09 09 09 20 tname))))))....
4e00: 20 20 74 65 73 74 6e 61 6d 65 73 29 29 29 29 29 testnames)))))
4e10: 0a 20 20 20 20 20 72 75 6e 73 29 0a 0a 20 20 20 . runs)..
4e20: 20 28 73 65 74 21 20 2a 61 6c 6c 74 65 73 74 6e (set! *alltestn
4e30: 61 6d 65 6c 73 74 2a 20 28 63 6f 6c 6c 61 70 73 amelst* (collaps
4e40: 65 2d 72 6f 77 73 20 2a 61 6c 6c 74 65 73 74 6e e-rows *alltestn
4e50: 61 6d 65 6c 73 74 2a 29 29 20 3b 3b 3b 20 61 72 amelst*)) ;;; ar
4e60: 67 68 2e 20 70 6c 65 61 73 65 20 63 6c 65 61 6e gh. please clean
4e70: 20 75 70 20 74 68 69 73 20 73 69 6c 6c 79 6e 65 up this sillyne
4e80: 73 73 0a 20 20 20 20 28 73 65 74 21 20 2a 61 6c ss. (set! *al
4e90: 6c 74 65 73 74 6e 61 6d 65 6c 73 74 2a 20 28 6c ltestnamelst* (l
4ea0: 65 74 20 28 28 78 6c 20 28 69 66 20 28 3e 20 28 et ((xl (if (> (
4eb0: 6c 65 6e 67 74 68 20 2a 61 6c 6c 74 65 73 74 6e length *alltestn
4ec0: 61 6d 65 6c 73 74 2a 29 20 28 64 3a 61 6c 6c 64 amelst*) (d:alld
4ed0: 61 74 2d 73 74 61 72 74 2d 74 65 73 74 2d 6f 66 at-start-test-of
4ee0: 66 73 65 74 20 2a 61 6c 6c 64 61 74 2a 29 29 0a fset *alldat*)).
4ef0: 09 09 09 09 09 20 28 64 72 6f 70 20 2a 61 6c 6c ..... (drop *all
4f00: 74 65 73 74 6e 61 6d 65 6c 73 74 2a 20 28 64 3a testnamelst* (d:
4f10: 61 6c 6c 64 61 74 2d 73 74 61 72 74 2d 74 65 73 alldat-start-tes
4f20: 74 2d 6f 66 66 73 65 74 20 2a 61 6c 6c 64 61 74 t-offset *alldat
4f30: 2a 29 29 0a 09 09 09 09 09 20 27 28 29 29 29 29 *))...... '())))
4f40: 0a 09 09 09 20 20 20 20 20 28 61 70 70 65 6e 64 .... (append
4f50: 20 78 6c 20 28 6d 61 6b 65 2d 6c 69 73 74 20 28 xl (make-list (
4f60: 2d 20 28 64 3a 61 6c 6c 64 61 74 2d 6e 75 6d 2d - (d:alldat-num-
4f70: 74 65 73 74 73 20 2a 61 6c 6c 64 61 74 2a 29 20 tests *alldat*)
4f80: 28 6c 65 6e 67 74 68 20 78 6c 29 29 20 22 22 29 (length xl)) "")
4f90: 29 29 29 0a 20 20 20 20 28 75 70 64 61 74 65 2d ))). (update-
4fa0: 6c 61 62 65 6c 73 20 75 69 64 61 74 29 0a 20 20 labels uidat).
4fb0: 20 20 28 66 6f 72 2d 65 61 63 68 0a 20 20 20 20 (for-each.
4fc0: 20 28 6c 61 6d 62 64 61 20 28 72 75 6e 64 61 74 (lambda (rundat
4fd0: 29 0a 20 20 20 20 20 20 20 28 69 66 20 28 6e 6f ). (if (no
4fe0: 74 20 72 75 6e 64 61 74 29 20 3b 3b 20 68 61 6e t rundat) ;; han
4ff0: 64 6c 65 20 70 61 64 64 65 64 20 72 75 6e 73 0a dle padded runs.
5000: 09 20 20 20 3b 3b 20 20 20 20 20 20 20 20 20 20 . ;;
5010: 20 3b 3b 20 69 64 20 72 75 6e 2d 69 64 20 74 65 ;; id run-id te
5020: 73 74 6e 61 6d 65 20 73 74 61 74 65 20 73 74 61 stname state sta
5030: 74 75 73 20 65 76 65 6e 74 2d 74 69 6d 65 20 68 tus event-time h
5040: 6f 73 74 20 63 70 75 6c 6f 61 64 20 64 69 73 6b ost cpuload disk
5050: 66 72 65 65 20 75 6e 61 6d 65 20 72 75 6e 64 69 free uname rundi
5060: 72 20 69 74 65 6d 2d 70 61 74 68 20 72 75 6e 2d r item-path run-
5070: 64 75 72 61 74 69 6f 6e 0a 09 20 20 20 28 73 65 duration.. (se
5080: 74 21 20 72 75 6e 64 61 74 20 28 76 65 63 74 6f t! rundat (vecto
5090: 72 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 32 r (make-vector 2
50a0: 30 20 23 66 29 20 27 28 29 20 28 6d 61 70 20 28 0 #f) '() (map (
50b0: 6c 61 6d 62 64 61 20 28 78 29 20 22 22 29 20 28 lambda (x) "") (
50c0: 64 3a 61 6c 6c 64 61 74 2d 6b 65 79 73 20 2a 61 d:alldat-keys *a
50d0: 6c 6c 64 61 74 2a 29 29 29 29 29 3b 3b 20 33 29 lldat*)))));; 3)
50e0: 29 29 0a 20 20 20 20 20 20 20 28 6c 65 74 2a 20 )). (let*
50f0: 28 28 72 75 6e 20 20 20 20 20 20 28 76 65 63 74 ((run (vect
5100: 6f 72 2d 72 65 66 20 72 75 6e 64 61 74 20 30 29 or-ref rundat 0)
5110: 29 0a 09 20 20 20 20 20 20 28 74 65 73 74 73 64 ).. (testsd
5120: 61 74 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72 at (vector-ref r
5130: 75 6e 64 61 74 20 31 29 29 0a 09 20 20 20 20 20 undat 1))..
5140: 20 28 6b 65 79 2d 76 61 6c 2d 64 61 74 20 28 76 (key-val-dat (v
5150: 65 63 74 6f 72 2d 72 65 66 20 72 75 6e 64 61 74 ector-ref rundat
5160: 20 32 29 29 0a 09 20 20 20 20 20 20 28 72 75 6e 2)).. (run
5170: 2d 69 64 20 20 20 28 64 62 3a 67 65 74 2d 76 61 -id (db:get-va
5180: 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 lue-by-header ru
5190: 6e 20 28 64 3a 61 6c 6c 64 61 74 2d 68 65 61 64 n (d:alldat-head
51a0: 65 72 20 2a 61 6c 6c 64 61 74 2a 29 20 22 69 64 er *alldat*) "id
51b0: 22 29 29 0a 09 20 20 20 20 20 20 28 6b 65 79 2d ")).. (key-
51c0: 76 61 6c 73 20 28 61 70 70 65 6e 64 20 6b 65 79 vals (append key
51d0: 2d 76 61 6c 2d 64 61 74 0a 09 09 09 09 28 6c 69 -val-dat.....(li
51e0: 73 74 20 28 6c 65 74 20 28 28 78 20 28 64 62 3a st (let ((x (db:
51f0: 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 get-value-by-hea
5200: 64 65 72 20 72 75 6e 20 28 64 3a 61 6c 6c 64 61 der run (d:allda
5210: 74 2d 68 65 61 64 65 72 20 2a 61 6c 6c 64 61 74 t-header *alldat
5220: 2a 29 20 22 72 75 6e 6e 61 6d 65 22 29 29 29 0a *) "runname"))).
5230: 09 09 09 09 09 28 69 66 20 78 20 78 20 22 22 29 .....(if x x "")
5240: 29 29 29 29 0a 09 20 20 20 20 20 20 28 72 75 6e )))).. (run
5250: 2d 6b 65 79 20 20 28 73 74 72 69 6e 67 2d 69 6e -key (string-in
5260: 74 65 72 73 70 65 72 73 65 20 6b 65 79 2d 76 61 tersperse key-va
5270: 6c 73 20 22 5c 6e 22 29 29 29 0a 09 20 0a 09 20 ls "\n"))).. ..
5280: 3b 3b 20 66 69 6c 6c 20 69 6e 20 74 68 65 20 72 ;; fill in the r
5290: 75 6e 20 68 65 61 64 65 72 20 6b 65 79 20 76 61 un header key va
52a0: 6c 75 65 73 0a 09 20 28 6c 65 74 20 28 28 72 6f lues.. (let ((ro
52b0: 77 6e 20 20 20 20 20 20 30 29 0a 09 20 20 20 20 wn 0)..
52c0: 20 20 20 28 68 65 61 64 65 72 63 6f 6c 20 28 76 (headercol (v
52d0: 65 63 74 6f 72 2d 72 65 66 20 74 61 62 6c 65 68 ector-ref tableh
52e0: 65 61 64 65 72 20 63 6f 6c 6e 29 29 29 0a 09 20 eader coln)))..
52f0: 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d (for-each (lam
5300: 62 64 61 20 28 6b 76 61 6c 29 0a 09 09 20 20 20 bda (kval)...
5310: 20 20 20 20 28 6c 65 74 2a 20 28 28 6c 61 62 6c (let* ((labl
5320: 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 (vector-re
5330: 66 20 68 65 61 64 65 72 63 6f 6c 20 72 6f 77 6e f headercol rown
5340: 29 29 29 0a 09 09 09 20 28 69 66 20 28 6e 6f 74 ))).... (if (not
5350: 20 28 65 71 75 61 6c 3f 20 6b 76 61 6c 20 28 69 (equal? kval (i
5360: 75 70 3a 61 74 74 72 69 62 75 74 65 20 6c 61 62 up:attribute lab
5370: 6c 20 22 54 49 54 4c 45 22 29 29 29 0a 09 09 09 l "TITLE")))....
5380: 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 (iup:attrib
5390: 75 74 65 2d 73 65 74 21 20 28 76 65 63 74 6f 72 ute-set! (vector
53a0: 2d 72 65 66 20 68 65 61 64 65 72 63 6f 6c 20 72 -ref headercol r
53b0: 6f 77 6e 29 20 22 54 49 54 4c 45 22 20 6b 76 61 own) "TITLE" kva
53c0: 6c 29 29 0a 09 09 09 20 28 73 65 74 21 20 72 6f l)).... (set! ro
53d0: 77 6e 20 28 2b 20 72 6f 77 6e 20 31 29 29 29 29 wn (+ rown 1))))
53e0: 0a 09 09 20 20 20 20 20 6b 65 79 2d 76 61 6c 73 ... key-vals
53f0: 29 29 0a 09 20 0a 09 20 3b 3b 20 46 6f 72 20 74 )).. .. ;; For t
5400: 68 69 73 20 72 75 6e 20 6e 6f 77 20 66 69 6c 6c his run now fill
5410: 20 69 6e 20 74 68 65 20 62 75 74 74 6f 6e 73 20 in the buttons
5420: 66 6f 72 20 65 61 63 68 20 74 65 73 74 0a 09 20 for each test..
5430: 28 6c 65 74 20 28 28 72 6f 77 6e 20 30 29 0a 09 (let ((rown 0)..
5440: 20 20 20 20 20 20 20 28 63 6f 6c 75 6d 6e 64 61 (columnda
5450: 74 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 74 t (vector-ref t
5460: 61 62 6c 65 20 63 6f 6c 6e 29 29 29 0a 09 20 20 able coln)))..
5470: 20 28 66 6f 72 2d 65 61 63 68 0a 09 20 20 20 20 (for-each..
5480: 28 6c 61 6d 62 64 61 20 28 74 65 73 74 6e 61 6d (lambda (testnam
5490: 65 29 0a 09 20 20 20 20 20 20 28 6c 65 74 20 28 e).. (let (
54a0: 28 62 75 74 74 6f 6e 64 61 74 20 20 28 68 61 73 (buttondat (has
54b0: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
54c0: 75 6c 74 20 28 64 3a 61 6c 6c 64 61 74 2d 62 75 ult (d:alldat-bu
54d0: 74 74 6f 6e 64 61 74 20 2a 61 6c 6c 64 61 74 2a ttondat *alldat*
54e0: 29 20 28 6d 6b 73 74 72 20 63 6f 6c 6e 20 72 6f ) (mkstr coln ro
54f0: 77 6e 29 20 23 66 29 29 29 0a 09 09 28 69 66 20 wn) #f)))...(if
5500: 62 75 74 74 6f 6e 64 61 74 0a 09 09 20 20 20 20 buttondat...
5510: 28 6c 65 74 2a 20 28 28 74 65 73 74 20 20 20 20 (let* ((test
5520: 20 20 20 28 6c 65 74 20 28 28 6d 61 74 63 68 69 (let ((matchi
5530: 6e 67 20 28 66 69 6c 74 65 72 20 0a 09 09 09 09 ng (filter .....
5540: 09 09 09 28 6c 61 6d 62 64 61 20 28 78 29 28 65 ...(lambda (x)(e
5550: 71 75 61 6c 3f 20 28 74 65 73 74 3a 74 65 73 74 qual? (test:test
5560: 2d 67 65 74 2d 66 75 6c 6c 6e 61 6d 65 20 78 29 -get-fullname x)
5570: 20 74 65 73 74 6e 61 6d 65 29 29 0a 09 09 09 09 testname)).....
5580: 09 09 09 74 65 73 74 73 64 61 74 29 29 29 0a 09 ...testsdat)))..
5590: 09 09 09 09 20 28 69 66 20 28 6e 75 6c 6c 3f 20 .... (if (null?
55a0: 6d 61 74 63 68 69 6e 67 29 0a 09 09 09 09 09 20 matching)......
55b0: 20 20 20 20 28 76 65 63 74 6f 72 20 2d 31 20 2d (vector -1 -
55c0: 31 20 22 22 20 22 22 20 22 22 20 30 20 22 22 20 1 "" "" "" 0 ""
55d0: 22 22 20 30 20 22 22 20 22 22 20 22 22 20 30 20 "" 0 "" "" "" 0
55e0: 22 22 20 22 22 29 0a 09 09 09 09 09 20 20 20 20 "" "")......
55f0: 20 28 63 61 72 20 6d 61 74 63 68 69 6e 67 29 29 (car matching))
5600: 29 29 0a 09 09 09 20 20 20 28 74 65 73 74 6e 61 )).... (testna
5610: 6d 65 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 me (db:test-ge
5620: 74 2d 74 65 73 74 6e 61 6d 65 20 20 74 65 73 74 t-testname test
5630: 29 29 0a 09 09 09 20 20 20 28 69 74 65 6d 70 61 )).... (itempa
5640: 74 68 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 th (db:test-ge
5650: 74 2d 69 74 65 6d 2d 70 61 74 68 20 74 65 73 74 t-item-path test
5660: 29 29 0a 09 09 09 20 20 20 28 74 65 73 74 66 75 )).... (testfu
5670: 6c 6c 6e 61 6d 65 20 28 74 65 73 74 3a 74 65 73 llname (test:tes
5680: 74 2d 67 65 74 2d 66 75 6c 6c 6e 61 6d 65 20 74 t-get-fullname t
5690: 65 73 74 29 29 0a 09 09 09 20 20 20 28 74 65 73 est)).... (tes
56a0: 74 73 74 61 74 75 73 20 28 64 62 3a 74 65 73 74 tstatus (db:test
56b0: 2d 67 65 74 2d 73 74 61 74 75 73 20 20 20 74 65 -get-status te
56c0: 73 74 29 29 0a 09 09 09 20 20 20 28 74 65 73 74 st)).... (test
56d0: 73 74 61 74 65 20 20 28 64 62 3a 74 65 73 74 2d state (db:test-
56e0: 67 65 74 2d 73 74 61 74 65 20 20 20 20 74 65 73 get-state tes
56f0: 74 29 29 0a 09 09 09 20 20 20 3b 3b 28 74 65 73 t)).... ;;(tes
5700: 74 73 74 61 72 74 20 20 28 64 62 3a 74 65 73 74 tstart (db:test
5710: 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 -get-event_time
5720: 74 65 73 74 29 29 0a 09 09 09 20 20 20 3b 3b 28 test)).... ;;(
5730: 72 75 6e 74 69 6d 65 20 20 20 20 28 64 62 3a 74 runtime (db:t
5740: 65 73 74 2d 67 65 74 2d 72 75 6e 5f 64 75 72 61 est-get-run_dura
5750: 74 69 6f 6e 20 74 65 73 74 29 29 0a 09 09 09 20 tion test))....
5760: 20 20 28 62 75 74 74 6f 6e 74 78 74 20 20 28 63 (buttontxt (c
5770: 6f 6e 64 0a 09 09 09 09 09 28 28 6d 65 6d 62 65 ond......((membe
5780: 72 20 74 65 73 74 73 74 61 74 65 20 27 28 22 43 r teststate '("C
5790: 4f 4d 50 4c 45 54 45 44 22 20 22 41 52 43 48 49 OMPLETED" "ARCHI
57a0: 56 45 44 22 29 29 20 74 65 73 74 73 74 61 74 75 VED")) teststatu
57b0: 73 29 0a 09 09 09 09 09 28 28 61 6e 64 20 28 65 s)......((and (e
57c0: 71 75 61 6c 3f 20 74 65 73 74 73 74 61 74 65 20 qual? teststate
57d0: 22 4e 4f 54 5f 53 54 41 52 54 45 44 22 29 0a 09 "NOT_STARTED")..
57e0: 09 09 09 09 20 20 20 20 20 20 28 6d 65 6d 62 65 .... (membe
57f0: 72 20 74 65 73 74 73 74 61 74 75 73 20 27 28 22 r teststatus '("
5800: 5a 45 52 4f 5f 49 54 45 4d 53 22 20 22 42 4c 4f ZERO_ITEMS" "BLO
5810: 43 4b 45 44 22 20 22 50 52 45 51 5f 46 41 49 4c CKED" "PREQ_FAIL
5820: 22 20 22 50 52 45 51 5f 44 49 53 43 41 52 44 45 " "PREQ_DISCARDE
5830: 44 22 20 22 54 49 4d 45 44 5f 4f 55 54 22 20 22 D" "TIMED_OUT" "
5840: 4b 45 45 50 5f 54 52 59 49 4e 47 22 20 22 54 45 KEEP_TRYING" "TE
5850: 4e 5f 53 54 52 49 4b 45 53 22 29 29 29 0a 09 09 N_STRIKES")))...
5860: 09 09 09 20 74 65 73 74 73 74 61 74 75 73 29 0a ... teststatus).
5870: 09 09 09 09 09 28 65 6c 73 65 0a 09 09 09 09 09 .....(else......
5880: 20 74 65 73 74 73 74 61 74 65 29 29 29 0a 09 09 teststate)))...
5890: 09 20 20 20 28 62 75 74 74 6f 6e 20 20 20 20 20 . (button
58a0: 28 76 65 63 74 6f 72 2d 72 65 66 20 63 6f 6c 75 (vector-ref colu
58b0: 6d 6e 64 61 74 20 72 6f 77 6e 29 29 0a 09 09 09 mndat rown))....
58c0: 20 20 20 28 63 6f 6c 6f 72 20 20 20 20 20 20 28 (color (
58d0: 63 61 72 20 28 67 75 74 69 6c 73 3a 67 65 74 2d car (gutils:get-
58e0: 63 6f 6c 6f 72 2d 66 6f 72 2d 73 74 61 74 65 2d color-for-state-
58f0: 73 74 61 74 75 73 20 74 65 73 74 73 74 61 74 65 status teststate
5900: 20 74 65 73 74 73 74 61 74 75 73 29 29 29 0a 09 teststatus)))..
5910: 09 09 20 20 20 28 63 75 72 72 2d 63 6f 6c 6f 72 .. (curr-color
5920: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 62 75 74 (vector-ref but
5930: 74 6f 6e 64 61 74 20 31 29 29 20 3b 3b 20 28 69 tondat 1)) ;; (i
5940: 75 70 3a 61 74 74 72 69 62 75 74 65 20 62 75 74 up:attribute but
5950: 74 6f 6e 20 22 42 47 43 4f 4c 4f 52 22 29 29 0a ton "BGCOLOR")).
5960: 09 09 09 20 20 20 28 63 75 72 72 2d 74 69 74 6c ... (curr-titl
5970: 65 20 28 76 65 63 74 6f 72 2d 72 65 66 20 62 75 e (vector-ref bu
5980: 74 74 6f 6e 64 61 74 20 32 29 29 29 20 3b 3b 20 ttondat 2))) ;;
5990: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 62 (iup:attribute b
59a0: 75 74 74 6f 6e 20 22 54 49 54 4c 45 22 29 29 29 utton "TITLE")))
59b0: 0a 09 09 20 20 20 20 20 20 28 69 66 20 28 6e 6f ... (if (no
59c0: 74 20 28 65 71 75 61 6c 3f 20 63 75 72 72 2d 63 t (equal? curr-c
59d0: 6f 6c 6f 72 20 63 6f 6c 6f 72 29 29 0a 09 09 09 olor color))....
59e0: 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 (iup:attribute
59f0: 2d 73 65 74 21 20 62 75 74 74 6f 6e 20 22 42 47 -set! button "BG
5a00: 43 4f 4c 4f 52 22 20 63 6f 6c 6f 72 29 29 0a 09 COLOR" color))..
5a10: 09 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 . (if (not
5a20: 28 65 71 75 61 6c 3f 20 63 75 72 72 2d 74 69 74 (equal? curr-tit
5a30: 6c 65 20 62 75 74 74 6f 6e 74 78 74 29 29 0a 09 le buttontxt))..
5a40: 09 09 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 .. (iup:attribu
5a50: 74 65 2d 73 65 74 21 20 62 75 74 74 6f 6e 20 22 te-set! button "
5a60: 54 49 54 4c 45 22 20 20 20 62 75 74 74 6f 6e 74 TITLE" buttont
5a70: 78 74 29 29 0a 09 09 20 20 20 20 20 20 28 76 65 xt))... (ve
5a80: 63 74 6f 72 2d 73 65 74 21 20 62 75 74 74 6f 6e ctor-set! button
5a90: 64 61 74 20 30 20 72 75 6e 2d 69 64 29 0a 09 09 dat 0 run-id)...
5aa0: 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 (vector-se
5ab0: 74 21 20 62 75 74 74 6f 6e 64 61 74 20 31 20 63 t! buttondat 1 c
5ac0: 6f 6c 6f 72 29 0a 09 09 20 20 20 20 20 20 28 76 olor)... (v
5ad0: 65 63 74 6f 72 2d 73 65 74 21 20 62 75 74 74 6f ector-set! butto
5ae0: 6e 64 61 74 20 32 20 62 75 74 74 6f 6e 74 78 74 ndat 2 buttontxt
5af0: 29 0a 09 09 20 20 20 20 20 20 28 76 65 63 74 6f )... (vecto
5b00: 72 2d 73 65 74 21 20 62 75 74 74 6f 6e 64 61 74 r-set! buttondat
5b10: 20 33 20 74 65 73 74 29 0a 09 09 20 20 20 20 20 3 test)...
5b20: 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 62 75 (vector-set! bu
5b30: 74 74 6f 6e 64 61 74 20 34 20 72 75 6e 2d 6b 65 ttondat 4 run-ke
5b40: 79 29 29 29 0a 09 09 28 73 65 74 21 20 72 6f 77 y)))...(set! row
5b50: 6e 20 28 2b 20 72 6f 77 6e 20 31 29 29 29 29 0a n (+ rown 1)))).
5b60: 09 20 20 20 20 2a 61 6c 6c 74 65 73 74 6e 61 6d . *alltestnam
5b70: 65 6c 73 74 2a 29 29 0a 09 20 28 73 65 74 21 20 elst*)).. (set!
5b80: 63 6f 6c 6e 20 28 2b 20 63 6f 6c 6e 20 31 29 29 coln (+ coln 1))
5b90: 29 29 0a 20 20 20 20 20 72 75 6e 73 29 29 29 0a )). runs))).
5ba0: 0a 28 64 65 66 69 6e 65 20 28 6d 6b 73 74 72 20 .(define (mkstr
5bb0: 2e 20 78 29 0a 20 20 28 73 74 72 69 6e 67 2d 69 . x). (string-i
5bc0: 6e 74 65 72 73 70 65 72 73 65 20 28 6d 61 70 20 ntersperse (map
5bd0: 63 6f 6e 63 20 78 29 20 22 2c 22 29 29 0a 0a 28 conc x) ","))..(
5be0: 64 65 66 69 6e 65 20 28 73 65 74 2d 62 67 2d 6f define (set-bg-o
5bf0: 6e 2d 66 69 6c 74 65 72 29 0a 20 20 28 6c 65 74 n-filter). (let
5c00: 20 28 28 73 65 61 72 63 68 2d 63 68 61 6e 67 65 ((search-change
5c10: 64 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 28 66 d (not (null? (f
5c20: 69 6c 74 65 72 20 28 6c 61 6d 62 64 61 20 28 6b ilter (lambda (k
5c30: 65 79 29 0a 09 09 09 09 09 20 20 20 20 20 20 28 ey)...... (
5c40: 6e 6f 74 20 28 65 71 75 61 6c 3f 20 28 68 61 73 not (equal? (has
5c50: 68 2d 74 61 62 6c 65 2d 72 65 66 20 28 64 3a 61 h-table-ref (d:a
5c60: 6c 6c 64 61 74 2d 73 65 61 72 63 68 70 61 74 74 lldat-searchpatt
5c70: 73 20 2a 61 6c 6c 64 61 74 2a 29 20 6b 65 79 29 s *alldat*) key)
5c80: 20 22 25 22 29 29 29 0a 09 09 09 09 09 20 20 20 "%")))......
5c90: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 (hash-table-key
5ca0: 73 20 28 64 3a 61 6c 6c 64 61 74 2d 73 65 61 72 s (d:alldat-sear
5cb0: 63 68 70 61 74 74 73 20 2a 61 6c 6c 64 61 74 2a chpatts *alldat*
5cc0: 29 29 29 29 29 29 0a 09 28 73 74 61 74 65 2d 63 ))))))..(state-c
5cd0: 68 61 6e 67 65 64 20 20 28 6e 6f 74 20 28 6e 75 hanged (not (nu
5ce0: 6c 6c 3f 20 28 68 61 73 68 2d 74 61 62 6c 65 2d ll? (hash-table-
5cf0: 6b 65 79 73 20 28 64 3a 61 6c 6c 64 61 74 2d 73 keys (d:alldat-s
5d00: 74 61 74 65 2d 69 67 6e 6f 72 65 2d 68 61 73 68 tate-ignore-hash
5d10: 20 2a 61 6c 6c 64 61 74 2a 29 29 29 29 29 0a 09 *alldat*)))))..
5d20: 28 73 74 61 74 75 73 2d 63 68 61 6e 67 65 64 20 (status-changed
5d30: 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 28 68 61 73 (not (null? (has
5d40: 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 28 64 3a h-table-keys (d:
5d50: 61 6c 6c 64 61 74 2d 73 74 61 74 75 73 2d 69 67 alldat-status-ig
5d60: 6e 6f 72 65 2d 68 61 73 68 20 2a 61 6c 6c 64 61 nore-hash *allda
5d70: 74 2a 29 29 29 29 29 29 0a 20 20 20 20 28 69 75 t*)))))). (iu
5d80: 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 p:attribute-set!
5d90: 20 28 64 3a 61 6c 6c 64 61 74 2d 68 69 64 65 2d (d:alldat-hide-
5da0: 6e 6f 74 2d 68 69 64 65 2d 74 61 62 73 20 2a 61 not-hide-tabs *a
5db0: 6c 6c 64 61 74 2a 29 20 22 42 47 43 4f 4c 4f 52 lldat*) "BGCOLOR
5dc0: 22 0a 09 09 09 28 69 66 20 28 6f 72 20 73 65 61 "....(if (or sea
5dd0: 72 63 68 2d 63 68 61 6e 67 65 64 0a 09 09 09 09 rch-changed.....
5de0: 73 74 61 74 65 2d 63 68 61 6e 67 65 64 0a 09 09 state-changed...
5df0: 09 09 73 74 61 74 75 73 2d 63 68 61 6e 67 65 64 ..status-changed
5e00: 29 0a 09 09 09 20 20 20 20 22 31 39 30 20 31 38 ).... "190 18
5e10: 30 20 31 39 30 22 0a 09 09 09 20 20 20 20 22 31 0 190".... "1
5e20: 39 30 20 31 39 30 20 31 39 30 22 0a 09 09 09 20 90 190 190"....
5e30: 20 20 20 29 29 0a 20 20 20 20 28 64 3a 61 6c 6c )). (d:all
5e40: 64 61 74 2d 66 69 6c 74 65 72 73 2d 63 68 61 6e dat-filters-chan
5e50: 67 65 64 2d 73 65 74 21 20 2a 61 6c 6c 64 61 74 ged-set! *alldat
5e60: 2a 20 23 74 29 29 29 0a 0a 28 64 65 66 69 6e 65 * #t)))..(define
5e70: 20 28 75 70 64 61 74 65 2d 73 65 61 72 63 68 20 (update-search
5e80: 78 20 76 61 6c 29 0a 20 20 28 68 61 73 68 2d 74 x val). (hash-t
5e90: 61 62 6c 65 2d 73 65 74 21 20 28 64 3a 61 6c 6c able-set! (d:all
5ea0: 64 61 74 2d 73 65 61 72 63 68 70 61 74 74 73 20 dat-searchpatts
5eb0: 2a 61 6c 6c 64 61 74 2a 29 20 78 20 76 61 6c 29 *alldat*) x val)
5ec0: 0a 20 20 28 64 3a 61 6c 6c 64 61 74 2d 66 69 6c . (d:alldat-fil
5ed0: 74 65 72 73 2d 63 68 61 6e 67 65 64 2d 73 65 74 ters-changed-set
5ee0: 21 20 2a 61 6c 6c 64 61 74 2a 20 23 74 29 0a 20 ! *alldat* #t).
5ef0: 20 28 73 65 74 2d 62 67 2d 6f 6e 2d 66 69 6c 74 (set-bg-on-filt
5f00: 65 72 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 6d er))..(define (m
5f10: 61 72 6b 2d 66 6f 72 2d 75 70 64 61 74 65 29 0a ark-for-update).
5f20: 20 20 28 64 3a 61 6c 6c 64 61 74 2d 66 69 6c 74 (d:alldat-filt
5f30: 65 72 73 2d 63 68 61 6e 67 65 64 2d 73 65 74 21 ers-changed-set!
5f40: 20 2a 61 6c 6c 64 61 74 2a 20 23 74 29 0a 20 20 *alldat* #t).
5f50: 28 64 3a 61 6c 6c 64 61 74 2d 6c 61 73 74 2d 64 (d:alldat-last-d
5f60: 62 2d 75 70 64 61 74 65 2d 73 65 74 21 20 2a 61 b-update-set! *a
5f70: 6c 6c 64 61 74 2a 20 30 29 29 0a 0a 3b 3b 3d 3d lldat* 0))..;;==
5f80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5f90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5fa0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5fb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5fc0: 3d 3d 3d 3d 0a 3b 3b 20 52 20 55 20 4e 20 43 20 ====.;; R U N C
5fd0: 4f 20 4e 20 54 20 52 20 4f 20 4c 0a 3b 3b 3d 3d O N T R O L.;;==
5fe0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5ff0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6000: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6020: 3d 3d 3d 3d 0a 0a 3b 3b 20 74 61 72 67 65 74 20 ====..;; target
6030: 70 6f 70 75 6c 61 74 69 6e 67 20 6c 6f 67 69 63 populating logic
6040: 0a 3b 3b 20 20 0a 3b 3b 20 6c 62 20 20 20 20 20 .;; .;; lb
6050: 20 20 20 20 20 20 20 3d 20 3c 76 65 63 74 6f 72 = <vector
6060: 20 63 75 72 72 2d 6c 61 62 65 6c 2d 6f 62 6a 65 curr-label-obje
6070: 63 74 20 6e 65 78 74 2d 6c 61 62 65 6c 2d 6f 62 ct next-label-ob
6080: 6a 65 63 74 3e 0a 3b 3b 20 66 69 65 6c 64 20 20 ject>.;; field
6090: 20 20 20 20 20 20 20 3d 20 74 61 72 67 65 74 20 = target
60a0: 66 69 65 6c 64 20 6e 61 6d 65 20 66 6f 72 20 74 field name for t
60b0: 68 69 73 20 64 72 6f 70 64 6f 77 6e 0a 3b 3b 20 his dropdown.;;
60c0: 72 65 66 65 72 65 6e 74 2d 76 61 6c 73 20 3d 20 referent-vals =
60d0: 73 65 6c 65 63 74 65 64 20 76 61 6c 75 65 20 69 selected value i
60e0: 6e 20 74 68 65 20 6c 65 66 74 20 64 72 6f 70 64 n the left dropd
60f0: 6f 77 6e 0a 3b 3b 20 74 61 72 67 65 74 73 20 20 own.;; targets
6100: 20 20 20 20 20 3d 20 6c 69 73 74 20 6f 66 20 74 = list of t
6110: 61 72 67 65 74 73 20 74 6f 20 75 73 65 20 74 6f argets to use to
6120: 20 62 75 69 6c 64 20 74 68 65 20 64 72 6f 70 64 build the dropd
6130: 6f 77 6e 0a 3b 3b 20 0a 3b 3b 20 65 61 63 68 20 own.;; .;; each
6140: 6e 6f 64 65 20 69 73 20 63 68 61 69 6e 65 64 3a node is chained:
6150: 20 6b 65 79 31 20 2d 3e 20 6b 65 79 32 20 2d 3e key1 -> key2 ->
6160: 20 6b 65 79 33 0a 3b 3b 0a 3b 3b 20 6d 75 73 74 key3.;;.;; must
6170: 20 73 65 6c 65 63 74 20 76 61 6c 75 65 73 20 66 select values f
6180: 72 6f 6d 20 6f 6e 6c 79 20 61 70 72 6f 70 72 69 rom only apropri
6190: 61 74 65 20 74 61 72 67 65 74 73 0a 3b 3b 20 20 ate targets.;;
61a0: 20 61 20 62 20 63 0a 3b 3b 20 20 20 61 20 64 20 a b c.;; a d
61b0: 65 0a 3b 3b 20 20 20 61 20 62 20 66 0a 3b 3b 20 e.;; a b f.;;
61c0: 20 20 20 20 20 20 20 61 2f 62 20 3d 3e 20 63 20 a/b => c
61d0: 66 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 64 61 f.;;.(define (da
61e0: 73 68 62 6f 61 72 64 3a 70 6f 70 75 6c 61 74 65 shboard:populate
61f0: 2d 74 61 72 67 65 74 2d 64 72 6f 70 64 6f 77 6e -target-dropdown
6200: 20 6c 62 20 72 65 66 65 72 65 6e 74 2d 76 61 6c lb referent-val
6210: 73 20 74 61 72 67 65 74 73 29 20 3b 3b 20 20 72 s targets) ;; r
6220: 75 6e 63 6f 6e 66 2d 74 61 72 67 73 29 0a 20 20 unconf-targs).
6230: 3b 3b 20 69 73 20 74 68 65 20 63 75 72 72 65 6e ;; is the curren
6240: 74 20 76 61 6c 75 65 20 69 6e 20 74 68 65 20 6e t value in the n
6250: 65 77 20 6c 69 73 74 3f 20 63 68 6f 6f 73 65 20 ew list? choose
6260: 6e 65 77 20 64 65 66 61 75 6c 74 20 69 66 20 6e new default if n
6270: 6f 74 0a 20 20 28 6c 65 74 2a 20 28 28 72 65 6d ot. (let* ((rem
6280: 76 61 6c 75 65 73 20 20 28 6d 61 70 20 28 6c 61 values (map (la
6290: 6d 62 64 61 20 28 72 6f 77 29 0a 09 09 09 20 20 mbda (row)....
62a0: 20 20 28 63 6f 6d 6d 6f 6e 3a 6c 69 73 74 2d 69 (common:list-i
62b0: 73 2d 73 75 62 6c 69 73 74 20 72 65 66 65 72 65 s-sublist refere
62c0: 6e 74 2d 76 61 6c 73 20 28 76 65 63 74 6f 72 2d nt-vals (vector-
62d0: 3e 6c 69 73 74 20 72 6f 77 29 29 29 0a 09 09 09 >list row)))....
62e0: 20 20 74 61 72 67 65 74 73 29 29 0a 09 20 28 76 targets)).. (v
62f0: 61 6c 75 65 73 20 20 20 20 20 28 64 65 6c 65 74 alues (delet
6300: 65 2d 64 75 70 6c 69 63 61 74 65 73 20 28 6d 61 e-duplicates (ma
6310: 70 20 63 61 72 20 28 66 69 6c 74 65 72 20 6c 69 p car (filter li
6320: 73 74 3f 20 72 65 6d 76 61 6c 75 65 73 29 29 29 st? remvalues)))
6330: 29 0a 09 20 28 73 65 6c 2d 76 61 6c 6e 75 6d 20 ).. (sel-valnum
6340: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 6c (iup:attribute l
6350: 62 20 22 56 41 4c 55 45 22 29 29 0a 09 20 28 73 b "VALUE")).. (s
6360: 65 6c 2d 76 61 6c 20 20 20 20 28 69 75 70 3a 61 el-val (iup:a
6370: 74 74 72 69 62 75 74 65 20 6c 62 20 73 65 6c 2d ttribute lb sel-
6380: 76 61 6c 6e 75 6d 29 29 0a 09 20 28 76 61 6c 2d valnum)).. (val-
6390: 6e 75 6d 20 20 20 20 31 29 29 0a 20 20 20 20 3b num 1)). ;
63a0: 3b 20 66 69 72 73 74 20 63 68 65 63 6b 20 69 66 ; first check if
63b0: 20 74 68 65 20 63 75 72 72 65 6e 74 20 76 61 6c the current val
63c0: 75 65 20 69 73 20 69 6e 20 74 68 65 20 6e 65 77 ue is in the new
63d0: 20 6c 69 73 74 2c 20 6f 74 68 65 72 77 69 73 65 list, otherwise
63e0: 20 72 65 70 6c 61 63 65 20 77 69 74 68 20 0a 20 replace with .
63f0: 20 20 20 3b 3b 20 66 69 72 73 74 20 76 61 6c 75 ;; first valu
6400: 65 20 66 72 6f 6d 20 76 61 6c 75 65 73 0a 20 20 e from values.
6410: 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 (iup:attribute
6420: 2d 73 65 74 21 20 6c 62 20 22 52 45 4d 4f 56 45 -set! lb "REMOVE
6430: 49 54 45 4d 22 20 22 41 4c 4c 22 29 0a 20 20 20 ITEM" "ALL").
6440: 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 (for-each (lamb
6450: 64 61 20 28 76 61 6c 29 0a 09 09 3b 3b 20 28 69 da (val)...;; (i
6460: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 up:attribute-set
6470: 21 20 6c 62 20 22 41 50 50 45 4e 44 49 54 45 4d ! lb "APPENDITEM
6480: 22 20 76 61 6c 29 0a 09 09 28 69 75 70 3a 61 74 " val)...(iup:at
6490: 74 72 69 62 75 74 65 2d 73 65 74 21 20 6c 62 20 tribute-set! lb
64a0: 28 63 6f 6e 63 20 76 61 6c 2d 6e 75 6d 29 20 76 (conc val-num) v
64b0: 61 6c 29 0a 09 09 28 69 66 20 28 65 71 75 61 6c al)...(if (equal
64c0: 3f 20 73 65 6c 2d 76 61 6c 20 76 61 6c 29 0a 09 ? sel-val val)..
64d0: 09 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 . (iup:attrib
64e0: 75 74 65 2d 73 65 74 21 20 6c 62 20 22 56 41 4c ute-set! lb "VAL
64f0: 55 45 22 20 76 61 6c 2d 6e 75 6d 29 29 0a 09 09 UE" val-num))...
6500: 28 73 65 74 21 20 76 61 6c 2d 6e 75 6d 20 28 2b (set! val-num (+
6510: 20 76 61 6c 2d 6e 75 6d 20 31 29 29 29 0a 09 20 val-num 1)))..
6520: 20 20 20 20 20 76 61 6c 75 65 73 29 0a 20 20 20 values).
6530: 20 28 6c 65 74 20 28 28 76 61 6c 20 28 69 75 70 (let ((val (iup
6540: 3a 61 74 74 72 69 62 75 74 65 20 6c 62 20 22 56 :attribute lb "V
6550: 41 4c 55 45 22 29 29 29 0a 20 20 20 20 20 20 28 ALUE"))). (
6560: 69 66 20 76 61 6c 0a 09 20 20 76 61 6c 0a 09 20 if val.. val..
6570: 20 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f (if (not (null?
6580: 20 76 61 6c 75 65 73 29 29 0a 09 20 20 20 20 20 values))..
6590: 20 28 6c 65 74 20 28 28 6e 65 77 76 61 6c 20 28 (let ((newval (
65a0: 63 61 72 20 76 61 6c 75 65 73 29 29 29 0a 09 09 car values)))...
65b0: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 (iup:attribute-s
65c0: 65 74 21 20 6c 62 20 22 56 41 4c 55 45 22 20 6e et! lb "VALUE" n
65d0: 65 77 76 61 6c 29 0a 09 09 6e 65 77 76 61 6c 29 ewval)...newval)
65e0: 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 )))))..(define (
65f0: 64 61 73 68 62 6f 61 72 64 3a 75 70 64 61 74 65 dashboard:update
6600: 2d 74 61 72 67 65 74 2d 73 65 6c 65 63 74 6f 72 -target-selector
6610: 20 6b 65 79 2d 6c 62 73 20 23 21 6b 65 79 20 28 key-lbs #!key (
6620: 61 63 74 69 6f 6e 2d 70 72 6f 63 20 23 66 29 29 action-proc #f))
6630: 0a 20 20 28 6c 65 74 2a 20 28 28 72 75 6e 63 6f . (let* ((runco
6640: 6e 66 2d 74 61 72 67 73 20 28 63 6f 6d 6d 6f 6e nf-targs (common
6650: 3a 67 65 74 2d 72 75 6e 63 6f 6e 66 69 67 2d 74 :get-runconfig-t
6660: 61 72 67 65 74 73 29 29 0a 09 20 28 64 62 2d 74 argets)).. (db-t
6670: 61 72 67 65 74 2d 64 61 74 20 28 69 66 20 28 64 arget-dat (if (d
6680: 3a 61 6c 6c 64 61 74 2d 75 73 65 73 65 72 76 65 :alldat-useserve
6690: 72 20 2a 61 6c 6c 64 61 74 2a 29 20 0a 09 09 09 r *alldat*) ....
66a0: 20 20 20 20 28 72 6d 74 3a 67 65 74 2d 74 61 72 (rmt:get-tar
66b0: 67 65 74 73 29 0a 09 09 09 20 20 20 20 28 64 62 gets).... (db
66c0: 3a 67 65 74 2d 74 61 72 67 65 74 73 20 28 64 3a :get-targets (d:
66d0: 61 6c 6c 64 61 74 2d 64 62 6c 6f 63 61 6c 20 2a alldat-dblocal *
66e0: 61 6c 6c 64 61 74 2a 29 29 29 29 0a 09 20 28 68 alldat*)))).. (h
66f0: 65 61 64 65 72 20 20 20 20 20 20 20 20 28 76 65 eader (ve
6700: 63 74 6f 72 2d 72 65 66 20 64 62 2d 74 61 72 67 ctor-ref db-targ
6710: 65 74 2d 64 61 74 20 30 29 29 0a 09 20 28 64 62 et-dat 0)).. (db
6720: 2d 74 61 72 67 65 74 73 20 20 20 20 28 76 65 63 -targets (vec
6730: 74 6f 72 2d 72 65 66 20 64 62 2d 74 61 72 67 65 tor-ref db-targe
6740: 74 2d 64 61 74 20 31 29 29 0a 09 20 28 61 6c 6c t-dat 1)).. (all
6750: 2d 74 61 72 67 65 74 73 20 20 20 28 61 70 70 65 -targets (appe
6760: 6e 64 20 64 62 2d 74 61 72 67 65 74 73 0a 09 09 nd db-targets...
6770: 09 09 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 ..(map (lambda (
6780: 78 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 6c x)..... (l
6790: 69 73 74 2d 3e 76 65 63 74 6f 72 0a 09 09 09 09 ist->vector.....
67a0: 09 28 74 61 6b 65 20 28 61 70 70 65 6e 64 20 28 .(take (append (
67b0: 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 78 20 22 string-split x "
67c0: 2f 22 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 /").......
67d0: 28 6d 61 6b 65 2d 6c 69 73 74 20 28 6c 65 6e 67 (make-list (leng
67e0: 74 68 20 68 65 61 64 65 72 29 20 22 6e 61 22 29 th header) "na")
67f0: 29 0a 09 09 09 09 09 20 20 20 20 20 20 28 6c 65 )...... (le
6800: 6e 67 74 68 20 68 65 61 64 65 72 29 29 29 29 0a ngth header)))).
6810: 09 09 09 09 20 20 20 20 20 72 75 6e 63 6f 6e 66 .... runconf
6820: 2d 74 61 72 67 73 29 29 29 0a 09 20 28 6b 65 79 -targs))).. (key
6830: 2d 6c 69 73 74 62 6f 78 65 73 20 28 69 66 20 6b -listboxes (if k
6840: 65 79 2d 6c 62 73 20 6b 65 79 2d 6c 62 73 20 28 ey-lbs key-lbs (
6850: 6d 61 6b 65 2d 6c 69 73 74 20 28 6c 65 6e 67 74 make-list (lengt
6860: 68 20 68 65 61 64 65 72 29 20 23 66 29 29 29 29 h header) #f))))
6870: 0a 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 . (let loop (
6880: 28 6b 65 79 20 20 20 20 20 28 63 61 72 20 68 65 (key (car he
6890: 61 64 65 72 29 29 0a 09 20 20 20 20 20 20 20 28 ader)).. (
68a0: 72 65 6d 6b 65 79 73 20 28 63 64 72 20 68 65 61 remkeys (cdr hea
68b0: 64 65 72 29 29 0a 09 20 20 20 20 20 20 20 28 72 der)).. (r
68c0: 65 66 76 61 6c 73 20 27 28 29 29 0a 09 20 20 20 efvals '())..
68d0: 20 20 20 20 28 69 6e 64 78 20 20 20 20 30 29 0a (indx 0).
68e0: 09 20 20 20 20 20 20 20 28 6c 62 73 20 20 20 20 . (lbs
68f0: 20 27 28 29 29 29 0a 20 20 20 20 20 20 28 6c 65 '())). (le
6900: 74 2a 20 28 28 6c 62 20 28 6c 65 74 20 28 28 6c t* ((lb (let ((l
6910: 62 20 28 6c 69 73 74 2d 72 65 66 20 6b 65 79 2d b (list-ref key-
6920: 6c 69 73 74 62 6f 78 65 73 20 69 6e 64 78 29 29 listboxes indx))
6930: 29 0a 09 09 20 20 20 28 69 66 20 6c 62 0a 09 09 )... (if lb...
6940: 20 20 20 20 20 20 20 6c 62 0a 09 09 20 20 20 20 lb...
6950: 20 20 20 28 69 75 70 3a 6c 69 73 74 62 6f 78 20 (iup:listbox
6960: 0a 09 09 09 23 3a 73 69 7a 65 20 22 34 35 78 35 ....#:size "45x5
6970: 30 22 20 0a 09 09 09 23 3a 66 6f 6e 74 73 69 7a 0" ....#:fontsiz
6980: 65 20 22 31 30 22 0a 09 09 09 23 3a 65 78 70 61 e "10"....#:expa
6990: 6e 64 20 22 59 45 53 22 20 3b 3b 20 22 56 45 52 nd "YES" ;; "VER
69a0: 54 49 43 41 4c 22 0a 09 09 09 3b 3b 20 23 3a 64 TICAL"....;; #:d
69b0: 72 6f 70 64 6f 77 6e 20 22 59 45 53 22 0a 09 09 ropdown "YES"...
69c0: 09 23 3a 65 64 69 74 62 6f 78 20 22 59 45 53 22 .#:editbox "YES"
69d0: 0a 09 09 09 23 3a 61 63 74 69 6f 6e 20 28 6c 61 ....#:action (la
69e0: 6d 62 64 61 20 28 6f 62 6a 20 61 20 62 20 63 29 mbda (obj a b c)
69f0: 0a 09 09 09 09 20 20 20 28 61 63 74 69 6f 6e 2d ..... (action-
6a00: 70 72 6f 63 29 29 0a 09 09 09 23 3a 63 61 72 65 proc))....#:care
6a10: 74 5f 63 62 20 28 6c 61 6d 62 64 61 20 28 6f 62 t_cb (lambda (ob
6a20: 6a 20 61 20 62 20 63 29 28 61 63 74 69 6f 6e 2d j a b c)(action-
6a30: 70 72 6f 63 29 29 0a 09 09 09 29 29 29 29 0a 09 proc))....))))..
6a40: 20 20 20 20 20 3b 3b 20 6c 6f 6f 70 20 74 68 6f ;; loop tho
6a50: 75 67 68 20 61 6c 6c 20 74 68 65 20 74 61 72 67 ugh all the targ
6a60: 65 74 73 20 61 6e 64 20 62 75 69 6c 64 20 74 68 ets and build th
6a70: 65 20 6c 69 73 74 20 66 6f 72 20 74 68 69 73 20 e list for this
6a80: 64 72 6f 70 64 6f 77 6e 0a 09 20 20 20 20 20 28 dropdown.. (
6a90: 73 65 6c 65 63 74 65 64 2d 76 61 6c 75 65 20 28 selected-value (
6aa0: 64 61 73 68 62 6f 61 72 64 3a 70 6f 70 75 6c 61 dashboard:popula
6ab0: 74 65 2d 74 61 72 67 65 74 2d 64 72 6f 70 64 6f te-target-dropdo
6ac0: 77 6e 20 6c 62 20 72 65 66 76 61 6c 73 20 61 6c wn lb refvals al
6ad0: 6c 2d 74 61 72 67 65 74 73 29 29 29 0a 09 28 69 l-targets)))..(i
6ae0: 66 20 28 6e 75 6c 6c 3f 20 72 65 6d 6b 65 79 73 f (null? remkeys
6af0: 29 0a 09 20 20 20 20 3b 3b 20 72 65 74 75 72 6e ).. ;; return
6b00: 20 61 20 6c 69 73 74 20 6f 66 20 74 68 65 20 6c a list of the l
6b10: 69 73 74 62 6f 78 20 69 74 65 6d 73 20 61 6e 64 istbox items and
6b20: 20 61 6e 20 69 75 70 3a 68 62 6f 78 20 77 69 74 an iup:hbox wit
6b30: 68 20 74 68 65 20 6c 61 62 65 6c 73 20 61 6e 64 h the labels and
6b40: 20 6c 69 73 74 62 6f 78 65 73 0a 09 20 20 20 20 listboxes..
6b50: 28 6c 65 74 20 28 28 6c 69 73 74 62 6f 78 65 73 (let ((listboxes
6b60: 20 28 61 70 70 65 6e 64 20 6c 62 73 20 28 6c 69 (append lbs (li
6b70: 73 74 20 6c 62 29 29 29 29 0a 09 20 20 20 20 20 st lb))))..
6b80: 20 28 6c 69 73 74 20 6c 69 73 74 62 6f 78 65 73 (list listboxes
6b90: 0a 09 09 20 20 20 20 28 6d 61 70 20 28 6c 61 6d ... (map (lam
6ba0: 62 64 61 20 28 68 74 78 74 20 6c 62 29 0a 09 09 bda (htxt lb)...
6bb0: 09 20 20 20 28 69 75 70 3a 76 62 6f 78 0a 09 09 . (iup:vbox...
6bc0: 09 20 20 20 20 28 69 75 70 3a 6c 61 62 65 6c 20 . (iup:label
6bd0: 68 74 78 74 29 20 0a 09 09 09 20 20 20 20 6c 62 htxt) .... lb
6be0: 29 29 0a 09 09 09 20 68 65 61 64 65 72 0a 09 09 )).... header...
6bf0: 09 20 6c 69 73 74 62 6f 78 65 73 29 29 29 0a 09 . listboxes)))..
6c00: 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 72 (loop (car r
6c10: 65 6d 6b 65 79 73 29 0a 09 09 20 20 28 63 64 72 emkeys)... (cdr
6c20: 20 72 65 6d 6b 65 79 73 29 0a 09 09 20 20 28 61 remkeys)... (a
6c30: 70 70 65 6e 64 20 72 65 66 76 61 6c 73 20 28 6c ppend refvals (l
6c40: 69 73 74 20 73 65 6c 65 63 74 65 64 2d 76 61 6c ist selected-val
6c50: 75 65 29 29 0a 09 09 20 20 28 2b 20 69 6e 64 78 ue))... (+ indx
6c60: 20 31 29 0a 09 09 20 20 28 61 70 70 65 6e 64 20 1)... (append
6c70: 6c 62 73 20 28 6c 69 73 74 20 6c 62 29 29 29 29 lbs (list lb))))
6c80: 29 29 29 29 0a 0a 3b 3b 20 4d 61 6b 65 20 61 20 ))))..;; Make a
6c90: 76 65 72 74 69 63 61 6c 20 6c 69 73 74 20 6f 66 vertical list of
6ca0: 20 74 6f 67 67 6c 65 73 20 75 73 69 6e 67 20 69 toggles using i
6cb0: 74 65 6d 73 2c 20 77 68 65 6e 20 74 6f 67 67 6c tems, when toggl
6cc0: 65 64 20 63 61 6c 6c 20 70 72 6f 63 20 77 69 74 ed call proc wit
6cd0: 68 20 74 68 65 20 63 6f 6e 63 27 64 20 73 74 72 h the conc'd str
6ce0: 69 6e 67 20 0a 3b 3b 20 69 6e 74 65 72 73 70 65 ing .;; interspe
6cf0: 72 73 65 64 20 77 69 74 68 20 63 6f 6d 6d 61 73 rsed with commas
6d00: 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 64 61 73 .;;.(define (das
6d10: 68 62 6f 61 72 64 3a 74 65 78 74 2d 6c 69 73 74 hboard:text-list
6d20: 2d 74 6f 67 67 6c 65 2d 62 6f 78 20 69 74 65 6d -toggle-box item
6d30: 73 20 70 72 6f 63 29 0a 20 20 28 6c 65 74 20 28 s proc). (let (
6d40: 28 61 6c 6c 74 67 6c 73 20 28 6d 61 6b 65 2d 68 (alltgls (make-h
6d50: 61 73 68 2d 74 61 62 6c 65 29 29 29 0a 20 20 20 ash-table))).
6d60: 20 28 61 70 70 6c 79 20 69 75 70 3a 76 62 6f 78 (apply iup:vbox
6d70: 0a 09 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 .. (map (lambd
6d80: 61 20 28 69 74 65 6d 29 0a 09 09 20 20 28 69 75 a (item)... (iu
6d90: 70 3a 74 6f 67 67 6c 65 20 0a 09 09 20 20 20 69 p:toggle ... i
6da0: 74 65 6d 0a 09 09 20 20 20 23 3a 65 78 70 61 6e tem... #:expan
6db0: 64 20 22 59 45 53 22 0a 09 09 20 20 20 23 3a 61 d "YES"... #:a
6dc0: 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f ction (lambda (o
6dd0: 62 6a 20 74 73 74 61 74 65 29 0a 09 09 09 20 20 bj tstate)....
6de0: 20 20 20 20 28 69 66 20 28 65 71 3f 20 74 73 74 (if (eq? tst
6df0: 61 74 65 20 30 29 0a 09 09 09 09 20 20 28 68 61 ate 0)..... (ha
6e00: 73 68 2d 74 61 62 6c 65 2d 64 65 6c 65 74 65 21 sh-table-delete!
6e10: 20 61 6c 6c 74 67 6c 73 20 69 74 65 6d 29 0a 09 alltgls item)..
6e20: 09 09 09 20 20 28 68 61 73 68 2d 74 61 62 6c 65 ... (hash-table
6e30: 2d 73 65 74 21 20 61 6c 6c 74 67 6c 73 20 69 74 -set! alltgls it
6e40: 65 6d 20 23 74 29 29 0a 09 09 09 20 20 20 20 20 em #t))....
6e50: 20 28 6c 65 74 20 28 28 61 6c 6c 20 28 68 61 73 (let ((all (has
6e60: 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 61 6c 6c h-table-keys all
6e70: 74 67 6c 73 29 29 29 0a 09 09 09 09 28 70 72 6f tgls))).....(pro
6e80: 63 20 61 6c 6c 29 29 29 29 29 0a 09 09 69 74 65 c all)))))...ite
6e90: 6d 73 29 29 29 29 0a 0a 3b 3b 20 45 78 74 72 61 ms))))..;; Extra
6ea0: 63 74 20 74 68 65 20 76 61 72 69 6f 75 73 20 62 ct the various b
6eb0: 69 74 73 20 6f 66 20 64 61 74 61 20 66 72 6f 6d its of data from
6ec0: 20 2a 64 61 74 61 2a 20 61 6e 64 20 63 72 65 61 *data* and crea
6ed0: 74 65 20 74 68 65 20 63 6f 6d 6d 61 6e 64 20 6c te the command l
6ee0: 69 6e 65 20 65 71 75 69 76 61 6c 65 6e 74 20 74 ine equivalent t
6ef0: 68 61 74 20 77 69 6c 6c 20 62 65 20 64 69 73 70 hat will be disp
6f00: 6c 61 79 65 64 0a 3b 3b 0a 28 64 65 66 69 6e 65 layed.;;.(define
6f10: 20 28 64 61 73 68 62 6f 61 72 64 3a 75 70 64 61 (dashboard:upda
6f20: 74 65 2d 72 75 6e 2d 63 6f 6d 6d 61 6e 64 29 0a te-run-command).
6f30: 20 20 28 6c 65 74 2a 20 28 28 63 6d 64 2d 74 62 (let* ((cmd-tb
6f40: 20 20 20 20 20 20 20 28 64 62 6f 61 72 64 3a 64 (dboard:d
6f50: 61 74 61 2d 67 65 74 2d 63 6f 6d 6d 61 6e 64 2d ata-get-command-
6f60: 74 62 20 2a 64 61 74 61 2a 29 29 0a 09 20 28 63 tb *data*)).. (c
6f70: 6d 64 20 20 20 20 20 20 20 20 20 20 28 64 62 6f md (dbo
6f80: 61 72 64 3a 64 61 74 61 2d 67 65 74 2d 63 6f 6d ard:data-get-com
6f90: 6d 61 6e 64 20 20 20 20 2a 64 61 74 61 2a 29 29 mand *data*))
6fa0: 0a 09 20 28 74 65 73 74 2d 70 61 74 74 20 20 20 .. (test-patt
6fb0: 20 28 6c 65 74 20 28 28 74 70 20 28 64 62 6f 61 (let ((tp (dboa
6fc0: 72 64 3a 64 61 74 61 2d 67 65 74 2d 74 65 73 74 rd:data-get-test
6fd0: 2d 70 61 74 74 73 20 2a 64 61 74 61 2a 29 29 29 -patts *data*)))
6fe0: 0a 09 09 09 20 28 69 66 20 28 65 71 75 61 6c 3f .... (if (equal?
6ff0: 20 74 70 20 22 22 29 20 22 25 22 20 74 70 29 29 tp "") "%" tp))
7000: 29 0a 09 20 28 73 74 61 74 65 73 20 20 20 20 20 ).. (states
7010: 20 20 28 64 62 6f 61 72 64 3a 64 61 74 61 2d 67 (dboard:data-g
7020: 65 74 2d 73 74 61 74 65 73 20 20 20 20 20 2a 64 et-states *d
7030: 61 74 61 2a 29 29 0a 09 20 28 73 74 61 74 75 73 ata*)).. (status
7040: 65 73 20 20 20 20 20 28 64 62 6f 61 72 64 3a 64 es (dboard:d
7050: 61 74 61 2d 67 65 74 2d 73 74 61 74 75 73 65 73 ata-get-statuses
7060: 20 20 20 2a 64 61 74 61 2a 29 29 0a 09 20 28 74 *data*)).. (t
7070: 61 72 67 65 74 20 20 20 20 20 20 20 28 6c 65 74 arget (let
7080: 20 28 28 74 61 72 67 2d 6c 69 73 74 20 28 64 62 ((targ-list (db
7090: 6f 61 72 64 3a 64 61 74 61 2d 67 65 74 2d 74 61 oard:data-get-ta
70a0: 72 67 65 74 20 20 20 20 20 2a 64 61 74 61 2a 29 rget *data*)
70b0: 29 29 0a 09 09 09 20 28 69 66 20 74 61 72 67 2d )).... (if targ-
70c0: 6c 69 73 74 20 28 73 74 72 69 6e 67 2d 69 6e 74 list (string-int
70d0: 65 72 73 70 65 72 73 65 20 74 61 72 67 2d 6c 69 ersperse targ-li
70e0: 73 74 20 22 2f 22 29 20 22 6e 6f 2d 74 61 72 67 st "/") "no-targ
70f0: 65 74 2d 73 65 6c 65 63 74 65 64 22 29 29 29 0a et-selected"))).
7100: 09 20 28 72 75 6e 2d 6e 61 6d 65 20 20 20 20 20 . (run-name
7110: 28 64 62 6f 61 72 64 3a 64 61 74 61 2d 67 65 74 (dboard:data-get
7120: 2d 72 75 6e 2d 6e 61 6d 65 20 20 20 2a 64 61 74 -run-name *dat
7130: 61 2a 29 29 0a 09 20 28 73 74 61 74 65 73 2d 73 a*)).. (states-s
7140: 74 72 20 20 20 28 69 66 20 28 6f 72 20 28 6e 6f tr (if (or (no
7150: 74 20 73 74 61 74 65 73 29 0a 09 09 09 20 20 20 t states)....
7160: 20 20 20 20 28 6e 75 6c 6c 3f 20 73 74 61 74 65 (null? state
7170: 73 29 29 0a 09 09 09 20 20 20 22 22 0a 09 09 09 s)).... ""....
7180: 20 20 20 28 63 6f 6e 63 20 22 20 2d 73 74 61 74 (conc " -stat
7190: 65 20 22 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 e " (string-int
71a0: 65 72 73 70 65 72 73 65 20 73 74 61 74 65 73 20 ersperse states
71b0: 22 2c 22 29 29 29 29 0a 09 20 28 73 74 61 74 75 ",")))).. (statu
71c0: 73 65 73 2d 73 74 72 20 28 69 66 20 28 6f 72 20 ses-str (if (or
71d0: 28 6e 6f 74 20 73 74 61 74 75 73 65 73 29 0a 09 (not statuses)..
71e0: 09 09 20 20 20 20 20 20 20 28 6e 75 6c 6c 3f 20 .. (null?
71f0: 73 74 61 74 75 73 65 73 29 29 0a 09 09 09 20 20 statuses))....
7200: 20 22 22 0a 09 09 09 20 20 20 28 63 6f 6e 63 20 "".... (conc
7210: 22 20 2d 73 74 61 74 75 73 20 22 20 28 73 74 72 " -status " (str
7220: 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 ing-intersperse
7230: 73 74 61 74 75 73 65 73 20 22 2c 22 29 29 29 29 statuses ","))))
7240: 0a 09 20 28 66 75 6c 6c 2d 63 6d 64 20 20 22 6d .. (full-cmd "m
7250: 65 67 61 74 65 73 74 22 29 29 0a 20 20 20 20 28 egatest")). (
7260: 63 61 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 79 case (string->sy
7270: 6d 62 6f 6c 20 63 6d 64 29 0a 20 20 20 20 20 20 mbol cmd).
7280: 28 28 72 75 6e 29 0a 20 20 20 20 20 20 20 28 73 ((run). (s
7290: 65 74 21 20 66 75 6c 6c 2d 63 6d 64 20 28 63 6f et! full-cmd (co
72a0: 6e 63 20 66 75 6c 6c 2d 63 6d 64 20 0a 09 09 09 nc full-cmd ....
72b0: 20 20 20 20 22 20 2d 72 75 6e 22 0a 09 09 09 20 " -run"....
72c0: 20 20 20 22 20 2d 74 65 73 74 70 61 74 74 20 22 " -testpatt "
72d0: 0a 09 09 09 20 20 20 20 74 65 73 74 2d 70 61 74 .... test-pat
72e0: 74 0a 09 09 09 20 20 20 20 22 20 2d 74 61 72 67 t.... " -targ
72f0: 65 74 20 22 0a 09 09 09 20 20 20 20 74 61 72 67 et ".... targ
7300: 65 74 0a 09 09 09 20 20 20 20 22 20 2d 72 75 6e et.... " -run
7310: 6e 61 6d 65 20 22 0a 09 09 09 20 20 20 20 72 75 name ".... ru
7320: 6e 2d 6e 61 6d 65 0a 09 09 09 20 20 20 20 22 20 n-name.... "
7330: 2d 63 6c 65 61 6e 2d 63 61 63 68 65 22 0a 09 09 -clean-cache"...
7340: 09 20 20 20 20 29 29 29 0a 20 20 20 20 20 20 28 . ))). (
7350: 28 72 65 6d 6f 76 65 2d 72 75 6e 73 29 0a 20 20 (remove-runs).
7360: 20 20 20 20 20 28 73 65 74 21 20 66 75 6c 6c 2d (set! full-
7370: 63 6d 64 20 28 63 6f 6e 63 20 66 75 6c 6c 2d 63 cmd (conc full-c
7380: 6d 64 0a 09 09 09 20 20 20 20 22 20 2d 72 65 6d md.... " -rem
7390: 6f 76 65 2d 72 75 6e 73 20 2d 72 75 6e 6e 61 6d ove-runs -runnam
73a0: 65 20 22 0a 09 09 09 20 20 20 20 72 75 6e 2d 6e e ".... run-n
73b0: 61 6d 65 0a 09 09 09 20 20 20 20 22 20 2d 74 61 ame.... " -ta
73c0: 72 67 65 74 20 22 20 0a 09 09 09 20 20 20 20 74 rget " .... t
73d0: 61 72 67 65 74 0a 09 09 09 20 20 20 20 22 20 2d arget.... " -
73e0: 74 65 73 74 70 61 74 74 20 22 0a 09 09 09 20 20 testpatt "....
73f0: 20 20 74 65 73 74 2d 70 61 74 74 0a 09 09 09 20 test-patt....
7400: 20 20 20 73 74 61 74 65 73 2d 73 74 72 0a 09 09 states-str...
7410: 09 20 20 20 20 73 74 61 74 75 73 65 73 2d 73 74 . statuses-st
7420: 72 0a 09 09 09 20 20 20 20 29 29 29 0a 20 20 20 r.... ))).
7430: 20 20 20 28 65 6c 73 65 20 28 73 65 74 21 20 66 (else (set! f
7440: 75 6c 6c 2d 63 6d 64 20 22 20 6e 6f 20 76 61 6c ull-cmd " no val
7450: 69 64 20 63 6f 6d 6d 61 6e 64 20 22 29 29 29 0a id command "))).
7460: 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 (iup:attribu
7470: 74 65 2d 73 65 74 21 20 63 6d 64 2d 74 62 20 22 te-set! cmd-tb "
7480: 56 41 4c 55 45 22 20 66 75 6c 6c 2d 63 6d 64 29 VALUE" full-cmd)
7490: 29 29 0a 0a 3b 3b 20 44 69 73 70 6c 61 79 20 74 ))..;; Display t
74a0: 68 65 20 74 65 73 74 73 20 61 73 20 72 6f 77 73 he tests as rows
74b0: 20 6f 66 20 62 6f 78 65 73 20 6f 6e 20 74 68 65 of boxes on the
74c0: 20 74 65 73 74 2f 74 61 73 6b 20 70 61 6e 65 0a test/task pane.
74d0: 3b 3b 0a 28 64 65 66 69 6e 65 20 28 64 61 73 68 ;;.(define (dash
74e0: 62 6f 61 72 64 3a 64 72 61 77 2d 74 65 73 74 73 board:draw-tests
74f0: 20 63 6e 76 20 78 61 64 6a 20 79 61 64 6a 20 74 cnv xadj yadj t
7500: 65 73 74 73 2d 64 72 61 77 2d 73 74 61 74 65 20 ests-draw-state
7510: 73 6f 72 74 65 64 2d 74 65 73 74 6e 61 6d 65 73 sorted-testnames
7520: 20 74 65 73 74 2d 72 65 63 6f 72 64 73 29 0a 20 test-records).
7530: 20 28 63 61 6e 76 61 73 2d 63 6c 65 61 72 21 20 (canvas-clear!
7540: 63 6e 76 29 0a 20 20 28 63 61 6e 76 61 73 2d 66 cnv). (canvas-f
7550: 6f 6e 74 2d 73 65 74 21 20 63 6e 76 20 22 48 65 ont-set! cnv "He
7560: 6c 76 65 74 69 63 61 2c 20 2d 31 30 22 29 0a 20 lvetica, -10").
7570: 20 28 6c 65 74 2d 76 61 6c 75 65 73 20 28 28 28 (let-values (((
7580: 73 69 7a 65 78 20 73 69 7a 65 79 20 73 69 7a 65 sizex sizey size
7590: 78 6d 6d 20 73 69 7a 65 79 6d 6d 29 20 28 63 61 xmm sizeymm) (ca
75a0: 6e 76 61 73 2d 73 69 7a 65 20 63 6e 76 29 29 0a nvas-size cnv)).
75b0: 09 20 20 20 20 20 20 20 28 28 6f 72 69 67 69 6e . ((origin
75c0: 78 20 6f 72 69 67 69 6e 79 29 20 20 20 20 20 20 x originy)
75d0: 20 20 20 20 20 20 20 28 63 61 6e 76 61 73 2d 6f (canvas-o
75e0: 72 69 67 69 6e 20 63 6e 76 29 29 29 0a 20 20 20 rigin cnv))).
75f0: 20 3b 3b 20 28 70 72 69 6e 74 20 22 6f 72 69 67 ;; (print "orig
7600: 69 6e 78 3a 20 22 20 6f 72 69 67 69 6e 78 20 22 inx: " originx "
7610: 20 6f 72 69 67 69 6e 79 3a 20 22 20 6f 72 69 67 originy: " orig
7620: 69 6e 79 29 0a 20 20 20 20 3b 3b 20 28 63 61 6e iny). ;; (can
7630: 76 61 73 2d 6f 72 69 67 69 6e 2d 73 65 74 21 20 vas-origin-set!
7640: 63 6e 76 20 30 20 28 2d 20 28 2f 20 73 69 7a 65 cnv 0 (- (/ size
7650: 79 20 32 29 29 29 0a 20 20 20 20 28 69 66 20 28 y 2))). (if (
7660: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d
7670: 65 66 61 75 6c 74 20 74 65 73 74 73 2d 64 72 61 efault tests-dra
7680: 77 2d 73 74 61 74 65 20 27 66 69 72 73 74 2d 74 w-state 'first-t
7690: 69 6d 65 20 23 74 29 0a 09 28 62 65 67 69 6e 0a ime #t)..(begin.
76a0: 09 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 . (hash-table-s
76b0: 65 74 21 20 74 65 73 74 73 2d 64 72 61 77 2d 73 et! tests-draw-s
76c0: 74 61 74 65 20 27 66 69 72 73 74 2d 74 69 6d 65 tate 'first-time
76d0: 20 23 66 29 0a 09 20 20 28 68 61 73 68 2d 74 61 #f).. (hash-ta
76e0: 62 6c 65 2d 73 65 74 21 20 74 65 73 74 73 2d 64 ble-set! tests-d
76f0: 72 61 77 2d 73 74 61 74 65 20 27 73 63 61 6c 65 raw-state 'scale
7700: 66 20 31 29 0a 09 20 20 28 68 61 73 68 2d 74 61 f 1).. (hash-ta
7710: 62 6c 65 2d 73 65 74 21 20 74 65 73 74 73 2d 64 ble-set! tests-d
7720: 72 61 77 2d 73 74 61 74 65 20 27 74 65 73 74 73 raw-state 'tests
7730: 2d 69 6e 66 6f 20 28 6d 61 6b 65 2d 68 61 73 68 -info (make-hash
7740: 2d 74 61 62 6c 65 29 29 0a 09 20 20 28 68 61 73 -table)).. (has
7750: 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 74 65 73 h-table-set! tes
7760: 74 73 2d 64 72 61 77 2d 73 74 61 74 65 20 27 73 ts-draw-state 's
7770: 65 6c 65 63 74 65 64 2d 74 65 73 74 73 20 28 6d elected-tests (m
7780: 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 ake-hash-table))
7790: 0a 09 20 20 3b 3b 20 73 65 74 20 74 68 65 73 65 .. ;; set these
77a0: 20 0a 09 20 20 28 64 63 6f 6d 6d 6f 6e 3a 69 6e .. (dcommon:in
77b0: 69 74 69 61 6c 2d 64 72 61 77 2d 74 65 73 74 73 itial-draw-tests
77c0: 20 63 6e 76 20 78 61 64 6a 20 79 61 64 6a 20 73 cnv xadj yadj s
77d0: 69 7a 65 78 20 73 69 7a 65 79 20 73 69 7a 65 78 izex sizey sizex
77e0: 6d 6d 20 73 69 7a 65 79 6d 6d 20 6f 72 69 67 69 mm sizeymm origi
77f0: 6e 78 20 6f 72 69 67 69 6e 79 20 74 65 73 74 73 nx originy tests
7800: 2d 64 72 61 77 2d 73 74 61 74 65 20 73 6f 72 74 -draw-state sort
7810: 65 64 2d 74 65 73 74 6e 61 6d 65 73 20 74 65 73 ed-testnames tes
7820: 74 2d 72 65 63 6f 72 64 73 29 29 0a 09 28 64 63 t-records))..(dc
7830: 6f 6d 6d 6f 6e 3a 72 65 64 72 61 77 2d 74 65 73 ommon:redraw-tes
7840: 74 73 20 63 6e 76 20 78 61 64 6a 20 79 61 64 6a ts cnv xadj yadj
7850: 20 73 69 7a 65 78 20 73 69 7a 65 79 20 73 69 7a sizex sizey siz
7860: 65 78 6d 6d 20 73 69 7a 65 79 6d 6d 20 6f 72 69 exmm sizeymm ori
7870: 67 69 6e 78 20 6f 72 69 67 69 6e 79 20 74 65 73 ginx originy tes
7880: 74 73 2d 64 72 61 77 2d 73 74 61 74 65 20 73 6f ts-draw-state so
7890: 72 74 65 64 2d 74 65 73 74 6e 61 6d 65 73 20 74 rted-testnames t
78a0: 65 73 74 2d 72 65 63 6f 72 64 73 29 29 0a 20 20 est-records)).
78b0: 20 20 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d ))..;;========
78c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
78d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
78e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
78f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
7900: 3b 20 52 20 55 20 4e 20 20 20 43 20 4f 20 4e 20 ; R U N C O N
7910: 54 20 52 20 4f 20 4c 20 53 0a 3b 3b 3d 3d 3d 3d T R O L S.;;====
7920: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7930: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7940: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7950: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7960: 3d 3d 0a 3b 3b 0a 3b 3b 20 41 20 67 75 69 20 66 ==.;;.;; A gui f
7970: 6f 72 20 6c 61 75 6e 63 68 69 6e 67 20 74 65 73 or launching tes
7980: 74 73 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 64 ts.;;.(define (d
7990: 61 73 68 62 6f 61 72 64 3a 72 75 6e 2d 63 6f 6e ashboard:run-con
79a0: 74 72 6f 6c 73 29 0a 20 20 28 6c 65 74 2a 20 28 trols). (let* (
79b0: 28 74 61 72 67 65 74 73 20 20 20 20 20 20 20 28 (targets (
79c0: 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 make-hash-table)
79d0: 29 0a 09 20 28 74 65 73 74 2d 72 65 63 6f 72 64 ).. (test-record
79e0: 73 20 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 s (make-hash-ta
79f0: 62 6c 65 29 29 0a 09 20 28 61 6c 6c 2d 74 65 73 ble)).. (all-tes
7a00: 74 73 2d 72 65 67 69 73 74 72 79 20 28 74 65 73 ts-registry (tes
7a10: 74 73 3a 67 65 74 2d 61 6c 6c 29 29 20 3b 3b 20 ts:get-all)) ;;
7a20: 28 74 65 73 74 73 3a 67 65 74 2d 76 61 6c 69 64 (tests:get-valid
7a30: 2d 74 65 73 74 73 20 2a 74 6f 70 70 61 74 68 2a -tests *toppath*
7a40: 20 27 28 29 29 29 0a 09 20 28 74 65 73 74 2d 6e '())).. (test-n
7a50: 61 6d 65 73 20 20 20 20 28 68 61 73 68 2d 74 61 ames (hash-ta
7a60: 62 6c 65 2d 6b 65 79 73 20 61 6c 6c 2d 74 65 73 ble-keys all-tes
7a70: 74 73 2d 72 65 67 69 73 74 72 79 29 29 0a 09 20 ts-registry))..
7a80: 28 73 6f 72 74 65 64 2d 74 65 73 74 6e 61 6d 65 (sorted-testname
7a90: 73 20 23 66 29 0a 09 20 28 61 63 74 69 6f 6e 20 s #f).. (action
7aa0: 20 20 20 20 20 20 20 22 2d 72 75 6e 22 29 0a 09 "-run")..
7ab0: 20 28 63 6d 64 6c 6e 20 20 20 20 20 20 20 20 20 (cmdln
7ac0: 22 22 29 0a 09 20 28 72 75 6e 6c 6f 67 73 20 20 "").. (runlogs
7ad0: 20 20 20 20 20 28 6d 61 6b 65 2d 68 61 73 68 2d (make-hash-
7ae0: 74 61 62 6c 65 29 29 0a 09 20 28 6b 65 79 2d 6c table)).. (key-l
7af0: 69 73 74 62 6f 78 65 73 20 23 66 29 0a 09 20 28 istboxes #f).. (
7b00: 75 70 64 61 74 65 72 2d 66 6f 72 2d 72 75 6e 73 updater-for-runs
7b10: 20 23 66 29 0a 09 20 28 75 70 64 61 74 65 2d 6b #f).. (update-k
7b20: 65 79 76 61 6c 73 20 28 6c 61 6d 62 64 61 20 28 eyvals (lambda (
7b30: 29 0a 09 09 09 20 20 20 28 6c 65 74 20 28 28 74 ).... (let ((t
7b40: 61 72 67 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 arg (map (lambda
7b50: 20 28 78 29 0a 09 09 09 09 09 20 20 20 20 20 20 (x)......
7b60: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 78 (iup:attribute x
7b70: 20 22 56 41 4c 55 45 22 29 29 0a 09 09 09 09 09 "VALUE"))......
7b80: 20 20 20 20 28 63 61 72 20 28 64 61 73 68 62 6f (car (dashbo
7b90: 61 72 64 3a 75 70 64 61 74 65 2d 74 61 72 67 65 ard:update-targe
7ba0: 74 2d 73 65 6c 65 63 74 6f 72 20 6b 65 79 2d 6c t-selector key-l
7bb0: 69 73 74 62 6f 78 65 73 29 29 29 29 0a 09 09 09 istboxes))))....
7bc0: 09 20 28 63 75 72 72 2d 72 75 6e 6e 61 6d 65 20 . (curr-runname
7bd0: 28 64 62 6f 61 72 64 3a 64 61 74 61 2d 67 65 74 (dboard:data-get
7be0: 2d 72 75 6e 2d 6e 61 6d 65 20 2a 64 61 74 61 2a -run-name *data*
7bf0: 29 29 29 0a 09 09 09 20 20 20 20 20 28 64 62 6f ))).... (dbo
7c00: 61 72 64 3a 64 61 74 61 2d 73 65 74 2d 74 61 72 ard:data-set-tar
7c10: 67 65 74 21 20 2a 64 61 74 61 2a 20 74 61 72 67 get! *data* targ
7c20: 29 0a 09 09 09 20 20 20 20 20 28 69 66 20 75 70 ).... (if up
7c30: 64 61 74 65 72 2d 66 6f 72 2d 72 75 6e 73 20 28 dater-for-runs (
7c40: 75 70 64 61 74 65 72 2d 66 6f 72 2d 72 75 6e 73 updater-for-runs
7c50: 29 29 0a 09 09 09 20 20 20 20 20 28 69 66 20 28 )).... (if (
7c60: 6f 72 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 or (not (equal?
7c70: 63 75 72 72 2d 72 75 6e 6e 61 6d 65 20 28 64 62 curr-runname (db
7c80: 6f 61 72 64 3a 64 61 74 61 2d 67 65 74 2d 72 75 oard:data-get-ru
7c90: 6e 2d 6e 61 6d 65 20 2a 64 61 74 61 2a 29 29 29 n-name *data*)))
7ca0: 0a 09 09 09 09 20 20 20 20 20 28 65 71 75 61 6c ..... (equal
7cb0: 3f 20 28 64 62 6f 61 72 64 3a 64 61 74 61 2d 67 ? (dboard:data-g
7cc0: 65 74 2d 72 75 6e 2d 6e 61 6d 65 20 2a 64 61 74 et-run-name *dat
7cd0: 61 2a 29 20 22 22 29 29 0a 09 09 09 09 20 28 64 a*) ""))..... (d
7ce0: 62 6f 61 72 64 3a 64 61 74 61 2d 73 65 74 2d 72 board:data-set-r
7cf0: 75 6e 2d 6e 61 6d 65 21 20 2a 64 61 74 61 2a 20 un-name! *data*
7d00: 63 75 72 72 2d 72 75 6e 6e 61 6d 65 29 29 0a 09 curr-runname))..
7d10: 09 09 20 20 20 20 20 28 64 61 73 68 62 6f 61 72 .. (dashboar
7d20: 64 3a 75 70 64 61 74 65 2d 72 75 6e 2d 63 6f 6d d:update-run-com
7d30: 6d 61 6e 64 29 29 29 29 0a 09 20 28 74 65 73 74 mand)))).. (test
7d40: 73 2d 64 72 61 77 2d 73 74 61 74 65 20 28 6d 61 s-draw-state (ma
7d50: 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 20 ke-hash-table))
7d60: 3b 3b 20 75 73 65 20 66 6f 72 20 6b 65 65 70 69 ;; use for keepi
7d70: 6e 67 20 73 74 61 74 65 20 6f 66 20 74 68 65 20 ng state of the
7d80: 74 65 73 74 20 63 61 6e 76 61 73 0a 09 20 28 74 test canvas.. (t
7d90: 65 73 74 2d 70 61 74 74 65 72 6e 73 2d 74 65 78 est-patterns-tex
7da0: 74 62 6f 78 20 20 23 66 29 29 0a 20 20 20 20 28 tbox #f)). (
7db0: 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 hash-table-set!
7dc0: 74 65 73 74 73 2d 64 72 61 77 2d 73 74 61 74 65 tests-draw-state
7dd0: 20 27 66 69 72 73 74 2d 74 69 6d 65 20 23 74 29 'first-time #t)
7de0: 0a 20 20 20 20 3b 3b 20 28 68 61 73 68 2d 74 61 . ;; (hash-ta
7df0: 62 6c 65 2d 73 65 74 21 20 74 65 73 74 73 2d 64 ble-set! tests-d
7e00: 72 61 77 2d 73 74 61 74 65 20 27 73 63 61 6c 65 raw-state 'scale
7e10: 66 20 31 29 0a 20 20 20 20 28 74 65 73 74 73 3a f 1). (tests:
7e20: 67 65 74 2d 66 75 6c 6c 2d 64 61 74 61 20 74 65 get-full-data te
7e30: 73 74 2d 6e 61 6d 65 73 20 74 65 73 74 2d 72 65 st-names test-re
7e40: 63 6f 72 64 73 20 27 28 29 20 61 6c 6c 2d 74 65 cords '() all-te
7e50: 73 74 73 2d 72 65 67 69 73 74 72 79 29 0a 20 20 sts-registry).
7e60: 20 20 28 73 65 74 21 20 73 6f 72 74 65 64 2d 74 (set! sorted-t
7e70: 65 73 74 6e 61 6d 65 73 20 28 74 65 73 74 73 3a estnames (tests:
7e80: 73 6f 72 74 2d 62 79 2d 70 72 69 6f 72 69 74 79 sort-by-priority
7e90: 2d 61 6e 64 2d 77 61 69 74 6f 6e 20 74 65 73 74 -and-waiton test
7ea0: 2d 72 65 63 6f 72 64 73 29 29 0a 20 20 20 20 0a -records)). .
7eb0: 20 20 20 20 3b 3b 20 72 65 66 65 72 20 74 6f 20 ;; refer to
7ec0: 28 64 3a 61 6c 6c 64 61 74 2d 6b 65 79 73 20 2a (d:alldat-keys *
7ed0: 61 6c 6c 64 61 74 2a 29 2c 20 28 64 3a 61 6c 6c alldat*), (d:all
7ee0: 64 61 74 2d 64 62 6b 65 79 73 20 2a 61 6c 6c 64 dat-dbkeys *alld
7ef0: 61 74 2a 29 20 66 6f 72 20 6b 65 79 73 0a 20 20 at*) for keys.
7f00: 20 20 28 69 75 70 3a 76 62 6f 78 0a 20 20 20 20 (iup:vbox.
7f10: 20 3b 3b 20 54 68 65 20 63 6f 6d 6d 61 6e 64 20 ;; The command
7f20: 6c 69 6e 65 20 64 69 73 70 6c 61 79 2f 65 78 65 line display/exe
7f30: 63 74 75 74 69 6f 6e 20 63 6f 6e 74 72 6f 6c 0a ctution control.
7f40: 20 20 20 20 20 28 69 75 70 3a 66 72 61 6d 65 0a (iup:frame.
7f50: 20 20 20 20 20 20 23 3a 74 69 74 6c 65 20 22 43 #:title "C
7f60: 6f 6d 6d 61 6e 64 20 74 6f 20 62 65 20 65 78 65 ommand to be exe
7f70: 63 74 75 74 65 64 22 0a 20 20 20 20 20 20 28 69 ctuted". (i
7f80: 75 70 3a 68 62 6f 78 0a 20 20 20 20 20 20 20 28 up:hbox. (
7f90: 69 75 70 3a 6c 61 62 65 6c 20 22 52 75 6e 20 6f iup:label "Run o
7fa0: 6e 22 20 23 3a 73 69 7a 65 20 22 34 30 78 22 29 n" #:size "40x")
7fb0: 0a 20 20 20 20 20 20 20 28 69 75 70 3a 72 61 64 . (iup:rad
7fc0: 69 6f 20 0a 09 28 69 75 70 3a 68 62 6f 78 0a 09 io ..(iup:hbox..
7fd0: 20 28 69 75 70 3a 74 6f 67 67 6c 65 20 22 4c 6f (iup:toggle "Lo
7fe0: 63 61 6c 22 20 23 3a 73 69 7a 65 20 22 34 30 78 cal" #:size "40x
7ff0: 22 29 0a 09 20 28 69 75 70 3a 74 6f 67 67 6c 65 ").. (iup:toggle
8000: 20 22 53 65 72 76 65 72 22 20 23 3a 73 69 7a 65 "Server" #:size
8010: 20 22 34 30 78 22 29 29 29 0a 20 20 20 20 20 20 "40x"))).
8020: 20 28 6c 65 74 20 28 28 74 62 20 28 69 75 70 3a (let ((tb (iup:
8030: 74 65 78 74 62 6f 78 20 0a 09 09 20 20 23 3a 76 textbox ... #:v
8040: 61 6c 75 65 20 22 6d 65 67 61 74 65 73 74 20 22 alue "megatest "
8050: 0a 09 09 20 20 23 3a 65 78 70 61 6e 64 20 22 48 ... #:expand "H
8060: 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 09 20 20 23 ORIZONTAL"... #
8070: 3a 72 65 61 64 6f 6e 6c 79 20 22 59 45 53 22 0a :readonly "YES".
8080: 09 09 20 20 23 3a 66 6f 6e 74 20 22 43 6f 75 72 .. #:font "Cour
8090: 69 65 72 20 4e 65 77 2c 20 2d 31 32 22 0a 09 09 ier New, -12"...
80a0: 20 20 29 29 29 0a 09 20 28 64 62 6f 61 72 64 3a ))).. (dboard:
80b0: 64 61 74 61 2d 73 65 74 2d 63 6f 6d 6d 61 6e 64 data-set-command
80c0: 2d 74 62 21 20 2a 64 61 74 61 2a 20 74 62 29 0a -tb! *data* tb).
80d0: 09 20 74 62 29 0a 20 20 20 20 20 20 20 28 69 75 . tb). (iu
80e0: 70 3a 62 75 74 74 6f 6e 20 22 45 78 65 63 75 74 p:button "Execut
80f0: 65 22 20 23 3a 73 69 7a 65 20 22 35 30 78 22 0a e" #:size "50x".
8100: 09 09 20 20 20 23 3a 61 63 74 69 6f 6e 20 28 6c .. #:action (l
8110: 61 6d 62 64 61 20 28 6f 62 6a 29 0a 09 09 09 20 ambda (obj)....
8120: 20 20 20 20 20 28 6c 65 74 20 28 28 63 6d 64 20 (let ((cmd
8130: 28 63 6f 6e 63 20 22 78 74 65 72 6d 20 2d 67 65 (conc "xterm -ge
8140: 6f 6d 65 74 72 79 20 31 38 30 78 32 30 20 2d 65 ometry 180x20 -e
8150: 20 5c 22 22 0a 09 09 09 09 09 20 20 20 20 20 20 \""......
8160: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 (iup:attribute
8170: 28 64 62 6f 61 72 64 3a 64 61 74 61 2d 67 65 74 (dboard:data-get
8180: 2d 63 6f 6d 6d 61 6e 64 2d 74 62 20 2a 64 61 74 -command-tb *dat
8190: 61 2a 29 20 22 56 41 4c 55 45 22 29 0a 09 09 09 a*) "VALUE")....
81a0: 09 09 20 20 20 20 20 20 20 22 3b 65 63 68 6f 20 .. ";echo
81b0: 50 72 65 73 73 20 61 6e 79 20 6b 65 79 20 74 6f Press any key to
81c0: 20 63 6f 6e 74 69 6e 75 65 3b 62 61 73 68 20 2d continue;bash -
81d0: 63 20 27 72 65 61 64 20 2d 6e 20 31 20 2d 73 27 c 'read -n 1 -s'
81e0: 5c 22 20 26 22 29 29 29 0a 09 09 09 09 28 73 79 \" &"))).....(sy
81f0: 73 74 65 6d 20 63 6d 64 29 29 29 29 29 29 0a 0a stem cmd))))))..
8200: 20 20 20 20 20 28 69 75 70 3a 73 70 6c 69 74 0a (iup:split.
8210: 20 20 20 20 20 20 23 3a 6f 72 69 65 6e 74 61 74 #:orientat
8220: 69 6f 6e 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 ion "HORIZONTAL"
8230: 0a 20 20 20 20 20 20 0a 20 20 20 20 20 20 28 69 . . (i
8240: 75 70 3a 73 70 6c 69 74 0a 20 20 20 20 20 20 20 up:split.
8250: 23 3a 76 61 6c 75 65 20 33 30 30 0a 0a 20 20 20 #:value 300..
8260: 20 20 20 20 3b 3b 20 54 61 72 67 65 74 2c 20 74 ;; Target, t
8270: 65 73 74 70 61 74 74 2c 20 73 74 61 74 65 20 61 estpatt, state a
8280: 6e 64 20 73 74 61 74 75 73 20 69 6e 70 75 74 20 nd status input
8290: 62 6f 78 65 73 0a 20 20 20 20 20 20 20 3b 3b 0a boxes. ;;.
82a0: 20 20 20 20 20 20 20 28 69 75 70 3a 76 62 6f 78 (iup:vbox
82b0: 0a 09 3b 3b 20 43 6f 6d 6d 61 6e 64 20 74 6f 20 ..;; Command to
82c0: 72 75 6e 0a 09 28 69 75 70 3a 66 72 61 6d 65 0a run..(iup:frame.
82d0: 09 20 23 3a 74 69 74 6c 65 20 22 53 65 74 20 74 . #:title "Set t
82e0: 68 65 20 61 63 74 69 6f 6e 20 74 6f 20 74 61 6b he action to tak
82f0: 65 22 0a 09 20 28 69 75 70 3a 68 62 6f 78 0a 09 e".. (iup:hbox..
8300: 20 20 3b 3b 20 28 69 75 70 3a 6c 61 62 65 6c 20 ;; (iup:label
8310: 22 43 6f 6d 6d 61 6e 64 20 74 6f 20 72 75 6e 22 "Command to run"
8320: 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a #:expand "HORIZ
8330: 4f 4e 54 41 4c 22 20 23 3a 73 69 7a 65 20 22 37 ONTAL" #:size "7
8340: 30 78 22 20 23 3a 61 6c 69 67 6e 6d 65 6e 74 20 0x" #:alignment
8350: 22 4c 45 46 54 3a 41 43 45 4e 54 45 52 22 29 0a "LEFT:ACENTER").
8360: 09 20 20 28 6c 65 74 2a 20 28 28 63 6d 64 73 2d . (let* ((cmds-
8370: 6c 69 73 74 20 27 28 22 72 75 6e 22 20 22 72 65 list '("run" "re
8380: 6d 6f 76 65 2d 72 75 6e 73 22 20 22 73 65 74 2d move-runs" "set-
8390: 73 74 61 74 65 2d 73 74 61 74 75 73 22 20 22 6c state-status" "l
83a0: 6f 63 6b 2d 72 75 6e 73 22 20 22 75 6e 6c 6f 63 ock-runs" "unloc
83b0: 6b 2d 72 75 6e 73 22 29 29 0a 09 09 20 28 6c 62 k-runs"))... (lb
83c0: 20 20 20 20 20 20 20 20 20 28 69 75 70 3a 6c 69 (iup:li
83d0: 73 74 62 6f 78 20 23 3a 65 78 70 61 6e 64 20 22 stbox #:expand "
83e0: 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 09 09 09 HORIZONTAL".....
83f0: 09 20 20 23 3a 64 72 6f 70 64 6f 77 6e 20 22 59 . #:dropdown "Y
8400: 45 53 22 0a 09 09 09 09 09 20 20 23 3a 61 63 74 ES"...... #:act
8410: 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a ion (lambda (obj
8420: 20 76 61 6c 20 69 6e 64 65 78 20 6c 62 73 74 61 val index lbsta
8430: 74 65 29 0a 09 09 09 09 09 09 20 20 20 20 20 3b te)....... ;
8440: 3b 20 28 70 72 69 6e 74 20 6f 62 6a 20 22 20 22 ; (print obj " "
8450: 20 76 61 6c 20 22 20 22 20 69 6e 64 65 78 20 22 val " " index "
8460: 20 22 20 6c 62 73 74 61 74 65 29 0a 09 09 09 09 " lbstate).....
8470: 09 09 20 20 20 20 20 28 64 62 6f 61 72 64 3a 64 .. (dboard:d
8480: 61 74 61 2d 73 65 74 2d 63 6f 6d 6d 61 6e 64 21 ata-set-command!
8490: 20 2a 64 61 74 61 2a 20 76 61 6c 29 0a 09 09 09 *data* val)....
84a0: 09 09 09 20 20 20 20 20 28 64 61 73 68 62 6f 61 ... (dashboa
84b0: 72 64 3a 75 70 64 61 74 65 2d 72 75 6e 2d 63 6f rd:update-run-co
84c0: 6d 6d 61 6e 64 29 29 29 29 0a 09 09 20 28 64 65 mmand))))... (de
84d0: 66 61 75 6c 74 2d 63 6d 64 20 28 63 61 72 20 63 fault-cmd (car c
84e0: 6d 64 73 2d 6c 69 73 74 29 29 29 0a 09 20 20 20 mds-list)))..
84f0: 20 28 69 75 70 6c 69 73 74 62 6f 78 2d 66 69 6c (iuplistbox-fil
8500: 6c 2d 6c 69 73 74 20 6c 62 20 63 6d 64 73 2d 6c l-list lb cmds-l
8510: 69 73 74 20 73 65 6c 65 63 74 65 64 2d 69 74 65 ist selected-ite
8520: 6d 3a 20 64 65 66 61 75 6c 74 2d 63 6d 64 29 0a m: default-cmd).
8530: 09 20 20 20 20 28 64 62 6f 61 72 64 3a 64 61 74 . (dboard:dat
8540: 61 2d 73 65 74 2d 63 6f 6d 6d 61 6e 64 21 20 2a a-set-command! *
8550: 64 61 74 61 2a 20 64 65 66 61 75 6c 74 2d 63 6d data* default-cm
8560: 64 29 0a 09 20 20 20 20 6c 62 29 29 29 0a 0a 09 d).. lb)))...
8570: 28 69 75 70 3a 66 72 61 6d 65 0a 09 20 23 3a 74 (iup:frame.. #:t
8580: 69 74 6c 65 20 22 52 75 6e 6e 61 6d 65 22 0a 09 itle "Runname"..
8590: 20 28 6c 65 74 2a 20 28 28 64 65 66 61 75 6c 74 (let* ((default
85a0: 2d 72 75 6e 2d 6e 61 6d 65 20 28 73 65 63 6f 6e -run-name (secon
85b0: 64 73 2d 3e 77 6f 72 6b 2d 77 65 65 6b 2f 64 61 ds->work-week/da
85c0: 79 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e y (current-secon
85d0: 64 73 29 29 29 0a 09 09 28 74 62 20 28 69 75 70 ds)))...(tb (iup
85e0: 3a 74 65 78 74 62 6f 78 20 23 3a 65 78 70 61 6e :textbox #:expan
85f0: 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 d "HORIZONTAL"..
8600: 09 09 09 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 ... #:action (la
8610: 6d 62 64 61 20 28 6f 62 6a 20 76 61 6c 20 74 78 mbda (obj val tx
8620: 74 29 0a 09 09 09 09 09 20 20 20 20 3b 3b 20 28 t)...... ;; (
8630: 70 72 69 6e 74 20 22 6f 62 6a 3a 20 22 20 6f 62 print "obj: " ob
8640: 6a 20 22 20 76 61 6c 3a 20 22 20 76 61 6c 20 22 j " val: " val "
8650: 20 75 6e 6b 3a 20 22 20 75 6e 6b 29 0a 09 09 09 unk: " unk)....
8660: 09 09 20 20 20 20 28 64 62 6f 61 72 64 3a 64 61 .. (dboard:da
8670: 74 61 2d 73 65 74 2d 72 75 6e 2d 6e 61 6d 65 21 ta-set-run-name!
8680: 20 2a 64 61 74 61 2a 20 74 78 74 29 20 3b 3b 20 *data* txt) ;;
8690: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 6f (iup:attribute o
86a0: 62 6a 20 22 56 41 4c 55 45 22 29 29 0a 09 09 09 bj "VALUE"))....
86b0: 09 09 20 20 20 20 28 64 61 73 68 62 6f 61 72 64 .. (dashboard
86c0: 3a 75 70 64 61 74 65 2d 72 75 6e 2d 63 6f 6d 6d :update-run-comm
86d0: 61 6e 64 29 29 0a 09 09 09 09 20 23 3a 76 61 6c and))..... #:val
86e0: 75 65 20 28 6f 72 20 64 65 66 61 75 6c 74 2d 72 ue (or default-r
86f0: 75 6e 2d 6e 61 6d 65 20 28 64 62 6f 61 72 64 3a un-name (dboard:
8700: 64 61 74 61 2d 67 65 74 2d 72 75 6e 2d 6e 61 6d data-get-run-nam
8710: 65 20 2a 64 61 74 61 2a 29 29 29 29 0a 09 09 28 e *data*))))...(
8720: 6c 62 20 28 69 75 70 3a 6c 69 73 74 62 6f 78 20 lb (iup:listbox
8730: 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f #:expand "HORIZO
8740: 4e 54 41 4c 22 0a 09 09 09 09 20 23 3a 64 72 6f NTAL"..... #:dro
8750: 70 64 6f 77 6e 20 22 59 45 53 22 0a 09 09 09 09 pdown "YES".....
8760: 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 #:action (lambd
8770: 61 20 28 6f 62 6a 20 76 61 6c 20 69 6e 64 65 78 a (obj val index
8780: 20 6c 62 73 74 61 74 65 29 0a 09 09 09 09 09 20 lbstate)......
8790: 20 20 20 28 69 66 20 28 6e 6f 74 20 28 65 71 75 (if (not (equ
87a0: 61 6c 3f 20 76 61 6c 20 22 22 29 29 0a 09 09 09 al? val ""))....
87b0: 09 09 09 28 62 65 67 69 6e 0a 09 09 09 09 09 09 ...(begin.......
87c0: 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 (iup:attribute
87d0: 2d 73 65 74 21 20 74 62 20 22 56 41 4c 55 45 22 -set! tb "VALUE"
87e0: 20 76 61 6c 29 0a 09 09 09 09 09 09 20 20 28 64 val)....... (d
87f0: 62 6f 61 72 64 3a 64 61 74 61 2d 73 65 74 2d 72 board:data-set-r
8800: 75 6e 2d 6e 61 6d 65 21 20 2a 64 61 74 61 2a 20 un-name! *data*
8810: 76 61 6c 29 0a 09 09 09 09 09 09 20 20 28 64 61 val)....... (da
8820: 73 68 62 6f 61 72 64 3a 75 70 64 61 74 65 2d 72 shboard:update-r
8830: 75 6e 2d 63 6f 6d 6d 61 6e 64 29 29 29 29 29 29 un-command))))))
8840: 0a 09 09 28 72 65 66 72 65 73 68 2d 72 75 6e 73 ...(refresh-runs
8850: 2d 6c 69 73 74 20 28 6c 61 6d 62 64 61 20 28 29 -list (lambda ()
8860: 0a 09 09 09 09 20 20 20 20 20 28 6c 65 74 2a 20 ..... (let*
8870: 28 28 74 61 72 67 65 74 20 20 20 20 20 20 20 20 ((target
8880: 28 64 62 6f 61 72 64 3a 64 61 74 61 2d 67 65 74 (dboard:data-get
8890: 2d 74 61 72 67 65 74 2d 73 74 72 69 6e 67 20 2a -target-string *
88a0: 64 61 74 61 2a 29 29 0a 09 09 09 09 09 20 20 20 data*))......
88b0: 20 28 72 75 6e 73 2d 66 6f 72 2d 74 61 72 67 20 (runs-for-targ
88c0: 28 69 66 20 28 64 3a 61 6c 6c 64 61 74 2d 75 73 (if (d:alldat-us
88d0: 65 73 65 72 76 65 72 20 2a 61 6c 6c 64 61 74 2a eserver *alldat*
88e0: 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 20 20 )........
88f0: 28 72 6d 74 3a 67 65 74 2d 72 75 6e 73 2d 62 79 (rmt:get-runs-by
8900: 2d 70 61 74 74 20 28 64 3a 61 6c 6c 64 61 74 2d -patt (d:alldat-
8910: 6b 65 79 73 20 2a 61 6c 6c 64 61 74 2a 29 20 22 keys *alldat*) "
8920: 25 22 20 74 61 72 67 65 74 20 23 66 20 23 66 20 %" target #f #f
8930: 23 66 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 #f)........
8940: 20 20 28 64 62 3a 67 65 74 2d 72 75 6e 73 2d 62 (db:get-runs-b
8950: 79 2d 70 61 74 74 20 28 64 3a 61 6c 6c 64 61 74 y-patt (d:alldat
8960: 2d 64 62 6c 6f 63 61 6c 20 2a 61 6c 6c 64 61 74 -dblocal *alldat
8970: 2a 29 20 28 64 3a 61 6c 6c 64 61 74 2d 6b 65 79 *) (d:alldat-key
8980: 73 20 2a 61 6c 6c 64 61 74 2a 29 20 22 25 22 20 s *alldat*) "%"
8990: 74 61 72 67 65 74 20 23 66 20 23 66 20 23 66 29 target #f #f #f)
89a0: 29 29 0a 09 09 09 09 09 20 20 20 20 28 72 75 6e ))...... (run
89b0: 73 2d 68 65 61 64 65 72 20 20 20 28 76 65 63 74 s-header (vect
89c0: 6f 72 2d 72 65 66 20 72 75 6e 73 2d 66 6f 72 2d or-ref runs-for-
89d0: 74 61 72 67 20 30 29 29 0a 09 09 09 09 09 20 20 targ 0))......
89e0: 20 20 28 72 75 6e 73 2d 64 61 74 20 20 20 20 20 (runs-dat
89f0: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72 75 6e (vector-ref run
8a00: 73 2d 66 6f 72 2d 74 61 72 67 20 31 29 29 0a 09 s-for-targ 1))..
8a10: 09 09 09 09 20 20 20 20 28 72 75 6e 2d 6e 61 6d .... (run-nam
8a20: 65 73 20 20 20 20 20 28 63 6f 6e 73 20 64 65 66 es (cons def
8a30: 61 75 6c 74 2d 72 75 6e 2d 6e 61 6d 65 20 0a 09 ault-run-name ..
8a40: 09 09 09 09 09 09 09 20 28 6d 61 70 20 28 6c 61 ....... (map (la
8a50: 6d 62 64 61 20 28 78 29 0a 09 09 09 09 09 09 09 mbda (x)........
8a60: 09 09 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d ..(db:get-value-
8a70: 62 79 2d 68 65 61 64 65 72 20 78 20 72 75 6e 73 by-header x runs
8a80: 2d 68 65 61 64 65 72 20 22 72 75 6e 6e 61 6d 65 -header "runname
8a90: 22 29 29 0a 09 09 09 09 09 09 09 09 20 20 20 20 ")).........
8aa0: 20 20 72 75 6e 73 2d 64 61 74 29 29 29 29 0a 09 runs-dat))))..
8ab0: 09 09 09 20 20 20 20 20 20 20 3b 3b 20 28 69 75 ... ;; (iu
8ac0: 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 p:attribute-set!
8ad0: 20 6c 62 20 22 52 45 4d 4f 56 45 49 54 45 4d 22 lb "REMOVEITEM"
8ae0: 20 22 41 4c 4c 22 29 0a 09 09 09 09 20 20 20 20 "ALL").....
8af0: 20 20 20 28 69 75 70 6c 69 73 74 62 6f 78 2d 66 (iuplistbox-f
8b00: 69 6c 6c 2d 6c 69 73 74 20 6c 62 20 72 75 6e 2d ill-list lb run-
8b10: 6e 61 6d 65 73 20 73 65 6c 65 63 74 65 64 2d 69 names selected-i
8b20: 74 65 6d 3a 20 64 65 66 61 75 6c 74 2d 72 75 6e tem: default-run
8b30: 2d 6e 61 6d 65 29 29 29 29 29 0a 09 20 20 20 28 -name))))).. (
8b40: 73 65 74 21 20 75 70 64 61 74 65 72 2d 66 6f 72 set! updater-for
8b50: 2d 72 75 6e 73 20 72 65 66 72 65 73 68 2d 72 75 -runs refresh-ru
8b60: 6e 73 2d 6c 69 73 74 29 0a 09 20 20 20 28 72 65 ns-list).. (re
8b70: 66 72 65 73 68 2d 72 75 6e 73 2d 6c 69 73 74 29 fresh-runs-list)
8b80: 0a 09 20 20 20 28 64 62 6f 61 72 64 3a 64 61 74 .. (dboard:dat
8b90: 61 2d 73 65 74 2d 72 75 6e 2d 6e 61 6d 65 21 20 a-set-run-name!
8ba0: 2a 64 61 74 61 2a 20 64 65 66 61 75 6c 74 2d 72 *data* default-r
8bb0: 75 6e 2d 6e 61 6d 65 29 0a 09 20 20 20 28 69 75 un-name).. (iu
8bc0: 70 3a 68 62 6f 78 0a 09 20 20 20 20 74 62 0a 09 p:hbox.. tb..
8bd0: 20 20 20 20 6c 62 29 29 29 0a 0a 09 28 69 75 70 lb)))...(iup
8be0: 3a 66 72 61 6d 65 0a 09 20 23 3a 74 69 74 6c 65 :frame.. #:title
8bf0: 20 22 53 45 4c 45 43 54 4f 52 53 22 0a 09 20 28 "SELECTORS".. (
8c00: 69 75 70 3a 76 62 6f 78 0a 09 20 20 3b 3b 20 54 iup:vbox.. ;; T
8c10: 65 78 74 20 62 6f 78 20 66 6f 72 20 74 65 73 74 ext box for test
8c20: 20 70 61 74 74 65 72 6e 73 0a 09 20 20 28 69 75 patterns.. (iu
8c30: 70 3a 66 72 61 6d 65 0a 09 20 20 20 23 3a 74 69 p:frame.. #:ti
8c40: 74 6c 65 20 22 54 65 73 74 20 70 61 74 74 65 72 tle "Test patter
8c50: 6e 73 20 28 6f 6e 65 20 70 65 72 20 6c 69 6e 65 ns (one per line
8c60: 29 22 0a 09 20 20 20 28 6c 65 74 20 28 28 74 62 )".. (let ((tb
8c70: 20 28 69 75 70 3a 74 65 78 74 62 6f 78 20 23 3a (iup:textbox #:
8c80: 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 action (lambda (
8c90: 76 61 6c 20 61 20 62 29 0a 09 09 09 09 09 20 20 val a b)......
8ca0: 20 20 20 28 64 62 6f 61 72 64 3a 64 61 74 61 2d (dboard:data-
8cb0: 73 65 74 2d 74 65 73 74 2d 70 61 74 74 73 21 0a set-test-patts!.
8cc0: 09 09 09 09 09 20 20 20 20 20 20 2a 64 61 74 61 ..... *data
8cd0: 2a 0a 09 09 09 09 09 20 20 20 20 20 20 28 64 62 *...... (db
8ce0: 6f 61 72 64 3a 6c 69 6e 65 73 2d 3e 74 65 73 74 oard:lines->test
8cf0: 2d 70 61 74 74 20 62 29 29 0a 09 09 09 09 09 20 -patt b))......
8d00: 20 20 20 20 28 64 61 73 68 62 6f 61 72 64 3a 75 (dashboard:u
8d10: 70 64 61 74 65 2d 72 75 6e 2d 63 6f 6d 6d 61 6e pdate-run-comman
8d20: 64 29 29 0a 09 09 09 09 20 20 23 3a 76 61 6c 75 d))..... #:valu
8d30: 65 20 28 64 62 6f 61 72 64 3a 74 65 73 74 2d 70 e (dboard:test-p
8d40: 61 74 74 2d 3e 6c 69 6e 65 73 0a 09 09 09 09 09 att->lines......
8d50: 20 20 20 28 64 62 6f 61 72 64 3a 64 61 74 61 2d (dboard:data-
8d60: 67 65 74 2d 74 65 73 74 2d 70 61 74 74 73 20 2a get-test-patts *
8d70: 64 61 74 61 2a 29 29 0a 09 09 09 09 20 20 23 3a data*))..... #:
8d80: 65 78 70 61 6e 64 20 22 59 45 53 22 0a 09 09 09 expand "YES"....
8d90: 09 20 20 23 3a 73 69 7a 65 20 22 78 35 30 22 0a . #:size "x50".
8da0: 09 09 09 09 20 20 23 3a 6d 75 6c 74 69 6c 69 6e .... #:multilin
8db0: 65 20 22 59 45 53 22 29 29 29 0a 09 20 20 20 20 e "YES")))..
8dc0: 20 28 73 65 74 21 20 74 65 73 74 2d 70 61 74 74 (set! test-patt
8dd0: 65 72 6e 73 2d 74 65 78 74 62 6f 78 20 74 62 29 erns-textbox tb)
8de0: 0a 09 20 20 20 20 20 74 62 29 29 0a 09 20 20 28 .. tb)).. (
8df0: 69 75 70 3a 66 72 61 6d 65 0a 09 20 20 20 23 3a iup:frame.. #:
8e00: 74 69 74 6c 65 20 22 54 61 72 67 65 74 22 0a 09 title "Target"..
8e10: 20 20 20 3b 3b 20 54 61 72 67 65 74 20 73 65 6c ;; Target sel
8e20: 65 63 74 6f 72 73 0a 09 20 20 20 28 61 70 70 6c ectors.. (appl
8e30: 79 20 69 75 70 3a 68 62 6f 78 0a 09 09 20 20 28 y iup:hbox... (
8e40: 6c 65 74 2a 20 28 28 64 61 74 20 20 20 20 20 20 let* ((dat
8e50: 28 64 61 73 68 62 6f 61 72 64 3a 75 70 64 61 74 (dashboard:updat
8e60: 65 2d 74 61 72 67 65 74 2d 73 65 6c 65 63 74 6f e-target-selecto
8e70: 72 20 6b 65 79 2d 6c 69 73 74 62 6f 78 65 73 20 r key-listboxes
8e80: 61 63 74 69 6f 6e 2d 70 72 6f 63 3a 20 75 70 64 action-proc: upd
8e90: 61 74 65 2d 6b 65 79 76 61 6c 73 29 29 0a 09 09 ate-keyvals))...
8ea0: 09 20 28 6b 65 79 2d 6c 62 20 20 20 28 63 61 72 . (key-lb (car
8eb0: 20 64 61 74 29 29 0a 09 09 09 20 28 63 6f 6d 62 dat)).... (comb
8ec0: 6f 73 20 20 20 28 63 61 64 72 20 64 61 74 29 29 os (cadr dat))
8ed0: 29 0a 09 09 20 20 20 20 28 73 65 74 21 20 6b 65 )... (set! ke
8ee0: 79 2d 6c 69 73 74 62 6f 78 65 73 20 6b 65 79 2d y-listboxes key-
8ef0: 6c 62 29 0a 09 09 20 20 20 20 63 6f 6d 62 6f 73 lb)... combos
8f00: 29 29 29 0a 09 20 20 28 69 75 70 3a 68 62 6f 78 ))).. (iup:hbox
8f10: 0a 09 20 20 20 3b 3b 20 54 65 78 74 20 62 6f 78 .. ;; Text box
8f20: 20 66 6f 72 20 53 54 41 54 45 53 0a 09 20 20 20 for STATES..
8f30: 28 69 75 70 3a 66 72 61 6d 65 0a 09 20 20 20 20 (iup:frame..
8f40: 23 3a 74 69 74 6c 65 20 22 53 74 61 74 65 73 22 #:title "States"
8f50: 0a 09 20 20 20 20 28 64 61 73 68 62 6f 61 72 64 .. (dashboard
8f60: 3a 74 65 78 74 2d 6c 69 73 74 2d 74 6f 67 67 6c :text-list-toggl
8f70: 65 2d 62 6f 78 20 0a 09 20 20 20 20 20 3b 3b 20 e-box .. ;;
8f80: 4d 6f 76 65 20 74 68 65 73 65 20 64 65 66 69 6e Move these defin
8f90: 69 74 69 6f 6e 73 20 74 6f 20 63 6f 6d 6d 6f 6e itions to common
8fa0: 20 61 6e 64 20 66 69 6e 64 20 74 68 65 20 6f 74 and find the ot
8fb0: 68 65 72 20 75 73 65 61 67 65 73 20 61 6e 64 20 her useages and
8fc0: 72 65 70 6c 61 63 65 21 0a 09 20 20 20 20 20 28 replace!.. (
8fd0: 6d 61 70 20 63 61 64 72 20 2a 63 6f 6d 6d 6f 6e map cadr *common
8fe0: 3a 73 74 64 2d 73 74 61 74 65 73 2a 29 20 3b 3b :std-states*) ;;
8ff0: 20 27 28 22 43 4f 4d 50 4c 45 54 45 44 22 20 22 '("COMPLETED" "
9000: 52 55 4e 4e 49 4e 47 22 20 22 53 54 55 43 4b 22 RUNNING" "STUCK"
9010: 20 22 49 4e 43 4f 4d 50 4c 45 54 45 22 20 22 4c "INCOMPLETE" "L
9020: 41 55 4e 43 48 45 44 22 20 22 52 45 4d 4f 54 45 AUNCHED" "REMOTE
9030: 48 4f 53 54 53 54 41 52 54 22 20 22 4b 49 4c 4c HOSTSTART" "KILL
9040: 45 44 22 29 0a 09 20 20 20 20 20 28 6c 61 6d 62 ED").. (lamb
9050: 64 61 20 28 61 6c 6c 29 0a 09 20 20 20 20 20 20 da (all)..
9060: 20 28 64 62 6f 61 72 64 3a 64 61 74 61 2d 73 65 (dboard:data-se
9070: 74 2d 73 74 61 74 65 73 21 20 2a 64 61 74 61 2a t-states! *data*
9080: 20 61 6c 6c 29 0a 09 20 20 20 20 20 20 20 28 64 all).. (d
9090: 61 73 68 62 6f 61 72 64 3a 75 70 64 61 74 65 2d ashboard:update-
90a0: 72 75 6e 2d 63 6f 6d 6d 61 6e 64 29 29 29 29 0a run-command)))).
90b0: 09 20 20 20 3b 3b 20 54 65 78 74 20 62 6f 78 20 . ;; Text box
90c0: 66 6f 72 20 53 54 41 54 45 53 0a 09 20 20 20 28 for STATES.. (
90d0: 69 75 70 3a 66 72 61 6d 65 0a 09 20 20 20 20 23 iup:frame.. #
90e0: 3a 74 69 74 6c 65 20 22 53 74 61 74 75 73 65 73 :title "Statuses
90f0: 22 0a 09 20 20 20 20 28 64 61 73 68 62 6f 61 72 ".. (dashboar
9100: 64 3a 74 65 78 74 2d 6c 69 73 74 2d 74 6f 67 67 d:text-list-togg
9110: 6c 65 2d 62 6f 78 20 0a 09 20 20 20 20 20 28 6d le-box .. (m
9120: 61 70 20 63 61 64 72 20 2a 63 6f 6d 6d 6f 6e 3a ap cadr *common:
9130: 73 74 64 2d 73 74 61 74 75 73 65 73 2a 29 20 3b std-statuses*) ;
9140: 3b 20 27 28 22 50 41 53 53 22 20 22 46 41 49 4c ; '("PASS" "FAIL
9150: 22 20 22 6e 2f 61 22 20 22 43 48 45 43 4b 22 20 " "n/a" "CHECK"
9160: 22 57 41 49 56 45 44 22 20 22 53 4b 49 50 22 20 "WAIVED" "SKIP"
9170: 22 44 45 4c 45 54 45 44 22 20 22 53 54 55 43 4b "DELETED" "STUCK
9180: 2f 44 45 41 44 22 29 0a 09 20 20 20 20 20 28 6c /DEAD").. (l
9190: 61 6d 62 64 61 20 28 61 6c 6c 29 0a 09 20 20 20 ambda (all)..
91a0: 20 20 20 20 28 64 62 6f 61 72 64 3a 64 61 74 61 (dboard:data
91b0: 2d 73 65 74 2d 73 74 61 74 75 73 65 73 21 20 2a -set-statuses! *
91c0: 64 61 74 61 2a 20 61 6c 6c 29 0a 09 20 20 20 20 data* all)..
91d0: 20 20 20 28 64 61 73 68 62 6f 61 72 64 3a 75 70 (dashboard:up
91e0: 64 61 74 65 2d 72 75 6e 2d 63 6f 6d 6d 61 6e 64 date-run-command
91f0: 29 29 29 29 29 29 29 29 0a 20 20 20 20 20 20 20 )))))))).
9200: 0a 20 20 20 20 20 20 20 28 69 75 70 3a 66 72 61 . (iup:fra
9210: 6d 65 0a 09 23 3a 74 69 74 6c 65 20 22 54 65 73 me..#:title "Tes
9220: 74 73 20 61 6e 64 20 54 61 73 6b 73 22 0a 09 28 ts and Tasks"..(
9230: 6c 65 74 2a 20 28 28 75 70 64 61 74 65 72 20 23 let* ((updater #
9240: 66 29 0a 09 20 20 20 20 20 20 20 28 6c 61 73 74 f).. (last
9250: 2d 78 61 64 6a 20 30 29 0a 09 20 20 20 20 20 20 -xadj 0)..
9260: 20 28 6c 61 73 74 2d 79 61 64 6a 20 30 29 0a 09 (last-yadj 0)..
9270: 20 20 20 20 20 20 20 28 74 68 65 2d 63 6e 76 20 (the-cnv
9280: 20 20 23 66 29 0a 09 20 20 20 20 20 20 20 28 63 #f).. (c
9290: 61 6e 76 61 73 2d 6f 62 6a 20 0a 20 20 20 20 20 anvas-obj .
92a0: 20 20 20 20 20 20 20 20 20 20 20 28 69 75 70 3a (iup:
92b0: 63 61 6e 76 61 73 20 23 3a 61 63 74 69 6f 6e 20 canvas #:action
92c0: 28 6d 61 6b 65 2d 63 61 6e 76 61 73 2d 61 63 74 (make-canvas-act
92d0: 69 6f 6e 0a 09 09 09 09 20 20 20 20 20 20 28 6c ion..... (l
92e0: 61 6d 62 64 61 20 28 63 6e 76 20 78 61 64 6a 20 ambda (cnv xadj
92f0: 79 61 64 6a 29 0a 09 09 09 09 09 28 69 66 20 28 yadj)......(if (
9300: 6e 6f 74 20 75 70 64 61 74 65 72 29 0a 09 09 09 not updater)....
9310: 09 09 20 20 20 20 28 73 65 74 21 20 75 70 64 61 .. (set! upda
9320: 74 65 72 20 28 6c 61 6d 62 64 61 20 28 78 61 64 ter (lambda (xad
9330: 6a 20 79 61 64 6a 29 0a 09 09 09 09 09 09 09 20 j yadj)........
9340: 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 63 6e ;; (print "cn
9350: 76 3a 20 22 20 63 6e 76 20 22 20 78 61 64 6a 3a v: " cnv " xadj:
9360: 20 22 20 78 61 64 6a 20 22 20 79 61 64 6a 3a 20 " xadj " yadj:
9370: 22 20 79 61 64 6a 29 0a 09 09 09 09 09 09 09 20 " yadj)........
9380: 20 20 20 28 64 61 73 68 62 6f 61 72 64 3a 64 72 (dashboard:dr
9390: 61 77 2d 74 65 73 74 73 20 63 6e 76 20 78 61 64 aw-tests cnv xad
93a0: 6a 20 79 61 64 6a 20 74 65 73 74 73 2d 64 72 61 j yadj tests-dra
93b0: 77 2d 73 74 61 74 65 20 73 6f 72 74 65 64 2d 74 w-state sorted-t
93c0: 65 73 74 6e 61 6d 65 73 20 74 65 73 74 2d 72 65 estnames test-re
93d0: 63 6f 72 64 73 29 0a 09 09 09 09 09 09 09 20 20 cords)........
93e0: 20 20 28 73 65 74 21 20 6c 61 73 74 2d 78 61 64 (set! last-xad
93f0: 6a 20 78 61 64 6a 29 0a 09 09 09 09 09 09 09 20 j xadj)........
9400: 20 20 20 28 73 65 74 21 20 6c 61 73 74 2d 79 61 (set! last-ya
9410: 64 6a 20 79 61 64 6a 29 29 29 29 0a 09 09 09 09 dj yadj)))).....
9420: 09 28 75 70 64 61 74 65 72 20 78 61 64 6a 20 79 .(updater xadj y
9430: 61 64 6a 29 0a 09 09 09 09 09 28 73 65 74 21 20 adj)......(set!
9440: 74 68 65 2d 63 6e 76 20 63 6e 76 29 0a 09 09 09 the-cnv cnv)....
9450: 09 09 29 29 0a 09 09 09 20 20 20 20 3b 3b 20 46 ..)).... ;; F
9460: 6f 6c 6c 6f 77 69 6e 67 20 64 6f 65 73 6e 27 74 ollowing doesn't
9470: 20 77 6f 72 6b 20 0a 09 09 09 20 20 20 20 23 3a work .... #:
9480: 77 68 65 65 6c 2d 63 62 20 28 6c 61 6d 62 64 61 wheel-cb (lambda
9490: 20 28 6f 62 6a 20 73 74 65 70 20 78 20 79 20 64 (obj step x y d
94a0: 69 72 29 20 3b 3b 20 64 69 72 20 69 73 20 34 20 ir) ;; dir is 4
94b0: 66 6f 72 20 75 70 20 61 6e 64 20 35 20 66 6f 72 for up and 5 for
94c0: 20 64 6f 77 6e 2e 20 49 20 74 68 69 6e 6b 2e 0a down. I think..
94d0: 09 09 09 09 09 20 28 6c 65 74 20 28 28 73 63 61 ..... (let ((sca
94e0: 6c 65 66 20 28 68 61 73 68 2d 74 61 62 6c 65 2d lef (hash-table-
94f0: 72 65 66 20 74 65 73 74 73 2d 64 72 61 77 2d 73 ref tests-draw-s
9500: 74 61 74 65 20 27 73 63 61 6c 65 66 29 29 29 0a tate 'scalef))).
9510: 09 09 09 09 09 20 20 20 28 68 61 73 68 2d 74 61 ..... (hash-ta
9520: 62 6c 65 2d 73 65 74 21 20 74 65 73 74 73 2d 64 ble-set! tests-d
9530: 72 61 77 2d 73 74 61 74 65 20 27 73 63 61 6c 65 raw-state 'scale
9540: 66 20 28 2b 20 73 63 61 6c 65 66 0a 09 09 09 09 f (+ scalef.....
9550: 09 09 09 09 09 09 09 28 69 66 20 28 3e 20 73 74 .......(if (> st
9560: 65 70 20 30 29 0a 09 09 09 09 09 09 09 09 09 09 ep 0)...........
9570: 09 20 20 20 20 28 2a 20 73 63 61 6c 65 66 20 30 . (* scalef 0
9580: 2e 30 31 29 0a 09 09 09 09 09 09 09 09 09 09 09 .01)............
9590: 20 20 20 20 28 2a 20 73 63 61 6c 65 66 20 2d 30 (* scalef -0
95a0: 2e 30 31 29 29 29 29 0a 09 09 09 09 09 20 20 20 .01))))......
95b0: 28 69 66 20 74 68 65 2d 63 6e 76 0a 09 09 09 09 (if the-cnv.....
95c0: 09 20 20 20 20 20 20 20 28 64 61 73 68 62 6f 61 . (dashboa
95d0: 72 64 3a 64 72 61 77 2d 74 65 73 74 73 20 74 68 rd:draw-tests th
95e0: 65 2d 63 6e 76 20 6c 61 73 74 2d 78 61 64 6a 20 e-cnv last-xadj
95f0: 6c 61 73 74 2d 79 61 64 6a 20 74 65 73 74 73 2d last-yadj tests-
9600: 64 72 61 77 2d 73 74 61 74 65 20 73 6f 72 74 65 draw-state sorte
9610: 64 2d 74 65 73 74 6e 61 6d 65 73 20 74 65 73 74 d-testnames test
9620: 2d 72 65 63 6f 72 64 73 29 29 0a 09 09 09 09 09 -records))......
9630: 20 20 20 29 29 0a 09 09 09 20 20 20 20 3b 3b 20 )).... ;;
9640: 23 3a 73 69 7a 65 20 22 35 30 78 35 30 22 0a 09 #:size "50x50"..
9650: 09 09 20 20 20 20 23 3a 65 78 70 61 6e 64 20 22 .. #:expand "
9660: 59 45 53 22 0a 09 09 09 20 20 20 20 23 3a 73 63 YES".... #:sc
9670: 72 6f 6c 6c 62 61 72 20 22 59 45 53 22 0a 09 09 rollbar "YES"...
9680: 09 20 20 20 20 23 3a 70 6f 73 78 20 22 30 2e 35 . #:posx "0.5
9690: 22 0a 09 09 09 20 20 20 20 23 3a 70 6f 73 79 20 ".... #:posy
96a0: 22 30 2e 35 22 0a 09 09 09 20 20 20 20 23 3a 62 "0.5".... #:b
96b0: 75 74 74 6f 6e 2d 63 62 20 28 6c 61 6d 62 64 61 utton-cb (lambda
96c0: 20 28 6f 62 6a 20 62 74 6e 20 70 72 65 73 73 65 (obj btn presse
96d0: 64 20 78 20 79 20 73 74 61 74 75 73 29 0a 09 09 d x y status)...
96e0: 09 09 09 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 ... ;; (print "
96f0: 6f 62 6a 3a 20 22 20 6f 62 6a 20 22 2c 20 70 72 obj: " obj ", pr
9700: 65 73 73 65 64 20 22 20 70 72 65 73 73 65 64 20 essed " pressed
9710: 22 2c 20 73 74 61 74 75 73 20 22 20 73 74 61 74 ", status " stat
9720: 75 73 29 0a 09 09 09 09 09 3b 20 28 70 72 69 6e us)......; (prin
9730: 74 20 22 63 61 6e 76 61 73 2d 6f 72 69 67 69 6e t "canvas-origin
9740: 3a 20 22 20 28 63 61 6e 76 61 73 2d 6f 72 69 67 : " (canvas-orig
9750: 69 6e 20 74 68 65 2d 63 6e 76 29 29 0a 09 09 09 in the-cnv))....
9760: 09 09 20 20 3b 3b 20 28 6c 65 74 2d 76 61 6c 75 .. ;; (let-valu
9770: 65 73 20 28 28 28 78 78 20 79 79 29 28 63 61 6e es (((xx yy)(can
9780: 76 61 73 2d 6f 72 69 67 69 6e 20 74 68 65 2d 63 vas-origin the-c
9790: 6e 76 29 29 29 0a 09 09 09 09 09 20 20 3b 3b 20 nv)))...... ;;
97a0: 28 63 61 6e 76 61 73 2d 74 72 61 6e 73 66 6f 72 (canvas-transfor
97b0: 6d 2d 73 65 74 21 20 74 68 65 2d 63 6e 76 20 23 m-set! the-cnv #
97c0: 66 29 0a 09 09 09 09 09 20 20 3b 3b 20 28 70 72 f)...... ;; (pr
97d0: 69 6e 74 20 22 63 61 6e 76 61 73 2d 6f 72 69 67 int "canvas-orig
97e0: 69 6e 3a 20 22 20 78 78 20 22 20 22 20 79 79 20 in: " xx " " yy
97f0: 22 20 63 6c 69 63 6b 20 61 74 20 22 20 78 20 22 " click at " x "
9800: 20 22 20 79 29 29 0a 09 09 09 09 09 20 20 28 6c " y))...... (l
9810: 65 74 2a 20 28 28 74 65 73 74 73 2d 69 6e 66 6f et* ((tests-info
9820: 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 (hash-table
9830: 2d 72 65 66 20 74 65 73 74 73 2d 64 72 61 77 2d -ref tests-draw-
9840: 73 74 61 74 65 20 27 74 65 73 74 73 2d 69 6e 66 state 'tests-inf
9850: 6f 29 29 0a 09 09 09 09 09 09 20 28 73 65 6c 65 o))....... (sele
9860: 63 74 65 64 2d 74 65 73 74 73 20 28 68 61 73 68 cted-tests (hash
9870: 2d 74 61 62 6c 65 2d 72 65 66 20 74 65 73 74 73 -table-ref tests
9880: 2d 64 72 61 77 2d 73 74 61 74 65 20 27 73 65 6c -draw-state 'sel
9890: 65 63 74 65 64 2d 74 65 73 74 73 29 29 0a 09 09 ected-tests))...
98a0: 09 09 09 09 20 28 73 63 61 6c 65 66 20 20 20 20 .... (scalef
98b0: 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 (hash-table
98c0: 2d 72 65 66 20 74 65 73 74 73 2d 64 72 61 77 2d -ref tests-draw-
98d0: 73 74 61 74 65 20 27 73 63 61 6c 65 66 29 29 0a state 'scalef)).
98e0: 09 09 09 09 09 09 20 28 73 69 7a 65 79 20 20 20 ...... (sizey
98f0: 20 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 (hash-tab
9900: 6c 65 2d 72 65 66 20 74 65 73 74 73 2d 64 72 61 le-ref tests-dra
9910: 77 2d 73 74 61 74 65 20 27 73 69 7a 65 79 29 29 w-state 'sizey))
9920: 0a 09 09 09 09 09 09 20 28 78 6f 66 66 73 65 74 ....... (xoffset
9930: 20 20 20 20 20 20 20 20 28 64 63 6f 6d 6d 6f 6e (dcommon
9940: 3a 67 65 74 2d 78 6f 66 66 73 65 74 20 74 65 73 :get-xoffset tes
9950: 74 73 2d 64 72 61 77 2d 73 74 61 74 65 20 23 66 ts-draw-state #f
9960: 20 23 66 29 29 0a 09 09 09 09 09 09 20 28 79 6f #f))....... (yo
9970: 66 66 73 65 74 20 20 20 20 20 20 20 20 28 64 63 ffset (dc
9980: 6f 6d 6d 6f 6e 3a 67 65 74 2d 79 6f 66 66 73 65 ommon:get-yoffse
9990: 74 20 74 65 73 74 73 2d 64 72 61 77 2d 73 74 61 t tests-draw-sta
99a0: 74 65 20 23 66 20 23 66 29 29 0a 09 09 09 09 09 te #f #f))......
99b0: 09 20 28 6e 65 77 2d 79 20 20 20 20 20 20 20 20 . (new-y
99c0: 20 20 28 2d 20 73 69 7a 65 79 20 79 29 29 29 0a (- sizey y))).
99d0: 09 09 09 09 09 20 20 20 20 3b 3b 20 28 70 72 69 ..... ;; (pri
99e0: 6e 74 20 22 78 6f 66 66 73 65 74 3d 22 20 78 6f nt "xoffset=" xo
99f0: 66 66 73 65 74 20 22 2c 20 79 6f 66 66 73 65 74 ffset ", yoffset
9a00: 3d 22 20 79 6f 66 66 73 65 74 29 0a 09 09 09 09 =" yoffset).....
9a10: 09 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 . ;; (print "
9a20: 5c 74 78 5c 74 79 5c 74 6c 6c 78 5c 74 6c 6c 79 \tx\ty\tllx\tlly
9a30: 5c 74 75 72 78 5c 74 75 72 79 22 29 0a 09 09 09 \turx\tury")....
9a40: 09 09 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 .. (for-each
9a50: 28 6c 61 6d 62 64 61 20 28 74 65 73 74 2d 6e 61 (lambda (test-na
9a60: 6d 65 29 0a 09 09 09 09 09 09 09 28 6c 65 74 2a me)........(let*
9a70: 20 28 28 72 65 63 2d 63 6f 6f 72 64 73 20 28 68 ((rec-coords (h
9a80: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 74 65 ash-table-ref te
9a90: 73 74 73 2d 69 6e 66 6f 20 74 65 73 74 2d 6e 61 sts-info test-na
9aa0: 6d 65 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 me))........
9ab0: 20 20 20 28 6c 6c 78 20 20 20 20 20 20 20 20 28 (llx (
9ac0: 64 63 6f 6d 6d 6f 6e 3a 78 2d 3e 63 61 6e 76 61 dcommon:x->canva
9ad0: 73 20 28 6c 69 73 74 2d 72 65 66 20 72 65 63 2d s (list-ref rec-
9ae0: 63 6f 6f 72 64 73 20 30 29 20 73 63 61 6c 65 66 coords 0) scalef
9af0: 20 78 6f 66 66 73 65 74 29 29 0a 09 09 09 09 09 xoffset))......
9b00: 09 09 20 20 20 20 20 20 20 28 6c 6c 79 20 20 20 .. (lly
9b10: 20 20 20 20 20 28 64 63 6f 6d 6d 6f 6e 3a 79 2d (dcommon:y-
9b20: 3e 63 61 6e 76 61 73 20 28 6c 69 73 74 2d 72 65 >canvas (list-re
9b30: 66 20 72 65 63 2d 63 6f 6f 72 64 73 20 31 29 20 f rec-coords 1)
9b40: 73 63 61 6c 65 66 20 79 6f 66 66 73 65 74 29 29 scalef yoffset))
9b50: 0a 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 ........ (
9b60: 75 72 78 20 20 20 20 20 20 20 20 28 64 63 6f 6d urx (dcom
9b70: 6d 6f 6e 3a 78 2d 3e 63 61 6e 76 61 73 20 28 6c mon:x->canvas (l
9b80: 69 73 74 2d 72 65 66 20 72 65 63 2d 63 6f 6f 72 ist-ref rec-coor
9b90: 64 73 20 32 29 20 73 63 61 6c 65 66 20 78 6f 66 ds 2) scalef xof
9ba0: 66 73 65 74 29 29 0a 09 09 09 09 09 09 09 20 20 fset))........
9bb0: 20 20 20 20 20 28 75 72 79 20 20 20 20 20 20 20 (ury
9bc0: 20 28 64 63 6f 6d 6d 6f 6e 3a 79 2d 3e 63 61 6e (dcommon:y->can
9bd0: 76 61 73 20 28 6c 69 73 74 2d 72 65 66 20 72 65 vas (list-ref re
9be0: 63 2d 63 6f 6f 72 64 73 20 33 29 20 73 63 61 6c c-coords 3) scal
9bf0: 65 66 20 79 6f 66 66 73 65 74 29 29 29 0a 09 09 ef yoffset)))...
9c00: 09 09 09 09 09 20 20 3b 3b 20 28 69 66 20 28 65 ..... ;; (if (e
9c10: 71 3f 20 70 72 65 73 73 65 64 20 31 29 0a 09 09 q? pressed 1)...
9c20: 09 09 09 09 09 20 20 3b 3b 20 20 20 20 28 70 72 ..... ;; (pr
9c30: 69 6e 74 20 22 5c 74 78 3d 22 20 78 20 22 5c 74 int "\tx=" x "\t
9c40: 79 3d 22 20 79 20 22 5c 74 6e 65 77 2d 79 3d 22 y=" y "\tnew-y="
9c50: 20 6e 65 77 2d 79 20 22 5c 74 6c 6c 78 3d 22 20 new-y "\tllx="
9c60: 6c 6c 78 20 22 5c 74 6c 6c 79 3d 22 20 6c 6c 79 llx "\tlly=" lly
9c70: 20 22 5c 74 75 72 78 3d 22 20 75 72 78 20 22 5c "\turx=" urx "\
9c80: 74 75 72 79 3d 22 20 75 72 79 20 22 5c 74 22 20 tury=" ury "\t"
9c90: 74 65 73 74 2d 6e 61 6d 65 20 22 20 22 29 29 0a test-name " ")).
9ca0: 09 09 09 09 09 09 09 20 20 28 69 66 20 28 61 6e ....... (if (an
9cb0: 64 20 28 65 71 3f 20 70 72 65 73 73 65 64 20 31 d (eq? pressed 1
9cc0: 29 0a 09 09 09 09 09 09 09 09 20 20 20 28 3e 3d )......... (>=
9cd0: 20 78 20 6c 6c 78 29 0a 09 09 09 09 09 09 09 09 x llx).........
9ce0: 20 20 20 28 3e 3d 20 6e 65 77 2d 79 20 6c 6c 79 (>= new-y lly
9cf0: 29 0a 09 09 09 09 09 09 09 09 20 20 20 28 3c 3d )......... (<=
9d00: 20 78 20 75 72 78 29 0a 09 09 09 09 09 09 09 09 x urx).........
9d10: 20 20 20 28 3c 3d 20 6e 65 77 2d 79 20 75 72 79 (<= new-y ury
9d20: 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 20 ))........
9d30: 28 6c 65 74 20 28 28 70 61 74 74 65 72 6e 73 20 (let ((patterns
9d40: 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 28 69 (string-split (i
9d50: 75 70 3a 61 74 74 72 69 62 75 74 65 20 74 65 73 up:attribute tes
9d60: 74 2d 70 61 74 74 65 72 6e 73 2d 74 65 78 74 62 t-patterns-textb
9d70: 6f 78 20 22 56 41 4c 55 45 22 29 29 29 29 0a 09 ox "VALUE"))))..
9d80: 09 09 09 09 09 09 09 28 6c 65 74 2a 20 28 28 73 .......(let* ((s
9d90: 65 6c 65 63 74 65 64 20 20 20 20 20 28 6e 6f 74 elected (not
9da0: 20 28 6d 65 6d 62 65 72 20 74 65 73 74 2d 6e 61 (member test-na
9db0: 6d 65 20 70 61 74 74 65 72 6e 73 29 29 29 0a 09 me patterns)))..
9dc0: 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 6e ....... (n
9dd0: 65 77 70 61 74 74 2d 6c 69 73 74 20 28 69 66 20 ewpatt-list (if
9de0: 73 65 6c 65 63 74 65 64 0a 09 09 09 09 09 09 09 selected........
9df0: 09 09 09 09 20 28 63 6f 6e 73 20 74 65 73 74 2d .... (cons test-
9e00: 6e 61 6d 65 20 70 61 74 74 65 72 6e 73 29 0a 09 name patterns)..
9e10: 09 09 09 09 09 09 09 09 09 09 20 28 64 65 6c 65 .......... (dele
9e20: 74 65 20 74 65 73 74 2d 6e 61 6d 65 20 70 61 74 te test-name pat
9e30: 74 65 72 6e 73 29 29 29 0a 09 09 09 09 09 09 09 terns)))........
9e40: 09 20 20 20 20 20 20 20 28 6e 65 77 70 61 74 74 . (newpatt
9e50: 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d 69 6e (string-in
9e60: 74 65 72 73 70 65 72 73 65 20 6e 65 77 70 61 74 tersperse newpat
9e70: 74 2d 6c 69 73 74 20 22 5c 6e 22 29 29 29 0a 09 t-list "\n")))..
9e80: 09 09 09 09 09 09 09 20 20 28 69 75 70 3a 61 74 ....... (iup:at
9e90: 74 72 69 62 75 74 65 2d 73 65 74 21 20 6f 62 6a tribute-set! obj
9ea0: 20 22 52 45 44 52 41 57 22 20 22 41 4c 4c 22 29 "REDRAW" "ALL")
9eb0: 0a 09 09 09 09 09 09 09 09 20 20 28 68 61 73 68 ......... (hash
9ec0: 2d 74 61 62 6c 65 2d 73 65 74 21 20 73 65 6c 65 -table-set! sele
9ed0: 63 74 65 64 2d 74 65 73 74 73 20 74 65 73 74 2d cted-tests test-
9ee0: 6e 61 6d 65 20 73 65 6c 65 63 74 65 64 29 0a 09 name selected)..
9ef0: 09 09 09 09 09 09 09 20 20 28 69 75 70 3a 61 74 ....... (iup:at
9f00: 74 72 69 62 75 74 65 2d 73 65 74 21 20 74 65 73 tribute-set! tes
9f10: 74 2d 70 61 74 74 65 72 6e 73 2d 74 65 78 74 62 t-patterns-textb
9f20: 6f 78 20 22 56 41 4c 55 45 22 20 6e 65 77 70 61 ox "VALUE" newpa
9f30: 74 74 29 0a 09 09 09 09 09 09 09 09 20 20 28 64 tt)......... (d
9f40: 62 6f 61 72 64 3a 64 61 74 61 2d 73 65 74 2d 74 board:data-set-t
9f50: 65 73 74 2d 70 61 74 74 73 21 20 2a 64 61 74 61 est-patts! *data
9f60: 2a 20 28 64 62 6f 61 72 64 3a 6c 69 6e 65 73 2d * (dboard:lines-
9f70: 3e 74 65 73 74 2d 70 61 74 74 20 6e 65 77 70 61 >test-patt newpa
9f80: 74 74 29 29 0a 09 09 09 09 09 09 09 09 20 20 28 tt))......... (
9f90: 64 61 73 68 62 6f 61 72 64 3a 75 70 64 61 74 65 dashboard:update
9fa0: 2d 72 75 6e 2d 63 6f 6d 6d 61 6e 64 29 0a 09 09 -run-command)...
9fb0: 09 09 09 09 09 09 20 20 28 69 66 20 75 70 64 61 ...... (if upda
9fc0: 74 65 72 20 28 75 70 64 61 74 65 72 20 6c 61 73 ter (updater las
9fd0: 74 2d 78 61 64 6a 20 6c 61 73 74 2d 79 61 64 6a t-xadj last-yadj
9fe0: 29 29 29 29 29 29 29 0a 09 09 09 09 09 09 20 20 ))))))).......
9ff0: 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (hash-table-
a000: 6b 65 79 73 20 74 65 73 74 73 2d 69 6e 66 6f 29 keys tests-info)
a010: 29 29 29 29 29 29 0a 09 20 20 63 61 6e 76 61 73 )))))).. canvas
a020: 2d 6f 62 6a 29 29 29 0a 20 20 20 20 20 20 0a 20 -obj))). .
a030: 20 20 20 20 20 28 69 75 70 3a 66 72 61 6d 65 0a (iup:frame.
a040: 20 20 20 20 20 20 20 23 3a 74 69 74 6c 65 20 22 #:title "
a050: 4c 6f 67 73 22 20 3b 3b 20 54 6f 20 62 65 20 72 Logs" ;; To be r
a060: 65 70 6c 61 63 65 64 20 77 69 74 68 20 74 61 62 eplaced with tab
a070: 73 0a 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 s. (let ((
a080: 6c 6f 67 73 2d 74 62 20 28 69 75 70 3a 74 65 78 logs-tb (iup:tex
a090: 74 62 6f 78 20 23 3a 65 78 70 61 6e 64 20 22 59 tbox #:expand "Y
a0a0: 45 53 22 0a 09 09 09 09 20 20 20 23 3a 6d 75 6c ES"..... #:mul
a0b0: 74 69 6c 69 6e 65 20 22 59 45 53 22 29 29 29 0a tiline "YES"))).
a0c0: 09 20 28 64 62 6f 61 72 64 3a 64 61 74 61 2d 73 . (dboard:data-s
a0d0: 65 74 2d 6c 6f 67 73 2d 74 65 78 74 62 6f 78 21 et-logs-textbox!
a0e0: 20 2a 64 61 74 61 2a 20 6c 6f 67 73 2d 74 62 29 *data* logs-tb)
a0f0: 0a 09 20 6c 6f 67 73 2d 74 62 29 29 29 29 29 29 .. logs-tb))))))
a100: 0a 0a 0a 3b 3b 20 28 74 72 61 63 65 20 64 61 73 ...;; (trace das
a110: 68 62 6f 61 72 64 3a 70 6f 70 75 6c 61 74 65 2d hboard:populate-
a120: 74 61 72 67 65 74 2d 64 72 6f 70 64 6f 77 6e 0a target-dropdown.
a130: 3b 3b 20 20 20 20 20 20 20 20 63 6f 6d 6d 6f 6e ;; common
a140: 3a 6c 69 73 74 2d 69 73 2d 73 75 62 6c 69 73 74 :list-is-sublist
a150: 29 0a 3b 3b 20 0a 3b 3b 20 20 20 20 20 20 20 3b ).;; .;; ;
a160: 3b 20 6b 65 79 31 20 6b 65 79 32 20 6b 65 79 33 ; key1 key2 key3
a170: 20 2e 2e 2e 0a 3b 3b 20 20 20 20 20 20 20 3b 3b ....;; ;;
a180: 20 74 61 72 67 65 74 20 65 6e 74 72 79 20 28 77 target entry (w
a190: 69 6c 64 20 63 61 72 64 73 20 61 6c 6c 6f 77 65 ild cards allowe
a1a0: 64 29 0a 3b 3b 20 20 20 20 20 20 20 0a 3b 3b 20 d).;; .;;
a1b0: 20 20 20 20 20 20 3b 3b 20 54 68 65 20 61 63 74 ;; The act
a1c0: 69 6f 6e 0a 3b 3b 20 20 20 20 20 20 20 28 69 75 ion.;; (iu
a1d0: 70 3a 68 62 6f 78 0a 3b 3b 20 20 20 20 20 20 20 p:hbox.;;
a1e0: 20 3b 3b 20 6c 61 62 65 6c 20 41 63 74 69 6f 6e ;; label Action
a1f0: 20 7c 20 61 63 74 69 6f 6e 20 73 65 6c 65 63 74 | action select
a200: 6f 72 0a 3b 3b 20 20 20 20 20 20 20 20 29 29 0a or.;; )).
a210: 3b 3b 20 20 20 20 20 20 3b 3b 20 54 65 73 74 2f ;; ;; Test/
a220: 69 74 65 6d 73 20 73 65 6c 65 63 74 6f 72 0a 3b items selector.;
a230: 3b 20 20 20 20 20 20 28 69 75 70 3a 68 62 6f 78 ; (iup:hbox
a240: 0a 3b 3b 20 20 20 20 20 20 20 3b 3b 20 74 65 73 .;; ;; tes
a250: 74 73 0a 3b 3b 20 20 20 20 20 20 20 3b 3b 20 69 ts.;; ;; i
a260: 74 65 6d 73 0a 3b 3b 20 20 20 20 20 20 20 29 29 tems.;; ))
a270: 0a 3b 3b 20 20 20 20 20 3b 3b 20 54 68 65 20 63 .;; ;; The c
a280: 6f 6d 6d 61 6e 64 20 6c 69 6e 65 0a 3b 3b 20 20 ommand line.;;
a290: 20 20 20 28 69 75 70 3a 68 62 6f 78 0a 3b 3b 20 (iup:hbox.;;
a2a0: 20 20 20 20 20 3b 3b 20 63 6f 6d 6d 61 6e 64 6c ;; commandl
a2b0: 69 6e 65 20 65 6e 74 72 79 0a 3b 3b 20 20 20 20 ine entry.;;
a2c0: 20 20 3b 3b 20 47 4f 20 62 75 74 74 6f 6e 0a 3b ;; GO button.;
a2d0: 3b 20 20 20 20 20 20 29 0a 3b 3b 20 20 20 20 20 ; ).;;
a2e0: 3b 3b 20 54 68 65 20 63 6f 6d 6d 61 6e 64 20 6c ;; The command l
a2f0: 6f 67 20 6d 6f 6e 69 74 6f 72 0a 3b 3b 20 20 20 og monitor.;;
a300: 20 20 28 69 75 70 3a 74 61 62 73 0a 3b 3b 20 20 (iup:tabs.;;
a310: 20 20 20 20 3b 3b 20 6c 6f 67 20 6d 6f 6e 69 74 ;; log monit
a320: 6f 72 0a 3b 3b 20 20 20 20 20 20 29 29 29 0a 0a or.;; )))..
a330: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
a340: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a350: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a360: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a370: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 53 20 55 20 ========.;; S U
a380: 4d 20 4d 20 41 20 52 20 59 20 0a 3b 3b 3d 3d 3d M M A R Y .;;===
a390: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a3a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a3b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a3c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a3d0: 3d 3d 3d 0a 3b 3b 0a 3b 3b 20 47 65 6e 65 72 61 ===.;;.;; Genera
a3e0: 6c 20 69 6e 66 6f 20 61 62 6f 75 74 20 74 68 65 l info about the
a3f0: 20 72 75 6e 28 73 29 20 61 6e 64 20 6d 65 67 61 run(s) and mega
a400: 74 65 73 74 20 61 72 65 61 0a 28 64 65 66 69 6e test area.(defin
a410: 65 20 28 64 61 73 68 62 6f 61 72 64 3a 73 75 6d e (dashboard:sum
a420: 6d 61 72 79 20 64 61 74 61 29 0a 20 20 28 6c 65 mary data). (le
a430: 74 2a 20 28 28 64 62 20 20 20 20 20 20 20 20 20 t* ((db
a440: 20 20 20 20 20 20 28 64 3a 61 6c 6c 64 61 74 2d (d:alldat-
a450: 64 62 6c 6f 63 61 6c 20 64 61 74 61 29 29 0a 09 dblocal data))..
a460: 20 28 72 61 77 63 6f 6e 66 69 67 20 20 20 20 20 (rawconfig
a470: 20 20 20 28 72 65 61 64 2d 63 6f 6e 66 69 67 20 (read-config
a480: 28 63 6f 6e 63 20 2a 74 6f 70 70 61 74 68 2a 20 (conc *toppath*
a490: 22 2f 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 "/megatest.confi
a4a0: 67 22 29 20 23 66 20 23 66 29 29 29 20 3b 3b 20 g") #f #f))) ;;
a4b0: 63 68 61 6e 67 65 64 20 74 6f 20 23 66 20 73 69 changed to #f si
a4c0: 6e 63 65 20 49 20 77 61 6e 74 20 23 7b 7d 20 74 nce I want #{} t
a4d0: 6f 20 62 65 20 65 78 70 61 6e 64 65 64 20 62 79 o be expanded by
a4e0: 20 5b 73 79 73 74 65 6d 20 2e 2e 2e 5d 20 74 6f [system ...] to
a4f0: 20 4e 4f 54 20 62 65 20 65 78 70 61 6e 64 65 64 NOT be expanded
a500: 2e 20 57 41 53 3a 20 27 72 65 74 75 72 6e 2d 73 . WAS: 'return-s
a510: 74 72 69 6e 67 29 29 29 0a 20 20 20 20 28 69 75 tring))). (iu
a520: 70 3a 76 62 6f 78 0a 20 20 20 20 20 28 69 75 70 p:vbox. (iup
a530: 3a 73 70 6c 69 74 0a 20 20 20 20 20 20 23 3a 76 :split. #:v
a540: 61 6c 75 65 20 35 30 30 0a 20 20 20 20 20 20 28 alue 500. (
a550: 69 75 70 3a 66 72 61 6d 65 20 0a 20 20 20 20 20 iup:frame .
a560: 20 20 23 3a 74 69 74 6c 65 20 22 47 65 6e 65 72 #:title "Gener
a570: 61 6c 20 49 6e 66 6f 22 0a 20 20 20 20 20 20 20 al Info".
a580: 28 69 75 70 3a 76 62 6f 78 0a 09 28 69 75 70 3a (iup:vbox..(iup:
a590: 68 62 6f 78 0a 09 20 28 69 75 70 3a 6c 61 62 65 hbox.. (iup:labe
a5a0: 6c 20 22 41 72 65 61 20 50 61 74 68 22 29 0a 09 l "Area Path")..
a5b0: 20 28 69 75 70 3a 74 65 78 74 62 6f 78 20 23 3a (iup:textbox #:
a5c0: 76 61 6c 75 65 20 2a 74 6f 70 70 61 74 68 2a 20 value *toppath*
a5d0: 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f #:expand "HORIZO
a5e0: 4e 54 41 4c 22 29 29 0a 09 28 69 75 70 3a 68 62 NTAL"))..(iup:hb
a5f0: 6f 78 20 0a 09 20 28 64 63 6f 6d 6d 6f 6e 3a 6b ox .. (dcommon:k
a600: 65 79 73 2d 6d 61 74 72 69 78 20 72 61 77 63 6f eys-matrix rawco
a610: 6e 66 69 67 29 0a 09 20 28 64 63 6f 6d 6d 6f 6e nfig).. (dcommon
a620: 3a 67 65 6e 65 72 61 6c 2d 69 6e 66 6f 29 0a 09 :general-info)..
a630: 20 29 29 29 0a 20 20 20 20 20 20 28 69 75 70 3a ))). (iup:
a640: 66 72 61 6d 65 0a 20 20 20 20 20 20 20 23 3a 74 frame. #:t
a650: 69 74 6c 65 20 22 53 65 72 76 65 72 22 0a 20 20 itle "Server".
a660: 20 20 20 20 20 28 64 63 6f 6d 6d 6f 6e 3a 73 65 (dcommon:se
a670: 72 76 65 72 73 2d 74 61 62 6c 65 29 29 29 0a 20 rvers-table))).
a680: 20 20 20 20 28 69 75 70 3a 66 72 61 6d 65 20 0a (iup:frame .
a690: 20 20 20 20 20 20 23 3a 74 69 74 6c 65 20 22 4d #:title "M
a6a0: 65 67 61 74 65 73 74 20 63 6f 6e 66 69 67 20 73 egatest config s
a6b0: 65 74 74 69 6e 67 73 22 0a 20 20 20 20 20 20 28 ettings". (
a6c0: 69 75 70 3a 68 62 6f 78 0a 20 20 20 20 20 20 20 iup:hbox.
a6d0: 28 64 63 6f 6d 6d 6f 6e 3a 73 65 63 74 69 6f 6e (dcommon:section
a6e0: 2d 6d 61 74 72 69 78 20 72 61 77 63 6f 6e 66 69 -matrix rawconfi
a6f0: 67 20 22 73 65 74 75 70 22 20 22 56 61 72 6e 61 g "setup" "Varna
a700: 6d 65 22 20 22 56 61 6c 75 65 22 29 0a 20 20 20 me" "Value").
a710: 20 20 20 20 28 69 75 70 3a 76 62 6f 78 0a 09 28 (iup:vbox..(
a720: 64 63 6f 6d 6d 6f 6e 3a 73 65 63 74 69 6f 6e 2d dcommon:section-
a730: 6d 61 74 72 69 78 20 72 61 77 63 6f 6e 66 69 67 matrix rawconfig
a740: 20 22 73 65 72 76 65 72 22 20 22 56 61 72 6e 61 "server" "Varna
a750: 6d 65 22 20 22 56 61 6c 75 65 22 29 0a 09 3b 3b me" "Value")..;;
a760: 20 28 69 75 70 3a 66 72 61 6d 65 0a 09 3b 3b 20 (iup:frame..;;
a770: 23 3a 74 69 74 6c 65 20 22 44 69 73 6b 73 20 41 #:title "Disks A
a780: 72 65 61 73 22 0a 09 28 64 63 6f 6d 6d 6f 6e 3a reas"..(dcommon:
a790: 73 65 63 74 69 6f 6e 2d 6d 61 74 72 69 78 20 72 section-matrix r
a7a0: 61 77 63 6f 6e 66 69 67 20 22 64 69 73 6b 73 22 awconfig "disks"
a7b0: 20 22 44 69 73 6b 20 61 72 65 61 22 20 22 50 61 "Disk area" "Pa
a7c0: 74 68 22 29 29 29 29 0a 20 20 20 20 20 28 69 75 th")))). (iu
a7d0: 70 3a 66 72 61 6d 65 0a 20 20 20 20 20 20 23 3a p:frame. #:
a7e0: 74 69 74 6c 65 20 22 52 75 6e 20 73 74 61 74 69 title "Run stati
a7f0: 73 74 69 63 73 22 0a 20 20 20 20 20 20 28 64 63 stics". (dc
a800: 6f 6d 6d 6f 6e 3a 72 75 6e 2d 73 74 61 74 73 20 ommon:run-stats
a810: 64 62 29 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d db)))))..;;=====
a820: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a830: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a840: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a850: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a860: 3d 0a 3b 3b 20 52 20 55 20 4e 0a 3b 3b 3d 3d 3d =.;; R U N.;;===
a870: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a880: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a890: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a8a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a8b0: 3d 3d 3d 0a 3b 3b 0a 3b 3b 20 64 69 73 70 6c 61 ===.;;.;; displa
a8c0: 79 20 61 6e 64 20 6d 61 6e 61 67 65 20 61 20 73 y and manage a s
a8d0: 69 6e 67 6c 65 20 72 75 6e 20 61 74 20 61 20 74 ingle run at a t
a8e0: 69 6d 65 0a 0a 28 64 65 66 69 6e 65 20 28 74 72 ime..(define (tr
a8f0: 65 65 2d 70 61 74 68 2d 3e 72 75 6e 2d 69 64 20 ee-path->run-id
a900: 64 61 74 61 20 70 61 74 68 29 0a 20 20 28 69 66 data path). (if
a910: 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 70 61 74 (not (null? pat
a920: 68 29 29 0a 20 20 20 20 20 20 28 68 61 73 68 2d h)). (hash-
a930: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
a940: 74 20 28 64 3a 64 61 74 61 2d 70 61 74 68 2d 72 t (d:data-path-r
a950: 75 6e 2d 69 64 73 20 64 61 74 61 29 20 70 61 74 un-ids data) pat
a960: 68 20 23 66 29 0a 20 20 20 20 20 20 23 66 29 29 h #f). #f))
a970: 0a 0a 28 64 65 66 69 6e 65 20 64 61 73 68 62 6f ..(define dashbo
a980: 61 72 64 3a 75 70 64 61 74 65 2d 72 75 6e 2d 73 ard:update-run-s
a990: 75 6d 6d 61 72 79 2d 74 61 62 20 23 66 29 0a 28 ummary-tab #f).(
a9a0: 64 65 66 69 6e 65 20 64 61 73 68 62 6f 61 72 64 define dashboard
a9b0: 3a 75 70 64 61 74 65 2d 6e 65 77 2d 76 69 65 77 :update-new-view
a9c0: 2d 74 61 62 20 23 66 29 0a 0a 28 64 65 66 69 6e -tab #f)..(defin
a9d0: 65 20 28 64 62 6f 61 72 64 3a 67 65 74 2d 74 65 e (dboard:get-te
a9e0: 73 74 73 2d 64 61 74 20 64 61 74 61 20 72 75 6e sts-dat data run
a9f0: 2d 69 64 20 6c 61 73 74 2d 75 70 64 61 74 65 29 -id last-update)
aa00: 0a 20 20 28 6c 65 74 20 28 28 74 64 61 74 20 28 . (let ((tdat (
aa10: 69 66 20 72 75 6e 2d 69 64 0a 09 09 20 20 28 69 if run-id... (i
aa20: 66 20 28 64 3a 61 6c 6c 64 61 74 2d 75 73 65 73 f (d:alldat-uses
aa30: 65 72 76 65 72 20 64 61 74 61 29 0a 09 09 20 20 erver data)...
aa40: 20 20 20 20 28 72 6d 74 3a 67 65 74 2d 74 65 73 (rmt:get-tes
aa50: 74 73 2d 66 6f 72 2d 72 75 6e 20 72 75 6e 2d 69 ts-for-run run-i
aa60: 64 20 0a 09 09 09 09 09 20 20 20 20 20 28 68 61 d ...... (ha
aa70: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def
aa80: 61 75 6c 74 20 28 64 3a 61 6c 6c 64 61 74 2d 73 ault (d:alldat-s
aa90: 65 61 72 63 68 70 61 74 74 73 20 64 61 74 61 29 earchpatts data)
aaa0: 20 22 74 65 73 74 2d 6e 61 6d 65 22 20 22 25 2f "test-name" "%/
aab0: 25 22 29 0a 09 09 09 09 09 20 20 20 20 20 28 68 %")...... (h
aac0: 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 28 ash-table-keys (
aad0: 64 3a 61 6c 6c 64 61 74 2d 73 74 61 74 65 2d 69 d:alldat-state-i
aae0: 67 6e 6f 72 65 2d 68 61 73 68 20 64 61 74 61 29 gnore-hash data)
aaf0: 29 20 3b 3b 20 27 28 29 0a 09 09 09 09 09 20 20 ) ;; '()......
ab00: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b (hash-table-k
ab10: 65 79 73 20 28 64 3a 61 6c 6c 64 61 74 2d 73 74 eys (d:alldat-st
ab20: 61 74 75 73 2d 69 67 6e 6f 72 65 2d 68 61 73 68 atus-ignore-hash
ab30: 20 64 61 74 61 29 29 20 3b 3b 20 27 28 29 0a 09 data)) ;; '()..
ab40: 09 09 09 09 20 20 20 20 20 23 66 20 23 66 0a 09 .... #f #f..
ab50: 09 09 09 09 20 20 20 20 20 28 64 3a 61 6c 6c 64 .... (d:alld
ab60: 61 74 2d 68 69 64 65 2d 6e 6f 74 2d 68 69 64 65 at-hide-not-hide
ab70: 20 64 61 74 61 29 0a 09 09 09 09 09 20 20 20 20 data)......
ab80: 20 23 66 20 23 66 0a 09 09 09 09 09 20 20 20 20 #f #f......
ab90: 20 22 69 64 2c 74 65 73 74 6e 61 6d 65 2c 69 74 "id,testname,it
aba0: 65 6d 5f 70 61 74 68 2c 73 74 61 74 65 2c 73 74 em_path,state,st
abb0: 61 74 75 73 22 0a 09 09 09 09 09 20 20 20 20 20 atus"......
abc0: 28 69 66 20 28 64 3a 61 6c 6c 64 61 74 2d 66 69 (if (d:alldat-fi
abd0: 6c 74 65 72 73 2d 63 68 61 6e 67 65 64 20 64 61 lters-changed da
abe0: 74 61 29 0a 09 09 09 09 09 09 20 30 0a 09 09 09 ta)....... 0....
abf0: 09 09 09 20 6c 61 73 74 2d 75 70 64 61 74 65 29 ... last-update)
ac00: 0a 09 09 09 09 09 20 20 20 20 20 2a 64 61 73 68 ...... *dash
ac10: 62 6f 61 72 64 2d 6d 6f 64 65 2a 29 20 3b 3b 20 board-mode*) ;;
ac20: 67 65 74 20 27 65 6d 20 61 6c 6c 0a 09 09 20 20 get 'em all...
ac30: 20 20 20 20 28 64 62 3a 67 65 74 2d 74 65 73 74 (db:get-test
ac40: 73 2d 66 6f 72 2d 72 75 6e 20 64 62 20 72 75 6e s-for-run db run
ac50: 2d 69 64 20 0a 09 09 09 09 09 20 20 20 20 28 68 -id ...... (h
ac60: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
ac70: 66 61 75 6c 74 20 28 64 3a 61 6c 6c 64 61 74 2d fault (d:alldat-
ac80: 73 65 61 72 63 68 70 61 74 74 73 20 64 61 74 61 searchpatts data
ac90: 29 20 22 74 65 73 74 2d 6e 61 6d 65 22 20 22 25 ) "test-name" "%
aca0: 2f 25 22 29 0a 09 09 09 09 09 20 20 20 20 28 68 /%")...... (h
acb0: 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 28 ash-table-keys (
acc0: 64 3a 61 6c 6c 64 61 74 2d 73 74 61 74 65 2d 69 d:alldat-state-i
acd0: 67 6e 6f 72 65 2d 68 61 73 68 20 64 61 74 61 29 gnore-hash data)
ace0: 29 20 3b 3b 20 27 28 29 0a 09 09 09 09 09 20 20 ) ;; '()......
acf0: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 (hash-table-ke
ad00: 79 73 20 28 64 3a 61 6c 6c 64 61 74 2d 73 74 61 ys (d:alldat-sta
ad10: 74 75 73 2d 69 67 6e 6f 72 65 2d 68 61 73 68 20 tus-ignore-hash
ad20: 64 61 74 61 29 29 20 3b 3b 20 27 28 29 0a 09 09 data)) ;; '()...
ad30: 09 09 09 20 20 20 20 23 66 20 23 66 0a 09 09 09 ... #f #f....
ad40: 09 09 20 20 20 20 28 64 3a 61 6c 6c 64 61 74 2d .. (d:alldat-
ad50: 68 69 64 65 2d 6e 6f 74 2d 68 69 64 65 20 64 61 hide-not-hide da
ad60: 74 61 29 0a 09 09 09 09 09 20 20 20 20 23 66 20 ta)...... #f
ad70: 23 66 0a 09 09 09 09 09 20 20 20 20 22 69 64 2c #f...... "id,
ad80: 74 65 73 74 6e 61 6d 65 2c 69 74 65 6d 5f 70 61 testname,item_pa
ad90: 74 68 2c 73 74 61 74 65 2c 73 74 61 74 75 73 22 th,state,status"
ada0: 0a 09 09 09 09 09 20 20 20 20 28 69 66 20 28 64 ...... (if (d
adb0: 3a 61 6c 6c 64 61 74 2d 66 69 6c 74 65 72 73 2d :alldat-filters-
adc0: 63 68 61 6e 67 65 64 20 64 61 74 61 29 0a 09 09 changed data)...
add0: 09 09 09 09 30 0a 09 09 09 09 09 09 6c 61 73 74 ....0.......last
ade0: 2d 75 70 64 61 74 65 29 0a 09 09 09 09 09 20 20 -update)......
adf0: 20 20 2a 64 61 73 68 62 6f 61 72 64 2d 6d 6f 64 *dashboard-mod
ae00: 65 2a 29 29 0a 09 09 20 20 27 28 29 29 29 29 20 e*))... '())))
ae10: 3b 3b 20 67 65 74 20 27 65 6d 20 61 6c 6c 0a 20 ;; get 'em all.
ae20: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
ae30: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
ae40: 6f 72 74 2a 20 22 64 62 6f 61 72 64 3a 67 65 74 ort* "dboard:get
ae50: 2d 74 65 73 74 73 2d 64 61 74 3a 20 67 6f 74 20 -tests-dat: got
ae60: 22 20 28 6c 65 6e 67 74 68 20 74 64 61 74 29 20 " (length tdat)
ae70: 22 20 74 65 73 74 20 72 65 63 6f 72 64 73 20 66 " test records f
ae80: 6f 72 20 72 75 6e 20 22 20 72 75 6e 2d 69 64 29 or run " run-id)
ae90: 0a 20 20 20 20 28 73 6f 72 74 20 74 64 61 74 20 . (sort tdat
aea0: 28 6c 61 6d 62 64 61 20 28 61 20 62 29 0a 09 09 (lambda (a b)...
aeb0: 20 28 6c 65 74 2a 20 28 28 61 76 61 6c 20 28 76 (let* ((aval (v
aec0: 65 63 74 6f 72 2d 72 65 66 20 61 20 32 29 29 0a ector-ref a 2)).
aed0: 09 09 09 28 62 76 61 6c 20 28 76 65 63 74 6f 72 ...(bval (vector
aee0: 2d 72 65 66 20 62 20 32 29 29 0a 09 09 09 28 61 -ref b 2))....(a
aef0: 6e 75 6d 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d num (string->num
af00: 62 65 72 20 61 76 61 6c 29 29 0a 09 09 09 28 62 ber aval))....(b
af10: 6e 75 6d 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d num (string->num
af20: 62 65 72 20 62 76 61 6c 29 29 29 0a 09 09 20 20 ber bval)))...
af30: 20 28 69 66 20 28 61 6e 64 20 61 6e 75 6d 20 62 (if (and anum b
af40: 6e 75 6d 29 0a 09 09 20 20 20 20 20 20 20 28 3c num)... (<
af50: 20 61 6e 75 6d 20 62 6e 75 6d 29 0a 09 09 20 20 anum bnum)...
af60: 20 20 20 20 20 28 73 74 72 69 6e 67 3c 3d 20 61 (string<= a
af70: 76 61 6c 20 62 76 61 6c 29 29 29 29 29 29 29 0a val bval))))))).
af80: 0a 3b 3b 20 54 68 69 73 20 69 73 20 74 68 65 20 .;; This is the
af90: 52 75 6e 20 53 75 6d 6d 61 72 79 20 74 61 62 0a Run Summary tab.
afa0: 3b 3b 20 0a 28 64 65 66 69 6e 65 20 28 64 61 73 ;; .(define (das
afb0: 68 62 6f 61 72 64 3a 6f 6e 65 2d 72 75 6e 20 64 hboard:one-run d
afc0: 62 20 64 61 74 61 20 64 64 61 74 61 29 0a 20 20 b data ddata).
afd0: 28 6c 65 74 2a 20 28 28 74 62 20 20 20 20 20 20 (let* ((tb
afe0: 28 69 75 70 3a 74 72 65 65 62 6f 78 0a 09 09 20 (iup:treebox...
aff0: 20 20 23 3a 76 61 6c 75 65 20 30 0a 09 09 20 20 #:value 0...
b000: 20 23 3a 6e 61 6d 65 20 22 52 75 6e 73 22 0a 09 #:name "Runs"..
b010: 09 20 20 20 23 3a 65 78 70 61 6e 64 20 22 59 45 . #:expand "YE
b020: 53 22 0a 09 09 20 20 20 23 3a 61 64 64 65 78 70 S"... #:addexp
b030: 61 6e 64 65 64 20 22 4e 4f 22 0a 09 09 20 20 20 anded "NO"...
b040: 23 3a 73 65 6c 65 63 74 69 6f 6e 2d 63 62 0a 09 #:selection-cb..
b050: 09 20 20 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a . (lambda (obj
b060: 20 69 64 20 73 74 61 74 65 29 0a 09 09 20 20 20 id state)...
b070: 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 6f 62 6a ;; (print "obj
b080: 3a 20 22 20 6f 62 6a 20 22 2c 20 69 64 3a 20 22 : " obj ", id: "
b090: 20 69 64 20 22 2c 20 73 74 61 74 65 3a 20 22 20 id ", state: "
b0a0: 73 74 61 74 65 29 0a 09 09 20 20 20 20 20 28 6c state)... (l
b0b0: 65 74 2a 20 28 28 72 75 6e 2d 70 61 74 68 20 28 et* ((run-path (
b0c0: 74 72 65 65 3a 6e 6f 64 65 2d 3e 70 61 74 68 20 tree:node->path
b0d0: 6f 62 6a 20 69 64 29 29 0a 09 09 09 20 20 20 20 obj id))....
b0e0: 28 72 75 6e 2d 69 64 20 20 20 28 74 72 65 65 2d (run-id (tree-
b0f0: 70 61 74 68 2d 3e 72 75 6e 2d 69 64 20 64 64 61 path->run-id dda
b100: 74 61 20 28 63 64 72 20 72 75 6e 2d 70 61 74 68 ta (cdr run-path
b110: 29 29 29 29 0a 09 09 20 20 20 20 20 20 20 28 69 ))))... (i
b120: 66 20 28 6e 75 6d 62 65 72 3f 20 72 75 6e 2d 69 f (number? run-i
b130: 64 29 0a 09 09 09 20 20 20 28 62 65 67 69 6e 0a d).... (begin.
b140: 09 09 09 20 20 20 20 20 28 64 3a 64 61 74 61 2d ... (d:data-
b150: 63 75 72 72 2d 72 75 6e 2d 69 64 2d 73 65 74 21 curr-run-id-set!
b160: 20 64 64 61 74 61 20 72 75 6e 2d 69 64 29 0a 09 ddata run-id)..
b170: 09 09 20 20 20 20 20 28 64 61 73 68 62 6f 61 72 .. (dashboar
b180: 64 3a 75 70 64 61 74 65 2d 72 75 6e 2d 73 75 6d d:update-run-sum
b190: 6d 61 72 79 2d 74 61 62 29 29 0a 09 09 09 20 20 mary-tab))....
b1a0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
b1b0: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
b1c0: 74 2a 20 22 45 52 52 4f 52 3a 20 74 72 65 65 2d t* "ERROR: tree-
b1d0: 70 61 74 68 2d 3e 72 75 6e 2d 69 64 20 72 65 74 path->run-id ret
b1e0: 75 72 6e 65 64 20 6e 6f 6e 2d 6e 75 6d 62 65 72 urned non-number
b1f0: 20 22 20 72 75 6e 2d 69 64 29 29 29 0a 09 09 20 " run-id)))...
b200: 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 70 ;; (print "p
b210: 61 74 68 3a 20 22 20 28 74 72 65 65 3a 6e 6f 64 ath: " (tree:nod
b220: 65 2d 3e 70 61 74 68 20 6f 62 6a 20 69 64 29 20 e->path obj id)
b230: 22 20 72 75 6e 2d 69 64 3a 20 22 20 72 75 6e 2d " run-id: " run-
b240: 69 64 29 0a 09 09 20 20 20 20 20 29 29 29 0a 09 id)... )))..
b250: 20 28 63 65 6c 6c 2d 6c 6f 6f 6b 75 70 20 28 6d (cell-lookup (m
b260: 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 ake-hash-table))
b270: 0a 09 20 28 72 75 6e 2d 6d 61 74 72 69 78 20 28 .. (run-matrix (
b280: 69 75 70 3a 6d 61 74 72 69 78 0a 09 09 20 20 20 iup:matrix...
b290: 20 20 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 #:expand "YES
b2a0: 22 0a 09 09 20 20 20 20 20 20 23 3a 63 6c 69 63 "... #:clic
b2b0: 6b 2d 63 62 0a 09 09 20 20 20 20 20 20 28 6c 61 k-cb... (la
b2c0: 6d 62 64 61 20 28 6f 62 6a 20 6c 69 6e 20 63 6f mbda (obj lin co
b2d0: 6c 20 73 74 61 74 75 73 29 0a 09 09 09 28 6c 65 l status)....(le
b2e0: 74 2a 20 28 28 74 6f 6f 6c 70 61 74 68 20 28 63 t* ((toolpath (c
b2f0: 61 72 20 28 61 72 67 76 29 29 29 0a 09 09 09 20 ar (argv)))....
b300: 20 20 20 20 20 20 28 6b 65 79 20 20 20 20 20 20 (key
b310: 28 63 6f 6e 63 20 6c 69 6e 20 22 3a 22 20 63 6f (conc lin ":" co
b320: 6c 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 74 l)).... (t
b330: 65 73 74 2d 69 64 20 20 28 68 61 73 68 2d 74 61 est-id (hash-ta
b340: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default
b350: 63 65 6c 6c 2d 6c 6f 6f 6b 75 70 20 6b 65 79 20 cell-lookup key
b360: 2d 31 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 -1)).... (
b370: 63 6d 64 20 20 20 20 20 20 28 63 6f 6e 63 20 74 cmd (conc t
b380: 6f 6f 6c 70 61 74 68 20 22 20 2d 74 65 73 74 20 oolpath " -test
b390: 22 20 28 64 3a 64 61 74 61 2d 63 75 72 72 2d 72 " (d:data-curr-r
b3a0: 75 6e 2d 69 64 20 64 64 61 74 61 29 20 22 2c 22 un-id ddata) ","
b3b0: 20 74 65 73 74 2d 69 64 20 22 26 22 29 29 29 0a test-id "&"))).
b3c0: 09 09 09 20 20 28 73 79 73 74 65 6d 20 63 6d 64 ... (system cmd
b3d0: 29 29 29 29 29 0a 09 20 28 75 70 64 61 74 65 72 ))))).. (updater
b3e0: 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 20 (lambda ()...
b3f0: 20 20 20 20 28 6c 65 74 2a 20 28 28 72 75 6e 73 (let* ((runs
b400: 2d 64 61 74 20 20 20 20 20 28 69 66 20 28 64 3a -dat (if (d:
b410: 61 6c 6c 64 61 74 2d 75 73 65 73 65 72 76 65 72 alldat-useserver
b420: 20 64 61 74 61 29 0a 09 09 09 09 09 20 20 20 20 data)......
b430: 20 20 28 72 6d 74 3a 67 65 74 2d 72 75 6e 73 2d (rmt:get-runs-
b440: 62 79 2d 70 61 74 74 20 28 64 3a 61 6c 6c 64 61 by-patt (d:allda
b450: 74 2d 6b 65 79 73 20 64 61 74 61 29 20 22 25 22 t-keys data) "%"
b460: 20 23 66 20 23 66 20 23 66 20 23 66 29 0a 09 09 #f #f #f #f)...
b470: 09 09 09 20 20 20 20 20 20 28 64 62 3a 67 65 74 ... (db:get
b480: 2d 72 75 6e 73 2d 62 79 2d 70 61 74 74 20 64 62 -runs-by-patt db
b490: 20 28 64 3a 61 6c 6c 64 61 74 2d 6b 65 79 73 20 (d:alldat-keys
b4a0: 64 61 74 61 29 20 22 25 22 20 23 66 20 23 66 20 data) "%" #f #f
b4b0: 23 66 20 23 66 29 29 29 0a 09 09 09 20 20 20 20 #f #f)))....
b4c0: 28 72 75 6e 73 2d 68 65 61 64 65 72 20 20 28 76 (runs-header (v
b4d0: 65 63 74 6f 72 2d 72 65 66 20 72 75 6e 73 2d 64 ector-ref runs-d
b4e0: 61 74 20 30 29 29 20 3b 3b 20 30 20 69 73 20 68 at 0)) ;; 0 is h
b4f0: 65 61 64 65 72 2c 20 31 20 69 73 20 6c 69 73 74 eader, 1 is list
b500: 20 6f 66 20 72 65 63 6f 72 64 73 0a 09 09 09 20 of records....
b510: 20 20 20 28 72 75 6e 2d 69 64 20 20 20 20 20 20 (run-id
b520: 20 28 64 3a 64 61 74 61 2d 63 75 72 72 2d 72 75 (d:data-curr-ru
b530: 6e 2d 69 64 20 64 64 61 74 61 29 29 0a 09 09 09 n-id ddata))....
b540: 20 20 20 20 28 6c 61 73 74 2d 75 70 64 61 74 65 (last-update
b550: 20 20 30 29 20 3b 3b 20 66 69 78 20 6d 65 0a 09 0) ;; fix me..
b560: 09 09 20 20 20 20 28 74 65 73 74 73 2d 64 61 74 .. (tests-dat
b570: 20 20 20 20 28 64 62 6f 61 72 64 3a 67 65 74 2d (dboard:get-
b580: 74 65 73 74 73 2d 64 61 74 20 64 61 74 61 20 72 tests-dat data r
b590: 75 6e 2d 69 64 20 6c 61 73 74 2d 75 70 64 61 74 un-id last-updat
b5a0: 65 29 29 0a 09 09 09 20 20 20 20 28 74 65 73 74 e)).... (test
b5b0: 73 2d 6d 69 6e 64 61 74 20 28 64 63 6f 6d 6d 6f s-mindat (dcommo
b5c0: 6e 3a 6d 69 6e 69 6d 69 7a 65 2d 74 65 73 74 2d n:minimize-test-
b5d0: 64 61 74 61 20 74 65 73 74 73 2d 64 61 74 29 29 data tests-dat))
b5e0: 0a 09 09 09 20 20 20 20 28 69 6e 64 69 63 65 73 .... (indices
b5f0: 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 73 70 (common:sp
b600: 61 72 73 65 2d 6c 69 73 74 2d 67 65 6e 65 72 61 arse-list-genera
b610: 74 65 2d 69 6e 64 65 78 20 74 65 73 74 73 2d 6d te-index tests-m
b620: 69 6e 64 61 74 29 29 20 3b 3b 20 20 70 72 6f 63 indat)) ;; proc
b630: 3a 20 73 65 74 2d 63 65 6c 6c 29 29 0a 09 09 09 : set-cell))....
b640: 20 20 20 20 28 72 6f 77 2d 69 6e 64 69 63 65 73 (row-indices
b650: 20 20 28 63 61 64 72 20 69 6e 64 69 63 65 73 29 (cadr indices)
b660: 29 0a 09 09 09 20 20 20 20 28 63 6f 6c 2d 69 6e ).... (col-in
b670: 64 69 63 65 73 20 20 28 63 61 72 20 69 6e 64 69 dices (car indi
b680: 63 65 73 29 29 0a 09 09 09 20 20 20 20 28 6d 61 ces)).... (ma
b690: 78 2d 72 6f 77 20 20 20 20 20 20 28 69 66 20 28 x-row (if (
b6a0: 6e 75 6c 6c 3f 20 72 6f 77 2d 69 6e 64 69 63 65 null? row-indice
b6b0: 73 29 20 31 20 28 63 6f 6d 6d 6f 6e 3a 6d 61 78 s) 1 (common:max
b6c0: 20 28 6d 61 70 20 63 61 64 72 20 72 6f 77 2d 69 (map cadr row-i
b6d0: 6e 64 69 63 65 73 29 29 29 29 0a 09 09 09 20 20 ndices))))....
b6e0: 20 20 28 6d 61 78 2d 63 6f 6c 20 20 20 20 20 20 (max-col
b6f0: 28 69 66 20 28 6e 75 6c 6c 3f 20 63 6f 6c 2d 69 (if (null? col-i
b700: 6e 64 69 63 65 73 29 20 31 20 28 63 6f 6d 6d 6f ndices) 1 (commo
b710: 6e 3a 6d 61 78 20 28 6d 61 70 20 63 61 64 72 20 n:max (map cadr
b720: 63 6f 6c 2d 69 6e 64 69 63 65 73 29 29 29 29 0a col-indices)))).
b730: 09 09 09 20 20 20 20 28 6d 61 78 2d 76 69 73 69 ... (max-visi
b740: 62 6c 65 20 20 28 6d 61 78 20 28 2d 20 28 64 3a ble (max (- (d:
b750: 61 6c 6c 64 61 74 2d 6e 75 6d 2d 74 65 73 74 73 alldat-num-tests
b760: 20 64 61 74 61 29 20 31 35 29 20 33 29 29 20 3b data) 15) 3)) ;
b770: 3b 20 28 64 3a 61 6c 6c 64 61 74 2d 6e 75 6d 2d ; (d:alldat-num-
b780: 74 65 73 74 73 20 64 61 74 61 29 20 69 73 20 70 tests data) is p
b790: 72 6f 70 6f 72 74 69 6f 6e 61 6c 20 74 6f 20 74 roportional to t
b7a0: 68 65 20 73 69 7a 65 20 6f 66 20 74 68 65 20 77 he size of the w
b7b0: 69 6e 64 6f 77 0a 09 09 09 20 20 20 20 28 6e 75 indow.... (nu
b7c0: 6d 72 6f 77 73 20 20 20 20 20 20 31 29 0a 09 09 mrows 1)...
b7d0: 09 20 20 20 20 28 6e 75 6d 63 6f 6c 73 20 20 20 . (numcols
b7e0: 20 20 20 31 29 0a 09 09 09 20 20 20 20 28 63 68 1).... (ch
b7f0: 61 6e 67 65 64 20 20 20 20 20 20 23 66 29 0a 09 anged #f)..
b800: 09 09 20 20 20 20 28 72 75 6e 73 2d 68 61 73 68 .. (runs-hash
b810: 20 20 20 20 28 6c 65 74 20 28 28 68 74 20 28 6d (let ((ht (m
b820: 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 ake-hash-table))
b830: 29 0a 09 09 09 09 09 20 20 20 20 28 66 6f 72 2d )...... (for-
b840: 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 72 75 each (lambda (ru
b850: 6e 29 0a 09 09 09 09 09 09 09 28 68 61 73 68 2d n)........(hash-
b860: 74 61 62 6c 65 2d 73 65 74 21 20 68 74 20 28 64 table-set! ht (d
b870: 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 b:get-value-by-h
b880: 65 61 64 65 72 20 72 75 6e 20 72 75 6e 73 2d 68 eader run runs-h
b890: 65 61 64 65 72 20 22 69 64 22 29 20 72 75 6e 29 eader "id") run)
b8a0: 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 28 76 )....... (v
b8b0: 65 63 74 6f 72 2d 72 65 66 20 72 75 6e 73 2d 64 ector-ref runs-d
b8c0: 61 74 20 31 29 29 0a 09 09 09 09 09 20 20 20 20 at 1))......
b8d0: 68 74 29 29 0a 09 09 09 20 20 20 20 28 72 75 6e ht)).... (run
b8e0: 2d 69 64 73 20 20 20 20 20 20 28 73 6f 72 74 20 -ids (sort
b8f0: 28 66 69 6c 74 65 72 20 6e 75 6d 62 65 72 3f 20 (filter number?
b900: 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 (hash-table-keys
b910: 20 72 75 6e 73 2d 68 61 73 68 29 29 0a 09 09 09 runs-hash))....
b920: 09 09 09 28 6c 61 6d 62 64 61 20 28 61 20 62 29 ...(lambda (a b)
b930: 0a 09 09 09 09 09 09 20 20 28 6c 65 74 2a 20 28 ....... (let* (
b940: 28 72 65 63 6f 72 64 2d 61 20 28 68 61 73 68 2d (record-a (hash-
b950: 74 61 62 6c 65 2d 72 65 66 20 72 75 6e 73 2d 68 table-ref runs-h
b960: 61 73 68 20 61 29 29 0a 09 09 09 09 09 09 09 20 ash a))........
b970: 28 72 65 63 6f 72 64 2d 62 20 28 68 61 73 68 2d (record-b (hash-
b980: 74 61 62 6c 65 2d 72 65 66 20 72 75 6e 73 2d 68 table-ref runs-h
b990: 61 73 68 20 62 29 29 0a 09 09 09 09 09 09 09 20 ash b))........
b9a0: 28 74 69 6d 65 2d 61 20 20 20 28 64 62 3a 67 65 (time-a (db:ge
b9b0: 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 t-value-by-heade
b9c0: 72 20 72 65 63 6f 72 64 2d 61 20 72 75 6e 73 2d r record-a runs-
b9d0: 68 65 61 64 65 72 20 22 65 76 65 6e 74 5f 74 69 header "event_ti
b9e0: 6d 65 22 29 29 0a 09 09 09 09 09 09 09 20 28 74 me"))........ (t
b9f0: 69 6d 65 2d 62 20 20 20 28 64 62 3a 67 65 74 2d ime-b (db:get-
ba00: 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 value-by-header
ba10: 72 65 63 6f 72 64 2d 62 20 72 75 6e 73 2d 68 65 record-b runs-he
ba20: 61 64 65 72 20 22 65 76 65 6e 74 5f 74 69 6d 65 ader "event_time
ba30: 22 29 29 29 0a 09 09 09 09 09 09 20 20 20 20 28 ")))....... (
ba40: 3c 20 74 69 6d 65 2d 61 20 74 69 6d 65 2d 62 29 < time-a time-b)
ba50: 29 29 29 29 29 0a 09 09 20 20 20 20 20 20 20 0a )))))... .
ba60: 09 09 20 20 20 20 20 20 20 28 64 3a 61 6c 6c 64 .. (d:alld
ba70: 61 74 2d 66 69 6c 74 65 72 73 2d 63 68 61 6e 67 at-filters-chang
ba80: 65 64 2d 73 65 74 21 20 64 61 74 61 20 23 66 29 ed-set! data #f)
ba90: 0a 09 09 20 20 20 20 20 20 20 3b 3b 20 28 69 75 ... ;; (iu
baa0: 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 p:attribute-set!
bab0: 20 74 62 20 22 56 41 4c 55 45 22 20 22 30 22 29 tb "VALUE" "0")
bac0: 0a 09 09 20 20 20 20 20 20 20 3b 3b 20 28 69 75 ... ;; (iu
bad0: 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 p:attribute-set!
bae0: 20 74 62 20 22 4e 41 4d 45 22 20 22 52 75 6e 73 tb "NAME" "Runs
baf0: 22 29 0a 09 09 20 20 20 20 20 20 20 3b 3b 20 55 ")... ;; U
bb00: 70 64 61 74 65 20 74 68 65 20 72 75 6e 73 20 74 pdate the runs t
bb10: 72 65 65 0a 09 09 20 20 20 20 20 20 20 28 66 6f ree... (fo
bb20: 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 r-each (lambda (
bb30: 72 75 6e 2d 69 64 29 0a 09 09 09 09 20 20 20 28 run-id)..... (
bb40: 6c 65 74 2a 20 28 28 72 75 6e 2d 72 65 63 6f 72 let* ((run-recor
bb50: 64 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 d (hash-table-re
bb60: 66 2f 64 65 66 61 75 6c 74 20 72 75 6e 73 2d 68 f/default runs-h
bb70: 61 73 68 20 72 75 6e 2d 69 64 20 23 66 29 29 0a ash run-id #f)).
bb80: 09 09 09 09 09 20 20 28 6b 65 79 2d 76 61 6c 73 ..... (key-vals
bb90: 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 (map (lambda
bba0: 28 6b 65 79 29 28 64 62 3a 67 65 74 2d 76 61 6c (key)(db:get-val
bbb0: 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e ue-by-header run
bbc0: 2d 72 65 63 6f 72 64 20 72 75 6e 73 2d 68 65 61 -record runs-hea
bbd0: 64 65 72 20 6b 65 79 29 29 0a 09 09 09 09 09 09 der key)).......
bbe0: 09 20 20 20 28 64 3a 61 6c 6c 64 61 74 2d 6b 65 . (d:alldat-ke
bbf0: 79 73 20 64 61 74 61 29 29 29 0a 09 09 09 09 09 ys data)))......
bc00: 20 20 28 72 75 6e 2d 6e 61 6d 65 20 20 20 28 64 (run-name (d
bc10: 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 b:get-value-by-h
bc20: 65 61 64 65 72 20 72 75 6e 2d 72 65 63 6f 72 64 eader run-record
bc30: 20 72 75 6e 73 2d 68 65 61 64 65 72 20 22 72 75 runs-header "ru
bc40: 6e 6e 61 6d 65 22 29 29 0a 09 09 09 09 09 20 20 nname"))......
bc50: 28 63 6f 6c 2d 6e 61 6d 65 20 20 20 28 63 6f 6e (col-name (con
bc60: 63 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 c (string-inters
bc70: 70 65 72 73 65 20 6b 65 79 2d 76 61 6c 73 20 22 perse key-vals "
bc80: 5c 6e 22 29 20 22 5c 6e 22 20 72 75 6e 2d 6e 61 \n") "\n" run-na
bc90: 6d 65 29 29 0a 09 09 09 09 09 20 20 28 72 75 6e me))...... (run
bca0: 2d 70 61 74 68 20 20 20 28 61 70 70 65 6e 64 20 -path (append
bcb0: 6b 65 79 2d 76 61 6c 73 20 28 6c 69 73 74 20 72 key-vals (list r
bcc0: 75 6e 2d 6e 61 6d 65 29 29 29 0a 09 09 09 09 09 un-name)))......
bcd0: 20 20 28 65 78 69 73 74 69 6e 67 20 20 20 28 74 (existing (t
bce0: 72 65 65 3a 66 69 6e 64 2d 6e 6f 64 65 20 74 62 ree:find-node tb
bcf0: 20 72 75 6e 2d 70 61 74 68 29 29 29 0a 09 09 09 run-path)))....
bd00: 09 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 . (if (not (
bd10: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d
bd20: 65 66 61 75 6c 74 20 28 64 3a 64 61 74 61 2d 70 efault (d:data-p
bd30: 61 74 68 2d 72 75 6e 2d 69 64 73 20 64 64 61 74 ath-run-ids ddat
bd40: 61 29 20 72 75 6e 2d 70 61 74 68 20 23 66 29 29 a) run-path #f))
bd50: 0a 09 09 09 09 09 20 28 62 65 67 69 6e 0a 09 09 ...... (begin...
bd60: 09 09 09 20 20 20 28 68 61 73 68 2d 74 61 62 6c ... (hash-tabl
bd70: 65 2d 73 65 74 21 20 28 64 3a 64 61 74 61 2d 72 e-set! (d:data-r
bd80: 75 6e 2d 6b 65 79 73 20 64 64 61 74 61 29 20 72 un-keys ddata) r
bd90: 75 6e 2d 69 64 20 72 75 6e 2d 70 61 74 68 29 0a un-id run-path).
bda0: 09 09 09 09 09 20 20 20 3b 3b 20 28 69 75 70 3a ..... ;; (iup:
bdb0: 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 28 attribute-set! (
bdc0: 64 62 6f 61 72 64 3a 64 61 74 61 2d 67 65 74 2d dboard:data-get-
bdd0: 72 75 6e 73 2d 6d 61 74 72 69 78 20 2a 64 61 74 runs-matrix *dat
bde0: 61 2a 29 0a 09 09 09 09 09 20 20 20 3b 3b 20 20 a*)...... ;;
bdf0: 20 20 09 09 20 28 63 6f 6e 63 20 72 6f 77 6e 75 .. (conc rownu
be00: 6d 20 22 3a 22 20 63 6f 6c 6e 75 6d 29 20 63 6f m ":" colnum) co
be10: 6c 2d 6e 61 6d 65 29 0a 09 09 09 09 09 20 20 20 l-name)......
be20: 3b 3b 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 ;; (hash-table-s
be30: 65 74 21 20 72 75 6e 69 64 2d 74 6f 2d 63 6f 6c et! runid-to-col
be40: 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 20 63 6f run-id (list co
be50: 6c 6e 75 6d 20 72 75 6e 2d 72 65 63 6f 72 64 29 lnum run-record)
be60: 29 0a 09 09 09 09 09 20 20 20 3b 3b 20 48 65 72 )...... ;; Her
be70: 65 20 77 65 20 75 70 64 61 74 65 20 74 68 65 20 e we update the
be80: 74 65 73 74 73 20 74 72 65 65 62 6f 78 20 61 6e tests treebox an
be90: 64 20 74 72 65 65 20 6b 65 79 73 0a 09 09 09 09 d tree keys.....
bea0: 09 20 20 20 28 74 72 65 65 3a 61 64 64 2d 6e 6f . (tree:add-no
beb0: 64 65 20 74 62 20 22 52 75 6e 73 22 20 72 75 6e de tb "Runs" run
bec0: 2d 70 61 74 68 20 3b 3b 20 28 61 70 70 65 6e 64 -path ;; (append
bed0: 20 6b 65 79 2d 76 61 6c 73 20 28 6c 69 73 74 20 key-vals (list
bee0: 72 75 6e 2d 6e 61 6d 65 29 29 0a 09 09 09 09 09 run-name))......
bef0: 09 09 20 20 75 73 65 72 64 61 74 61 3a 20 28 63 .. userdata: (c
bf00: 6f 6e 63 20 22 72 75 6e 2d 69 64 3a 20 22 20 72 onc "run-id: " r
bf10: 75 6e 2d 69 64 29 29 0a 09 09 09 09 09 20 20 20 un-id))......
bf20: 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 (hash-table-set!
bf30: 20 28 64 3a 64 61 74 61 2d 70 61 74 68 2d 72 75 (d:data-path-ru
bf40: 6e 2d 69 64 73 20 64 64 61 74 61 29 20 72 75 6e n-ids ddata) run
bf50: 2d 70 61 74 68 20 72 75 6e 2d 69 64 29 0a 09 09 -path run-id)...
bf60: 09 09 09 20 20 20 3b 3b 20 28 73 65 74 21 20 63 ... ;; (set! c
bf70: 6f 6c 6e 75 6d 20 28 2b 20 63 6f 6c 6e 75 6d 20 olnum (+ colnum
bf80: 31 29 29 0a 09 09 09 09 09 20 20 20 29 29 29 29 1))...... ))))
bf90: 0a 09 09 09 09 20 72 75 6e 2d 69 64 73 29 0a 09 ..... run-ids)..
bfa0: 09 20 20 20 20 20 20 20 28 69 75 70 3a 61 74 74 . (iup:att
bfb0: 72 69 62 75 74 65 2d 73 65 74 21 20 72 75 6e 2d ribute-set! run-
bfc0: 6d 61 74 72 69 78 20 22 43 4c 45 41 52 56 41 4c matrix "CLEARVAL
bfd0: 55 45 22 20 22 41 4c 4c 22 29 20 3b 3b 20 4e 4f UE" "ALL") ;; NO
bfe0: 54 45 3a 20 57 61 73 20 43 4f 4e 54 45 4e 54 53 TE: Was CONTENTS
bff0: 0a 09 09 20 20 20 20 20 20 20 28 69 75 70 3a 61 ... (iup:a
c000: 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 72 75 ttribute-set! ru
c010: 6e 2d 6d 61 74 72 69 78 20 22 43 4c 45 41 52 41 n-matrix "CLEARA
c020: 54 54 52 49 42 22 20 22 43 4f 4e 54 45 4e 54 53 TTRIB" "CONTENTS
c030: 22 29 0a 09 09 20 20 20 20 20 20 20 28 69 75 70 ")... (iup
c040: 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 :attribute-set!
c050: 72 75 6e 2d 6d 61 74 72 69 78 20 22 52 45 53 49 run-matrix "RESI
c060: 5a 45 4d 41 54 52 49 58 22 20 22 59 45 53 22 29 ZEMATRIX" "YES")
c070: 0a 09 09 20 20 20 20 20 20 20 28 69 75 70 3a 61 ... (iup:a
c080: 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 72 75 ttribute-set! ru
c090: 6e 2d 6d 61 74 72 69 78 20 22 4e 55 4d 43 4f 4c n-matrix "NUMCOL
c0a0: 22 20 6d 61 78 2d 63 6f 6c 20 29 0a 09 09 20 20 " max-col )...
c0b0: 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 (iup:attrib
c0c0: 75 74 65 2d 73 65 74 21 20 72 75 6e 2d 6d 61 74 ute-set! run-mat
c0d0: 72 69 78 20 22 4e 55 4d 4c 49 4e 22 20 28 69 66 rix "NUMLIN" (if
c0e0: 20 28 3c 20 6d 61 78 2d 72 6f 77 20 6d 61 78 2d (< max-row max-
c0f0: 76 69 73 69 62 6c 65 29 20 6d 61 78 2d 76 69 73 visible) max-vis
c100: 69 62 6c 65 20 6d 61 78 2d 72 6f 77 29 29 20 3b ible max-row)) ;
c110: 3b 20 6d 69 6e 20 6f 66 20 32 30 0a 09 09 20 20 ; min of 20...
c120: 20 20 20 20 20 3b 3b 20 28 69 75 70 3a 61 74 74 ;; (iup:att
c130: 72 69 62 75 74 65 2d 73 65 74 21 20 72 75 6e 2d ribute-set! run-
c140: 6d 61 74 72 69 78 20 22 4e 55 4d 43 4f 4c 5f 56 matrix "NUMCOL_V
c150: 49 53 49 42 4c 45 22 20 6d 61 78 2d 63 6f 6c 29 ISIBLE" max-col)
c160: 0a 09 09 20 20 20 20 20 20 20 3b 3b 20 28 69 75 ... ;; (iu
c170: 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 p:attribute-set!
c180: 20 72 75 6e 2d 6d 61 74 72 69 78 20 22 4e 55 4d run-matrix "NUM
c190: 4c 49 4e 5f 56 49 53 49 42 4c 45 22 20 28 69 66 LIN_VISIBLE" (if
c1a0: 20 28 3e 20 6d 61 78 2d 72 6f 77 20 6d 61 78 2d (> max-row max-
c1b0: 76 69 73 69 62 6c 65 29 20 6d 61 78 2d 76 69 73 visible) max-vis
c1c0: 69 62 6c 65 20 6d 61 78 2d 72 6f 77 29 29 0a 09 ible max-row))..
c1d0: 09 20 20 20 20 20 20 20 0a 09 09 20 20 20 20 20 . ...
c1e0: 20 20 3b 3b 20 52 6f 77 20 6c 61 62 65 6c 73 0a ;; Row labels.
c1f0: 09 09 20 20 20 20 20 20 20 28 66 6f 72 2d 65 61 .. (for-ea
c200: 63 68 20 28 6c 61 6d 62 64 61 20 28 69 6e 64 29 ch (lambda (ind)
c210: 0a 09 09 09 09 20 20 20 28 6c 65 74 2a 20 28 28 ..... (let* ((
c220: 6e 61 6d 65 20 28 63 61 72 20 69 6e 64 29 29 0a name (car ind)).
c230: 09 09 09 09 09 20 20 28 6e 75 6d 20 20 28 63 61 ..... (num (ca
c240: 64 72 20 69 6e 64 29 29 0a 09 09 09 09 09 20 20 dr ind))......
c250: 28 6b 65 79 20 20 28 63 6f 6e 63 20 6e 75 6d 20 (key (conc num
c260: 22 3a 30 22 29 29 29 0a 09 09 09 09 20 20 20 20 ":0"))).....
c270: 20 28 69 66 20 28 6e 6f 74 20 28 65 71 75 61 6c (if (not (equal
c280: 3f 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 ? (iup:attribute
c290: 20 72 75 6e 2d 6d 61 74 72 69 78 20 6b 65 79 29 run-matrix key)
c2a0: 20 6e 61 6d 65 29 29 0a 09 09 09 09 09 20 28 62 name))...... (b
c2b0: 65 67 69 6e 0a 09 09 09 09 09 20 20 20 28 73 65 egin...... (se
c2c0: 74 21 20 63 68 61 6e 67 65 64 20 23 74 29 0a 09 t! changed #t)..
c2d0: 09 09 09 09 20 20 20 28 69 75 70 3a 61 74 74 72 .... (iup:attr
c2e0: 69 62 75 74 65 2d 73 65 74 21 20 72 75 6e 2d 6d ibute-set! run-m
c2f0: 61 74 72 69 78 20 6b 65 79 20 6e 61 6d 65 29 29 atrix key name))
c300: 29 29 29 0a 09 09 09 09 20 72 6f 77 2d 69 6e 64 )))..... row-ind
c310: 69 63 65 73 29 0a 09 09 20 20 20 20 20 20 20 0a ices)... .
c320: 09 09 20 20 20 20 20 20 20 3b 3b 20 43 65 6c 6c .. ;; Cell
c330: 20 63 6f 6e 74 65 6e 74 73 0a 09 09 20 20 20 20 contents...
c340: 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 (for-each (la
c350: 6d 62 64 61 20 28 65 6e 74 72 79 29 0a 09 09 09 mbda (entry)....
c360: 09 20 20 20 28 6c 65 74 2a 20 28 28 72 6f 77 2d . (let* ((row-
c370: 6e 61 6d 65 20 20 28 63 61 64 72 20 65 6e 74 72 name (cadr entr
c380: 79 29 29 0a 09 09 09 09 09 20 20 28 63 6f 6c 2d y))...... (col-
c390: 6e 61 6d 65 20 20 28 63 61 72 20 65 6e 74 72 79 name (car entry
c3a0: 29 29 0a 09 09 09 09 09 20 20 28 76 61 6c 75 65 ))...... (value
c3b0: 64 61 74 20 20 28 63 61 64 64 72 20 65 6e 74 72 dat (caddr entr
c3c0: 79 29 29 0a 09 09 09 09 09 20 20 28 74 65 73 74 y))...... (test
c3d0: 2d 69 64 20 20 20 28 6c 69 73 74 2d 72 65 66 20 -id (list-ref
c3e0: 76 61 6c 75 65 64 61 74 20 30 29 29 0a 09 09 09 valuedat 0))....
c3f0: 09 09 20 20 28 74 65 73 74 2d 6e 61 6d 65 20 72 .. (test-name r
c400: 6f 77 2d 6e 61 6d 65 29 20 3b 3b 20 28 6c 69 73 ow-name) ;; (lis
c410: 74 2d 72 65 66 20 76 61 6c 75 65 64 61 74 20 31 t-ref valuedat 1
c420: 29 29 0a 09 09 09 09 09 20 20 28 69 74 65 6d 2d ))...... (item-
c430: 70 61 74 68 20 63 6f 6c 2d 6e 61 6d 65 29 20 3b path col-name) ;
c440: 3b 20 28 6c 69 73 74 2d 72 65 66 20 76 61 6c 75 ; (list-ref valu
c450: 65 64 61 74 20 32 29 29 0a 09 09 09 09 09 20 20 edat 2))......
c460: 28 73 74 61 74 65 20 20 20 20 20 28 6c 69 73 74 (state (list
c470: 2d 72 65 66 20 76 61 6c 75 65 64 61 74 20 31 29 -ref valuedat 1)
c480: 29 0a 09 09 09 09 09 20 20 28 73 74 61 74 75 73 )...... (status
c490: 20 20 20 20 28 6c 69 73 74 2d 72 65 66 20 76 61 (list-ref va
c4a0: 6c 75 65 64 61 74 20 32 29 29 0a 09 09 09 09 09 luedat 2))......
c4b0: 20 20 28 76 61 6c 75 65 20 20 20 20 20 28 67 75 (value (gu
c4c0: 74 69 6c 73 3a 67 65 74 2d 63 6f 6c 6f 72 2d 66 tils:get-color-f
c4d0: 6f 72 2d 73 74 61 74 65 2d 73 74 61 74 75 73 20 or-state-status
c4e0: 73 74 61 74 65 20 73 74 61 74 75 73 29 29 0a 09 state status))..
c4f0: 09 09 09 09 20 20 28 72 6f 77 2d 6e 75 6d 20 20 .... (row-num
c500: 20 28 63 61 64 72 20 28 61 73 73 6f 63 20 72 6f (cadr (assoc ro
c510: 77 2d 6e 61 6d 65 20 72 6f 77 2d 69 6e 64 69 63 w-name row-indic
c520: 65 73 29 29 29 0a 09 09 09 09 09 20 20 28 63 6f es)))...... (co
c530: 6c 2d 6e 75 6d 20 20 20 28 63 61 64 72 20 28 61 l-num (cadr (a
c540: 73 73 6f 63 20 63 6f 6c 2d 6e 61 6d 65 20 63 6f ssoc col-name co
c550: 6c 2d 69 6e 64 69 63 65 73 29 29 29 0a 09 09 09 l-indices)))....
c560: 09 09 20 20 28 6b 65 79 20 20 20 20 20 20 20 28 .. (key (
c570: 63 6f 6e 63 20 72 6f 77 2d 6e 75 6d 20 22 3a 22 conc row-num ":"
c580: 20 63 6f 6c 2d 6e 75 6d 29 29 29 0a 09 09 09 09 col-num))).....
c590: 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 (hash-table
c5a0: 2d 73 65 74 21 20 63 65 6c 6c 2d 6c 6f 6f 6b 75 -set! cell-looku
c5b0: 70 20 6b 65 79 20 74 65 73 74 2d 69 64 29 0a 09 p key test-id)..
c5c0: 09 09 09 20 20 20 20 20 28 69 66 20 28 6e 6f 74 ... (if (not
c5d0: 20 28 65 71 75 61 6c 3f 20 28 69 75 70 3a 61 74 (equal? (iup:at
c5e0: 74 72 69 62 75 74 65 20 72 75 6e 2d 6d 61 74 72 tribute run-matr
c5f0: 69 78 20 6b 65 79 29 20 28 63 61 64 72 20 76 61 ix key) (cadr va
c600: 6c 75 65 29 29 29 0a 09 09 09 09 09 20 28 62 65 lue)))...... (be
c610: 67 69 6e 0a 09 09 09 09 09 20 20 20 28 73 65 74 gin...... (set
c620: 21 20 63 68 61 6e 67 65 64 20 23 74 29 0a 09 09 ! changed #t)...
c630: 09 09 09 20 20 20 28 69 75 70 3a 61 74 74 72 69 ... (iup:attri
c640: 62 75 74 65 2d 73 65 74 21 20 72 75 6e 2d 6d 61 bute-set! run-ma
c650: 74 72 69 78 20 6b 65 79 20 28 63 61 64 72 20 76 trix key (cadr v
c660: 61 6c 75 65 29 29 0a 09 09 09 09 09 20 20 20 28 alue))...... (
c670: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se
c680: 74 21 20 72 75 6e 2d 6d 61 74 72 69 78 20 28 63 t! run-matrix (c
c690: 6f 6e 63 20 22 42 47 43 4f 4c 4f 52 22 20 6b 65 onc "BGCOLOR" ke
c6a0: 79 29 20 28 63 61 72 20 76 61 6c 75 65 29 29 29 y) (car value)))
c6b0: 29 29 29 0a 09 09 09 09 20 74 65 73 74 73 2d 6d )))..... tests-m
c6c0: 69 6e 64 61 74 29 0a 09 09 20 20 20 20 20 20 20 indat)...
c6d0: 0a 09 09 20 20 20 20 20 20 20 3b 3b 20 43 6f 6c ... ;; Col
c6e0: 20 6c 61 62 65 6c 73 20 2d 20 64 6f 20 61 66 74 labels - do aft
c6f0: 65 72 20 73 65 74 74 69 6e 67 20 43 65 6c 6c 20 er setting Cell
c700: 63 6f 6e 74 65 6e 74 73 20 73 6f 20 74 68 65 79 contents so they
c710: 20 61 72 65 20 61 63 63 6f 75 6e 74 65 64 20 66 are accounted f
c720: 6f 72 20 69 6e 20 74 68 65 20 73 69 7a 65 20 63 or in the size c
c730: 61 6c 63 2e 0a 0a 09 09 20 20 20 20 20 20 20 28 alc..... (
c740: 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 for-each (lambda
c750: 20 28 69 6e 64 29 0a 09 09 09 09 20 20 20 28 6c (ind)..... (l
c760: 65 74 2a 20 28 28 6e 61 6d 65 20 28 63 61 72 20 et* ((name (car
c770: 69 6e 64 29 29 0a 09 09 09 09 09 20 20 28 6e 75 ind))...... (nu
c780: 6d 20 20 28 63 61 64 72 20 69 6e 64 29 29 0a 09 m (cadr ind))..
c790: 09 09 09 09 20 20 28 6b 65 79 20 20 28 63 6f 6e .... (key (con
c7a0: 63 20 22 30 3a 22 20 6e 75 6d 29 29 29 0a 09 09 c "0:" num)))...
c7b0: 09 09 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 .. (if (not
c7c0: 28 65 71 75 61 6c 3f 20 28 69 75 70 3a 61 74 74 (equal? (iup:att
c7d0: 72 69 62 75 74 65 20 72 75 6e 2d 6d 61 74 72 69 ribute run-matri
c7e0: 78 20 6b 65 79 29 20 6e 61 6d 65 29 29 0a 09 09 x key) name))...
c7f0: 09 09 09 20 28 62 65 67 69 6e 0a 09 09 09 09 09 ... (begin......
c800: 20 20 20 28 73 65 74 21 20 63 68 61 6e 67 65 64 (set! changed
c810: 20 23 74 29 0a 09 09 09 09 09 20 20 20 28 69 75 #t)...... (iu
c820: 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 p:attribute-set!
c830: 20 72 75 6e 2d 6d 61 74 72 69 78 20 6b 65 79 20 run-matrix key
c840: 6e 61 6d 65 29 0a 09 09 09 09 09 20 20 20 28 69 name)...... (i
c850: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 up:attribute-set
c860: 21 20 72 75 6e 2d 6d 61 74 72 69 78 20 22 46 49 ! run-matrix "FI
c870: 54 54 4f 54 45 58 54 22 20 28 63 6f 6e 63 20 22 TTOTEXT" (conc "
c880: 43 22 20 6e 75 6d 29 29 29 29 29 29 0a 09 09 09 C" num))))))....
c890: 09 20 63 6f 6c 2d 69 6e 64 69 63 65 73 29 0a 09 . col-indices)..
c8a0: 09 20 20 20 20 20 20 20 28 69 66 20 63 68 61 6e . (if chan
c8b0: 67 65 64 20 28 69 75 70 3a 61 74 74 72 69 62 75 ged (iup:attribu
c8c0: 74 65 2d 73 65 74 21 20 72 75 6e 2d 6d 61 74 72 te-set! run-matr
c8d0: 69 78 20 22 52 45 44 52 41 57 22 20 22 41 4c 4c ix "REDRAW" "ALL
c8e0: 22 29 29 29 29 29 29 0a 20 20 20 20 0a 20 20 20 ")))))). .
c8f0: 20 28 73 65 74 21 20 64 61 73 68 62 6f 61 72 64 (set! dashboard
c900: 3a 75 70 64 61 74 65 2d 72 75 6e 2d 73 75 6d 6d :update-run-summ
c910: 61 72 79 2d 74 61 62 20 75 70 64 61 74 65 72 29 ary-tab updater)
c920: 0a 20 20 20 20 28 64 3a 64 61 74 61 2d 72 75 6e . (d:data-run
c930: 73 2d 74 72 65 65 2d 73 65 74 21 20 64 64 61 74 s-tree-set! ddat
c940: 61 20 74 62 29 0a 20 20 20 20 28 69 75 70 3a 73 a tb). (iup:s
c950: 70 6c 69 74 0a 20 20 20 20 20 74 62 0a 20 20 20 plit. tb.
c960: 20 20 72 75 6e 2d 6d 61 74 72 69 78 29 29 29 0a run-matrix))).
c970: 0a 3b 3b 20 54 68 69 73 20 69 73 20 74 68 65 20 .;; This is the
c980: 4e 65 77 20 56 69 65 77 20 74 61 62 0a 3b 3b 20 New View tab.;;
c990: 0a 28 64 65 66 69 6e 65 20 28 64 61 73 68 62 6f .(define (dashbo
c9a0: 61 72 64 3a 6e 65 77 2d 76 69 65 77 20 64 62 20 ard:new-view db
c9b0: 64 61 74 61 20 64 64 61 74 61 29 0a 20 20 28 6c data ddata). (l
c9c0: 65 74 2a 20 28 28 74 62 20 20 20 20 20 20 28 69 et* ((tb (i
c9d0: 75 70 3a 74 72 65 65 62 6f 78 0a 09 09 20 20 20 up:treebox...
c9e0: 23 3a 76 61 6c 75 65 20 30 0a 09 09 20 20 20 23 #:value 0... #
c9f0: 3a 6e 61 6d 65 20 22 52 75 6e 73 22 0a 09 09 20 :name "Runs"...
ca00: 20 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 #:expand "YES"
ca10: 0a 09 09 20 20 20 23 3a 61 64 64 65 78 70 61 6e ... #:addexpan
ca20: 64 65 64 20 22 4e 4f 22 0a 09 09 20 20 20 23 3a ded "NO"... #:
ca30: 73 65 6c 65 63 74 69 6f 6e 2d 63 62 0a 09 09 20 selection-cb...
ca40: 20 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 20 69 (lambda (obj i
ca50: 64 20 73 74 61 74 65 29 0a 09 09 20 20 20 20 20 d state)...
ca60: 3b 3b 20 28 70 72 69 6e 74 20 22 6f 62 6a 3a 20 ;; (print "obj:
ca70: 22 20 6f 62 6a 20 22 2c 20 69 64 3a 20 22 20 69 " obj ", id: " i
ca80: 64 20 22 2c 20 73 74 61 74 65 3a 20 22 20 73 74 d ", state: " st
ca90: 61 74 65 29 0a 09 09 20 20 20 20 20 28 6c 65 74 ate)... (let
caa0: 2a 20 28 28 72 75 6e 2d 70 61 74 68 20 28 74 72 * ((run-path (tr
cab0: 65 65 3a 6e 6f 64 65 2d 3e 70 61 74 68 20 6f 62 ee:node->path ob
cac0: 6a 20 69 64 29 29 0a 09 09 09 20 20 20 20 28 72 j id)).... (r
cad0: 75 6e 2d 69 64 20 20 20 28 74 72 65 65 2d 70 61 un-id (tree-pa
cae0: 74 68 2d 3e 72 75 6e 2d 69 64 20 64 64 61 74 61 th->run-id ddata
caf0: 20 28 63 64 72 20 72 75 6e 2d 70 61 74 68 29 29 (cdr run-path))
cb00: 29 29 0a 09 09 20 20 20 20 20 20 20 28 69 66 20 ))... (if
cb10: 28 6e 75 6d 62 65 72 3f 20 72 75 6e 2d 69 64 29 (number? run-id)
cb20: 0a 09 09 09 20 20 20 28 62 65 67 69 6e 0a 09 09 .... (begin...
cb30: 09 20 20 20 20 20 28 64 3a 64 61 74 61 2d 63 75 . (d:data-cu
cb40: 72 72 2d 72 75 6e 2d 69 64 2d 73 65 74 21 20 64 rr-run-id-set! d
cb50: 64 61 74 61 20 72 75 6e 2d 69 64 29 0a 09 09 09 data run-id)....
cb60: 20 20 20 20 20 28 64 61 73 68 62 6f 61 72 64 3a (dashboard:
cb70: 75 70 64 61 74 65 2d 6e 65 77 2d 76 69 65 77 2d update-new-view-
cb80: 74 61 62 29 29 0a 09 09 09 20 20 20 28 64 65 62 tab)).... (deb
cb90: 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 ug:print 0 *defa
cba0: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 45 ult-log-port* "E
cbb0: 52 52 4f 52 3a 20 74 72 65 65 2d 70 61 74 68 2d RROR: tree-path-
cbc0: 3e 72 75 6e 2d 69 64 20 72 65 74 75 72 6e 65 64 >run-id returned
cbd0: 20 6e 6f 6e 2d 6e 75 6d 62 65 72 20 22 20 72 75 non-number " ru
cbe0: 6e 2d 69 64 29 29 29 0a 09 09 20 20 20 20 20 3b n-id)))... ;
cbf0: 3b 20 28 70 72 69 6e 74 20 22 70 61 74 68 3a 20 ; (print "path:
cc00: 22 20 28 74 72 65 65 3a 6e 6f 64 65 2d 3e 70 61 " (tree:node->pa
cc10: 74 68 20 6f 62 6a 20 69 64 29 20 22 20 72 75 6e th obj id) " run
cc20: 2d 69 64 3a 20 22 20 72 75 6e 2d 69 64 29 0a 09 -id: " run-id)..
cc30: 09 20 20 20 20 20 29 29 29 0a 09 20 28 63 65 6c . ))).. (cel
cc40: 6c 2d 6c 6f 6f 6b 75 70 20 28 6d 61 6b 65 2d 68 l-lookup (make-h
cc50: 61 73 68 2d 74 61 62 6c 65 29 29 0a 09 20 28 72 ash-table)).. (r
cc60: 75 6e 2d 6d 61 74 72 69 78 20 28 69 75 70 3a 6d un-matrix (iup:m
cc70: 61 74 72 69 78 0a 09 09 20 20 20 20 20 20 23 3a atrix... #:
cc80: 65 78 70 61 6e 64 20 22 59 45 53 22 0a 09 09 20 expand "YES"...
cc90: 20 20 20 20 20 23 3a 63 6c 69 63 6b 2d 63 62 0a #:click-cb.
cca0: 09 09 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 .. (lambda
ccb0: 28 6f 62 6a 20 6c 69 6e 20 63 6f 6c 20 73 74 61 (obj lin col sta
ccc0: 74 75 73 29 0a 09 09 09 28 6c 65 74 2a 20 28 28 tus)....(let* ((
ccd0: 74 6f 6f 6c 70 61 74 68 20 28 63 61 72 20 28 61 toolpath (car (a
cce0: 72 67 76 29 29 29 0a 09 09 09 20 20 20 20 20 20 rgv)))....
ccf0: 20 28 6b 65 79 20 20 20 20 20 20 28 63 6f 6e 63 (key (conc
cd00: 20 6c 69 6e 20 22 3a 22 20 63 6f 6c 29 29 0a 09 lin ":" col))..
cd10: 09 09 20 20 20 20 20 20 20 28 74 65 73 74 2d 69 .. (test-i
cd20: 64 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 d (hash-table-r
cd30: 65 66 2f 64 65 66 61 75 6c 74 20 63 65 6c 6c 2d ef/default cell-
cd40: 6c 6f 6f 6b 75 70 20 6b 65 79 20 2d 31 29 29 0a lookup key -1)).
cd50: 09 09 09 20 20 20 20 20 20 20 28 63 6d 64 20 20 ... (cmd
cd60: 20 20 20 20 28 63 6f 6e 63 20 74 6f 6f 6c 70 61 (conc toolpa
cd70: 74 68 20 22 20 2d 74 65 73 74 20 22 20 28 64 3a th " -test " (d:
cd80: 64 61 74 61 2d 63 75 72 72 2d 72 75 6e 2d 69 64 data-curr-run-id
cd90: 20 64 64 61 74 61 29 20 22 2c 22 20 74 65 73 74 ddata) "," test
cda0: 2d 69 64 20 22 26 22 29 29 29 0a 09 09 09 20 20 -id "&")))....
cdb0: 28 73 79 73 74 65 6d 20 63 6d 64 29 29 29 29 29 (system cmd)))))
cdc0: 0a 09 20 28 75 70 64 61 74 65 72 20 20 28 6c 61 .. (updater (la
cdd0: 6d 62 64 61 20 28 29 0a 09 09 20 20 20 20 20 28 mbda ()... (
cde0: 6c 65 74 2a 20 28 28 72 75 6e 73 2d 64 61 74 20 let* ((runs-dat
cdf0: 20 20 20 20 28 69 66 20 28 64 3a 61 6c 6c 64 61 (if (d:allda
ce00: 74 2d 75 73 65 73 65 72 76 65 72 20 64 61 74 61 t-useserver data
ce10: 29 0a 09 09 09 09 09 20 20 20 20 20 20 28 72 6d )...... (rm
ce20: 74 3a 67 65 74 2d 72 75 6e 73 2d 62 79 2d 70 61 t:get-runs-by-pa
ce30: 74 74 20 28 64 3a 61 6c 6c 64 61 74 2d 6b 65 79 tt (d:alldat-key
ce40: 73 20 64 61 74 61 29 20 22 25 22 20 23 66 20 23 s data) "%" #f #
ce50: 66 20 23 66 20 23 66 29 0a 09 09 09 09 09 20 20 f #f #f)......
ce60: 20 20 20 20 28 64 62 3a 67 65 74 2d 72 75 6e 73 (db:get-runs
ce70: 2d 62 79 2d 70 61 74 74 20 64 62 20 28 64 3a 61 -by-patt db (d:a
ce80: 6c 6c 64 61 74 2d 6b 65 79 73 20 64 61 74 61 29 lldat-keys data)
ce90: 20 22 25 22 20 23 66 20 23 66 20 23 66 20 23 66 "%" #f #f #f #f
cea0: 29 29 29 0a 09 09 09 20 20 20 20 28 72 75 6e 73 ))).... (runs
ceb0: 2d 68 65 61 64 65 72 20 20 28 76 65 63 74 6f 72 -header (vector
cec0: 2d 72 65 66 20 72 75 6e 73 2d 64 61 74 20 30 29 -ref runs-dat 0)
ced0: 29 20 3b 3b 20 30 20 69 73 20 68 65 61 64 65 72 ) ;; 0 is header
cee0: 2c 20 31 20 69 73 20 6c 69 73 74 20 6f 66 20 72 , 1 is list of r
cef0: 65 63 6f 72 64 73 0a 09 09 09 20 20 20 20 28 72 ecords.... (r
cf00: 75 6e 2d 69 64 20 20 20 20 20 20 20 28 64 3a 64 un-id (d:d
cf10: 61 74 61 2d 63 75 72 72 2d 72 75 6e 2d 69 64 20 ata-curr-run-id
cf20: 64 64 61 74 61 29 29 0a 09 09 09 20 20 20 20 28 ddata)).... (
cf30: 6c 61 73 74 2d 75 70 64 61 74 65 20 20 30 29 20 last-update 0)
cf40: 3b 3b 20 66 69 78 20 6d 65 0a 09 09 09 20 20 20 ;; fix me....
cf50: 20 28 74 65 73 74 73 2d 64 61 74 20 20 20 20 28 (tests-dat (
cf60: 64 62 6f 61 72 64 3a 67 65 74 2d 74 65 73 74 73 dboard:get-tests
cf70: 2d 64 61 74 20 64 61 74 61 20 72 75 6e 2d 69 64 -dat data run-id
cf80: 20 6c 61 73 74 2d 75 70 64 61 74 65 29 29 0a 09 last-update))..
cf90: 09 09 20 20 20 20 28 74 65 73 74 73 2d 6d 69 6e .. (tests-min
cfa0: 64 61 74 20 28 64 63 6f 6d 6d 6f 6e 3a 6d 69 6e dat (dcommon:min
cfb0: 69 6d 69 7a 65 2d 74 65 73 74 2d 64 61 74 61 20 imize-test-data
cfc0: 74 65 73 74 73 2d 64 61 74 29 29 0a 09 09 09 20 tests-dat))....
cfd0: 20 20 20 28 69 6e 64 69 63 65 73 20 20 20 20 20 (indices
cfe0: 20 28 63 6f 6d 6d 6f 6e 3a 73 70 61 72 73 65 2d (common:sparse-
cff0: 6c 69 73 74 2d 67 65 6e 65 72 61 74 65 2d 69 6e list-generate-in
d000: 64 65 78 20 74 65 73 74 73 2d 6d 69 6e 64 61 74 dex tests-mindat
d010: 29 29 20 3b 3b 20 20 70 72 6f 63 3a 20 73 65 74 )) ;; proc: set
d020: 2d 63 65 6c 6c 29 29 0a 09 09 09 20 20 20 20 28 -cell)).... (
d030: 72 6f 77 2d 69 6e 64 69 63 65 73 20 20 28 63 61 row-indices (ca
d040: 64 72 20 69 6e 64 69 63 65 73 29 29 0a 09 09 09 dr indices))....
d050: 20 20 20 20 28 63 6f 6c 2d 69 6e 64 69 63 65 73 (col-indices
d060: 20 20 28 63 61 72 20 69 6e 64 69 63 65 73 29 29 (car indices))
d070: 0a 09 09 09 20 20 20 20 28 6d 61 78 2d 72 6f 77 .... (max-row
d080: 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f (if (null?
d090: 20 72 6f 77 2d 69 6e 64 69 63 65 73 29 20 31 20 row-indices) 1
d0a0: 28 63 6f 6d 6d 6f 6e 3a 6d 61 78 20 28 6d 61 70 (common:max (map
d0b0: 20 63 61 64 72 20 72 6f 77 2d 69 6e 64 69 63 65 cadr row-indice
d0c0: 73 29 29 29 29 0a 09 09 09 20 20 20 20 28 6d 61 s)))).... (ma
d0d0: 78 2d 63 6f 6c 20 20 20 20 20 20 28 69 66 20 28 x-col (if (
d0e0: 6e 75 6c 6c 3f 20 63 6f 6c 2d 69 6e 64 69 63 65 null? col-indice
d0f0: 73 29 20 31 20 28 63 6f 6d 6d 6f 6e 3a 6d 61 78 s) 1 (common:max
d100: 20 28 6d 61 70 20 63 61 64 72 20 63 6f 6c 2d 69 (map cadr col-i
d110: 6e 64 69 63 65 73 29 29 29 29 0a 09 09 09 20 20 ndices))))....
d120: 20 20 28 6d 61 78 2d 76 69 73 69 62 6c 65 20 20 (max-visible
d130: 28 6d 61 78 20 28 2d 20 28 64 3a 61 6c 6c 64 61 (max (- (d:allda
d140: 74 2d 6e 75 6d 2d 74 65 73 74 73 20 64 61 74 61 t-num-tests data
d150: 29 20 31 35 29 20 33 29 29 20 3b 3b 20 28 64 3a ) 15) 3)) ;; (d:
d160: 61 6c 6c 64 61 74 2d 6e 75 6d 2d 74 65 73 74 73 alldat-num-tests
d170: 20 64 61 74 61 29 20 69 73 20 70 72 6f 70 6f 72 data) is propor
d180: 74 69 6f 6e 61 6c 20 74 6f 20 74 68 65 20 73 69 tional to the si
d190: 7a 65 20 6f 66 20 74 68 65 20 77 69 6e 64 6f 77 ze of the window
d1a0: 0a 09 09 09 20 20 20 20 28 6e 75 6d 72 6f 77 73 .... (numrows
d1b0: 20 20 20 20 20 20 31 29 0a 09 09 09 20 20 20 20 1)....
d1c0: 28 6e 75 6d 63 6f 6c 73 20 20 20 20 20 20 31 29 (numcols 1)
d1d0: 0a 09 09 09 20 20 20 20 28 63 68 61 6e 67 65 64 .... (changed
d1e0: 20 20 20 20 20 20 23 66 29 0a 09 09 09 20 20 20 #f)....
d1f0: 20 28 72 75 6e 73 2d 68 61 73 68 20 20 20 20 28 (runs-hash (
d200: 6c 65 74 20 28 28 68 74 20 28 6d 61 6b 65 2d 68 let ((ht (make-h
d210: 61 73 68 2d 74 61 62 6c 65 29 29 29 0a 09 09 09 ash-table)))....
d220: 09 09 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 .. (for-each
d230: 28 6c 61 6d 62 64 61 20 28 72 75 6e 29 0a 09 09 (lambda (run)...
d240: 09 09 09 09 09 28 68 61 73 68 2d 74 61 62 6c 65 .....(hash-table
d250: 2d 73 65 74 21 20 68 74 20 28 64 62 3a 67 65 74 -set! ht (db:get
d260: 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 -value-by-header
d270: 20 72 75 6e 20 72 75 6e 73 2d 68 65 61 64 65 72 run runs-header
d280: 20 22 69 64 22 29 20 72 75 6e 29 29 0a 09 09 09 "id") run))....
d290: 09 09 09 20 20 20 20 20 20 28 76 65 63 74 6f 72 ... (vector
d2a0: 2d 72 65 66 20 72 75 6e 73 2d 64 61 74 20 31 29 -ref runs-dat 1)
d2b0: 29 0a 09 09 09 09 09 20 20 20 20 68 74 29 29 0a )...... ht)).
d2c0: 09 09 09 20 20 20 20 28 72 75 6e 2d 69 64 73 20 ... (run-ids
d2d0: 20 20 20 20 20 28 73 6f 72 74 20 28 66 69 6c 74 (sort (filt
d2e0: 65 72 20 6e 75 6d 62 65 72 3f 20 28 68 61 73 68 er number? (hash
d2f0: 2d 74 61 62 6c 65 2d 6b 65 79 73 20 72 75 6e 73 -table-keys runs
d300: 2d 68 61 73 68 29 29 0a 09 09 09 09 09 09 28 6c -hash)).......(l
d310: 61 6d 62 64 61 20 28 61 20 62 29 0a 09 09 09 09 ambda (a b).....
d320: 09 09 20 20 28 6c 65 74 2a 20 28 28 72 65 63 6f .. (let* ((reco
d330: 72 64 2d 61 20 28 68 61 73 68 2d 74 61 62 6c 65 rd-a (hash-table
d340: 2d 72 65 66 20 72 75 6e 73 2d 68 61 73 68 20 61 -ref runs-hash a
d350: 29 29 0a 09 09 09 09 09 09 09 20 28 72 65 63 6f ))........ (reco
d360: 72 64 2d 62 20 28 68 61 73 68 2d 74 61 62 6c 65 rd-b (hash-table
d370: 2d 72 65 66 20 72 75 6e 73 2d 68 61 73 68 20 62 -ref runs-hash b
d380: 29 29 0a 09 09 09 09 09 09 09 20 28 74 69 6d 65 ))........ (time
d390: 2d 61 20 20 20 28 64 62 3a 67 65 74 2d 76 61 6c -a (db:get-val
d3a0: 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 65 63 ue-by-header rec
d3b0: 6f 72 64 2d 61 20 72 75 6e 73 2d 68 65 61 64 65 ord-a runs-heade
d3c0: 72 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 29 29 r "event_time"))
d3d0: 0a 09 09 09 09 09 09 09 20 28 74 69 6d 65 2d 62 ........ (time-b
d3e0: 20 20 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 (db:get-value
d3f0: 2d 62 79 2d 68 65 61 64 65 72 20 72 65 63 6f 72 -by-header recor
d400: 64 2d 62 20 72 75 6e 73 2d 68 65 61 64 65 72 20 d-b runs-header
d410: 22 65 76 65 6e 74 5f 74 69 6d 65 22 29 29 29 0a "event_time"))).
d420: 09 09 09 09 09 09 20 20 20 20 28 3c 20 74 69 6d ...... (< tim
d430: 65 2d 61 20 74 69 6d 65 2d 62 29 29 29 29 29 29 e-a time-b))))))
d440: 0a 09 09 20 20 20 20 20 20 20 0a 09 09 20 20 20 ... ...
d450: 20 20 20 20 3b 3b 20 28 69 75 70 3a 61 74 74 72 ;; (iup:attr
d460: 69 62 75 74 65 2d 73 65 74 21 20 74 62 20 22 56 ibute-set! tb "V
d470: 41 4c 55 45 22 20 22 30 22 29 0a 09 09 20 20 20 ALUE" "0")...
d480: 20 20 20 20 3b 3b 20 28 69 75 70 3a 61 74 74 72 ;; (iup:attr
d490: 69 62 75 74 65 2d 73 65 74 21 20 74 62 20 22 4e ibute-set! tb "N
d4a0: 41 4d 45 22 20 22 52 75 6e 73 22 29 0a 09 09 20 AME" "Runs")...
d4b0: 20 20 20 20 20 20 3b 3b 20 55 70 64 61 74 65 20 ;; Update
d4c0: 74 68 65 20 72 75 6e 73 20 74 72 65 65 0a 09 09 the runs tree...
d4d0: 20 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 (for-each
d4e0: 20 28 6c 61 6d 62 64 61 20 28 72 75 6e 2d 69 64 (lambda (run-id
d4f0: 29 0a 09 09 09 09 20 20 20 28 6c 65 74 2a 20 28 )..... (let* (
d500: 28 72 75 6e 2d 72 65 63 6f 72 64 20 28 68 61 73 (run-record (has
d510: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
d520: 75 6c 74 20 72 75 6e 73 2d 68 61 73 68 20 72 75 ult runs-hash ru
d530: 6e 2d 69 64 20 23 66 29 29 0a 09 09 09 09 09 20 n-id #f))......
d540: 20 28 6b 65 79 2d 76 61 6c 73 20 20 20 28 6d 61 (key-vals (ma
d550: 70 20 28 6c 61 6d 62 64 61 20 28 6b 65 79 29 28 p (lambda (key)(
d560: 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d db:get-value-by-
d570: 68 65 61 64 65 72 20 72 75 6e 2d 72 65 63 6f 72 header run-recor
d580: 64 20 72 75 6e 73 2d 68 65 61 64 65 72 20 6b 65 d runs-header ke
d590: 79 29 29 0a 09 09 09 09 09 09 09 20 20 20 28 64 y))........ (d
d5a0: 3a 61 6c 6c 64 61 74 2d 6b 65 79 73 20 64 61 74 :alldat-keys dat
d5b0: 61 29 29 29 0a 09 09 09 09 09 20 20 28 72 75 6e a)))...... (run
d5c0: 2d 6e 61 6d 65 20 20 20 28 64 62 3a 67 65 74 2d -name (db:get-
d5d0: 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 value-by-header
d5e0: 72 75 6e 2d 72 65 63 6f 72 64 20 72 75 6e 73 2d run-record runs-
d5f0: 68 65 61 64 65 72 20 22 72 75 6e 6e 61 6d 65 22 header "runname"
d600: 29 29 0a 09 09 09 09 09 20 20 28 63 6f 6c 2d 6e ))...... (col-n
d610: 61 6d 65 20 20 20 28 63 6f 6e 63 20 28 73 74 72 ame (conc (str
d620: 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 ing-intersperse
d630: 6b 65 79 2d 76 61 6c 73 20 22 5c 6e 22 29 20 22 key-vals "\n") "
d640: 5c 6e 22 20 72 75 6e 2d 6e 61 6d 65 29 29 0a 09 \n" run-name))..
d650: 09 09 09 09 20 20 28 72 75 6e 2d 70 61 74 68 20 .... (run-path
d660: 20 20 28 61 70 70 65 6e 64 20 6b 65 79 2d 76 61 (append key-va
d670: 6c 73 20 28 6c 69 73 74 20 72 75 6e 2d 6e 61 6d ls (list run-nam
d680: 65 29 29 29 0a 09 09 09 09 09 20 20 28 65 78 69 e)))...... (exi
d690: 73 74 69 6e 67 20 20 20 28 74 72 65 65 3a 66 69 sting (tree:fi
d6a0: 6e 64 2d 6e 6f 64 65 20 74 62 20 72 75 6e 2d 70 nd-node tb run-p
d6b0: 61 74 68 29 29 29 0a 09 09 09 09 20 20 20 20 20 ath))).....
d6c0: 28 69 66 20 28 6e 6f 74 20 28 68 61 73 68 2d 74 (if (not (hash-t
d6d0: 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 able-ref/default
d6e0: 20 28 64 3a 64 61 74 61 2d 70 61 74 68 2d 72 75 (d:data-path-ru
d6f0: 6e 2d 69 64 73 20 64 64 61 74 61 29 20 72 75 6e n-ids ddata) run
d700: 2d 70 61 74 68 20 23 66 29 29 0a 09 09 09 09 09 -path #f))......
d710: 20 28 62 65 67 69 6e 0a 09 09 09 09 09 20 20 20 (begin......
d720: 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 (hash-table-set!
d730: 20 28 64 3a 64 61 74 61 2d 72 75 6e 2d 6b 65 79 (d:data-run-key
d740: 73 20 64 64 61 74 61 29 20 72 75 6e 2d 69 64 20 s ddata) run-id
d750: 72 75 6e 2d 70 61 74 68 29 0a 09 09 09 09 09 20 run-path)......
d760: 20 20 3b 3b 20 28 69 75 70 3a 61 74 74 72 69 62 ;; (iup:attrib
d770: 75 74 65 2d 73 65 74 21 20 28 64 62 6f 61 72 64 ute-set! (dboard
d780: 3a 64 61 74 61 2d 67 65 74 2d 72 75 6e 73 2d 6d :data-get-runs-m
d790: 61 74 72 69 78 20 2a 64 61 74 61 2a 29 0a 09 09 atrix *data*)...
d7a0: 09 09 09 20 20 20 3b 3b 20 20 20 20 09 09 20 28 ... ;; .. (
d7b0: 63 6f 6e 63 20 72 6f 77 6e 75 6d 20 22 3a 22 20 conc rownum ":"
d7c0: 63 6f 6c 6e 75 6d 29 20 63 6f 6c 2d 6e 61 6d 65 colnum) col-name
d7d0: 29 0a 09 09 09 09 09 20 20 20 3b 3b 20 28 68 61 )...... ;; (ha
d7e0: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 72 75 sh-table-set! ru
d7f0: 6e 69 64 2d 74 6f 2d 63 6f 6c 20 72 75 6e 2d 69 nid-to-col run-i
d800: 64 20 28 6c 69 73 74 20 63 6f 6c 6e 75 6d 20 72 d (list colnum r
d810: 75 6e 2d 72 65 63 6f 72 64 29 29 0a 09 09 09 09 un-record)).....
d820: 09 20 20 20 3b 3b 20 48 65 72 65 20 77 65 20 75 . ;; Here we u
d830: 70 64 61 74 65 20 74 68 65 20 74 65 73 74 73 20 pdate the tests
d840: 74 72 65 65 62 6f 78 20 61 6e 64 20 74 72 65 65 treebox and tree
d850: 20 6b 65 79 73 0a 09 09 09 09 09 20 20 20 28 74 keys...... (t
d860: 72 65 65 3a 61 64 64 2d 6e 6f 64 65 20 74 62 20 ree:add-node tb
d870: 22 52 75 6e 73 22 20 72 75 6e 2d 70 61 74 68 20 "Runs" run-path
d880: 3b 3b 20 28 61 70 70 65 6e 64 20 6b 65 79 2d 76 ;; (append key-v
d890: 61 6c 73 20 28 6c 69 73 74 20 72 75 6e 2d 6e 61 als (list run-na
d8a0: 6d 65 29 29 0a 09 09 09 09 09 09 09 20 20 75 73 me))........ us
d8b0: 65 72 64 61 74 61 3a 20 28 63 6f 6e 63 20 22 72 erdata: (conc "r
d8c0: 75 6e 2d 69 64 3a 20 22 20 72 75 6e 2d 69 64 29 un-id: " run-id)
d8d0: 29 0a 09 09 09 09 09 20 20 20 28 68 61 73 68 2d )...... (hash-
d8e0: 74 61 62 6c 65 2d 73 65 74 21 20 28 64 3a 64 61 table-set! (d:da
d8f0: 74 61 2d 70 61 74 68 2d 72 75 6e 2d 69 64 73 20 ta-path-run-ids
d900: 64 64 61 74 61 29 20 72 75 6e 2d 70 61 74 68 20 ddata) run-path
d910: 72 75 6e 2d 69 64 29 0a 09 09 09 09 09 20 20 20 run-id)......
d920: 3b 3b 20 28 73 65 74 21 20 63 6f 6c 6e 75 6d 20 ;; (set! colnum
d930: 28 2b 20 63 6f 6c 6e 75 6d 20 31 29 29 0a 09 09 (+ colnum 1))...
d940: 09 09 09 20 20 20 29 29 29 29 0a 09 09 09 09 20 ... )))).....
d950: 72 75 6e 2d 69 64 73 29 0a 09 09 20 20 20 20 20 run-ids)...
d960: 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 (iup:attribute
d970: 2d 73 65 74 21 20 72 75 6e 2d 6d 61 74 72 69 78 -set! run-matrix
d980: 20 22 43 4c 45 41 52 56 41 4c 55 45 22 20 22 41 "CLEARVALUE" "A
d990: 4c 4c 22 29 20 3b 3b 20 4e 4f 54 45 3a 20 57 61 LL") ;; NOTE: Wa
d9a0: 73 20 43 4f 4e 54 45 4e 54 53 0a 09 09 20 20 20 s CONTENTS...
d9b0: 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 (iup:attribu
d9c0: 74 65 2d 73 65 74 21 20 72 75 6e 2d 6d 61 74 72 te-set! run-matr
d9d0: 69 78 20 22 43 4c 45 41 52 41 54 54 52 49 42 22 ix "CLEARATTRIB"
d9e0: 20 22 43 4f 4e 54 45 4e 54 53 22 29 0a 09 09 20 "CONTENTS")...
d9f0: 20 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 (iup:attri
da00: 62 75 74 65 2d 73 65 74 21 20 72 75 6e 2d 6d 61 bute-set! run-ma
da10: 74 72 69 78 20 22 52 45 53 49 5a 45 4d 41 54 52 trix "RESIZEMATR
da20: 49 58 22 20 22 59 45 53 22 29 0a 09 09 20 20 20 IX" "YES")...
da30: 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 (iup:attribu
da40: 74 65 2d 73 65 74 21 20 72 75 6e 2d 6d 61 74 72 te-set! run-matr
da50: 69 78 20 22 4e 55 4d 43 4f 4c 22 20 6d 61 78 2d ix "NUMCOL" max-
da60: 63 6f 6c 20 29 0a 09 09 20 20 20 20 20 20 20 28 col )... (
da70: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se
da80: 74 21 20 72 75 6e 2d 6d 61 74 72 69 78 20 22 4e t! run-matrix "N
da90: 55 4d 4c 49 4e 22 20 28 69 66 20 28 3c 20 6d 61 UMLIN" (if (< ma
daa0: 78 2d 72 6f 77 20 6d 61 78 2d 76 69 73 69 62 6c x-row max-visibl
dab0: 65 29 20 6d 61 78 2d 76 69 73 69 62 6c 65 20 6d e) max-visible m
dac0: 61 78 2d 72 6f 77 29 29 20 3b 3b 20 6d 69 6e 20 ax-row)) ;; min
dad0: 6f 66 20 32 30 0a 09 09 20 20 20 20 20 20 20 3b of 20... ;
dae0: 3b 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 ; (iup:attribute
daf0: 2d 73 65 74 21 20 72 75 6e 2d 6d 61 74 72 69 78 -set! run-matrix
db00: 20 22 4e 55 4d 43 4f 4c 5f 56 49 53 49 42 4c 45 "NUMCOL_VISIBLE
db10: 22 20 6d 61 78 2d 63 6f 6c 29 0a 09 09 20 20 20 " max-col)...
db20: 20 20 20 20 3b 3b 20 28 69 75 70 3a 61 74 74 72 ;; (iup:attr
db30: 69 62 75 74 65 2d 73 65 74 21 20 72 75 6e 2d 6d ibute-set! run-m
db40: 61 74 72 69 78 20 22 4e 55 4d 4c 49 4e 5f 56 49 atrix "NUMLIN_VI
db50: 53 49 42 4c 45 22 20 28 69 66 20 28 3e 20 6d 61 SIBLE" (if (> ma
db60: 78 2d 72 6f 77 20 6d 61 78 2d 76 69 73 69 62 6c x-row max-visibl
db70: 65 29 20 6d 61 78 2d 76 69 73 69 62 6c 65 20 6d e) max-visible m
db80: 61 78 2d 72 6f 77 29 29 0a 09 09 20 20 20 20 20 ax-row))...
db90: 20 20 0a 09 09 20 20 20 20 20 20 20 3b 3b 20 52 ... ;; R
dba0: 6f 77 20 6c 61 62 65 6c 73 0a 09 09 20 20 20 20 ow labels...
dbb0: 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 (for-each (la
dbc0: 6d 62 64 61 20 28 69 6e 64 29 0a 09 09 09 09 20 mbda (ind).....
dbd0: 20 20 28 6c 65 74 2a 20 28 28 6e 61 6d 65 20 28 (let* ((name (
dbe0: 63 61 72 20 69 6e 64 29 29 0a 09 09 09 09 09 20 car ind))......
dbf0: 20 28 6e 75 6d 20 20 28 63 61 64 72 20 69 6e 64 (num (cadr ind
dc00: 29 29 0a 09 09 09 09 09 20 20 28 6b 65 79 20 20 ))...... (key
dc10: 28 63 6f 6e 63 20 6e 75 6d 20 22 3a 30 22 29 29 (conc num ":0"))
dc20: 29 0a 09 09 09 09 20 20 20 20 20 28 69 66 20 28 )..... (if (
dc30: 6e 6f 74 20 28 65 71 75 61 6c 3f 20 28 69 75 70 not (equal? (iup
dc40: 3a 61 74 74 72 69 62 75 74 65 20 72 75 6e 2d 6d :attribute run-m
dc50: 61 74 72 69 78 20 6b 65 79 29 20 6e 61 6d 65 29 atrix key) name)
dc60: 29 0a 09 09 09 09 09 20 28 62 65 67 69 6e 0a 09 )...... (begin..
dc70: 09 09 09 09 20 20 20 28 73 65 74 21 20 63 68 61 .... (set! cha
dc80: 6e 67 65 64 20 23 74 29 0a 09 09 09 09 09 20 20 nged #t)......
dc90: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d (iup:attribute-
dca0: 73 65 74 21 20 72 75 6e 2d 6d 61 74 72 69 78 20 set! run-matrix
dcb0: 6b 65 79 20 6e 61 6d 65 29 29 29 29 29 0a 09 09 key name)))))...
dcc0: 09 09 20 72 6f 77 2d 69 6e 64 69 63 65 73 29 0a .. row-indices).
dcd0: 09 09 20 20 20 20 20 20 20 0a 09 09 20 20 20 20 .. ...
dce0: 20 20 20 3b 3b 20 43 65 6c 6c 20 63 6f 6e 74 65 ;; Cell conte
dcf0: 6e 74 73 0a 09 09 20 20 20 20 20 20 20 28 66 6f nts... (fo
dd00: 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 r-each (lambda (
dd10: 65 6e 74 72 79 29 0a 09 09 09 09 20 20 20 28 6c entry)..... (l
dd20: 65 74 2a 20 28 28 72 6f 77 2d 6e 61 6d 65 20 20 et* ((row-name
dd30: 28 63 61 64 72 20 65 6e 74 72 79 29 29 0a 09 09 (cadr entry))...
dd40: 09 09 09 20 20 28 63 6f 6c 2d 6e 61 6d 65 20 20 ... (col-name
dd50: 28 63 61 72 20 65 6e 74 72 79 29 29 0a 09 09 09 (car entry))....
dd60: 09 09 20 20 28 76 61 6c 75 65 64 61 74 20 20 28 .. (valuedat (
dd70: 63 61 64 64 72 20 65 6e 74 72 79 29 29 0a 09 09 caddr entry))...
dd80: 09 09 09 20 20 28 74 65 73 74 2d 69 64 20 20 20 ... (test-id
dd90: 28 6c 69 73 74 2d 72 65 66 20 76 61 6c 75 65 64 (list-ref valued
dda0: 61 74 20 30 29 29 0a 09 09 09 09 09 20 20 28 74 at 0))...... (t
ddb0: 65 73 74 2d 6e 61 6d 65 20 72 6f 77 2d 6e 61 6d est-name row-nam
ddc0: 65 29 20 3b 3b 20 28 6c 69 73 74 2d 72 65 66 20 e) ;; (list-ref
ddd0: 76 61 6c 75 65 64 61 74 20 31 29 29 0a 09 09 09 valuedat 1))....
dde0: 09 09 20 20 28 69 74 65 6d 2d 70 61 74 68 20 63 .. (item-path c
ddf0: 6f 6c 2d 6e 61 6d 65 29 20 3b 3b 20 28 6c 69 73 ol-name) ;; (lis
de00: 74 2d 72 65 66 20 76 61 6c 75 65 64 61 74 20 32 t-ref valuedat 2
de10: 29 29 0a 09 09 09 09 09 20 20 28 73 74 61 74 65 ))...... (state
de20: 20 20 20 20 20 28 6c 69 73 74 2d 72 65 66 20 76 (list-ref v
de30: 61 6c 75 65 64 61 74 20 31 29 29 0a 09 09 09 09 aluedat 1)).....
de40: 09 20 20 28 73 74 61 74 75 73 20 20 20 20 28 6c . (status (l
de50: 69 73 74 2d 72 65 66 20 76 61 6c 75 65 64 61 74 ist-ref valuedat
de60: 20 32 29 29 0a 09 09 09 09 09 20 20 28 76 61 6c 2))...... (val
de70: 75 65 20 20 20 20 20 28 67 75 74 69 6c 73 3a 67 ue (gutils:g
de80: 65 74 2d 63 6f 6c 6f 72 2d 66 6f 72 2d 73 74 61 et-color-for-sta
de90: 74 65 2d 73 74 61 74 75 73 20 73 74 61 74 65 20 te-status state
dea0: 73 74 61 74 75 73 29 29 0a 09 09 09 09 09 20 20 status))......
deb0: 28 72 6f 77 2d 6e 75 6d 20 20 20 28 63 61 64 72 (row-num (cadr
dec0: 20 28 61 73 73 6f 63 20 72 6f 77 2d 6e 61 6d 65 (assoc row-name
ded0: 20 72 6f 77 2d 69 6e 64 69 63 65 73 29 29 29 0a row-indices))).
dee0: 09 09 09 09 09 20 20 28 63 6f 6c 2d 6e 75 6d 20 ..... (col-num
def0: 20 20 28 63 61 64 72 20 28 61 73 73 6f 63 20 63 (cadr (assoc c
df00: 6f 6c 2d 6e 61 6d 65 20 63 6f 6c 2d 69 6e 64 69 ol-name col-indi
df10: 63 65 73 29 29 29 0a 09 09 09 09 09 20 20 28 6b ces)))...... (k
df20: 65 79 20 20 20 20 20 20 20 28 63 6f 6e 63 20 72 ey (conc r
df30: 6f 77 2d 6e 75 6d 20 22 3a 22 20 63 6f 6c 2d 6e ow-num ":" col-n
df40: 75 6d 29 29 29 0a 09 09 09 09 20 20 20 20 20 28 um)))..... (
df50: 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 hash-table-set!
df60: 63 65 6c 6c 2d 6c 6f 6f 6b 75 70 20 6b 65 79 20 cell-lookup key
df70: 74 65 73 74 2d 69 64 29 0a 09 09 09 09 20 20 20 test-id).....
df80: 20 20 28 69 66 20 28 6e 6f 74 20 28 65 71 75 61 (if (not (equa
df90: 6c 3f 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 l? (iup:attribut
dfa0: 65 20 72 75 6e 2d 6d 61 74 72 69 78 20 6b 65 79 e run-matrix key
dfb0: 29 20 28 63 61 64 72 20 76 61 6c 75 65 29 29 29 ) (cadr value)))
dfc0: 0a 09 09 09 09 09 20 28 62 65 67 69 6e 0a 09 09 ...... (begin...
dfd0: 09 09 09 20 20 20 28 73 65 74 21 20 63 68 61 6e ... (set! chan
dfe0: 67 65 64 20 23 74 29 0a 09 09 09 09 09 20 20 20 ged #t)......
dff0: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 (iup:attribute-s
e000: 65 74 21 20 72 75 6e 2d 6d 61 74 72 69 78 20 6b et! run-matrix k
e010: 65 79 20 28 63 61 64 72 20 76 61 6c 75 65 29 29 ey (cadr value))
e020: 0a 09 09 09 09 09 20 20 20 28 69 75 70 3a 61 74 ...... (iup:at
e030: 74 72 69 62 75 74 65 2d 73 65 74 21 20 72 75 6e tribute-set! run
e040: 2d 6d 61 74 72 69 78 20 28 63 6f 6e 63 20 22 42 -matrix (conc "B
e050: 47 43 4f 4c 4f 52 22 20 6b 65 79 29 20 28 63 61 GCOLOR" key) (ca
e060: 72 20 76 61 6c 75 65 29 29 29 29 29 29 0a 09 09 r value))))))...
e070: 09 09 20 74 65 73 74 73 2d 6d 69 6e 64 61 74 29 .. tests-mindat)
e080: 0a 09 09 20 20 20 20 20 20 20 0a 09 09 20 20 20 ... ...
e090: 20 20 20 20 3b 3b 20 43 6f 6c 20 6c 61 62 65 6c ;; Col label
e0a0: 73 20 2d 20 64 6f 20 61 66 74 65 72 20 73 65 74 s - do after set
e0b0: 74 69 6e 67 20 43 65 6c 6c 20 63 6f 6e 74 65 6e ting Cell conten
e0c0: 74 73 20 73 6f 20 74 68 65 79 20 61 72 65 20 61 ts so they are a
e0d0: 63 63 6f 75 6e 74 65 64 20 66 6f 72 20 69 6e 20 ccounted for in
e0e0: 74 68 65 20 73 69 7a 65 20 63 61 6c 63 2e 0a 0a the size calc...
e0f0: 09 09 20 20 20 20 20 20 20 28 66 6f 72 2d 65 61 .. (for-ea
e100: 63 68 20 28 6c 61 6d 62 64 61 20 28 69 6e 64 29 ch (lambda (ind)
e110: 0a 09 09 09 09 20 20 20 28 6c 65 74 2a 20 28 28 ..... (let* ((
e120: 6e 61 6d 65 20 28 63 61 72 20 69 6e 64 29 29 0a name (car ind)).
e130: 09 09 09 09 09 20 20 28 6e 75 6d 20 20 28 63 61 ..... (num (ca
e140: 64 72 20 69 6e 64 29 29 0a 09 09 09 09 09 20 20 dr ind))......
e150: 28 6b 65 79 20 20 28 63 6f 6e 63 20 22 30 3a 22 (key (conc "0:"
e160: 20 6e 75 6d 29 29 29 0a 09 09 09 09 20 20 20 20 num))).....
e170: 20 28 69 66 20 28 6e 6f 74 20 28 65 71 75 61 6c (if (not (equal
e180: 3f 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 ? (iup:attribute
e190: 20 72 75 6e 2d 6d 61 74 72 69 78 20 6b 65 79 29 run-matrix key)
e1a0: 20 6e 61 6d 65 29 29 0a 09 09 09 09 09 20 28 62 name))...... (b
e1b0: 65 67 69 6e 0a 09 09 09 09 09 20 20 20 28 73 65 egin...... (se
e1c0: 74 21 20 63 68 61 6e 67 65 64 20 23 74 29 0a 09 t! changed #t)..
e1d0: 09 09 09 09 20 20 20 28 69 75 70 3a 61 74 74 72 .... (iup:attr
e1e0: 69 62 75 74 65 2d 73 65 74 21 20 72 75 6e 2d 6d ibute-set! run-m
e1f0: 61 74 72 69 78 20 6b 65 79 20 6e 61 6d 65 29 0a atrix key name).
e200: 09 09 09 09 09 20 20 20 28 69 75 70 3a 61 74 74 ..... (iup:att
e210: 72 69 62 75 74 65 2d 73 65 74 21 20 72 75 6e 2d ribute-set! run-
e220: 6d 61 74 72 69 78 20 22 46 49 54 54 4f 54 45 58 matrix "FITTOTEX
e230: 54 22 20 28 63 6f 6e 63 20 22 43 22 20 6e 75 6d T" (conc "C" num
e240: 29 29 29 29 29 29 0a 09 09 09 09 20 63 6f 6c 2d ))))))..... col-
e250: 69 6e 64 69 63 65 73 29 0a 09 09 20 20 20 20 20 indices)...
e260: 20 20 28 69 66 20 63 68 61 6e 67 65 64 20 28 69 (if changed (i
e270: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 up:attribute-set
e280: 21 20 72 75 6e 2d 6d 61 74 72 69 78 20 22 52 45 ! run-matrix "RE
e290: 44 52 41 57 22 20 22 41 4c 4c 22 29 29 29 29 29 DRAW" "ALL")))))
e2a0: 29 0a 20 20 20 20 0a 20 20 20 20 28 73 65 74 21 ). . (set!
e2b0: 20 64 61 73 68 62 6f 61 72 64 3a 75 70 64 61 74 dashboard:updat
e2c0: 65 2d 6e 65 77 2d 76 69 65 77 2d 74 61 62 20 75 e-new-view-tab u
e2d0: 70 64 61 74 65 72 29 0a 20 20 20 20 28 64 3a 64 pdater). (d:d
e2e0: 61 74 61 2d 72 75 6e 73 2d 74 72 65 65 2d 73 65 ata-runs-tree-se
e2f0: 74 21 20 64 64 61 74 61 20 74 62 29 0a 20 20 20 t! ddata tb).
e300: 20 28 69 75 70 3a 73 70 6c 69 74 0a 20 20 20 20 (iup:split.
e310: 20 74 62 0a 20 20 20 20 20 72 75 6e 2d 6d 61 74 tb. run-mat
e320: 72 69 78 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d rix)))..;;======
e330: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e340: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e350: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e360: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e370: 0a 3b 3b 20 52 20 55 20 4e 20 53 20 0a 3b 3b 3d .;; R U N S .;;=
e380: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e390: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e3a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e3b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e3c0: 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 =====..(define (
e3d0: 64 62 6f 61 72 64 3a 6d 61 6b 65 2d 63 6f 6e 74 dboard:make-cont
e3e0: 72 6f 6c 73 20 64 61 74 61 29 0a 09 20 20 28 69 rols data).. (i
e3f0: 75 70 3a 68 62 6f 78 0a 09 20 20 20 28 69 75 70 up:hbox.. (iup
e400: 3a 76 62 6f 78 0a 09 20 20 20 20 28 69 75 70 3a :vbox.. (iup:
e410: 66 72 61 6d 65 20 0a 09 20 20 20 20 20 23 3a 74 frame .. #:t
e420: 69 74 6c 65 20 22 66 69 6c 74 65 72 20 74 65 73 itle "filter tes
e430: 74 20 61 6e 64 20 69 74 65 6d 73 22 0a 09 20 20 t and items"..
e440: 20 20 20 28 69 75 70 3a 68 62 6f 78 0a 09 20 20 (iup:hbox..
e450: 20 20 20 20 28 69 75 70 3a 76 62 6f 78 0a 09 20 (iup:vbox..
e460: 20 20 20 20 20 20 28 69 75 70 3a 74 65 78 74 62 (iup:textb
e470: 6f 78 20 23 3a 73 69 7a 65 20 22 31 32 30 78 31 ox #:size "120x1
e480: 35 22 20 23 3a 66 6f 6e 74 73 69 7a 65 20 22 31 5" #:fontsize "1
e490: 30 22 20 23 3a 76 61 6c 75 65 20 22 25 22 0a 09 0" #:value "%"..
e4a0: 09 09 20 20 20 20 23 3a 61 63 74 69 6f 6e 20 28 .. #:action (
e4b0: 6c 61 6d 62 64 61 20 28 6f 62 6a 20 75 6e 6b 20 lambda (obj unk
e4c0: 76 61 6c 29 0a 09 09 09 09 20 20 20 20 20 20 20 val).....
e4d0: 28 6d 61 72 6b 2d 66 6f 72 2d 75 70 64 61 74 65 (mark-for-update
e4e0: 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 75 70 )..... (up
e4f0: 64 61 74 65 2d 73 65 61 72 63 68 20 22 74 65 73 date-search "tes
e500: 74 2d 6e 61 6d 65 22 20 76 61 6c 29 29 29 0a 09 t-name" val)))..
e510: 20 20 20 20 20 20 20 28 69 75 70 3a 68 62 6f 78 (iup:hbox
e520: 0a 09 09 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 ...(iup:button "
e530: 51 75 69 74 22 20 20 20 20 20 20 23 3a 61 63 74 Quit" #:act
e540: 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a ion (lambda (obj
e550: 29 0a 09 09 09 09 09 09 20 20 20 3b 3b 20 28 69 )....... ;; (i
e560: 66 20 28 64 3a 61 6c 6c 64 61 74 2d 64 62 6c 6f f (d:alldat-dblo
e570: 63 61 6c 20 64 61 74 61 29 20 28 64 62 3a 63 6c cal data) (db:cl
e580: 6f 73 65 2d 61 6c 6c 20 28 64 3a 61 6c 6c 64 61 ose-all (d:allda
e590: 74 2d 64 62 6c 6f 63 61 6c 20 64 61 74 61 29 29 t-dblocal data))
e5a0: 29 0a 09 09 09 09 09 09 20 20 20 28 65 78 69 74 )....... (exit
e5b0: 29 29 29 0a 09 09 28 69 75 70 3a 62 75 74 74 6f )))...(iup:butto
e5c0: 6e 20 22 52 65 66 72 65 73 68 22 20 20 20 23 3a n "Refresh" #:
e5d0: 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 action (lambda (
e5e0: 6f 62 6a 29 0a 09 09 09 09 09 09 20 20 20 28 6d obj)....... (m
e5f0: 61 72 6b 2d 66 6f 72 2d 75 70 64 61 74 65 29 29 ark-for-update))
e600: 29 0a 09 09 28 69 75 70 3a 62 75 74 74 6f 6e 20 )...(iup:button
e610: 22 43 6f 6c 6c 61 70 73 65 22 20 20 23 3a 61 63 "Collapse" #:ac
e620: 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 tion (lambda (ob
e630: 6a 29 0a 09 09 09 09 09 09 20 20 20 28 6c 65 74 j)....... (let
e640: 20 28 28 6d 79 6e 61 6d 65 20 28 69 75 70 3a 61 ((myname (iup:a
e650: 74 74 72 69 62 75 74 65 20 6f 62 6a 20 22 54 49 ttribute obj "TI
e660: 54 4c 45 22 29 29 29 0a 09 09 09 09 09 09 20 20 TLE"))).......
e670: 20 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 6d (if (equal? m
e680: 79 6e 61 6d 65 20 22 43 6f 6c 6c 61 70 73 65 22 yname "Collapse"
e690: 29 0a 09 09 09 09 09 09 09 20 28 62 65 67 69 6e )........ (begin
e6a0: 0a 09 09 09 09 09 09 09 20 20 20 28 66 6f 72 2d ........ (for-
e6b0: 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 74 6e each (lambda (tn
e6c0: 61 6d 65 29 0a 09 09 09 09 09 09 09 09 20 20 20 ame).........
e6d0: 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (hash-table-
e6e0: 73 65 74 21 20 2a 63 6f 6c 6c 61 70 73 65 64 2a set! *collapsed*
e6f0: 20 74 6e 61 6d 65 20 23 74 29 29 0a 09 09 09 09 tname #t)).....
e700: 09 09 09 09 20 20 20 20 20 28 64 3a 61 6c 6c 64 .... (d:alld
e710: 61 74 2d 69 74 65 6d 2d 74 65 73 74 2d 6e 61 6d at-item-test-nam
e720: 65 73 20 64 61 74 61 29 29 0a 09 09 09 09 09 09 es data)).......
e730: 09 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 . (iup:attribu
e740: 74 65 2d 73 65 74 21 20 6f 62 6a 20 22 54 49 54 te-set! obj "TIT
e750: 4c 45 22 20 22 45 78 70 61 6e 64 22 29 29 0a 09 LE" "Expand"))..
e760: 09 09 09 09 09 09 20 28 62 65 67 69 6e 0a 09 09 ...... (begin...
e770: 09 09 09 09 09 20 20 20 28 66 6f 72 2d 65 61 63 ..... (for-eac
e780: 68 20 28 6c 61 6d 62 64 61 20 28 74 6e 61 6d 65 h (lambda (tname
e790: 29 0a 09 09 09 09 09 09 09 09 20 20 20 20 20 20 ).........
e7a0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 64 65 6c (hash-table-del
e7b0: 65 74 65 21 20 2a 63 6f 6c 6c 61 70 73 65 64 2a ete! *collapsed*
e7c0: 20 74 6e 61 6d 65 29 29 0a 09 09 09 09 09 09 09 tname))........
e7d0: 09 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c . (hash-tabl
e7e0: 65 2d 6b 65 79 73 20 2a 63 6f 6c 6c 61 70 73 65 e-keys *collapse
e7f0: 64 2a 29 29 0a 09 09 09 09 09 09 09 20 20 20 28 d*))........ (
e800: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se
e810: 74 21 20 6f 62 6a 20 22 54 49 54 4c 45 22 20 22 t! obj "TITLE" "
e820: 43 6f 6c 6c 61 70 73 65 22 29 29 29 29 0a 09 09 Collapse"))))...
e830: 09 09 09 09 20 20 20 28 6d 61 72 6b 2d 66 6f 72 .... (mark-for
e840: 2d 75 70 64 61 74 65 29 29 29 29 0a 09 20 20 20 -update))))..
e850: 20 20 20 20 29 0a 09 20 20 20 20 20 20 28 69 75 ).. (iu
e860: 70 3a 76 62 6f 78 0a 09 20 20 20 20 20 20 20 3b p:vbox.. ;
e870: 3b 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 53 ; (iup:button "S
e880: 6f 72 74 20 2d 74 22 20 20 20 23 3a 61 63 74 69 ort -t" #:acti
e890: 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 on (lambda (obj)
e8a0: 0a 09 20 20 20 20 20 20 20 3b 3b 20 20 20 09 09 .. ;; ..
e8b0: 09 09 20 28 6e 65 78 74 2d 73 6f 72 74 2d 6f 70 .. (next-sort-op
e8c0: 74 69 6f 6e 29 0a 09 20 20 20 20 20 20 20 3b 3b tion).. ;;
e8d0: 20 20 20 09 09 09 09 20 28 69 75 70 3a 61 74 74 .... (iup:att
e8e0: 72 69 62 75 74 65 2d 73 65 74 21 20 6f 62 6a 20 ribute-set! obj
e8f0: 22 54 49 54 4c 45 22 20 28 76 65 63 74 6f 72 2d "TITLE" (vector-
e900: 72 65 66 20 28 76 65 63 74 6f 72 2d 72 65 66 20 ref (vector-ref
e910: 2a 74 65 73 74 73 2d 73 6f 72 74 2d 6f 70 74 69 *tests-sort-opti
e920: 6f 6e 73 2a 20 2a 74 65 73 74 73 2d 73 6f 72 74 ons* *tests-sort
e930: 2d 72 65 76 65 72 73 65 2a 29 20 30 29 29 0a 09 -reverse*) 0))..
e940: 20 20 20 20 20 20 20 3b 3b 20 20 20 09 09 09 09 ;; ....
e950: 20 28 6d 61 72 6b 2d 66 6f 72 2d 75 70 64 61 74 (mark-for-updat
e960: 65 29 29 29 0a 09 20 20 20 20 20 20 20 0a 09 20 e))).. ..
e970: 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 68 69 (let* ((hi
e980: 64 65 20 23 66 29 0a 09 09 20 20 20 20 20 20 28 de #f)... (
e990: 73 68 6f 77 20 23 66 29 0a 09 09 20 20 20 20 20 show #f)...
e9a0: 20 28 68 69 64 65 2d 65 6d 70 74 79 20 23 66 29 (hide-empty #f)
e9b0: 0a 09 09 20 20 20 20 20 20 28 73 65 6c 2d 63 6f ... (sel-co
e9c0: 6c 6f 72 20 20 20 20 22 31 38 30 20 31 30 30 20 lor "180 100
e9d0: 31 30 30 22 29 0a 09 09 20 20 20 20 20 20 28 6e 100")... (n
e9e0: 6f 6e 73 65 6c 2d 63 6f 6c 6f 72 20 22 31 37 30 onsel-color "170
e9f0: 20 31 37 30 20 31 37 30 22 29 0a 09 09 20 20 20 170 170")...
ea00: 20 20 20 28 63 6d 64 73 2d 6c 69 73 74 20 27 28 (cmds-list '(
ea10: 22 2b 74 65 73 74 6e 61 6d 65 22 20 22 2d 74 65 "+testname" "-te
ea20: 73 74 6e 61 6d 65 22 20 22 2b 65 76 65 6e 74 5f stname" "+event_
ea30: 74 69 6d 65 22 20 22 2d 65 76 65 6e 74 5f 74 69 time" "-event_ti
ea40: 6d 65 22 20 22 2b 73 74 61 74 65 73 74 61 74 75 me" "+statestatu
ea50: 73 22 20 22 2d 73 74 61 74 65 73 74 61 74 75 73 s" "-statestatus
ea60: 22 29 29 0a 09 09 20 20 20 20 20 20 28 73 6f 72 "))... (sor
ea70: 74 2d 6c 62 20 20 20 20 28 69 75 70 3a 6c 69 73 t-lb (iup:lis
ea80: 74 62 6f 78 20 23 3a 65 78 70 61 6e 64 20 22 48 tbox #:expand "H
ea90: 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 09 09 09 09 ORIZONTAL"......
eaa0: 20 20 20 20 20 20 20 23 3a 64 72 6f 70 64 6f 77 #:dropdow
eab0: 6e 20 22 59 45 53 22 0a 09 09 09 09 09 20 20 20 n "YES"......
eac0: 20 20 20 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 #:action (la
ead0: 6d 62 64 61 20 28 6f 62 6a 20 76 61 6c 20 69 6e mbda (obj val in
eae0: 64 65 78 20 6c 62 73 74 61 74 65 29 0a 09 09 09 dex lbstate)....
eaf0: 09 09 09 09 20 20 28 73 65 74 21 20 2a 74 65 73 .... (set! *tes
eb00: 74 73 2d 73 6f 72 74 2d 72 65 76 65 72 73 65 2a ts-sort-reverse*
eb10: 20 69 6e 64 65 78 29 0a 09 09 09 09 09 09 09 20 index)........
eb20: 20 28 6d 61 72 6b 2d 66 6f 72 2d 75 70 64 61 74 (mark-for-updat
eb30: 65 29 29 29 29 0a 09 09 20 20 20 20 20 20 28 64 e))))... (d
eb40: 65 66 61 75 6c 74 2d 63 6d 64 20 28 63 61 72 20 efault-cmd (car
eb50: 28 6c 69 73 74 2d 72 65 66 20 2a 74 65 73 74 73 (list-ref *tests
eb60: 2d 73 6f 72 74 2d 74 79 70 65 2d 69 6e 64 65 78 -sort-type-index
eb70: 2a 20 2a 74 65 73 74 73 2d 73 6f 72 74 2d 72 65 * *tests-sort-re
eb80: 76 65 72 73 65 2a 29 29 29 29 0a 09 09 20 28 69 verse*))))... (i
eb90: 75 70 6c 69 73 74 62 6f 78 2d 66 69 6c 6c 2d 6c uplistbox-fill-l
eba0: 69 73 74 20 73 6f 72 74 2d 6c 62 20 63 6d 64 73 ist sort-lb cmds
ebb0: 2d 6c 69 73 74 20 73 65 6c 65 63 74 65 64 2d 69 -list selected-i
ebc0: 74 65 6d 3a 20 64 65 66 61 75 6c 74 2d 63 6d 64 tem: default-cmd
ebd0: 29 0a 09 09 20 0a 09 09 20 28 73 65 74 21 20 68 )... ... (set! h
ebe0: 69 64 65 2d 65 6d 70 74 79 20 28 69 75 70 3a 62 ide-empty (iup:b
ebf0: 75 74 74 6f 6e 20 22 48 69 64 65 45 6d 70 74 79 utton "HideEmpty
ec00: 22 0a 09 09 09 09 09 20 20 20 20 20 20 23 3a 65 "...... #:e
ec10: 78 70 61 6e 64 20 22 59 45 53 22 0a 09 09 09 09 xpand "YES".....
ec20: 09 20 20 20 20 20 20 23 3a 61 63 74 69 6f 6e 20 . #:action
ec30: 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 0a 09 09 (lambda (obj)...
ec40: 09 09 09 09 09 20 28 64 3a 61 6c 6c 64 61 74 2d ..... (d:alldat-
ec50: 68 69 64 65 2d 65 6d 70 74 79 2d 72 75 6e 73 2d hide-empty-runs-
ec60: 73 65 74 21 20 64 61 74 61 20 28 6e 6f 74 20 28 set! data (not (
ec70: 64 3a 61 6c 6c 64 61 74 2d 68 69 64 65 2d 65 6d d:alldat-hide-em
ec80: 70 74 79 2d 72 75 6e 73 20 64 61 74 61 29 29 29 pty-runs data)))
ec90: 0a 09 09 09 09 09 09 09 20 28 69 75 70 3a 61 74 ........ (iup:at
eca0: 74 72 69 62 75 74 65 2d 73 65 74 21 20 6f 62 6a tribute-set! obj
ecb0: 20 22 54 49 54 4c 45 22 20 28 69 66 20 28 64 3a "TITLE" (if (d:
ecc0: 61 6c 6c 64 61 74 2d 68 69 64 65 2d 65 6d 70 74 alldat-hide-empt
ecd0: 79 2d 72 75 6e 73 20 64 61 74 61 29 20 22 2b 48 y-runs data) "+H
ece0: 69 64 65 45 22 20 22 2d 48 69 64 65 45 22 29 29 ideE" "-HideE"))
ecf0: 0a 09 09 09 09 09 09 09 20 28 6d 61 72 6b 2d 66 ........ (mark-f
ed00: 6f 72 2d 75 70 64 61 74 65 29 29 29 29 0a 09 09 or-update))))...
ed10: 20 28 73 65 74 21 20 68 69 64 65 20 28 69 75 70 (set! hide (iup
ed20: 3a 62 75 74 74 6f 6e 20 22 48 69 64 65 22 0a 09 :button "Hide"..
ed30: 09 09 09 09 23 3a 65 78 70 61 6e 64 20 22 59 45 ....#:expand "YE
ed40: 53 22 0a 09 09 09 09 09 23 3a 61 63 74 69 6f 6e S"......#:action
ed50: 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 0a 09 (lambda (obj)..
ed60: 09 09 09 09 09 20 20 20 28 64 3a 61 6c 6c 64 61 ..... (d:allda
ed70: 74 2d 68 69 64 65 2d 6e 6f 74 2d 68 69 64 65 2d t-hide-not-hide-
ed80: 73 65 74 21 20 64 61 74 61 20 23 74 29 20 3b 3b set! data #t) ;;
ed90: 20 28 6e 6f 74 20 28 64 3a 61 6c 6c 64 61 74 2d (not (d:alldat-
eda0: 68 69 64 65 2d 6e 6f 74 2d 68 69 64 65 20 64 61 hide-not-hide da
edb0: 74 61 29 29 29 0a 09 09 09 09 09 09 20 20 20 3b ta)))....... ;
edc0: 3b 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 ; (iup:attribute
edd0: 2d 73 65 74 21 20 6f 62 6a 20 22 54 49 54 4c 45 -set! obj "TITLE
ede0: 22 20 28 69 66 20 28 64 3a 61 6c 6c 64 61 74 2d " (if (d:alldat-
edf0: 68 69 64 65 2d 6e 6f 74 2d 68 69 64 65 20 64 61 hide-not-hide da
ee00: 74 61 29 20 22 48 69 64 65 54 65 73 74 73 22 20 ta) "HideTests"
ee10: 22 4e 6f 74 48 69 64 65 22 29 29 0a 09 09 09 09 "NotHide")).....
ee20: 09 09 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 .. (iup:attrib
ee30: 75 74 65 2d 73 65 74 21 20 68 69 64 65 20 22 42 ute-set! hide "B
ee40: 47 43 4f 4c 4f 52 22 20 73 65 6c 2d 63 6f 6c 6f GCOLOR" sel-colo
ee50: 72 29 0a 09 09 09 09 09 09 20 20 20 28 69 75 70 r)....... (iup
ee60: 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 :attribute-set!
ee70: 73 68 6f 77 20 22 42 47 43 4f 4c 4f 52 22 20 6e show "BGCOLOR" n
ee80: 6f 6e 73 65 6c 2d 63 6f 6c 6f 72 29 0a 09 09 09 onsel-color)....
ee90: 09 09 09 20 20 20 28 6d 61 72 6b 2d 66 6f 72 2d ... (mark-for-
eea0: 75 70 64 61 74 65 29 29 29 29 0a 09 09 20 28 73 update))))... (s
eeb0: 65 74 21 20 73 68 6f 77 20 28 69 75 70 3a 62 75 et! show (iup:bu
eec0: 74 74 6f 6e 20 22 53 68 6f 77 22 0a 09 09 09 09 tton "Show".....
eed0: 09 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 0a .#:expand "YES".
eee0: 09 09 09 09 09 23 3a 61 63 74 69 6f 6e 20 28 6c .....#:action (l
eef0: 61 6d 62 64 61 20 28 6f 62 6a 29 0a 09 09 09 09 ambda (obj).....
ef00: 09 09 20 20 20 28 64 3a 61 6c 6c 64 61 74 2d 68 .. (d:alldat-h
ef10: 69 64 65 2d 6e 6f 74 2d 68 69 64 65 2d 73 65 74 ide-not-hide-set
ef20: 21 20 64 61 74 61 20 23 66 29 20 3b 3b 20 28 6e ! data #f) ;; (n
ef30: 6f 74 20 28 64 3a 61 6c 6c 64 61 74 2d 68 69 64 ot (d:alldat-hid
ef40: 65 2d 6e 6f 74 2d 68 69 64 65 20 64 61 74 61 29 e-not-hide data)
ef50: 29 29 0a 09 09 09 09 09 09 20 20 20 28 69 75 70 ))....... (iup
ef60: 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 :attribute-set!
ef70: 73 68 6f 77 20 22 42 47 43 4f 4c 4f 52 22 20 73 show "BGCOLOR" s
ef80: 65 6c 2d 63 6f 6c 6f 72 29 0a 09 09 09 09 09 09 el-color).......
ef90: 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 (iup:attribut
efa0: 65 2d 73 65 74 21 20 68 69 64 65 20 22 42 47 43 e-set! hide "BGC
efb0: 4f 4c 4f 52 22 20 6e 6f 6e 73 65 6c 2d 63 6f 6c OLOR" nonsel-col
efc0: 6f 72 29 0a 09 09 09 09 09 09 20 20 20 28 6d 61 or)....... (ma
efd0: 72 6b 2d 66 6f 72 2d 75 70 64 61 74 65 29 29 29 rk-for-update)))
efe0: 29 0a 09 09 20 28 69 75 70 3a 61 74 74 72 69 62 )... (iup:attrib
eff0: 75 74 65 2d 73 65 74 21 20 68 69 64 65 20 22 42 ute-set! hide "B
f000: 47 43 4f 4c 4f 52 22 20 73 65 6c 2d 63 6f 6c 6f GCOLOR" sel-colo
f010: 72 29 0a 09 09 20 28 69 75 70 3a 61 74 74 72 69 r)... (iup:attri
f020: 62 75 74 65 2d 73 65 74 21 20 73 68 6f 77 20 22 bute-set! show "
f030: 42 47 43 4f 4c 4f 52 22 20 6e 6f 6e 73 65 6c 2d BGCOLOR" nonsel-
f040: 63 6f 6c 6f 72 29 0a 09 09 20 3b 3b 20 28 64 3a color)... ;; (d:
f050: 61 6c 6c 64 61 74 2d 68 69 64 65 2d 6e 6f 74 2d alldat-hide-not-
f060: 68 69 64 65 2d 62 75 74 74 6f 6e 2d 73 65 74 21 hide-button-set!
f070: 20 64 61 74 61 20 68 69 64 65 69 74 29 20 3b 3b data hideit) ;;
f080: 20 6e 65 76 65 72 20 75 73 65 64 2c 20 63 61 6e never used, can
f090: 20 65 6c 69 6d 69 6e 61 74 65 20 2e 2e 2e 0a 09 eliminate .....
f0a0: 09 20 28 69 75 70 3a 76 62 6f 78 0a 09 09 20 20 . (iup:vbox...
f0b0: 28 69 75 70 3a 68 62 6f 78 20 68 69 64 65 20 73 (iup:hbox hide s
f0c0: 68 6f 77 29 0a 09 09 20 20 68 69 64 65 2d 65 6d how)... hide-em
f0d0: 70 74 79 20 73 6f 72 74 2d 6c 62 29 29 29 0a 09 pty sort-lb)))..
f0e0: 20 20 20 20 20 20 29 29 29 0a 09 20 20 20 28 69 ))).. (i
f0f0: 75 70 3a 66 72 61 6d 65 20 0a 09 20 20 20 20 23 up:frame .. #
f100: 3a 74 69 74 6c 65 20 22 73 74 61 74 65 2f 73 74 :title "state/st
f110: 61 74 75 73 20 66 69 6c 74 65 72 22 0a 09 20 20 atus filter"..
f120: 20 20 28 69 75 70 3a 76 62 6f 78 0a 09 20 20 20 (iup:vbox..
f130: 20 20 28 61 70 70 6c 79 20 0a 09 20 20 20 20 20 (apply ..
f140: 20 69 75 70 3a 68 62 6f 78 0a 09 20 20 20 20 20 iup:hbox..
f150: 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 73 (map (lambda (s
f160: 74 61 74 75 73 29 0a 09 09 20 20 20 20 20 28 69 tatus)... (i
f170: 75 70 3a 74 6f 67 67 6c 65 20 28 63 6f 6e 63 20 up:toggle (conc
f180: 73 74 61 74 75 73 20 22 20 20 22 29 0a 09 09 09 status " ")....
f190: 09 20 23 3a 61 63 74 69 6f 6e 20 20 20 28 6c 61 . #:action (la
f1a0: 6d 62 64 61 20 28 6f 62 6a 20 76 61 6c 29 0a 09 mbda (obj val)..
f1b0: 09 09 09 09 20 20 20 20 20 20 28 6d 61 72 6b 2d .... (mark-
f1c0: 66 6f 72 2d 75 70 64 61 74 65 29 0a 09 09 09 09 for-update).....
f1d0: 09 20 20 20 20 20 20 28 69 66 20 28 65 71 3f 20 . (if (eq?
f1e0: 76 61 6c 20 31 29 0a 09 09 09 09 09 09 20 20 28 val 1)....... (
f1f0: 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 hash-table-set!
f200: 28 64 3a 61 6c 6c 64 61 74 2d 73 74 61 74 75 73 (d:alldat-status
f210: 2d 69 67 6e 6f 72 65 2d 68 61 73 68 20 64 61 74 -ignore-hash dat
f220: 61 29 20 73 74 61 74 75 73 20 23 74 29 0a 09 09 a) status #t)...
f230: 09 09 09 09 20 20 28 68 61 73 68 2d 74 61 62 6c .... (hash-tabl
f240: 65 2d 64 65 6c 65 74 65 21 20 28 64 3a 61 6c 6c e-delete! (d:all
f250: 64 61 74 2d 73 74 61 74 75 73 2d 69 67 6e 6f 72 dat-status-ignor
f260: 65 2d 68 61 73 68 20 64 61 74 61 29 20 73 74 61 e-hash data) sta
f270: 74 75 73 29 29 0a 09 09 09 09 09 20 20 20 20 20 tus))......
f280: 20 28 73 65 74 2d 62 67 2d 6f 6e 2d 66 69 6c 74 (set-bg-on-filt
f290: 65 72 29 29 29 29 0a 09 09 20 20 20 28 6d 61 70 er))))... (map
f2a0: 20 63 61 64 72 20 2a 63 6f 6d 6d 6f 6e 3a 73 74 cadr *common:st
f2b0: 64 2d 73 74 61 74 75 73 65 73 2a 29 29 29 20 3b d-statuses*))) ;
f2c0: 3b 20 27 28 22 50 41 53 53 22 20 22 46 41 49 4c ; '("PASS" "FAIL
f2d0: 22 20 22 57 41 52 4e 22 20 22 43 48 45 43 4b 22 " "WARN" "CHECK"
f2e0: 20 22 57 41 49 56 45 44 22 20 22 53 54 55 43 4b "WAIVED" "STUCK
f2f0: 2f 44 45 41 44 22 20 22 6e 2f 61 22 20 22 53 4b /DEAD" "n/a" "SK
f300: 49 50 22 29 29 29 0a 09 20 20 20 20 20 28 61 70 IP"))).. (ap
f310: 70 6c 79 20 0a 09 20 20 20 20 20 20 69 75 70 3a ply .. iup:
f320: 68 62 6f 78 0a 09 20 20 20 20 20 20 28 6d 61 70 hbox.. (map
f330: 20 28 6c 61 6d 62 64 61 20 28 73 74 61 74 65 29 (lambda (state)
f340: 0a 09 09 20 20 20 20 20 28 69 75 70 3a 74 6f 67 ... (iup:tog
f350: 67 6c 65 20 28 63 6f 6e 63 20 73 74 61 74 65 20 gle (conc state
f360: 22 20 20 22 29 0a 09 09 09 09 20 23 3a 61 63 74 " ")..... #:act
f370: 69 6f 6e 20 20 20 28 6c 61 6d 62 64 61 20 28 6f ion (lambda (o
f380: 62 6a 20 76 61 6c 29 0a 09 09 09 09 09 20 20 20 bj val)......
f390: 20 20 20 28 6d 61 72 6b 2d 66 6f 72 2d 75 70 64 (mark-for-upd
f3a0: 61 74 65 29 0a 09 09 09 09 09 20 20 20 20 20 20 ate)......
f3b0: 28 69 66 20 28 65 71 3f 20 76 61 6c 20 31 29 0a (if (eq? val 1).
f3c0: 09 09 09 09 09 09 20 20 28 68 61 73 68 2d 74 61 ...... (hash-ta
f3d0: 62 6c 65 2d 73 65 74 21 20 28 64 3a 61 6c 6c 64 ble-set! (d:alld
f3e0: 61 74 2d 73 74 61 74 65 2d 69 67 6e 6f 72 65 2d at-state-ignore-
f3f0: 68 61 73 68 20 64 61 74 61 29 20 73 74 61 74 65 hash data) state
f400: 20 23 74 29 0a 09 09 09 09 09 09 20 20 28 68 61 #t)....... (ha
f410: 73 68 2d 74 61 62 6c 65 2d 64 65 6c 65 74 65 21 sh-table-delete!
f420: 20 28 64 3a 61 6c 6c 64 61 74 2d 73 74 61 74 65 (d:alldat-state
f430: 2d 69 67 6e 6f 72 65 2d 68 61 73 68 20 64 61 74 -ignore-hash dat
f440: 61 29 20 73 74 61 74 65 29 29 0a 09 09 09 09 09 a) state))......
f450: 20 20 20 20 20 20 28 73 65 74 2d 62 67 2d 6f 6e (set-bg-on
f460: 2d 66 69 6c 74 65 72 29 29 29 29 0a 09 09 20 20 -filter))))...
f470: 20 28 6d 61 70 20 63 61 64 72 20 2a 63 6f 6d 6d (map cadr *comm
f480: 6f 6e 3a 73 74 64 2d 73 74 61 74 65 73 2a 29 29 on:std-states*))
f490: 29 20 3b 3b 20 27 28 22 52 55 4e 4e 49 4e 47 22 ) ;; '("RUNNING"
f4a0: 20 22 43 4f 4d 50 4c 45 54 45 44 22 20 22 49 4e "COMPLETED" "IN
f4b0: 43 4f 4d 50 4c 45 54 45 22 20 22 4c 41 55 4e 43 COMPLETE" "LAUNC
f4c0: 48 45 44 22 20 22 4e 4f 54 5f 53 54 41 52 54 45 HED" "NOT_STARTE
f4d0: 44 22 20 22 4b 49 4c 4c 45 44 22 20 22 44 45 4c D" "KILLED" "DEL
f4e0: 45 54 45 44 22 29 29 29 0a 09 20 20 20 20 20 28 ETED"))).. (
f4f0: 69 75 70 3a 76 61 6c 75 61 74 6f 72 20 23 3a 76 iup:valuator #:v
f500: 61 6c 75 65 63 68 61 6e 67 65 64 5f 63 62 20 28 aluechanged_cb (
f510: 6c 61 6d 62 64 61 20 28 6f 62 6a 29 0a 09 09 09 lambda (obj)....
f520: 09 09 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 .. (let ((
f530: 76 61 6c 20 28 69 6e 65 78 61 63 74 2d 3e 65 78 val (inexact->ex
f540: 61 63 74 20 28 72 6f 75 6e 64 20 28 2f 20 28 73 act (round (/ (s
f550: 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 69 tring->number (i
f560: 75 70 3a 61 74 74 72 69 62 75 74 65 20 6f 62 6a up:attribute obj
f570: 20 22 56 41 4c 55 45 22 29 29 20 31 30 29 29 29 "VALUE")) 10)))
f580: 29 0a 09 09 09 09 09 09 20 20 20 20 20 28 6f 6c )....... (ol
f590: 64 6d 61 78 20 20 20 28 73 74 72 69 6e 67 2d 3e dmax (string->
f5a0: 6e 75 6d 62 65 72 20 28 69 75 70 3a 61 74 74 72 number (iup:attr
f5b0: 69 62 75 74 65 20 6f 62 6a 20 22 4d 41 58 22 29 ibute obj "MAX")
f5c0: 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 28 6d ))....... (m
f5d0: 61 78 72 75 6e 73 20 20 28 64 3a 61 6c 6c 64 61 axruns (d:allda
f5e0: 74 2d 74 6f 74 2d 72 75 6e 73 20 64 61 74 61 29 t-tot-runs data)
f5f0: 29 29 0a 09 09 09 09 09 09 20 28 64 3a 61 6c 6c ))....... (d:all
f600: 64 61 74 2d 73 74 61 72 74 2d 72 75 6e 2d 6f 66 dat-start-run-of
f610: 66 73 65 74 2d 73 65 74 21 20 64 61 74 61 20 76 fset-set! data v
f620: 61 6c 29 0a 09 09 09 09 09 09 20 28 6d 61 72 6b al)....... (mark
f630: 2d 66 6f 72 2d 75 70 64 61 74 65 29 0a 09 09 09 -for-update)....
f640: 09 09 09 20 28 64 65 62 75 67 3a 70 72 69 6e 74 ... (debug:print
f650: 20 36 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 6 *default-log-
f660: 70 6f 72 74 2a 20 22 28 64 3a 61 6c 6c 64 61 74 port* "(d:alldat
f670: 2d 73 74 61 72 74 2d 72 75 6e 2d 6f 66 66 73 65 -start-run-offse
f680: 74 20 64 61 74 61 29 20 22 20 28 64 3a 61 6c 6c t data) " (d:all
f690: 64 61 74 2d 73 74 61 72 74 2d 72 75 6e 2d 6f 66 dat-start-run-of
f6a0: 66 73 65 74 20 64 61 74 61 29 20 22 20 6d 61 78 fset data) " max
f6b0: 72 75 6e 73 3a 20 22 20 6d 61 78 72 75 6e 73 20 runs: " maxruns
f6c0: 22 2c 20 76 61 6c 3a 20 22 20 76 61 6c 20 22 20 ", val: " val "
f6d0: 6f 6c 64 6d 61 78 3a 20 22 20 6f 6c 64 6d 61 78 oldmax: " oldmax
f6e0: 29 0a 09 09 09 09 09 09 20 28 69 75 70 3a 61 74 )....... (iup:at
f6f0: 74 72 69 62 75 74 65 2d 73 65 74 21 20 6f 62 6a tribute-set! obj
f700: 20 22 4d 41 58 22 20 28 2a 20 6d 61 78 72 75 6e "MAX" (* maxrun
f710: 73 20 31 30 29 29 29 29 0a 09 09 09 20 20 20 23 s 10)))).... #
f720: 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e :expand "HORIZON
f730: 54 41 4c 22 0a 09 09 09 20 20 20 23 3a 6d 61 78 TAL".... #:max
f740: 20 28 2a 20 31 30 20 28 6c 65 6e 67 74 68 20 28 (* 10 (length (
f750: 64 3a 61 6c 6c 64 61 74 2d 61 6c 6c 72 75 6e 73 d:alldat-allruns
f760: 20 64 61 74 61 29 29 29 0a 09 09 09 20 20 20 23 data))).... #
f770: 3a 6d 69 6e 20 30 0a 09 09 09 20 20 20 23 3a 73 :min 0.... #:s
f780: 74 65 70 20 30 2e 30 31 29 29 29 0a 09 09 09 09 tep 0.01))).....
f790: 09 3b 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 69 .;(iup:button "i
f7a0: 6e 63 20 72 6f 77 73 22 20 23 3a 61 63 74 69 6f nc rows" #:actio
f7b0: 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 28 n (lambda (obj)(
f7c0: 64 3a 61 6c 6c 64 61 74 2d 6e 75 6d 2d 74 65 73 d:alldat-num-tes
f7d0: 74 73 2d 73 65 74 21 20 64 61 74 61 20 28 2b 20 ts-set! data (+
f7e0: 28 64 3a 61 6c 6c 64 61 74 2d 6e 75 6d 2d 74 65 (d:alldat-num-te
f7f0: 73 74 73 20 64 61 74 61 29 20 31 29 29 29 29 0a sts data) 1)))).
f800: 09 09 09 09 09 3b 28 69 75 70 3a 62 75 74 74 6f .....;(iup:butto
f810: 6e 20 22 64 65 63 20 72 6f 77 73 22 20 23 3a 61 n "dec rows" #:a
f820: 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f ction (lambda (o
f830: 62 6a 29 28 64 3a 61 6c 6c 64 61 74 2d 6e 75 6d bj)(d:alldat-num
f840: 2d 74 65 73 74 73 2d 73 65 74 21 20 64 61 74 61 -tests-set! data
f850: 20 28 69 66 20 28 3e 20 28 64 3a 61 6c 6c 64 61 (if (> (d:allda
f860: 74 2d 6e 75 6d 2d 74 65 73 74 73 20 64 61 74 61 t-num-tests data
f870: 29 20 30 29 28 2d 20 28 64 3a 61 6c 6c 64 61 74 ) 0)(- (d:alldat
f880: 2d 6e 75 6d 2d 74 65 73 74 73 20 64 61 74 61 29 -num-tests data)
f890: 20 31 29 20 30 29 29 29 29 0a 09 20 20 20 29 29 1) 0)))).. ))
f8a0: 0a 0a 28 64 65 66 69 6e 65 20 28 6d 61 6b 65 2d ..(define (make-
f8b0: 64 61 73 68 62 6f 61 72 64 2d 62 75 74 74 6f 6e dashboard-button
f8c0: 73 20 64 61 74 61 20 6e 72 75 6e 73 20 6e 74 65 s data nruns nte
f8d0: 73 74 73 20 6b 65 79 6e 61 6d 65 73 20 72 75 6e sts keynames run
f8e0: 73 2d 73 75 6d 2d 64 61 74 20 6e 65 77 2d 76 69 s-sum-dat new-vi
f8f0: 65 77 2d 64 61 74 29 0a 20 20 28 6c 65 74 2a 20 ew-dat). (let*
f900: 28 28 64 62 20 20 20 20 20 20 28 64 3a 61 6c 6c ((db (d:all
f910: 64 61 74 2d 64 62 6c 6f 63 61 6c 20 64 61 74 61 dat-dblocal data
f920: 29 29 0a 09 20 28 6e 6b 65 79 73 20 20 20 28 6c )).. (nkeys (l
f930: 65 6e 67 74 68 20 6b 65 79 6e 61 6d 65 73 29 29 ength keynames))
f940: 0a 09 20 28 72 75 6e 73 76 65 63 20 28 6d 61 6b .. (runsvec (mak
f950: 65 2d 76 65 63 74 6f 72 20 6e 72 75 6e 73 29 29 e-vector nruns))
f960: 0a 09 20 28 68 65 61 64 65 72 20 20 28 6d 61 6b .. (header (mak
f970: 65 2d 76 65 63 74 6f 72 20 6e 72 75 6e 73 29 29 e-vector nruns))
f980: 0a 09 20 28 6c 66 74 63 6f 6c 20 20 28 6d 61 6b .. (lftcol (mak
f990: 65 2d 76 65 63 74 6f 72 20 6e 74 65 73 74 73 29 e-vector ntests)
f9a0: 29 0a 09 20 28 6b 65 79 63 6f 6c 20 20 28 6d 61 ).. (keycol (ma
f9b0: 6b 65 2d 76 65 63 74 6f 72 20 6e 74 65 73 74 73 ke-vector ntests
f9c0: 29 29 0a 09 20 28 63 6f 6e 74 72 6f 6c 73 20 27 )).. (controls '
f9d0: 28 29 29 0a 09 20 28 6c 66 74 6c 73 74 20 20 27 ()).. (lftlst '
f9e0: 28 29 29 0a 09 20 28 68 64 72 6c 73 74 20 20 27 ()).. (hdrlst '
f9f0: 28 29 29 0a 09 20 28 62 64 79 6c 73 74 20 20 27 ()).. (bdylst '
fa00: 28 29 29 0a 09 20 28 72 65 73 75 6c 74 20 20 27 ()).. (result '
fa10: 28 29 29 0a 09 20 28 69 20 20 20 20 20 20 20 30 ()).. (i 0
fa20: 29 29 0a 20 20 20 20 3b 3b 20 63 6f 6e 74 72 6f )). ;; contro
fa30: 6c 73 20 28 61 6c 6f 6e 67 20 62 6f 74 74 6f 6d ls (along bottom
fa40: 29 0a 20 20 20 20 28 73 65 74 21 20 63 6f 6e 74 ). (set! cont
fa50: 72 6f 6c 73 20 28 64 62 6f 61 72 64 3a 6d 61 6b rols (dboard:mak
fa60: 65 2d 63 6f 6e 74 72 6f 6c 73 20 64 61 74 61 29 e-controls data)
fa70: 29 0a 20 20 20 20 0a 20 20 20 20 3b 3b 20 63 72 ). . ;; cr
fa80: 65 61 74 65 20 74 68 65 20 6c 65 66 74 20 6d 6f eate the left mo
fa90: 73 74 20 63 6f 6c 75 6d 6e 20 66 6f 72 20 74 68 st column for th
faa0: 65 20 72 75 6e 20 6b 65 79 20 6e 61 6d 65 73 20 e run key names
fab0: 61 6e 64 20 74 68 65 20 74 65 73 74 20 6e 61 6d and the test nam
fac0: 65 73 20 0a 20 20 20 20 28 73 65 74 21 20 6c 66 es . (set! lf
fad0: 74 6c 73 74 20 28 6c 69 73 74 20 28 69 75 70 3a tlst (list (iup:
fae0: 68 62 6f 78 0a 09 09 09 28 69 75 70 3a 6c 61 62 hbox....(iup:lab
faf0: 65 6c 29 20 3b 3b 20 28 69 75 70 3a 76 61 6c 75 el) ;; (iup:valu
fb00: 61 74 6f 72 29 0a 09 09 09 28 61 70 70 6c 79 20 ator)....(apply
fb10: 69 75 70 3a 76 62 6f 78 20 0a 09 09 09 20 20 20 iup:vbox ....
fb20: 20 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 (map (lambda
fb30: 20 28 78 29 09 09 0a 09 09 09 09 20 20 20 20 20 (x).......
fb40: 20 28 6c 65 74 20 28 28 72 65 73 20 28 69 75 70 (let ((res (iup
fb50: 3a 68 62 6f 78 20 23 3a 65 78 70 61 6e 64 20 22 :hbox #:expand "
fb60: 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 09 09 09 HORIZONTAL".....
fb70: 09 09 09 20 20 20 28 69 75 70 3a 6c 61 62 65 6c ... (iup:label
fb80: 20 78 20 23 3a 73 69 7a 65 20 22 78 31 35 22 20 x #:size "x15"
fb90: 23 3a 66 6f 6e 74 73 69 7a 65 20 22 31 30 22 20 #:fontsize "10"
fba0: 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f #:expand "HORIZO
fbb0: 4e 54 41 4c 22 29 0a 09 09 09 09 09 09 09 20 20 NTAL")........
fbc0: 20 28 69 75 70 3a 74 65 78 74 62 6f 78 20 23 3a (iup:textbox #:
fbd0: 73 69 7a 65 20 22 78 31 35 22 20 23 3a 66 6f 6e size "x15" #:fon
fbe0: 74 73 69 7a 65 20 22 31 30 22 20 23 3a 76 61 6c tsize "10" #:val
fbf0: 75 65 20 22 25 22 20 23 3a 65 78 70 61 6e 64 20 ue "%" #:expand
fc00: 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 09 09 "HORIZONTAL"....
fc10: 09 09 09 09 09 09 23 3a 61 63 74 69 6f 6e 20 28 ......#:action (
fc20: 6c 61 6d 62 64 61 20 28 6f 62 6a 20 75 6e 6b 20 lambda (obj unk
fc30: 76 61 6c 29 0a 09 09 09 09 09 09 09 09 09 09 20 val)...........
fc40: 20 20 28 6d 61 72 6b 2d 66 6f 72 2d 75 70 64 61 (mark-for-upda
fc50: 74 65 29 0a 09 09 09 09 09 09 09 09 09 09 20 20 te)...........
fc60: 20 28 75 70 64 61 74 65 2d 73 65 61 72 63 68 20 (update-search
fc70: 78 20 76 61 6c 29 29 29 29 29 29 0a 09 09 09 09 x val)))))).....
fc80: 09 28 73 65 74 21 20 69 20 28 2b 20 69 20 31 29 .(set! i (+ i 1)
fc90: 29 0a 09 09 09 09 09 72 65 73 29 29 0a 09 09 09 )......res))....
fca0: 09 20 20 20 20 6b 65 79 6e 61 6d 65 73 29 29 29 . keynames)))
fcb0: 29 29 0a 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 )). (let loop
fcc0: 20 28 28 74 65 73 74 6e 75 6d 20 20 30 29 0a 09 ((testnum 0)..
fcd0: 20 20 20 20 20 20 20 28 72 65 73 20 20 20 20 20 (res
fce0: 20 27 28 29 29 29 0a 20 20 20 20 20 20 28 63 6f '())). (co
fcf0: 6e 64 0a 20 20 20 20 20 20 20 28 28 3e 3d 20 74 nd. ((>= t
fd00: 65 73 74 6e 75 6d 20 6e 74 65 73 74 73 29 0a 09 estnum ntests)..
fd10: 3b 3b 20 6e 6f 77 20 6c 66 74 6c 73 74 20 77 69 ;; now lftlst wi
fd20: 6c 6c 20 62 65 20 61 6e 20 68 62 6f 78 20 77 69 ll be an hbox wi
fd30: 74 68 20 74 68 65 20 74 65 73 74 20 6b 65 79 73 th the test keys
fd40: 20 61 6e 64 20 74 68 65 20 74 65 73 74 20 6e 61 and the test na
fd50: 6d 65 20 6c 61 62 65 6c 73 0a 09 28 73 65 74 21 me labels..(set!
fd60: 20 6c 66 74 6c 73 74 20 28 61 70 70 65 6e 64 20 lftlst (append
fd70: 6c 66 74 6c 73 74 20 28 6c 69 73 74 20 28 69 75 lftlst (list (iu
fd80: 70 3a 68 62 6f 78 20 20 23 3a 65 78 70 61 6e 64 p:hbox #:expand
fd90: 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 09 "HORIZONTAL"...
fda0: 09 09 09 09 20 20 20 20 20 28 69 75 70 3a 76 61 .... (iup:va
fdb0: 6c 75 61 74 6f 72 20 23 3a 76 61 6c 75 65 63 68 luator #:valuech
fdc0: 61 6e 67 65 64 5f 63 62 20 28 6c 61 6d 62 64 61 anged_cb (lambda
fdd0: 20 28 6f 62 6a 29 0a 09 09 09 09 09 09 09 09 09 (obj)..........
fde0: 09 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 76 . (let ((v
fdf0: 61 6c 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 al (string->numb
fe00: 65 72 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 er (iup:attribut
fe10: 65 20 6f 62 6a 20 22 56 41 4c 55 45 22 29 29 29 e obj "VALUE")))
fe20: 0a 09 09 09 09 09 09 09 09 09 09 09 20 20 20 20 ............
fe30: 20 28 6f 6c 64 6d 61 78 20 20 28 73 74 72 69 6e (oldmax (strin
fe40: 67 2d 3e 6e 75 6d 62 65 72 20 28 69 75 70 3a 61 g->number (iup:a
fe50: 74 74 72 69 62 75 74 65 20 6f 62 6a 20 22 4d 41 ttribute obj "MA
fe60: 58 22 29 29 29 0a 09 09 09 09 09 09 09 09 09 09 X")))...........
fe70: 09 20 20 20 20 20 28 6e 65 77 6d 61 78 20 20 28 . (newmax (
fe80: 2a 20 31 30 20 28 6c 65 6e 67 74 68 20 2a 61 6c * 10 (length *al
fe90: 6c 74 65 73 74 6e 61 6d 65 6c 73 74 2a 29 29 29 ltestnamelst*)))
fea0: 29 0a 09 09 09 09 09 09 09 09 09 09 09 20 28 64 )............ (d
feb0: 3a 61 6c 6c 64 61 74 2d 70 6c 65 61 73 65 2d 75 :alldat-please-u
fec0: 70 64 61 74 65 2d 73 65 74 21 20 64 61 74 61 20 pdate-set! data
fed0: 23 74 29 0a 09 09 09 09 09 09 09 09 09 09 09 20 #t)............
fee0: 28 64 3a 61 6c 6c 64 61 74 2d 73 74 61 72 74 2d (d:alldat-start-
fef0: 74 65 73 74 2d 6f 66 66 73 65 74 2d 73 65 74 21 test-offset-set!
ff00: 20 2a 61 6c 6c 64 61 74 2a 20 28 69 6e 65 78 61 *alldat* (inexa
ff10: 63 74 2d 3e 65 78 61 63 74 20 28 72 6f 75 6e 64 ct->exact (round
ff20: 20 28 2f 20 76 61 6c 20 31 30 29 29 29 29 0a 09 (/ val 10))))..
ff30: 09 09 09 09 09 09 09 09 09 09 20 28 64 65 62 75 .......... (debu
ff40: 67 3a 70 72 69 6e 74 20 36 20 2a 64 65 66 61 75 g:print 6 *defau
ff50: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 28 64 lt-log-port* "(d
ff60: 3a 61 6c 6c 64 61 74 2d 73 74 61 72 74 2d 74 65 :alldat-start-te
ff70: 73 74 2d 6f 66 66 73 65 74 20 2a 61 6c 6c 64 61 st-offset *allda
ff80: 74 2a 29 20 22 20 28 64 3a 61 6c 6c 64 61 74 2d t*) " (d:alldat-
ff90: 73 74 61 72 74 2d 74 65 73 74 2d 6f 66 66 73 65 start-test-offse
ffa0: 74 20 2a 61 6c 6c 64 61 74 2a 29 20 22 20 76 61 t *alldat*) " va
ffb0: 6c 3a 20 22 20 76 61 6c 20 22 20 6e 65 77 6d 61 l: " val " newma
ffc0: 78 3a 20 22 20 6e 65 77 6d 61 78 20 22 20 6f 6c x: " newmax " ol
ffd0: 64 6d 61 78 3a 20 22 20 6f 6c 64 6d 61 78 29 0a dmax: " oldmax).
ffe0: 09 09 09 09 09 09 09 09 09 09 09 20 28 69 66 20 ........... (if
fff0: 28 3c 20 76 61 6c 20 31 30 29 0a 09 09 09 09 09 (< val 10)......
10000 09 09 09 09 09 09 20 20 20 20 20 28 69 75 70 3a ...... (iup:
10010 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 6f attribute-set! o
10020 62 6a 20 22 4d 41 58 22 20 6e 65 77 6d 61 78 29 bj "MAX" newmax)
10030 29 0a 09 09 09 09 09 09 09 09 09 09 09 20 29 29 )............ ))
10040 0a 09 09 09 09 09 09 09 09 20 20 20 23 3a 65 78 ......... #:ex
10050 70 61 6e 64 20 22 56 45 52 54 49 43 41 4c 22 20 pand "VERTICAL"
10060 0a 09 09 09 09 09 09 09 09 20 20 20 23 3a 6f 72 ......... #:or
10070 69 65 6e 74 61 74 69 6f 6e 20 22 56 45 52 54 49 ientation "VERTI
10080 43 41 4c 22 0a 09 09 09 09 09 09 09 09 20 20 20 CAL".........
10090 23 3a 6d 69 6e 20 30 0a 09 09 09 09 09 09 09 09 #:min 0.........
100a0 20 20 20 23 3a 73 74 65 70 20 30 2e 30 31 29 0a #:step 0.01).
100b0 09 09 09 09 09 09 20 20 20 20 20 28 61 70 70 6c ...... (appl
100c0 79 20 69 75 70 3a 76 62 6f 78 20 28 72 65 76 65 y iup:vbox (reve
100d0 72 73 65 20 72 65 73 29 29 29 29 29 29 29 0a 20 rse res))))))).
100e0 20 20 20 20 20 20 28 65 6c 73 65 0a 09 28 6c 65 (else..(le
100f0 74 20 28 28 6c 61 62 6c 20 20 28 69 75 70 3a 62 t ((labl (iup:b
10100 75 74 74 6f 6e 20 22 22 20 0a 09 09 09 09 20 23 utton "" ..... #
10110 3a 66 6c 61 74 20 22 59 45 53 22 20 0a 09 09 09 :flat "YES" ....
10120 09 20 23 3a 61 6c 69 67 6e 6d 65 6e 74 20 22 41 . #:alignment "A
10130 4c 45 46 54 22 0a 09 09 09 09 09 3b 20 23 3a 69 LEFT"......; #:i
10140 6d 61 67 65 20 69 6d 67 31 0a 09 09 09 09 09 3b mage img1......;
10150 20 23 3a 69 6d 70 72 65 73 73 20 69 6d 67 32 0a #:impress img2.
10160 09 09 09 09 20 23 3a 73 69 7a 65 20 22 78 31 35 .... #:size "x15
10170 22 0a 09 09 09 09 20 23 3a 65 78 70 61 6e 64 20 "..... #:expand
10180 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 09 09 "HORIZONTAL"....
10190 09 20 23 3a 66 6f 6e 74 73 69 7a 65 20 22 31 30 . #:fontsize "10
101a0 22 0a 09 09 09 09 20 23 3a 61 63 74 69 6f 6e 20 "..... #:action
101b0 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 0a 09 09 (lambda (obj)...
101c0 09 09 09 20 20 20 20 28 6d 61 72 6b 2d 66 6f 72 ... (mark-for
101d0 2d 75 70 64 61 74 65 29 0a 09 09 09 09 09 20 20 -update)......
101e0 20 20 28 74 6f 67 67 6c 65 2d 68 69 64 65 20 74 (toggle-hide t
101f0 65 73 74 6e 75 6d 29 29 29 29 29 20 3b 3b 20 28 estnum))))) ;; (
10200 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 6f 62 iup:attribute ob
10210 6a 20 22 54 49 54 4c 45 22 29 29 29 29 0a 09 20 j "TITLE"))))..
10220 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 6c 66 (vector-set! lf
10230 74 63 6f 6c 20 74 65 73 74 6e 75 6d 20 6c 61 62 tcol testnum lab
10240 6c 29 0a 09 20 20 28 6c 6f 6f 70 20 28 2b 20 74 l).. (loop (+ t
10250 65 73 74 6e 75 6d 20 31 29 28 63 6f 6e 73 20 6c estnum 1)(cons l
10260 61 62 6c 20 72 65 73 29 29 29 29 29 29 0a 20 20 abl res)))))).
10270 20 20 3b 3b 20 0a 20 20 20 20 28 6c 65 74 20 6c ;; . (let l
10280 6f 6f 70 20 28 28 72 75 6e 6e 75 6d 20 20 30 29 oop ((runnum 0)
10290 0a 09 20 20 20 20 20 20 20 28 6b 65 79 6e 75 6d .. (keynum
102a0 20 20 30 29 0a 09 20 20 20 20 20 20 20 28 6b 65 0).. (ke
102b0 79 76 65 63 20 20 28 6d 61 6b 65 2d 76 65 63 74 yvec (make-vect
102c0 6f 72 20 6e 6b 65 79 73 29 29 0a 09 20 20 20 20 or nkeys))..
102d0 20 20 20 28 72 65 73 20 20 20 20 27 28 29 29 29 (res '()))
102e0 0a 20 20 20 20 20 20 28 63 6f 6e 64 20 3b 3b 20 . (cond ;;
102f0 6e 62 2f 2f 20 6e 6f 20 65 6c 73 65 20 66 6f 72 nb// no else for
10300 20 74 68 69 73 20 61 70 70 72 6f 61 63 68 2e 0a this approach..
10310 20 20 20 20 20 20 20 28 28 3e 3d 20 72 75 6e 6e ((>= runn
10320 75 6d 20 6e 72 75 6e 73 29 20 23 66 29 0a 20 20 um nruns) #f).
10330 20 20 20 20 20 28 28 3e 3d 20 6b 65 79 6e 75 6d ((>= keynum
10340 20 6e 6b 65 79 73 29 20 0a 09 28 76 65 63 74 6f nkeys) ..(vecto
10350 72 2d 73 65 74 21 20 68 65 61 64 65 72 20 72 75 r-set! header ru
10360 6e 6e 75 6d 20 6b 65 79 76 65 63 29 0a 09 28 73 nnum keyvec)..(s
10370 65 74 21 20 68 64 72 6c 73 74 20 28 63 6f 6e 73 et! hdrlst (cons
10380 20 28 61 70 70 6c 79 20 69 75 70 3a 76 62 6f 78 (apply iup:vbox
10390 20 28 72 65 76 65 72 73 65 20 72 65 73 29 29 20 (reverse res))
103a0 68 64 72 6c 73 74 29 29 0a 09 28 6c 6f 6f 70 20 hdrlst))..(loop
103b0 28 2b 20 72 75 6e 6e 75 6d 20 31 29 20 30 20 28 (+ runnum 1) 0 (
103c0 6d 61 6b 65 2d 76 65 63 74 6f 72 20 6e 6b 65 79 make-vector nkey
103d0 73 29 20 27 28 29 29 29 0a 20 20 20 20 20 20 20 s) '())).
103e0 28 65 6c 73 65 0a 09 28 6c 65 74 20 28 28 6c 61 (else..(let ((la
103f0 62 6c 20 20 28 69 75 70 3a 6c 61 62 65 6c 20 22 bl (iup:label "
10400 22 20 23 3a 73 69 7a 65 20 22 36 30 78 31 35 22 " #:size "60x15"
10410 20 23 3a 66 6f 6e 74 73 69 7a 65 20 22 31 30 22 #:fontsize "10"
10420 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a #:expand "HORIZ
10430 4f 4e 54 41 4c 22 29 29 29 20 3b 3b 20 23 3a 65 ONTAL"))) ;; #:e
10440 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 xpand "HORIZONTA
10450 4c 22 0a 09 20 20 28 76 65 63 74 6f 72 2d 73 65 L".. (vector-se
10460 74 21 20 6b 65 79 76 65 63 20 6b 65 79 6e 75 6d t! keyvec keynum
10470 20 6c 61 62 6c 29 0a 09 20 20 28 6c 6f 6f 70 20 labl).. (loop
10480 72 75 6e 6e 75 6d 20 28 2b 20 6b 65 79 6e 75 6d runnum (+ keynum
10490 20 31 29 20 6b 65 79 76 65 63 20 28 63 6f 6e 73 1) keyvec (cons
104a0 20 6c 61 62 6c 20 72 65 73 29 29 29 29 29 29 0a labl res)))))).
104b0 20 20 20 20 3b 3b 20 42 79 20 68 65 72 65 20 74 ;; By here t
104c0 68 65 20 68 64 72 6c 73 74 20 63 6f 6e 74 61 69 he hdrlst contai
104d0 6e 73 20 61 20 6c 69 73 74 20 6f 66 20 76 62 6f ns a list of vbo
104e0 78 65 73 20 63 6f 6e 74 61 69 6e 69 6e 67 20 6e xes containing n
104f0 6b 65 79 73 20 6c 61 62 65 6c 73 0a 20 20 20 20 keys labels.
10500 28 6c 65 74 20 6c 6f 6f 70 20 28 28 72 75 6e 6e (let loop ((runn
10510 75 6d 20 20 30 29 0a 09 20 20 20 20 20 20 20 28 um 0).. (
10520 74 65 73 74 6e 75 6d 20 30 29 0a 09 20 20 20 20 testnum 0)..
10530 20 20 20 28 74 65 73 74 76 65 63 20 20 28 6d 61 (testvec (ma
10540 6b 65 2d 76 65 63 74 6f 72 20 6e 74 65 73 74 73 ke-vector ntests
10550 29 29 0a 09 20 20 20 20 20 20 20 28 72 65 73 20 )).. (res
10560 20 20 20 27 28 29 29 29 0a 20 20 20 20 20 20 28 '())). (
10570 63 6f 6e 64 0a 20 20 20 20 20 20 20 28 28 3e 3d cond. ((>=
10580 20 72 75 6e 6e 75 6d 20 6e 72 75 6e 73 29 20 23 runnum nruns) #
10590 66 29 20 3b 3b 20 20 28 76 65 63 74 6f 72 20 74 f) ;; (vector t
105a0 61 62 6c 65 68 65 61 64 65 72 20 72 75 6e 73 76 ableheader runsv
105b0 65 63 29 29 0a 20 20 20 20 20 20 20 28 28 3e 3d ec)). ((>=
105c0 20 74 65 73 74 6e 75 6d 20 6e 74 65 73 74 73 29 testnum ntests)
105d0 20 0a 09 28 76 65 63 74 6f 72 2d 73 65 74 21 20 ..(vector-set!
105e0 72 75 6e 73 76 65 63 20 72 75 6e 6e 75 6d 20 74 runsvec runnum t
105f0 65 73 74 76 65 63 29 0a 09 28 73 65 74 21 20 62 estvec)..(set! b
10600 64 79 6c 73 74 20 28 63 6f 6e 73 20 28 61 70 70 dylst (cons (app
10610 6c 79 20 69 75 70 3a 76 62 6f 78 20 28 72 65 76 ly iup:vbox (rev
10620 65 72 73 65 20 72 65 73 29 29 20 62 64 79 6c 73 erse res)) bdyls
10630 74 29 29 0a 09 28 6c 6f 6f 70 20 28 2b 20 72 75 t))..(loop (+ ru
10640 6e 6e 75 6d 20 31 29 20 30 20 28 6d 61 6b 65 2d nnum 1) 0 (make-
10650 76 65 63 74 6f 72 20 6e 74 65 73 74 73 29 20 27 vector ntests) '
10660 28 29 29 29 0a 20 20 20 20 20 20 20 28 65 6c 73 ())). (els
10670 65 0a 09 28 6c 65 74 2a 20 28 28 62 75 74 74 6f e..(let* ((butto
10680 6e 2d 6b 65 79 20 28 6d 6b 73 74 72 20 72 75 6e n-key (mkstr run
10690 6e 75 6d 20 74 65 73 74 6e 75 6d 29 29 0a 09 20 num testnum))..
106a0 20 20 20 20 20 20 28 62 75 74 6e 20 20 20 20 20 (butn
106b0 20 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 22 (iup:button ""
106c0 20 3b 3b 20 62 75 74 74 6f 6e 2d 6b 65 79 20 0a ;; button-key .
106d0 09 09 09 09 20 20 20 20 20 20 20 23 3a 73 69 7a .... #:siz
106e0 65 20 22 36 30 78 31 35 22 20 0a 09 09 09 09 20 e "60x15" .....
106f0 20 20 20 20 20 20 23 3a 65 78 70 61 6e 64 20 22 #:expand "
10700 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 09 09 09 HORIZONTAL".....
10710 20 20 20 20 20 20 20 23 3a 66 6f 6e 74 73 69 7a #:fontsiz
10720 65 20 22 31 30 22 20 0a 09 09 09 09 20 20 20 20 e "10" .....
10730 20 20 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d #:action (lam
10740 62 64 61 20 28 78 29 0a 09 09 09 09 09 09 20 20 bda (x).......
10750 28 6c 65 74 2a 20 28 28 74 6f 6f 6c 70 61 74 68 (let* ((toolpath
10760 20 28 63 61 72 20 28 61 72 67 76 29 29 29 0a 09 (car (argv)))..
10770 09 09 09 09 09 09 20 28 62 75 74 74 6e 64 61 74 ...... (buttndat
10780 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
10790 20 28 64 3a 61 6c 6c 64 61 74 2d 62 75 74 74 6f (d:alldat-butto
107a0 6e 64 61 74 20 2a 61 6c 6c 64 61 74 2a 29 20 62 ndat *alldat*) b
107b0 75 74 74 6f 6e 2d 6b 65 79 29 29 0a 09 09 09 09 utton-key)).....
107c0 09 09 09 20 28 74 65 73 74 2d 69 64 20 20 28 64 ... (test-id (d
107d0 62 3a 74 65 73 74 2d 67 65 74 2d 69 64 20 28 76 b:test-get-id (v
107e0 65 63 74 6f 72 2d 72 65 66 20 62 75 74 74 6e 64 ector-ref buttnd
107f0 61 74 20 33 29 29 29 0a 09 09 09 09 09 09 09 20 at 3)))........
10800 28 72 75 6e 2d 69 64 20 20 20 28 64 62 3a 74 65 (run-id (db:te
10810 73 74 2d 67 65 74 2d 72 75 6e 5f 69 64 20 28 76 st-get-run_id (v
10820 65 63 74 6f 72 2d 72 65 66 20 62 75 74 74 6e 64 ector-ref buttnd
10830 61 74 20 33 29 29 29 0a 09 09 09 09 09 09 09 20 at 3)))........
10840 28 63 6d 64 20 20 28 63 6f 6e 63 20 74 6f 6f 6c (cmd (conc tool
10850 70 61 74 68 20 22 20 2d 74 65 73 74 20 22 20 72 path " -test " r
10860 75 6e 2d 69 64 20 22 2c 22 20 74 65 73 74 2d 69 un-id "," test-i
10870 64 20 22 26 22 29 29 29 0a 09 09 09 09 09 3b 28 d "&")))......;(
10880 70 72 69 6e 74 20 22 4c 61 75 6e 63 68 69 6e 67 print "Launching
10890 20 22 20 63 6d 64 29 0a 09 09 09 09 09 09 20 20 " cmd).......
108a0 20 20 28 73 79 73 74 65 6d 20 63 6d 64 29 29 29 (system cmd)))
108b0 29 29 29 0a 09 20 20 28 68 61 73 68 2d 74 61 62 ))).. (hash-tab
108c0 6c 65 2d 73 65 74 21 20 28 64 3a 61 6c 6c 64 61 le-set! (d:allda
108d0 74 2d 62 75 74 74 6f 6e 64 61 74 20 2a 61 6c 6c t-buttondat *all
108e0 64 61 74 2a 29 20 62 75 74 74 6f 6e 2d 6b 65 79 dat*) button-key
108f0 20 28 76 65 63 74 6f 72 20 30 20 22 31 30 30 20 (vector 0 "100
10900 31 30 30 20 31 30 30 22 20 62 75 74 74 6f 6e 2d 100 100" button-
10910 6b 65 79 20 23 66 20 23 66 29 29 20 0a 09 20 20 key #f #f)) ..
10920 28 76 65 63 74 6f 72 2d 73 65 74 21 20 74 65 73 (vector-set! tes
10930 74 76 65 63 20 74 65 73 74 6e 75 6d 20 62 75 74 tvec testnum but
10940 6e 29 0a 09 20 20 28 6c 6f 6f 70 20 72 75 6e 6e n).. (loop runn
10950 75 6d 20 28 2b 20 74 65 73 74 6e 75 6d 20 31 29 um (+ testnum 1)
10960 20 74 65 73 74 76 65 63 20 28 63 6f 6e 73 20 62 testvec (cons b
10970 75 74 6e 20 72 65 73 29 29 29 29 29 29 0a 20 20 utn res)))))).
10980 20 20 3b 3b 20 6e 6f 77 20 61 73 73 65 6d 62 6c ;; now assembl
10990 65 20 74 68 65 20 68 64 72 6c 73 74 20 61 6e 64 e the hdrlst and
109a0 20 62 64 79 6c 73 74 20 61 6e 64 20 6b 69 63 6b bdylst and kick
109b0 20 6f 66 66 20 74 68 65 20 64 69 61 6c 6f 67 0a off the dialog.
109c0 20 20 20 20 28 69 75 70 3a 73 68 6f 77 0a 20 20 (iup:show.
109d0 20 20 20 28 69 75 70 3a 64 69 61 6c 6f 67 20 0a (iup:dialog .
109e0 20 20 20 20 20 20 23 3a 74 69 74 6c 65 20 28 63 #:title (c
109f0 6f 6e 63 20 22 4d 65 67 61 74 65 73 74 20 64 61 onc "Megatest da
10a00 73 68 62 6f 61 72 64 20 22 20 28 63 75 72 72 65 shboard " (curre
10a10 6e 74 2d 75 73 65 72 2d 6e 61 6d 65 29 20 22 3a nt-user-name) ":
10a20 22 20 2a 74 6f 70 70 61 74 68 2a 29 0a 20 20 20 " *toppath*).
10a30 20 20 20 23 3a 6d 65 6e 75 20 28 64 63 6f 6d 6d #:menu (dcomm
10a40 6f 6e 3a 6d 61 69 6e 2d 6d 65 6e 75 29 0a 20 20 on:main-menu).
10a50 20 20 20 20 28 6c 65 74 2a 20 28 28 72 75 6e 73 (let* ((runs
10a60 2d 76 69 65 77 20 28 69 75 70 3a 76 62 6f 78 0a -view (iup:vbox.
10a70 09 09 09 20 28 61 70 70 6c 79 20 69 75 70 3a 68 ... (apply iup:h
10a80 62 6f 78 20 0a 09 09 09 09 28 63 6f 6e 73 20 28 box .....(cons (
10a90 61 70 70 6c 79 20 69 75 70 3a 76 62 6f 78 20 6c apply iup:vbox l
10aa0 66 74 6c 73 74 29 0a 09 09 09 09 20 20 20 20 20 ftlst).....
10ab0 20 28 6c 69 73 74 20 0a 09 09 09 09 20 20 20 20 (list .....
10ac0 20 20 20 28 69 75 70 3a 76 62 6f 78 0a 09 09 09 (iup:vbox....
10ad0 09 09 3b 3b 20 74 68 65 20 68 65 61 64 65 72 0a ..;; the header.
10ae0 09 09 09 09 09 28 61 70 70 6c 79 20 69 75 70 3a .....(apply iup:
10af0 68 62 6f 78 20 28 72 65 76 65 72 73 65 20 68 64 hbox (reverse hd
10b00 72 6c 73 74 29 29 0a 09 09 09 09 09 28 61 70 70 rlst))......(app
10b10 6c 79 20 69 75 70 3a 68 62 6f 78 20 28 72 65 76 ly iup:hbox (rev
10b20 65 72 73 65 20 62 64 79 6c 73 74 29 29 29 29 29 erse bdylst)))))
10b30 29 0a 09 09 09 20 3b 3b 20 63 6f 6e 74 72 6f 6c ).... ;; control
10b40 73 0a 09 09 09 20 29 29 0a 09 20 20 20 20 20 3b s.... )).. ;
10b50 3b 20 28 64 61 74 61 20 28 64 3a 64 61 74 61 2d ; (data (d:data-
10b60 69 6e 69 74 20 28 6d 61 6b 65 2d 64 3a 64 61 74 init (make-d:dat
10b70 61 29 29 29 0a 09 20 20 20 20 20 28 74 61 62 73 a))).. (tabs
10b80 20 28 69 75 70 3a 74 61 62 73 0a 09 09 20 20 20 (iup:tabs...
10b90 20 23 3a 74 61 62 63 68 61 6e 67 65 70 6f 73 2d #:tabchangepos-
10ba0 63 62 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 20 cb (lambda (obj
10bb0 63 75 72 72 20 70 72 65 76 29 0a 09 09 09 09 09 curr prev)......
10bc0 28 64 3a 61 6c 6c 64 61 74 2d 70 6c 65 61 73 65 (d:alldat-please
10bd0 2d 75 70 64 61 74 65 2d 73 65 74 21 20 2a 61 6c -update-set! *al
10be0 6c 64 61 74 2a 20 23 74 29 0a 09 09 09 09 09 28 ldat* #t)......(
10bf0 64 3a 61 6c 6c 64 61 74 2d 63 75 72 72 2d 74 61 d:alldat-curr-ta
10c00 62 2d 6e 75 6d 2d 73 65 74 21 20 2a 61 6c 6c 64 b-num-set! *alld
10c10 61 74 2a 20 63 75 72 72 29 29 0a 09 09 20 20 20 at* curr))...
10c20 20 28 64 61 73 68 62 6f 61 72 64 3a 73 75 6d 6d (dashboard:summ
10c30 61 72 79 20 2a 61 6c 6c 64 61 74 2a 29 0a 09 09 ary *alldat*)...
10c40 20 20 20 20 72 75 6e 73 2d 76 69 65 77 0a 09 09 runs-view...
10c50 20 20 20 20 28 64 61 73 68 62 6f 61 72 64 3a 6f (dashboard:o
10c60 6e 65 2d 72 75 6e 20 64 62 20 20 64 61 74 61 20 ne-run db data
10c70 72 75 6e 73 2d 73 75 6d 2d 64 61 74 29 0a 09 09 runs-sum-dat)...
10c80 20 20 20 20 3b 3b 20 28 64 61 73 68 62 6f 61 72 ;; (dashboar
10c90 64 3a 6e 65 77 2d 76 69 65 77 20 64 62 20 64 61 d:new-view db da
10ca0 74 61 20 6e 65 77 2d 76 69 65 77 2d 64 61 74 29 ta new-view-dat)
10cb0 0a 09 09 20 20 20 20 28 64 61 73 68 62 6f 61 72 ... (dashboar
10cc0 64 3a 72 75 6e 2d 63 6f 6e 74 72 6f 6c 73 29 0a d:run-controls).
10cd0 09 09 20 20 20 20 29 29 29 0a 09 3b 3b 20 28 73 .. )))..;; (s
10ce0 65 74 21 20 28 69 75 70 3a 63 61 6c 6c 62 61 63 et! (iup:callbac
10cf0 6b 20 74 61 62 73 20 74 61 62 63 68 61 6e 67 65 k tabs tabchange
10d00 2d 63 62 3a 29 20 28 6c 61 6d 62 64 61 20 28 61 -cb:) (lambda (a
10d10 20 62 20 63 29 28 70 72 69 6e 74 20 22 53 57 49 b c)(print "SWI
10d20 54 43 48 45 44 20 54 4f 20 54 41 42 3a 20 22 20 TCHED TO TAB: "
10d30 61 20 22 20 22 20 62 20 22 20 22 20 63 29 29 29 a " " b " " c)))
10d40 0a 09 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 ..(iup:attribute
10d50 2d 73 65 74 21 20 74 61 62 73 20 22 54 41 42 54 -set! tabs "TABT
10d60 49 54 4c 45 30 22 20 22 53 75 6d 6d 61 72 79 22 ITLE0" "Summary"
10d70 29 0a 09 28 69 75 70 3a 61 74 74 72 69 62 75 74 )..(iup:attribut
10d80 65 2d 73 65 74 21 20 74 61 62 73 20 22 54 41 42 e-set! tabs "TAB
10d90 54 49 54 4c 45 31 22 20 22 52 75 6e 73 22 29 0a TITLE1" "Runs").
10da0 09 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d .(iup:attribute-
10db0 73 65 74 21 20 74 61 62 73 20 22 54 41 42 54 49 set! tabs "TABTI
10dc0 54 4c 45 32 22 20 22 52 75 6e 20 53 75 6d 6d 61 TLE2" "Run Summa
10dd0 72 79 22 29 0a 09 28 69 75 70 3a 61 74 74 72 69 ry")..(iup:attri
10de0 62 75 74 65 2d 73 65 74 21 20 74 61 62 73 20 22 bute-set! tabs "
10df0 54 41 42 54 49 54 4c 45 33 22 20 22 52 75 6e 20 TABTITLE3" "Run
10e00 43 6f 6e 74 72 6f 6c 22 29 0a 09 3b 3b 20 28 69 Control")..;; (i
10e10 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 up:attribute-set
10e20 21 20 74 61 62 73 20 22 54 41 42 54 49 54 4c 45 ! tabs "TABTITLE
10e30 33 22 20 22 4e 65 77 20 56 69 65 77 22 29 0a 09 3" "New View")..
10e40 3b 3b 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 ;; (iup:attribut
10e50 65 2d 73 65 74 21 20 74 61 62 73 20 22 54 41 42 e-set! tabs "TAB
10e60 54 49 54 4c 45 34 22 20 22 52 75 6e 20 43 6f 6e TITLE4" "Run Con
10e70 74 72 6f 6c 22 29 0a 09 28 69 75 70 3a 61 74 74 trol")..(iup:att
10e80 72 69 62 75 74 65 2d 73 65 74 21 20 74 61 62 73 ribute-set! tabs
10e90 20 22 42 47 43 4f 4c 4f 52 22 20 22 31 39 30 20 "BGCOLOR" "190
10ea0 31 39 30 20 31 39 30 22 29 0a 09 28 64 3a 61 6c 190 190")..(d:al
10eb0 6c 64 61 74 2d 68 69 64 65 2d 6e 6f 74 2d 68 69 ldat-hide-not-hi
10ec0 64 65 2d 74 61 62 73 2d 73 65 74 21 20 2a 61 6c de-tabs-set! *al
10ed0 6c 64 61 74 2a 20 74 61 62 73 29 0a 09 28 69 75 ldat* tabs)..(iu
10ee0 70 3a 76 62 6f 78 0a 09 20 74 61 62 73 0a 09 20 p:vbox.. tabs..
10ef0 63 6f 6e 74 72 6f 6c 73 29 29 29 29 0a 20 20 20 controls)))).
10f00 20 28 76 65 63 74 6f 72 20 6b 65 79 63 6f 6c 20 (vector keycol
10f10 6c 66 74 63 6f 6c 20 68 65 61 64 65 72 20 72 75 lftcol header ru
10f20 6e 73 76 65 63 29 29 29 0a 0a 28 69 66 20 28 6f nsvec)))..(if (o
10f30 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
10f40 22 2d 72 6f 77 73 22 29 0a 09 28 67 65 74 2d 65 "-rows")..(get-e
10f50 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 nvironment-varia
10f60 62 6c 65 20 22 44 41 53 48 42 4f 41 52 44 52 4f ble "DASHBOARDRO
10f70 57 53 22 20 29 29 0a 20 20 20 20 28 62 65 67 69 WS" )). (begi
10f80 6e 0a 20 20 20 20 20 20 28 64 3a 61 6c 6c 64 61 n. (d:allda
10f90 74 2d 6e 75 6d 2d 74 65 73 74 73 2d 73 65 74 21 t-num-tests-set!
10fa0 20 2a 61 6c 6c 64 61 74 2a 20 28 73 74 72 69 6e *alldat* (strin
10fb0 67 2d 3e 6e 75 6d 62 65 72 0a 09 09 09 09 09 20 g->number......
10fc0 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (or (args:get-ar
10fd0 67 20 22 2d 72 6f 77 73 22 29 0a 09 09 09 09 09 g "-rows")......
10fe0 20 20 20 20 20 28 67 65 74 2d 65 6e 76 69 72 6f (get-enviro
10ff0 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 nment-variable "
11000 44 41 53 48 42 4f 41 52 44 52 4f 57 53 22 29 29 DASHBOARDROWS"))
11010 29 29 0a 20 20 20 20 20 20 28 75 70 64 61 74 65 )). (update
11020 2d 72 75 6e 64 61 74 20 2a 61 6c 6c 64 61 74 2a -rundat *alldat*
11030 20 22 25 22 20 28 64 3a 61 6c 6c 64 61 74 2d 6e "%" (d:alldat-n
11040 75 6d 72 75 6e 73 20 2a 61 6c 6c 64 61 74 2a 29 umruns *alldat*)
11050 20 22 25 2f 25 22 20 27 28 29 29 29 0a 20 20 20 "%/%" '())).
11060 20 28 64 3a 61 6c 6c 64 61 74 2d 6e 75 6d 2d 74 (d:alldat-num-t
11070 65 73 74 73 2d 73 65 74 21 20 2a 61 6c 6c 64 61 ests-set! *allda
11080 74 2a 20 28 6d 69 6e 20 28 6d 61 78 20 28 75 70 t* (min (max (up
11090 64 61 74 65 2d 72 75 6e 64 61 74 20 2a 61 6c 6c date-rundat *all
110a0 64 61 74 2a 20 22 25 22 20 28 64 3a 61 6c 6c 64 dat* "%" (d:alld
110b0 61 74 2d 6e 75 6d 72 75 6e 73 20 2a 61 6c 6c 64 at-numruns *alld
110c0 61 74 2a 29 20 22 25 2f 25 22 20 27 28 29 29 20 at*) "%/%" '())
110d0 38 29 20 32 30 29 29 29 0a 0a 28 64 65 66 69 6e 8) 20)))..(defin
110e0 65 20 2a 74 69 6d 2a 20 28 69 75 70 3a 74 69 6d e *tim* (iup:tim
110f0 65 72 29 29 0a 28 64 65 66 69 6e 65 20 2a 6f 72 er)).(define *or
11100 64 2a 20 23 66 29 0a 28 69 75 70 3a 61 74 74 72 d* #f).(iup:attr
11110 69 62 75 74 65 2d 73 65 74 21 20 2a 74 69 6d 2a ibute-set! *tim*
11120 20 22 54 49 4d 45 22 20 33 30 30 29 0a 28 69 75 "TIME" 300).(iu
11130 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 p:attribute-set!
11140 20 2a 74 69 6d 2a 20 22 52 55 4e 22 20 22 59 45 *tim* "RUN" "YE
11150 53 22 29 0a 0a 3b 3b 20 4d 6f 76 65 20 74 68 69 S")..;; Move thi
11160 73 20 73 74 75 66 66 20 74 6f 20 64 62 2e 73 63 s stuff to db.sc
11170 6d 3f 20 49 27 6d 20 6e 6f 74 20 73 75 72 65 20 m? I'm not sure
11180 74 68 61 74 20 69 73 20 74 68 65 20 72 69 67 68 that is the righ
11190 74 20 74 68 69 6e 67 20 74 6f 20 64 6f 2e 2e 2e t thing to do...
111a0 0a 3b 3b 0a 28 64 3a 61 6c 6c 64 61 74 2d 6c 61 .;;.(d:alldat-la
111b0 73 74 2d 64 62 2d 75 70 64 61 74 65 2d 73 65 74 st-db-update-set
111c0 21 20 2a 61 6c 6c 64 61 74 2a 20 28 66 69 6c 65 ! *alldat* (file
111d0 2d 6d 6f 64 69 66 69 63 61 74 69 6f 6e 2d 74 69 -modification-ti
111e0 6d 65 20 28 64 3a 61 6c 6c 64 61 74 2d 64 62 66 me (d:alldat-dbf
111f0 70 61 74 68 20 2a 61 6c 6c 64 61 74 2a 29 29 29 path *alldat*)))
11200 20 3b 3b 20 28 63 6f 6e 63 20 2a 74 6f 70 70 61 ;; (conc *toppa
11210 74 68 2a 20 22 2f 64 62 2f 6d 61 69 6e 2e 64 62 th* "/db/main.db
11220 22 29 29 29 0a 28 64 65 66 69 6e 65 20 2a 6c 61 "))).(define *la
11230 73 74 2d 72 65 63 61 6c 63 2d 65 6e 64 65 64 2d st-recalc-ended-
11240 74 69 6d 65 2a 20 30 29 0a 0a 28 64 65 66 69 6e time* 0)..(defin
11250 65 20 28 64 61 73 68 62 6f 61 72 64 3a 62 65 65 e (dashboard:bee
11260 6e 2d 63 68 61 6e 67 65 64 29 0a 20 20 28 3e 20 n-changed). (>
11270 28 66 69 6c 65 2d 6d 6f 64 69 66 69 63 61 74 69 (file-modificati
11280 6f 6e 2d 74 69 6d 65 20 28 64 3a 61 6c 6c 64 61 on-time (d:allda
11290 74 2d 64 62 66 70 61 74 68 20 2a 61 6c 6c 64 61 t-dbfpath *allda
112a0 74 2a 29 29 20 28 64 3a 61 6c 6c 64 61 74 2d 6c t*)) (d:alldat-l
112b0 61 73 74 2d 64 62 2d 75 70 64 61 74 65 20 2a 61 ast-db-update *a
112c0 6c 6c 64 61 74 2a 29 29 29 0a 0a 28 64 65 66 69 lldat*)))..(defi
112d0 6e 65 20 28 64 61 73 68 62 6f 61 72 64 3a 73 65 ne (dashboard:se
112e0 74 2d 64 62 2d 75 70 64 61 74 65 2d 74 69 6d 65 t-db-update-time
112f0 29 0a 20 20 28 64 3a 61 6c 6c 64 61 74 2d 6c 61 ). (d:alldat-la
11300 73 74 2d 64 62 2d 75 70 64 61 74 65 2d 73 65 74 st-db-update-set
11310 21 20 2a 61 6c 6c 64 61 74 2a 20 28 66 69 6c 65 ! *alldat* (file
11320 2d 6d 6f 64 69 66 69 63 61 74 69 6f 6e 2d 74 69 -modification-ti
11330 6d 65 20 28 64 3a 61 6c 6c 64 61 74 2d 64 62 66 me (d:alldat-dbf
11340 70 61 74 68 20 2a 61 6c 6c 64 61 74 2a 29 29 29 path *alldat*)))
11350 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 61 73 68 )..(define (dash
11360 62 6f 61 72 64 3a 72 65 63 61 6c 63 20 6d 6f 64 board:recalc mod
11370 74 69 6d 65 20 70 6c 65 61 73 65 2d 75 70 64 61 time please-upda
11380 74 65 2d 62 75 74 74 6f 6e 73 20 6c 61 73 74 2d te-buttons last-
11390 64 62 2d 75 70 64 61 74 65 2d 74 69 6d 65 29 0a db-update-time).
113a0 20 20 28 6f 72 20 70 6c 65 61 73 65 2d 75 70 64 (or please-upd
113b0 61 74 65 2d 62 75 74 74 6f 6e 73 0a 20 20 20 20 ate-buttons.
113c0 20 20 28 61 6e 64 20 28 3e 20 28 63 75 72 72 65 (and (> (curre
113d0 6e 74 2d 6d 69 6c 6c 69 73 65 63 6f 6e 64 73 29 nt-milliseconds)
113e0 28 2b 20 2a 6c 61 73 74 2d 72 65 63 61 6c 63 2d (+ *last-recalc-
113f0 65 6e 64 65 64 2d 74 69 6d 65 2a 20 31 35 30 29 ended-time* 150)
11400 29 0a 09 20 20 20 28 3e 20 6d 6f 64 74 69 6d 65 ).. (> modtime
11410 20 6c 61 73 74 2d 64 62 2d 75 70 64 61 74 65 2d last-db-update-
11420 74 69 6d 65 29 0a 09 20 20 20 28 3e 20 28 63 75 time).. (> (cu
11430 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 28 2b rrent-seconds)(+
11440 20 6c 61 73 74 2d 64 62 2d 75 70 64 61 74 65 2d last-db-update-
11450 74 69 6d 65 20 31 29 29 29 29 29 0a 0a 28 64 65 time 1)))))..(de
11460 66 69 6e 65 20 2a 6d 6f 6e 69 74 6f 72 2d 64 62 fine *monitor-db
11470 2d 70 61 74 68 2a 20 28 63 6f 6e 63 20 28 64 3a -path* (conc (d:
11480 61 6c 6c 64 61 74 2d 64 62 64 69 72 20 2a 61 6c alldat-dbdir *al
11490 6c 64 61 74 2a 29 20 22 2f 6d 6f 6e 69 74 6f 72 ldat*) "/monitor
114a0 2e 64 62 22 29 29 0a 28 64 65 66 69 6e 65 20 2a .db")).(define *
114b0 6c 61 73 74 2d 6d 6f 6e 69 74 6f 72 2d 75 70 64 last-monitor-upd
114c0 61 74 65 2d 74 69 6d 65 2a 20 30 29 0a 0a 3b 3b ate-time* 0)..;;
114d0 20 46 6f 72 63 65 20 63 72 65 61 74 69 6f 6e 20 Force creation
114e0 6f 66 20 74 68 65 20 64 62 20 69 6e 20 63 61 73 of the db in cas
114f0 65 20 69 74 20 69 73 6e 27 74 20 61 6c 72 65 61 e it isn't alrea
11500 64 79 20 74 68 65 72 65 2e 0a 28 74 61 73 6b 73 dy there..(tasks
11510 3a 6f 70 65 6e 2d 64 62 29 0a 0a 28 64 65 66 69 :open-db)..(defi
11520 6e 65 20 28 64 61 73 68 62 6f 61 72 64 3a 67 65 ne (dashboard:ge
11530 74 2d 79 6f 75 6e 67 65 73 74 2d 72 75 6e 2d 64 t-youngest-run-d
11540 62 2d 6d 6f 64 2d 74 69 6d 65 29 0a 20 20 28 68 b-mod-time). (h
11550 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 andle-exceptions
11560 0a 20 20 20 65 78 6e 0a 20 20 20 28 62 65 67 69 . exn. (begi
11570 6e 0a 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 n. (debug:pr
11580 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c int 0 *default-l
11590 6f 67 2d 70 6f 72 74 2a 20 22 57 41 52 4e 49 4e og-port* "WARNIN
115a0 47 3a 20 65 72 72 6f 72 20 69 6e 20 61 63 63 65 G: error in acce
115b0 73 73 69 6e 67 20 64 61 74 61 62 61 73 65 73 20 ssing databases
115c0 69 6e 20 67 65 74 2d 79 6f 75 6e 67 65 73 74 2d in get-youngest-
115d0 72 75 6e 2d 64 62 2d 6d 6f 64 2d 74 69 6d 65 3a run-db-mod-time:
115e0 20 22 20 28 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 " ((condition-p
115f0 72 6f 70 65 72 74 79 2d 61 63 63 65 73 73 6f 72 roperty-accessor
11600 20 27 65 78 6e 20 27 6d 65 73 73 61 67 65 29 20 'exn 'message)
11610 65 78 6e 29 29 0a 20 20 20 20 20 28 63 75 72 72 exn)). (curr
11620 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 20 3b 3b ent-seconds)) ;;
11630 20 73 6f 6d 65 74 68 69 6e 67 20 77 65 6e 74 20 something went
11640 77 72 6f 6e 67 20 2d 20 6a 75 73 74 20 70 72 69 wrong - just pri
11650 6e 74 20 61 6e 20 65 72 72 6f 72 20 61 6e 64 20 nt an error and
11660 72 65 74 75 72 6e 20 63 75 72 72 65 6e 74 2d 73 return current-s
11670 65 63 6f 6e 64 73 0a 20 20 20 28 61 70 70 6c 79 econds. (apply
11680 20 6d 61 78 20 28 6d 61 70 20 28 6c 61 6d 62 64 max (map (lambd
11690 61 20 28 66 69 6c 65 6e 29 0a 09 09 20 20 20 20 a (filen)...
116a0 20 28 66 69 6c 65 2d 6d 6f 64 69 66 69 63 61 74 (file-modificat
116b0 69 6f 6e 2d 74 69 6d 65 20 66 69 6c 65 6e 29 29 ion-time filen))
116c0 0a 09 09 20 20 20 28 67 6c 6f 62 20 28 63 6f 6e ... (glob (con
116d0 63 20 28 64 3a 61 6c 6c 64 61 74 2d 64 62 64 69 c (d:alldat-dbdi
116e0 72 20 2a 61 6c 6c 64 61 74 2a 29 20 22 2f 2a 2e r *alldat*) "/*.
116f0 64 62 22 29 29 29 29 29 29 0a 0a 28 64 65 66 69 db"))))))..(defi
11700 6e 65 20 28 64 61 73 68 62 6f 61 72 64 3a 72 75 ne (dashboard:ru
11710 6e 2d 75 70 64 61 74 65 20 78 29 0a 20 20 28 6c n-update x). (l
11720 65 74 2a 20 28 28 6d 6f 64 74 69 6d 65 20 20 20 et* ((modtime
11730 20 20 20 20 20 20 28 64 61 73 68 62 6f 61 72 64 (dashboard
11740 3a 67 65 74 2d 79 6f 75 6e 67 65 73 74 2d 72 75 :get-youngest-ru
11750 6e 2d 64 62 2d 6d 6f 64 2d 74 69 6d 65 29 29 20 n-db-mod-time))
11760 3b 3b 20 28 66 69 6c 65 2d 6d 6f 64 69 66 69 63 ;; (file-modific
11770 61 74 69 6f 6e 2d 74 69 6d 65 20 28 64 3a 61 6c ation-time (d:al
11780 6c 64 61 74 2d 64 62 66 70 61 74 68 20 2a 61 6c ldat-dbfpath *al
11790 6c 64 61 74 2a 29 29 29 0a 09 20 28 6d 6f 6e 69 ldat*))).. (moni
117a0 74 6f 72 2d 6d 6f 64 74 69 6d 65 20 28 69 66 20 tor-modtime (if
117b0 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 2a 6d (file-exists? *m
117c0 6f 6e 69 74 6f 72 2d 64 62 2d 70 61 74 68 2a 29 onitor-db-path*)
117d0 0a 09 09 09 20 20 20 20 20 20 28 66 69 6c 65 2d .... (file-
117e0 6d 6f 64 69 66 69 63 61 74 69 6f 6e 2d 74 69 6d modification-tim
117f0 65 20 2a 6d 6f 6e 69 74 6f 72 2d 64 62 2d 70 61 e *monitor-db-pa
11800 74 68 2a 29 0a 09 09 09 20 20 20 20 20 20 2d 31 th*).... -1
11810 29 29 0a 09 20 28 72 75 6e 2d 75 70 64 61 74 65 )).. (run-update
11820 2d 74 69 6d 65 20 28 63 75 72 72 65 6e 74 2d 73 -time (current-s
11830 65 63 6f 6e 64 73 29 29 0a 09 20 28 72 65 63 61 econds)).. (reca
11840 6c 63 20 20 20 20 20 20 20 20 20 20 28 64 61 73 lc (das
11850 68 62 6f 61 72 64 3a 72 65 63 61 6c 63 20 6d 6f hboard:recalc mo
11860 64 74 69 6d 65 20 28 64 3a 61 6c 6c 64 61 74 2d dtime (d:alldat-
11870 70 6c 65 61 73 65 2d 75 70 64 61 74 65 20 2a 61 please-update *a
11880 6c 6c 64 61 74 2a 29 20 28 64 3a 61 6c 6c 64 61 lldat*) (d:allda
11890 74 2d 6c 61 73 74 2d 64 62 2d 75 70 64 61 74 65 t-last-db-update
118a0 20 2a 61 6c 6c 64 61 74 2a 29 29 29 29 0a 20 20 *alldat*)))).
118b0 20 20 28 69 66 20 28 61 6e 64 20 28 65 71 3f 20 (if (and (eq?
118c0 28 64 3a 61 6c 6c 64 61 74 2d 63 75 72 72 2d 74 (d:alldat-curr-t
118d0 61 62 2d 6e 75 6d 20 2a 61 6c 6c 64 61 74 2a 29 ab-num *alldat*)
118e0 20 30 29 0a 09 20 20 20 20 20 28 6f 72 20 28 3e 0).. (or (>
118f0 20 6d 6f 6e 69 74 6f 72 2d 6d 6f 64 74 69 6d 65 monitor-modtime
11900 20 2a 6c 61 73 74 2d 6d 6f 6e 69 74 6f 72 2d 75 *last-monitor-u
11910 70 64 61 74 65 2d 74 69 6d 65 2a 29 0a 09 09 20 pdate-time*)...
11920 28 3e 20 28 2d 20 72 75 6e 2d 75 70 64 61 74 65 (> (- run-update
11930 2d 74 69 6d 65 20 2a 6c 61 73 74 2d 6d 6f 6e 69 -time *last-moni
11940 74 6f 72 2d 75 70 64 61 74 65 2d 74 69 6d 65 2a tor-update-time*
11950 29 20 35 29 29 29 20 3b 3b 20 75 70 64 61 74 65 ) 5))) ;; update
11960 20 65 76 65 72 79 20 31 2f 32 20 6d 69 6e 75 74 every 1/2 minut
11970 65 20 6a 75 73 74 20 69 6e 20 63 61 73 65 0a 09 e just in case..
11980 28 62 65 67 69 6e 0a 09 20 20 28 73 65 74 21 20 (begin.. (set!
11990 2a 6c 61 73 74 2d 6d 6f 6e 69 74 6f 72 2d 75 70 *last-monitor-up
119a0 64 61 74 65 2d 74 69 6d 65 2a 20 72 75 6e 2d 75 date-time* run-u
119b0 70 64 61 74 65 2d 74 69 6d 65 29 20 3b 3b 20 6d pdate-time) ;; m
119c0 6f 6e 69 74 6f 72 2d 6d 6f 64 74 69 6d 65 29 0a onitor-modtime).
119d0 09 20 20 28 69 66 20 64 61 73 68 62 6f 61 72 64 . (if dashboard
119e0 3a 75 70 64 61 74 65 2d 73 65 72 76 65 72 73 2d :update-servers-
119f0 74 61 62 6c 65 20 28 64 61 73 68 62 6f 61 72 64 table (dashboard
11a00 3a 75 70 64 61 74 65 2d 73 65 72 76 65 72 73 2d :update-servers-
11a10 74 61 62 6c 65 29 29 29 29 0a 20 20 20 20 28 69 table)))). (i
11a20 66 20 72 65 63 61 6c 63 0a 09 28 62 65 67 69 6e f recalc..(begin
11a30 09 0a 09 20 20 28 63 61 73 65 20 28 64 3a 61 6c ... (case (d:al
11a40 6c 64 61 74 2d 63 75 72 72 2d 74 61 62 2d 6e 75 ldat-curr-tab-nu
11a50 6d 20 2a 61 6c 6c 64 61 74 2a 29 20 0a 09 20 20 m *alldat*) ..
11a60 20 20 28 28 30 29 20 0a 09 20 20 20 20 20 28 69 ((0) .. (i
11a70 66 20 64 61 73 68 62 6f 61 72 64 3a 75 70 64 61 f dashboard:upda
11a80 74 65 2d 73 75 6d 6d 61 72 79 2d 74 61 62 20 28 te-summary-tab (
11a90 64 61 73 68 62 6f 61 72 64 3a 75 70 64 61 74 65 dashboard:update
11aa0 2d 73 75 6d 6d 61 72 79 2d 74 61 62 29 29 29 0a -summary-tab))).
11ab0 09 20 20 20 20 28 28 31 29 20 3b 3b 20 54 68 65 . ((1) ;; The
11ac0 20 72 75 6e 73 20 74 61 62 6c 65 20 69 73 20 61 runs table is a
11ad0 63 74 69 76 65 0a 09 20 20 20 20 20 28 75 70 64 ctive.. (upd
11ae0 61 74 65 2d 72 75 6e 64 61 74 20 2a 61 6c 6c 64 ate-rundat *alld
11af0 61 74 2a 20 28 68 61 73 68 2d 74 61 62 6c 65 2d at* (hash-table-
11b00 72 65 66 2f 64 65 66 61 75 6c 74 20 28 64 3a 61 ref/default (d:a
11b10 6c 6c 64 61 74 2d 73 65 61 72 63 68 70 61 74 74 lldat-searchpatt
11b20 73 20 2a 61 6c 6c 64 61 74 2a 29 20 22 72 75 6e s *alldat*) "run
11b30 6e 61 6d 65 22 20 22 25 22 29 20 28 64 3a 61 6c name" "%") (d:al
11b40 6c 64 61 74 2d 6e 75 6d 72 75 6e 73 20 2a 61 6c ldat-numruns *al
11b50 6c 64 61 74 2a 29 0a 09 09 09 20 20 20 20 28 68 ldat*).... (h
11b60 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
11b70 66 61 75 6c 74 20 28 64 3a 61 6c 6c 64 61 74 2d fault (d:alldat-
11b80 73 65 61 72 63 68 70 61 74 74 73 20 2a 61 6c 6c searchpatts *all
11b90 64 61 74 2a 29 20 22 74 65 73 74 2d 6e 61 6d 65 dat*) "test-name
11ba0 22 20 22 25 2f 25 22 29 0a 09 09 09 20 20 20 20 " "%/%")....
11bb0 3b 3b 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 ;; (hash-table-r
11bc0 65 66 2f 64 65 66 61 75 6c 74 20 28 64 3a 61 6c ef/default (d:al
11bd0 6c 64 61 74 2d 73 65 61 72 63 68 70 61 74 74 73 ldat-searchpatts
11be0 20 2a 61 6c 6c 64 61 74 2a 29 20 22 69 74 65 6d *alldat*) "item
11bf0 2d 6e 61 6d 65 22 20 22 25 22 29 0a 09 09 09 20 -name" "%")....
11c00 20 20 20 28 6c 65 74 20 28 28 72 65 73 20 27 28 (let ((res '(
11c10 29 29 29 0a 09 09 09 20 20 20 20 20 20 28 66 6f ))).... (fo
11c20 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 r-each (lambda (
11c30 6b 65 79 29 0a 09 09 09 09 09 20 20 28 69 66 20 key)...... (if
11c40 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 6b 65 79 (not (equal? key
11c50 20 22 72 75 6e 6e 61 6d 65 22 29 29 0a 09 09 09 "runname"))....
11c60 09 09 20 20 20 20 20 20 28 6c 65 74 20 28 28 76 .. (let ((v
11c70 61 6c 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 al (hash-table-r
11c80 65 66 2f 64 65 66 61 75 6c 74 20 28 64 3a 61 6c ef/default (d:al
11c90 6c 64 61 74 2d 73 65 61 72 63 68 70 61 74 74 73 ldat-searchpatts
11ca0 20 2a 61 6c 6c 64 61 74 2a 29 20 6b 65 79 20 23 *alldat*) key #
11cb0 66 29 29 29 0a 09 09 09 09 09 09 28 69 66 20 76 f))).......(if v
11cc0 61 6c 20 28 73 65 74 21 20 72 65 73 20 28 63 6f al (set! res (co
11cd0 6e 73 20 28 6c 69 73 74 20 6b 65 79 20 76 61 6c ns (list key val
11ce0 29 20 72 65 73 29 29 29 29 29 29 0a 09 09 09 09 ) res)))))).....
11cf0 09 28 64 3a 61 6c 6c 64 61 74 2d 64 62 6b 65 79 .(d:alldat-dbkey
11d00 73 20 2a 61 6c 6c 64 61 74 2a 29 29 0a 09 09 09 s *alldat*))....
11d10 20 20 20 20 20 20 72 65 73 29 29 0a 09 20 20 20 res))..
11d20 20 20 28 75 70 64 61 74 65 2d 62 75 74 74 6f 6e (update-button
11d30 73 20 75 69 64 61 74 20 28 64 3a 61 6c 6c 64 61 s uidat (d:allda
11d40 74 2d 6e 75 6d 72 75 6e 73 20 2a 61 6c 6c 64 61 t-numruns *allda
11d50 74 2a 29 20 28 64 3a 61 6c 6c 64 61 74 2d 6e 75 t*) (d:alldat-nu
11d60 6d 2d 74 65 73 74 73 20 2a 61 6c 6c 64 61 74 2a m-tests *alldat*
11d70 29 29 29 0a 09 20 20 20 20 28 28 32 29 0a 09 20 ))).. ((2)..
11d80 20 20 20 20 28 64 61 73 68 62 6f 61 72 64 3a 75 (dashboard:u
11d90 70 64 61 74 65 2d 72 75 6e 2d 73 75 6d 6d 61 72 pdate-run-summar
11da0 79 2d 74 61 62 29 29 0a 09 20 20 20 20 28 28 33 y-tab)).. ((3
11db0 29 0a 09 20 20 20 20 20 28 64 61 73 68 62 6f 61 ).. (dashboa
11dc0 72 64 3a 75 70 64 61 74 65 2d 6e 65 77 2d 76 69 rd:update-new-vi
11dd0 65 77 2d 74 61 62 29 29 0a 09 20 20 20 20 28 65 ew-tab)).. (e
11de0 6c 73 65 0a 09 20 20 20 20 20 28 6c 65 74 20 28 lse.. (let (
11df0 28 75 70 64 61 74 65 72 20 28 68 61 73 68 2d 74 (updater (hash-t
11e00 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 able-ref/default
11e10 20 28 64 3a 61 6c 6c 64 61 74 2d 75 70 64 61 74 (d:alldat-updat
11e20 65 72 73 20 2a 61 6c 6c 64 61 74 2a 29 0a 09 09 ers *alldat*)...
11e30 09 09 09 09 20 20 20 20 28 64 3a 61 6c 6c 64 61 .... (d:allda
11e40 74 2d 63 75 72 72 2d 74 61 62 2d 6e 75 6d 20 2a t-curr-tab-num *
11e50 61 6c 6c 64 61 74 2a 29 20 23 66 29 29 29 0a 09 alldat*) #f)))..
11e60 20 20 20 20 20 20 20 28 69 66 20 75 70 64 61 74 (if updat
11e70 65 72 20 28 75 70 64 61 74 65 72 29 29 29 29 29 er (updater)))))
11e80 0a 09 20 20 28 64 3a 61 6c 6c 64 61 74 2d 70 6c .. (d:alldat-pl
11e90 65 61 73 65 2d 75 70 64 61 74 65 2d 73 65 74 21 ease-update-set!
11ea0 20 2a 61 6c 6c 64 61 74 2a 20 23 66 29 0a 09 20 *alldat* #f)..
11eb0 20 28 64 3a 61 6c 6c 64 61 74 2d 6c 61 73 74 2d (d:alldat-last-
11ec0 64 62 2d 75 70 64 61 74 65 2d 73 65 74 21 20 2a db-update-set! *
11ed0 61 6c 6c 64 61 74 2a 20 6d 6f 64 74 69 6d 65 29 alldat* modtime)
11ee0 0a 09 20 20 28 73 65 74 21 20 2a 6c 61 73 74 2d .. (set! *last-
11ef0 72 65 63 61 6c 63 2d 65 6e 64 65 64 2d 74 69 6d recalc-ended-tim
11f00 65 2a 20 28 63 75 72 72 65 6e 74 2d 6d 69 6c 6c e* (current-mill
11f10 69 73 65 63 6f 6e 64 73 29 29 29 29 29 29 0a 0a iseconds))))))..
11f20 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
11f30 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11f40 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11f50 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11f60 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 54 68 65 20 ========.;; The
11f70 68 65 61 76 79 20 6c 69 66 74 69 6e 67 20 73 74 heavy lifting st
11f80 61 72 74 73 20 68 65 72 65 0a 3b 3b 3d 3d 3d 3d arts here.;;====
11f90 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11fa0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11fb0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11fc0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11fd0 3d 3d 0a 0a 3b 3b 20 65 61 73 65 20 64 65 62 75 ==..;; ease debu
11fe0 67 67 69 6e 67 20 62 79 20 6c 6f 61 64 69 6e 67 gging by loading
11ff0 20 7e 2f 2e 64 61 73 68 62 6f 61 72 64 72 63 0a ~/.dashboardrc.
12000 28 6c 65 74 20 28 28 64 65 62 75 67 63 6f 6e 74 (let ((debugcont
12010 72 6f 6c 66 20 28 63 6f 6e 63 20 28 67 65 74 2d rolf (conc (get-
12020 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 environment-vari
12030 61 62 6c 65 20 22 48 4f 4d 45 22 29 20 22 2f 2e able "HOME") "/.
12040 64 61 73 68 62 6f 61 72 64 72 63 22 29 29 29 0a dashboardrc"))).
12050 20 20 28 69 66 20 28 66 69 6c 65 2d 65 78 69 73 (if (file-exis
12060 74 73 3f 20 64 65 62 75 67 63 6f 6e 74 72 6f 6c ts? debugcontrol
12070 66 29 0a 20 20 20 20 20 20 28 6c 6f 61 64 20 64 f). (load d
12080 65 62 75 67 63 6f 6e 74 72 6f 6c 66 29 29 29 0a ebugcontrolf))).
12090 0a 28 64 65 66 69 6e 65 20 28 6d 61 69 6e 29 0a .(define (main).
120a0 20 20 28 63 6f 6d 6d 6f 6e 3a 65 78 69 74 2d 6f (common:exit-o
120b0 6e 2d 76 65 72 73 69 6f 6e 2d 63 68 61 6e 67 65 n-version-change
120c0 64 29 0a 20 20 28 6c 65 74 2a 20 28 28 72 75 6e d). (let* ((run
120d0 73 2d 73 75 6d 2d 64 61 74 20 28 64 3a 64 61 74 s-sum-dat (d:dat
120e0 61 2d 69 6e 69 74 20 28 6d 61 6b 65 2d 64 3a 64 a-init (make-d:d
120f0 61 74 61 29 29 29 20 3b 3b 20 64 61 74 61 20 66 ata))) ;; data f
12100 6f 72 20 72 75 6e 2d 73 75 6d 6d 61 72 79 20 74 or run-summary t
12110 61 62 0a 09 20 28 6e 65 77 2d 76 69 65 77 2d 64 ab.. (new-view-d
12120 61 74 20 28 64 3a 64 61 74 61 2d 69 6e 69 74 20 at (d:data-init
12130 28 6d 61 6b 65 2d 64 3a 64 61 74 61 29 29 29 0a (make-d:data))).
12140 09 20 28 64 61 74 61 20 20 20 20 20 20 20 20 20 . (data
12150 2a 61 6c 6c 64 61 74 2a 29 29 0a 20 20 20 20 28 *alldat*)). (
12160 63 6f 6e 64 20 0a 20 20 20 20 20 28 28 61 72 67 cond . ((arg
12170 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 22 s:get-arg "-run"
12180 29 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 72 ). (let ((r
12190 75 6e 69 64 20 28 73 74 72 69 6e 67 2d 3e 6e 75 unid (string->nu
121a0 6d 62 65 72 20 28 61 72 67 73 3a 67 65 74 2d 61 mber (args:get-a
121b0 72 67 20 22 2d 72 75 6e 22 29 29 29 29 0a 09 28 rg "-run"))))..(
121c0 69 66 20 72 75 6e 69 64 0a 09 20 20 20 20 28 62 if runid.. (b
121d0 65 67 69 6e 0a 09 20 20 20 20 20 20 28 6c 61 6d egin.. (lam
121e0 62 64 61 20 28 78 29 0a 09 09 28 6f 6e 2d 65 78 bda (x)...(on-ex
121f0 69 74 20 73 74 64 2d 65 78 69 74 2d 70 72 6f 63 it std-exit-proc
12200 65 64 75 72 65 29 0a 09 09 28 65 78 61 6d 69 6e edure)...(examin
12210 65 2d 72 75 6e 20 28 64 3a 61 6c 6c 64 61 74 2d e-run (d:alldat-
12220 64 62 6c 6f 63 61 6c 20 64 61 74 61 29 20 72 75 dblocal data) ru
12230 6e 69 64 29 29 29 0a 09 20 20 20 20 28 62 65 67 nid))).. (beg
12240 69 6e 0a 09 20 20 20 20 20 20 28 70 72 69 6e 74 in.. (print
12250 20 22 45 52 52 4f 52 3a 20 72 75 6e 69 64 20 69 "ERROR: runid i
12260 73 20 6e 6f 74 20 61 20 6e 75 6d 62 65 72 20 22 s not a number "
12270 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
12280 2d 72 75 6e 22 29 29 0a 09 20 20 20 20 20 20 28 -run")).. (
12290 65 78 69 74 20 31 29 29 29 29 29 0a 20 20 20 20 exit 1))))).
122a0 20 28 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ((args:get-arg
122b0 22 2d 74 65 73 74 22 29 20 3b 3b 20 72 75 6e 2d "-test") ;; run-
122c0 69 64 2c 74 65 73 74 2d 69 64 0a 20 20 20 20 20 id,test-id.
122d0 20 28 6c 65 74 2a 20 28 28 64 61 74 20 20 20 20 (let* ((dat
122e0 20 28 6c 65 74 20 28 28 64 20 28 6d 61 70 20 73 (let ((d (map s
122f0 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 73 tring->number (s
12300 74 72 69 6e 67 2d 73 70 6c 69 74 20 28 61 72 67 tring-split (arg
12310 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 s:get-arg "-test
12320 22 29 20 22 2c 22 29 29 29 29 0a 09 09 09 28 69 ") ","))))....(i
12330 66 20 28 3e 20 28 6c 65 6e 67 74 68 20 64 29 20 f (> (length d)
12340 31 29 0a 09 09 09 20 20 20 20 64 0a 09 09 09 20 1).... d....
12350 20 20 20 28 6c 69 73 74 20 23 66 20 23 66 29 29 (list #f #f))
12360 29 29 0a 09 20 20 20 20 20 28 72 75 6e 2d 69 64 )).. (run-id
12370 20 20 28 63 61 72 20 64 61 74 29 29 0a 09 20 20 (car dat))..
12380 20 20 20 28 74 65 73 74 2d 69 64 20 28 63 61 64 (test-id (cad
12390 72 20 64 61 74 29 29 29 0a 09 28 69 66 20 28 61 r dat)))..(if (a
123a0 6e 64 20 28 6e 75 6d 62 65 72 3f 20 72 75 6e 2d nd (number? run-
123b0 69 64 29 0a 09 09 20 28 6e 75 6d 62 65 72 3f 20 id)... (number?
123c0 74 65 73 74 2d 69 64 29 0a 09 09 20 28 3e 3d 20 test-id)... (>=
123d0 74 65 73 74 2d 69 64 20 30 29 29 0a 09 20 20 20 test-id 0))..
123e0 20 28 65 78 61 6d 69 6e 65 2d 74 65 73 74 20 72 (examine-test r
123f0 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 0a 09 un-id test-id)..
12400 20 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 (begin..
12410 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 33 (debug:print 3
12420 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
12430 72 74 2a 20 22 49 4e 46 4f 3a 20 74 72 69 65 64 rt* "INFO: tried
12440 20 74 6f 20 6f 70 65 6e 20 74 65 73 74 20 77 69 to open test wi
12450 74 68 20 69 6e 76 61 6c 69 64 20 72 75 6e 2d 69 th invalid run-i
12460 64 2c 74 65 73 74 2d 69 64 2e 20 22 20 28 61 72 d,test-id. " (ar
12470 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 gs:get-arg "-tes
12480 74 22 29 29 0a 09 20 20 20 20 20 20 28 65 78 69 t")).. (exi
12490 74 20 31 29 29 29 29 29 0a 20 20 20 20 20 28 28 t 1))))). ((
124a0 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 67 args:get-arg "-g
124b0 75 69 6d 6f 6e 69 74 6f 72 22 29 0a 20 20 20 20 uimonitor").
124c0 20 20 28 67 75 69 2d 6d 6f 6e 69 74 6f 72 20 28 (gui-monitor (
124d0 64 3a 61 6c 6c 64 61 74 2d 64 62 6c 6f 63 61 6c d:alldat-dblocal
124e0 20 64 61 74 61 29 29 29 0a 20 20 20 20 20 28 65 data))). (e
124f0 6c 73 65 0a 20 20 20 20 20 20 28 73 65 74 21 20 lse. (set!
12500 75 69 64 61 74 20 28 6d 61 6b 65 2d 64 61 73 68 uidat (make-dash
12510 62 6f 61 72 64 2d 62 75 74 74 6f 6e 73 20 64 61 board-buttons da
12520 74 61 20 3b 3b 20 28 64 3a 61 6c 6c 64 61 74 2d ta ;; (d:alldat-
12530 64 62 6c 6f 63 61 6c 20 64 61 74 61 29 0a 09 09 dblocal data)...
12540 09 09 09 20 20 28 64 3a 61 6c 6c 64 61 74 2d 6e ... (d:alldat-n
12550 75 6d 72 75 6e 73 20 64 61 74 61 29 0a 09 09 09 umruns data)....
12560 09 09 20 20 28 64 3a 61 6c 6c 64 61 74 2d 6e 75 .. (d:alldat-nu
12570 6d 2d 74 65 73 74 73 20 64 61 74 61 29 0a 09 09 m-tests data)...
12580 09 09 09 20 20 28 64 3a 61 6c 6c 64 61 74 2d 64 ... (d:alldat-d
12590 62 6b 65 79 73 20 64 61 74 61 29 0a 09 09 09 09 bkeys data).....
125a0 09 20 20 72 75 6e 73 2d 73 75 6d 2d 64 61 74 20 . runs-sum-dat
125b0 6e 65 77 2d 76 69 65 77 2d 64 61 74 29 29 0a 20 new-view-dat)).
125c0 20 20 20 20 20 28 69 75 70 3a 63 61 6c 6c 62 61 (iup:callba
125d0 63 6b 2d 73 65 74 21 20 2a 74 69 6d 2a 0a 09 09 ck-set! *tim*...
125e0 09 20 22 41 43 54 49 4f 4e 5f 43 42 22 0a 09 09 . "ACTION_CB"...
125f0 09 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 . (lambda (x)...
12600 09 20 20 20 28 6c 65 74 20 28 28 75 70 64 61 74 . (let ((updat
12610 65 2d 69 73 2d 72 75 6e 6e 69 6e 67 20 23 66 29 e-is-running #f)
12620 29 0a 09 09 09 20 20 20 20 20 28 6d 75 74 65 78 ).... (mutex
12630 2d 6c 6f 63 6b 21 20 28 64 3a 61 6c 6c 64 61 74 -lock! (d:alldat
12640 2d 75 70 64 61 74 65 2d 6d 75 74 65 78 20 64 61 -update-mutex da
12650 74 61 29 29 0a 09 09 09 20 20 20 20 20 28 73 65 ta)).... (se
12660 74 21 20 75 70 64 61 74 65 2d 69 73 2d 72 75 6e t! update-is-run
12670 6e 69 6e 67 20 28 64 3a 61 6c 6c 64 61 74 2d 75 ning (d:alldat-u
12680 70 64 61 74 69 6e 67 20 64 61 74 61 29 29 0a 09 pdating data))..
12690 09 09 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 .. (if (not
126a0 75 70 64 61 74 65 2d 69 73 2d 72 75 6e 6e 69 6e update-is-runnin
126b0 67 29 0a 09 09 09 09 20 28 64 3a 61 6c 6c 64 61 g)..... (d:allda
126c0 74 2d 75 70 64 61 74 69 6e 67 2d 73 65 74 21 20 t-updating-set!
126d0 64 61 74 61 20 23 74 29 29 0a 09 09 09 20 20 20 data #t))....
126e0 20 20 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 (mutex-unlock!
126f0 20 28 64 3a 61 6c 6c 64 61 74 2d 75 70 64 61 74 (d:alldat-updat
12700 65 2d 6d 75 74 65 78 20 64 61 74 61 29 29 0a 09 e-mutex data))..
12710 09 09 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 .. (if (not
12720 75 70 64 61 74 65 2d 69 73 2d 72 75 6e 6e 69 6e update-is-runnin
12730 67 29 0a 09 09 09 09 20 28 62 65 67 69 6e 0a 09 g)..... (begin..
12740 09 09 09 20 20 20 28 64 61 73 68 62 6f 61 72 64 ... (dashboard
12750 3a 72 75 6e 2d 75 70 64 61 74 65 20 78 29 0a 09 :run-update x)..
12760 09 09 09 20 20 20 28 6d 75 74 65 78 2d 6c 6f 63 ... (mutex-loc
12770 6b 21 20 28 64 3a 61 6c 6c 64 61 74 2d 75 70 64 k! (d:alldat-upd
12780 61 74 65 2d 6d 75 74 65 78 20 64 61 74 61 29 29 ate-mutex data))
12790 0a 09 09 09 09 20 20 20 28 64 3a 61 6c 6c 64 61 ..... (d:allda
127a0 74 2d 75 70 64 61 74 69 6e 67 2d 73 65 74 21 20 t-updating-set!
127b0 64 61 74 61 20 23 66 29 0a 09 09 09 09 20 20 20 data #f).....
127c0 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 28 (mutex-unlock! (
127d0 64 3a 61 6c 6c 64 61 74 2d 75 70 64 61 74 65 2d d:alldat-update-
127e0 6d 75 74 65 78 20 64 61 74 61 29 29 29 29 29 0a mutex data))))).
127f0 09 09 09 20 20 20 31 29 29 29 29 0a 20 20 20 20 ... 1)))).
12800 0a 20 20 20 20 28 6c 65 74 20 28 28 74 68 31 20 . (let ((th1
12810 28 6d 61 6b 65 2d 74 68 72 65 61 64 20 28 6c 61 (make-thread (la
12820 6d 62 64 61 20 28 29 0a 09 09 09 20 20 20 20 20 mbda ()....
12830 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 (thread-sleep!
12840 31 29 0a 09 09 09 20 20 20 20 20 20 28 64 3a 61 1).... (d:a
12850 6c 6c 64 61 74 2d 70 6c 65 61 73 65 2d 75 70 64 lldat-please-upd
12860 61 74 65 2d 73 65 74 21 20 64 61 74 61 20 23 74 ate-set! data #t
12870 29 0a 09 09 09 20 20 20 20 20 20 28 64 61 73 68 ).... (dash
12880 62 6f 61 72 64 3a 72 75 6e 2d 75 70 64 61 74 65 board:run-update
12890 20 31 29 29 20 22 75 70 64 61 74 65 20 62 75 74 1)) "update but
128a0 74 6f 6e 73 20 6f 6e 63 65 22 29 29 0a 09 20 20 tons once"))..
128b0 28 74 68 32 20 28 6d 61 6b 65 2d 74 68 72 65 61 (th2 (make-threa
128c0 64 20 69 75 70 3a 6d 61 69 6e 2d 6c 6f 6f 70 20 d iup:main-loop
128d0 22 4d 61 69 6e 20 6c 6f 6f 70 22 29 29 29 0a 20 "Main loop"))).
128e0 20 20 20 20 20 28 74 68 72 65 61 64 2d 73 74 61 (thread-sta
128f0 72 74 21 20 74 68 31 29 0a 20 20 20 20 20 20 28 rt! th1). (
12900 74 68 72 65 61 64 2d 73 74 61 72 74 21 20 74 68 thread-start! th
12910 32 29 0a 20 20 20 20 20 20 28 74 68 72 65 61 64 2). (thread
12920 2d 6a 6f 69 6e 21 20 74 68 32 29 29 29 29 0a 0a -join! th2))))..
12930 28 6d 61 69 6e 29 0a (main).