Artifact
cf1ba76b54360a42446d3dbbf92e6cbbbbbb2cfe:
0000: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
0010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0040: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 43 6f 70 79 ========.;; Copy
0050: 72 69 67 68 74 20 32 30 30 36 2d 32 30 31 32 2c right 2006-2012,
0060: 20 4d 61 74 74 68 65 77 20 57 65 6c 6c 61 6e 64 Matthew Welland
0070: 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68 69 73 20 70 ..;; .;; This p
0080: 72 6f 67 72 61 6d 20 69 73 20 6d 61 64 65 20 61 rogram is made a
0090: 76 61 69 6c 61 62 6c 65 20 75 6e 64 65 72 20 74 vailable under t
00a0: 68 65 20 47 4e 55 20 47 50 4c 20 76 65 72 73 69 he GNU GPL versi
00b0: 6f 6e 20 32 2e 30 20 6f 72 0a 3b 3b 20 20 67 72 on 2.0 or.;; gr
00c0: 65 61 74 65 72 2e 20 53 65 65 20 74 68 65 20 61 eater. See the a
00d0: 63 63 6f 6d 70 61 6e 79 69 6e 67 20 66 69 6c 65 ccompanying file
00e0: 20 43 4f 50 59 49 4e 47 20 66 6f 72 20 64 65 74 COPYING for det
00f0: 61 69 6c 73 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68 ails..;; .;; Th
0100: 69 73 20 70 72 6f 67 72 61 6d 20 69 73 20 64 69 is program is di
0110: 73 74 72 69 62 75 74 65 64 20 57 49 54 48 4f 55 stributed WITHOU
0120: 54 20 41 4e 59 20 57 41 52 52 41 4e 54 59 3b 20 T ANY WARRANTY;
0130: 77 69 74 68 6f 75 74 20 65 76 65 6e 20 74 68 65 without even the
0140: 0a 3b 3b 20 20 69 6d 70 6c 69 65 64 20 77 61 72 .;; implied war
0150: 72 61 6e 74 79 20 6f 66 20 4d 45 52 43 48 41 4e ranty of MERCHAN
0160: 54 41 42 49 4c 49 54 59 20 6f 72 20 46 49 54 4e TABILITY or FITN
0170: 45 53 53 20 46 4f 52 20 41 20 50 41 52 54 49 43 ESS FOR A PARTIC
0180: 55 4c 41 52 0a 3b 3b 20 20 50 55 52 50 4f 53 45 ULAR.;; PURPOSE
0190: 2e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
01a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 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 29 0a 28 69 6d 70 6f e srfi-69).(impo
0280: 72 74 20 28 70 72 65 66 69 78 20 73 71 6c 69 74 rt (prefix sqlit
0290: 65 33 20 73 71 6c 69 74 65 33 3a 29 29 0a 0a 28 e3 sqlite3:))..(
02a0: 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 63 6f declare (uses co
02b0: 6d 6d 6f 6e 29 29 0a 28 64 65 63 6c 61 72 65 20 mmon)).(declare
02c0: 28 75 73 65 73 20 6d 61 72 67 73 29 29 0a 28 64 (uses margs)).(d
02d0: 65 63 6c 61 72 65 20 28 75 73 65 73 20 6b 65 79 eclare (uses key
02e0: 73 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 s)).(declare (us
02f0: 65 73 20 69 74 65 6d 73 29 29 0a 28 64 65 63 6c es items)).(decl
0300: 61 72 65 20 28 75 73 65 73 20 64 62 29 29 0a 28 are (uses db)).(
0310: 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 63 6f declare (uses co
0320: 6e 66 69 67 66 29 29 0a 28 64 65 63 6c 61 72 65 nfigf)).(declare
0330: 20 28 75 73 65 73 20 70 72 6f 63 65 73 73 29 29 (uses process))
0340: 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 .(declare (uses
0350: 6c 61 75 6e 63 68 29 29 0a 28 64 65 63 6c 61 72 launch)).(declar
0360: 65 20 28 75 73 65 73 20 72 75 6e 73 29 29 0a 28 e (uses runs)).(
0370: 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 64 61 declare (uses da
0380: 73 68 62 6f 61 72 64 2d 74 65 73 74 73 29 29 0a shboard-tests)).
0390: 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 64 (declare (uses d
03a0: 61 73 68 62 6f 61 72 64 2d 67 75 69 6d 6f 6e 69 ashboard-guimoni
03b0: 74 6f 72 29 29 0a 28 64 65 63 6c 61 72 65 20 28 tor)).(declare (
03c0: 75 73 65 73 20 74 72 65 65 29 29 0a 28 64 65 63 uses tree)).(dec
03d0: 6c 61 72 65 20 28 75 73 65 73 20 64 63 6f 6d 6d lare (uses dcomm
03e0: 6f 6e 29 29 0a 0a 3b 3b 20 28 64 65 63 6c 61 72 on))..;; (declar
03f0: 65 20 28 75 73 65 73 20 64 61 73 68 62 6f 61 72 e (uses dashboar
0400: 64 2d 6d 61 69 6e 29 29 0a 28 64 65 63 6c 61 72 d-main)).(declar
0410: 65 20 28 75 73 65 73 20 6d 65 67 61 74 65 73 74 e (uses megatest
0420: 2d 76 65 72 73 69 6f 6e 29 29 0a 28 64 65 63 6c -version)).(decl
0430: 61 72 65 20 28 75 73 65 73 20 6d 74 29 29 0a 0a are (uses mt))..
0440: 28 69 6e 63 6c 75 64 65 20 22 63 6f 6d 6d 6f 6e (include "common
0450: 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 28 _records.scm").(
0460: 69 6e 63 6c 75 64 65 20 22 64 62 5f 72 65 63 6f include "db_reco
0470: 72 64 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 rds.scm").(inclu
0480: 64 65 20 22 72 75 6e 5f 72 65 63 6f 72 64 73 2e de "run_records.
0490: 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 scm").(include "
04a0: 6d 65 67 61 74 65 73 74 2d 66 6f 73 73 69 6c 2d megatest-fossil-
04b0: 68 61 73 68 2e 73 63 6d 22 29 0a 0a 28 64 65 66 hash.scm")..(def
04c0: 69 6e 65 20 68 65 6c 70 20 28 63 6f 6e 63 20 0a ine help (conc .
04d0: 22 4d 65 67 61 74 65 73 74 20 44 61 73 68 62 6f "Megatest Dashbo
04e0: 61 72 64 2c 20 64 6f 63 75 6d 65 6e 74 61 74 69 ard, documentati
04f0: 6f 6e 20 61 74 20 68 74 74 70 3a 2f 2f 77 77 77 on at http://www
0500: 2e 6b 69 61 74 6f 61 2e 63 6f 6d 2f 66 6f 73 73 .kiatoa.com/foss
0510: 69 6c 73 2f 6d 65 67 61 74 65 73 74 0a 20 20 76 ils/megatest. v
0520: 65 72 73 69 6f 6e 20 22 20 6d 65 67 61 74 65 73 ersion " megates
0530: 74 2d 76 65 72 73 69 6f 6e 20 22 0a 20 20 6c 69 t-version ". li
0540: 63 65 6e 73 65 20 47 50 4c 2c 20 43 6f 70 79 72 cense GPL, Copyr
0550: 69 67 68 74 20 28 43 29 20 4d 61 74 74 20 57 65 ight (C) Matt We
0560: 6c 6c 61 6e 64 20 32 30 31 32 2d 32 30 31 34 0a lland 2012-2014.
0570: 0a 55 73 61 67 65 3a 20 64 61 73 68 62 6f 61 72 .Usage: dashboar
0580: 64 20 5b 6f 70 74 69 6f 6e 73 5d 0a 20 20 2d 68 d [options]. -h
0590: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
05a0: 20 20 20 3a 20 74 68 69 73 20 68 65 6c 70 0a 20 : this help.
05b0: 20 2d 73 65 72 76 65 72 20 68 6f 73 74 3a 70 6f -server host:po
05c0: 72 74 20 20 20 20 3a 20 63 6f 6e 6e 65 63 74 20 rt : connect
05d0: 74 6f 20 68 6f 73 74 3a 70 6f 72 74 20 69 6e 73 to host:port ins
05e0: 74 65 61 64 20 6f 66 20 64 62 20 61 63 63 65 73 tead of db acces
05f0: 73 0a 20 20 2d 74 65 73 74 20 72 75 6e 2d 69 64 s. -test run-id
0600: 2c 74 65 73 74 2d 69 64 20 3a 20 63 6f 6e 74 72 ,test-id : contr
0610: 6f 6c 20 74 65 73 74 20 69 64 65 6e 74 69 66 69 ol test identifi
0620: 65 64 20 62 79 20 74 65 73 74 69 64 0a 20 20 2d ed by testid. -
0630: 67 75 69 6d 6f 6e 69 74 6f 72 20 20 20 20 20 20 guimonitor
0640: 20 20 20 20 3a 20 63 6f 6e 74 72 6f 6c 20 70 61 : control pa
0650: 6e 65 6c 20 66 6f 72 20 72 75 6e 73 0a 0a 4d 69 nel for runs..Mi
0660: 73 63 0a 20 20 2d 72 6f 77 73 20 4e 20 20 20 20 sc. -rows N
0670: 20 20 20 20 20 3a 20 73 65 74 20 6e 75 6d 62 65 : set numbe
0680: 72 20 6f 66 20 72 6f 77 73 0a 22 29 29 0a 0a 3b r of rows."))..;
0690: 3b 20 70 72 6f 63 65 73 73 20 61 72 67 73 0a 28 ; process args.(
06a0: 64 65 66 69 6e 65 20 72 65 6d 61 72 67 73 20 28 define remargs (
06b0: 61 72 67 73 3a 67 65 74 2d 61 72 67 73 20 0a 09 args:get-args ..
06c0: 09 20 28 61 72 67 76 29 0a 09 09 20 28 6c 69 73 . (argv)... (lis
06d0: 74 20 20 22 2d 72 6f 77 73 22 0a 09 09 09 22 2d t "-rows"...."-
06e0: 72 75 6e 22 0a 09 09 09 22 2d 74 65 73 74 22 0a run"...."-test".
06f0: 09 09 09 22 2d 64 65 62 75 67 22 0a 09 09 09 22 ..."-debug"...."
0700: 2d 68 6f 73 74 22 20 0a 09 09 09 22 2d 74 72 61 -host" ...."-tra
0710: 6e 73 70 6f 72 74 22 0a 09 09 09 29 20 0a 09 09 nsport"....) ...
0720: 20 28 6c 69 73 74 20 20 22 2d 68 22 0a 09 09 09 (list "-h"....
0730: 22 2d 75 73 65 2d 73 65 72 76 65 72 22 0a 09 09 "-use-server"...
0740: 09 22 2d 67 75 69 6d 6f 6e 69 74 6f 72 22 0a 09 ."-guimonitor"..
0750: 09 09 22 2d 6d 61 69 6e 22 0a 09 09 09 22 2d 76 .."-main"...."-v
0760: 22 0a 09 09 09 22 2d 71 22 0a 09 09 20 20 20 20 "...."-q"...
0770: 20 20 20 29 0a 09 09 20 61 72 67 73 3a 61 72 67 )... args:arg
0780: 2d 68 61 73 68 0a 09 09 20 30 29 29 0a 0a 28 69 -hash... 0))..(i
0790: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
07a0: 22 2d 68 22 29 0a 20 20 20 20 28 62 65 67 69 6e "-h"). (begin
07b0: 0a 20 20 20 20 20 20 28 70 72 69 6e 74 20 68 65 . (print he
07c0: 6c 70 29 0a 20 20 20 20 20 20 28 65 78 69 74 29 lp). (exit)
07d0: 29 29 0a 0a 28 69 66 20 28 6e 6f 74 20 28 6c 61 ))..(if (not (la
07e0: 75 6e 63 68 3a 73 65 74 75 70 2d 66 6f 72 2d 72 unch:setup-for-r
07f0: 75 6e 29 29 0a 20 20 20 20 28 62 65 67 69 6e 0a un)). (begin.
0800: 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 46 61 (print "Fa
0810: 69 6c 65 64 20 74 6f 20 66 69 6e 64 20 6d 65 67 iled to find meg
0820: 61 74 65 73 74 2e 63 6f 6e 66 69 67 2c 20 65 78 atest.config, ex
0830: 69 74 69 6e 67 22 29 20 0a 20 20 20 20 20 20 28 iting") . (
0840: 65 78 69 74 20 31 29 29 29 0a 0a 28 64 65 66 69 exit 1)))..(defi
0850: 6e 65 20 2a 75 73 65 73 65 72 76 65 72 2a 20 28 ne *useserver* (
0860: 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 or (args:get-arg
0870: 20 22 2d 75 73 65 2d 73 65 72 76 65 72 22 29 0a "-use-server").
0880: 09 09 09 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b ...(configf:look
0890: 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 up *configdat* "
08a0: 64 61 73 68 62 6f 61 72 64 22 20 22 75 73 65 2d dashboard" "use-
08b0: 73 65 72 76 65 72 22 29 29 29 0a 0a 28 64 65 66 server")))..(def
08c0: 69 6e 65 20 2a 64 62 64 69 72 2a 20 28 64 62 3a ine *dbdir* (db:
08d0: 64 62 66 69 6c 65 2d 70 61 74 68 20 23 66 29 29 dbfile-path #f))
08e0: 20 3b 3b 20 28 63 6f 6e 63 20 28 63 6f 6e 66 69 ;; (conc (confi
08f0: 67 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 gf:lookup *confi
0900: 67 64 61 74 2a 20 22 73 65 74 75 70 22 20 22 6c gdat* "setup" "l
0910: 69 6e 6b 74 72 65 65 22 29 20 22 2f 2e 64 62 22 inktree") "/.db"
0920: 29 29 0a 28 64 65 66 69 6e 65 20 2a 64 62 73 74 )).(define *dbst
0930: 72 75 63 74 2d 6c 6f 63 61 6c 2a 20 20 28 6d 61 ruct-local* (ma
0940: 6b 65 2d 64 62 72 3a 64 62 73 74 72 75 63 74 20 ke-dbr:dbstruct
0950: 70 61 74 68 3a 20 20 2a 64 62 64 69 72 2a 0a 09 path: *dbdir*..
0960: 09 09 09 09 20 20 20 20 20 6c 6f 63 61 6c 3a 20 .... local:
0970: 23 74 29 29 0a 28 64 65 66 69 6e 65 20 2a 64 62 #t)).(define *db
0980: 2d 66 69 6c 65 2d 70 61 74 68 2a 20 28 64 62 3a -file-path* (db:
0990: 64 62 66 69 6c 65 2d 70 61 74 68 20 30 29 29 0a dbfile-path 0)).
09a0: 0a 3b 3b 20 48 41 43 4b 20 41 4c 45 52 54 3a 20 .;; HACK ALERT:
09b0: 74 68 69 73 20 69 73 20 61 20 68 61 63 6b 2c 20 this is a hack,
09c0: 70 6c 65 61 73 65 20 66 69 78 2e 0a 28 64 65 66 please fix..(def
09d0: 69 6e 65 20 2a 72 65 61 64 2d 6f 6e 6c 79 2a 20 ine *read-only*
09e0: 28 6e 6f 74 20 28 66 69 6c 65 2d 72 65 61 64 2d (not (file-read-
09f0: 61 63 63 65 73 73 3f 20 2a 64 62 2d 66 69 6c 65 access? *db-file
0a00: 2d 70 61 74 68 2a 29 29 29 0a 0a 28 64 65 66 69 -path*)))..(defi
0a10: 6e 65 20 74 6f 70 6c 65 76 65 6c 20 23 66 29 0a ne toplevel #f).
0a20: 28 64 65 66 69 6e 65 20 64 6c 67 20 20 20 20 20 (define dlg
0a30: 20 23 66 29 0a 28 64 65 66 69 6e 65 20 6d 61 78 #f).(define max
0a40: 2d 74 65 73 74 2d 6e 75 6d 20 30 29 0a 28 64 65 -test-num 0).(de
0a50: 66 69 6e 65 20 2a 6b 65 79 73 2a 20 20 20 28 69 fine *keys* (i
0a60: 66 20 2a 75 73 65 73 65 72 76 65 72 2a 0a 09 09 f *useserver*...
0a70: 20 20 20 20 20 28 72 6d 74 3a 67 65 74 2d 6b 65 (rmt:get-ke
0a80: 79 73 29 0a 09 09 20 20 20 20 20 28 64 62 3a 67 ys)... (db:g
0a90: 65 74 2d 6b 65 79 73 20 2a 64 62 73 74 72 75 63 et-keys *dbstruc
0aa0: 74 2d 6c 6f 63 61 6c 2a 29 29 29 0a 0a 28 64 65 t-local*)))..(de
0ab0: 66 69 6e 65 20 2a 64 62 6b 65 79 73 2a 20 20 28 fine *dbkeys* (
0ac0: 61 70 70 65 6e 64 20 2a 6b 65 79 73 2a 20 28 6c append *keys* (l
0ad0: 69 73 74 20 22 72 75 6e 6e 61 6d 65 22 29 29 29 ist "runname")))
0ae0: 0a 0a 28 64 65 66 69 6e 65 20 2a 68 65 61 64 65 ..(define *heade
0af0: 72 2a 20 20 20 20 20 20 20 23 66 29 0a 28 64 65 r* #f).(de
0b00: 66 69 6e 65 20 2a 61 6c 6c 72 75 6e 73 2a 20 20 fine *allruns*
0b10: 20 20 20 27 28 29 29 0a 28 64 65 66 69 6e 65 20 '()).(define
0b20: 2a 61 6c 6c 72 75 6e 73 2d 62 79 2d 69 64 2a 20 *allruns-by-id*
0b30: 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 (make-hash-table
0b40: 29 29 20 3b 3b 20 0a 28 64 65 66 69 6e 65 20 2a )) ;; .(define *
0b50: 72 75 6e 63 68 61 6e 67 65 72 61 74 65 2a 20 28 runchangerate* (
0b60: 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 make-hash-table)
0b70: 29 0a 0a 28 64 65 66 69 6e 65 20 2a 62 75 74 74 )..(define *butt
0b80: 6f 6e 64 61 74 2a 20 20 20 20 28 6d 61 6b 65 2d ondat* (make-
0b90: 68 61 73 68 2d 74 61 62 6c 65 29 29 20 3b 3b 20 hash-table)) ;;
0ba0: 3c 72 75 6e 2d 69 64 20 63 6f 6c 6f 72 20 74 65 <run-id color te
0bb0: 78 74 20 74 65 73 74 20 72 75 6e 2d 6b 65 79 3e xt test run-key>
0bc0: 0a 28 64 65 66 69 6e 65 20 2a 61 6c 6c 74 65 73 .(define *alltes
0bd0: 74 6e 61 6d 65 6c 73 74 2a 20 27 28 29 29 0a 28 tnamelst* '()).(
0be0: 64 65 66 69 6e 65 20 2a 73 65 61 72 63 68 70 61 define *searchpa
0bf0: 74 74 73 2a 20 20 28 6d 61 6b 65 2d 68 61 73 68 tts* (make-hash
0c00: 2d 74 61 62 6c 65 29 29 0a 28 64 65 66 69 6e 65 -table)).(define
0c10: 20 2a 6e 75 6d 2d 72 75 6e 73 2a 20 20 20 20 20 *num-runs*
0c20: 20 38 29 0a 28 64 65 66 69 6e 65 20 2a 74 6f 74 8).(define *tot
0c30: 2d 72 75 6e 2d 63 6f 75 6e 74 2a 20 28 69 66 20 -run-count* (if
0c40: 2a 75 73 65 73 65 72 76 65 72 2a 0a 09 09 09 20 *useserver*....
0c50: 20 20 20 28 72 6d 74 3a 67 65 74 2d 6e 75 6d 2d (rmt:get-num-
0c60: 72 75 6e 73 20 22 25 22 29 0a 09 09 09 20 20 20 runs "%")....
0c70: 20 28 64 62 3a 67 65 74 2d 6e 75 6d 2d 72 75 6e (db:get-num-run
0c80: 73 20 2a 64 62 73 74 72 75 63 74 2d 6c 6f 63 61 s *dbstruct-loca
0c90: 6c 2a 20 22 25 22 29 29 29 0a 0a 3b 3b 20 28 64 l* "%")))..;; (d
0ca0: 65 66 69 6e 65 20 2a 74 6f 74 2d 72 75 6e 2d 63 efine *tot-run-c
0cb0: 6f 75 6e 74 2a 20 28 64 62 3a 67 65 74 2d 6e 75 ount* (db:get-nu
0cc0: 6d 2d 72 75 6e 73 20 2a 64 62 73 74 72 75 63 74 m-runs *dbstruct
0cd0: 2d 6c 6f 63 61 6c 2a 20 22 25 22 29 29 0a 0a 3b -local* "%"))..;
0ce0: 3b 20 55 70 64 61 74 65 20 6d 61 6e 61 67 65 6d ; Update managem
0cf0: 65 6e 74 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 2a ent.;;.(define *
0d00: 6c 61 73 74 2d 75 70 64 61 74 65 2a 20 20 20 28 last-update* (
0d10: 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 current-seconds)
0d20: 29 0a 28 64 65 66 69 6e 65 20 2a 6c 61 73 74 2d ).(define *last-
0d30: 64 62 2d 75 70 64 61 74 65 2d 74 69 6d 65 2a 20 db-update-time*
0d40: 30 29 0a 28 64 65 66 69 6e 65 20 2a 70 6c 65 61 0).(define *plea
0d50: 73 65 2d 75 70 64 61 74 65 2d 62 75 74 74 6f 6e se-update-button
0d60: 73 2a 20 23 74 29 0a 28 64 65 66 69 6e 65 20 2a s* #t).(define *
0d70: 64 65 6c 61 79 65 64 2d 75 70 64 61 74 65 2a 20 delayed-update*
0d80: 30 29 0a 28 64 65 66 69 6e 65 20 2a 75 70 64 61 0).(define *upda
0d90: 74 65 2d 69 73 2d 72 75 6e 6e 69 6e 67 2a 20 23 te-is-running* #
0da0: 66 29 0a 28 64 65 66 69 6e 65 20 2a 75 70 64 61 f).(define *upda
0db0: 74 65 2d 6d 75 74 65 78 2a 20 28 6d 61 6b 65 2d te-mutex* (make-
0dc0: 6d 75 74 65 78 29 29 0a 0a 28 64 65 66 69 6e 65 mutex))..(define
0dd0: 20 2a 61 6c 6c 2d 69 74 65 6d 2d 74 65 73 74 2d *all-item-test-
0de0: 6e 61 6d 65 73 2a 20 27 28 29 29 0a 28 64 65 66 names* '()).(def
0df0: 69 6e 65 20 2a 6e 75 6d 2d 74 65 73 74 73 2a 20 ine *num-tests*
0e00: 20 20 20 20 31 35 29 0a 28 64 65 66 69 6e 65 20 15).(define
0e10: 2a 73 74 61 72 74 2d 72 75 6e 2d 6f 66 66 73 65 *start-run-offse
0e20: 74 2a 20 20 30 29 0a 28 64 65 66 69 6e 65 20 2a t* 0).(define *
0e30: 73 74 61 72 74 2d 74 65 73 74 2d 6f 66 66 73 65 start-test-offse
0e40: 74 2a 20 30 29 0a 28 64 65 66 69 6e 65 20 2a 65 t* 0).(define *e
0e50: 78 61 6d 69 6e 65 2d 74 65 73 74 2d 64 61 74 2a xamine-test-dat*
0e60: 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c (make-hash-tabl
0e70: 65 29 29 0a 28 64 65 66 69 6e 65 20 2a 65 78 69 e)).(define *exi
0e80: 74 2d 73 74 61 72 74 65 64 2a 20 23 66 29 0a 28 t-started* #f).(
0e90: 64 65 66 69 6e 65 20 2a 73 74 61 74 75 73 2d 69 define *status-i
0ea0: 67 6e 6f 72 65 2d 68 61 73 68 2a 20 28 6d 61 6b gnore-hash* (mak
0eb0: 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a 28 e-hash-table)).(
0ec0: 64 65 66 69 6e 65 20 2a 73 74 61 74 65 2d 69 67 define *state-ig
0ed0: 6e 6f 72 65 2d 68 61 73 68 2a 20 20 28 6d 61 6b nore-hash* (mak
0ee0: 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a 0a e-hash-table))..
0ef0: 28 64 65 66 69 6e 65 20 2a 74 65 73 74 73 2d 73 (define *tests-s
0f00: 6f 72 74 2d 6f 70 74 69 6f 6e 73 2a 20 28 76 65 ort-options* (ve
0f10: 63 74 6f 72 20 28 76 65 63 74 6f 72 20 22 53 6f ctor (vector "So
0f20: 72 74 20 2b 61 22 20 27 74 65 73 74 6e 61 6d 65 rt +a" 'testname
0f30: 20 20 20 22 41 53 43 22 29 0a 09 09 09 09 20 20 "ASC").....
0f40: 20 20 20 28 76 65 63 74 6f 72 20 22 53 6f 72 74 (vector "Sort
0f50: 20 2d 61 22 20 27 74 65 73 74 6e 61 6d 65 20 20 -a" 'testname
0f60: 20 22 44 45 53 43 22 29 0a 09 09 09 09 20 20 20 "DESC").....
0f70: 20 20 28 76 65 63 74 6f 72 20 22 53 6f 72 74 20 (vector "Sort
0f80: 2b 74 22 20 27 65 76 65 6e 74 5f 74 69 6d 65 20 +t" 'event_time
0f90: 22 41 53 43 22 29 0a 09 09 09 09 20 20 20 20 20 "ASC").....
0fa0: 28 76 65 63 74 6f 72 20 22 53 6f 72 74 20 2d 74 (vector "Sort -t
0fb0: 22 20 27 65 76 65 6e 74 5f 74 69 6d 65 20 22 44 " 'event_time "D
0fc0: 45 53 43 22 29 0a 09 09 09 09 20 20 20 20 20 28 ESC")..... (
0fd0: 76 65 63 74 6f 72 20 22 53 6f 72 74 20 2b 73 22 vector "Sort +s"
0fe0: 20 27 73 74 61 74 65 73 74 61 74 75 73 20 22 41 'statestatus "A
0ff0: 53 43 22 29 0a 09 09 09 09 20 20 20 20 20 28 76 SC")..... (v
1000: 65 63 74 6f 72 20 22 53 6f 72 74 20 2d 73 22 20 ector "Sort -s"
1010: 27 73 74 61 74 65 73 74 61 74 75 73 20 22 44 45 'statestatus "DE
1020: 53 43 22 29 0a 09 09 09 09 20 20 20 20 20 28 76 SC")..... (v
1030: 65 63 74 6f 72 20 22 53 6f 72 74 20 2b 61 22 20 ector "Sort +a"
1040: 27 74 65 73 74 6e 61 6d 65 20 20 20 22 41 53 43 'testname "ASC
1050: 22 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 2a 74 ")))..(define *t
1060: 65 73 74 73 2d 73 6f 72 74 2d 74 79 70 65 2d 69 ests-sort-type-i
1070: 6e 64 65 78 2a 20 27 28 28 22 2b 74 65 73 74 6e ndex* '(("+testn
1080: 61 6d 65 22 20 30 29 0a 09 09 09 09 20 20 28 22 ame" 0)..... ("
1090: 2d 74 65 73 74 6e 61 6d 65 22 20 31 29 0a 09 09 -testname" 1)...
10a0: 09 09 20 20 28 22 2b 65 76 65 6e 74 5f 74 69 6d .. ("+event_tim
10b0: 65 22 20 32 29 0a 09 09 09 09 20 20 28 22 2d 65 e" 2)..... ("-e
10c0: 76 65 6e 74 5f 74 69 6d 65 22 20 33 29 0a 09 09 vent_time" 3)...
10d0: 09 09 20 20 28 22 2b 73 74 61 74 65 73 74 61 74 .. ("+statestat
10e0: 75 73 22 20 34 29 0a 09 09 09 09 20 20 28 22 2d us" 4)..... ("-
10f0: 73 74 61 74 65 73 74 61 74 75 73 22 20 35 29 29 statestatus" 5))
1100: 29 0a 0a 3b 3b 20 44 6f 6e 27 74 20 66 6f 72 67 )..;; Don't forg
1110: 65 74 20 74 6f 20 61 64 6a 75 73 74 20 74 68 65 et to adjust the
1120: 20 3e 3d 20 62 65 6c 6f 77 20 69 66 20 79 6f 75 >= below if you
1130: 20 61 64 64 20 74 6f 20 74 68 65 20 73 6f 72 74 add to the sort
1140: 2d 6f 70 74 69 6f 6e 73 20 61 62 6f 76 65 0a 28 -options above.(
1150: 64 65 66 69 6e 65 20 28 6e 65 78 74 2d 73 6f 72 define (next-sor
1160: 74 2d 6f 70 74 69 6f 6e 29 0a 20 20 28 69 66 20 t-option). (if
1170: 28 3e 3d 20 2a 74 65 73 74 73 2d 73 6f 72 74 2d (>= *tests-sort-
1180: 72 65 76 65 72 73 65 2a 20 35 29 0a 20 20 20 20 reverse* 5).
1190: 20 20 28 73 65 74 21 20 2a 74 65 73 74 73 2d 73 (set! *tests-s
11a0: 6f 72 74 2d 72 65 76 65 72 73 65 2a 20 30 29 0a ort-reverse* 0).
11b0: 20 20 20 20 20 20 28 73 65 74 21 20 2a 74 65 73 (set! *tes
11c0: 74 73 2d 73 6f 72 74 2d 72 65 76 65 72 73 65 2a ts-sort-reverse*
11d0: 20 28 2b 20 2a 74 65 73 74 73 2d 73 6f 72 74 2d (+ *tests-sort-
11e0: 72 65 76 65 72 73 65 2a 20 31 29 29 29 0a 20 20 reverse* 1))).
11f0: 2a 74 65 73 74 73 2d 73 6f 72 74 2d 72 65 76 65 *tests-sort-reve
1200: 72 73 65 2a 29 0a 0a 28 64 65 66 69 6e 65 20 2a rse*)..(define *
1210: 74 65 73 74 73 2d 73 6f 72 74 2d 72 65 76 65 72 tests-sort-rever
1220: 73 65 2a 20 0a 20 20 28 6c 65 74 20 28 28 74 2d se* . (let ((t-
1230: 73 6f 72 74 20 28 61 73 73 6f 63 20 28 63 6f 6e sort (assoc (con
1240: 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f 6e figf:lookup *con
1250: 66 69 67 64 61 74 2a 20 22 64 61 73 68 62 6f 61 figdat* "dashboa
1260: 72 64 22 20 22 74 65 73 74 73 6f 72 74 22 29 20 rd" "testsort")
1270: 2a 74 65 73 74 73 2d 73 6f 72 74 2d 74 79 70 65 *tests-sort-type
1280: 2d 69 6e 64 65 78 2a 29 29 29 0a 20 20 20 20 28 -index*))). (
1290: 69 66 20 74 2d 73 6f 72 74 0a 09 28 63 61 64 72 if t-sort..(cadr
12a0: 20 74 2d 73 6f 72 74 29 0a 09 33 29 29 29 0a 0a t-sort)..3)))..
12b0: 28 64 65 66 69 6e 65 20 28 67 65 74 2d 63 75 72 (define (get-cur
12c0: 72 2d 73 6f 72 74 29 0a 20 20 28 76 65 63 74 6f r-sort). (vecto
12d0: 72 2d 72 65 66 20 2a 74 65 73 74 73 2d 73 6f 72 r-ref *tests-sor
12e0: 74 2d 6f 70 74 69 6f 6e 73 2a 20 2a 74 65 73 74 t-options* *test
12f0: 73 2d 73 6f 72 74 2d 72 65 76 65 72 73 65 2a 29 s-sort-reverse*)
1300: 29 0a 0a 28 64 65 66 69 6e 65 20 2a 68 69 64 65 )..(define *hide
1310: 2d 65 6d 70 74 79 2d 72 75 6e 73 2a 20 23 66 29 -empty-runs* #f)
1320: 0a 28 64 65 66 69 6e 65 20 2a 68 69 64 65 2d 6e .(define *hide-n
1330: 6f 74 2d 68 69 64 65 2a 20 23 74 29 20 3b 3b 20 ot-hide* #t) ;;
1340: 74 6f 67 67 6c 65 20 66 6f 72 20 68 69 64 65 2f toggle for hide/
1350: 6e 6f 74 20 68 69 64 65 0a 28 64 65 66 69 6e 65 not hide.(define
1360: 20 2a 68 69 64 65 2d 6e 6f 74 2d 68 69 64 65 2d *hide-not-hide-
1370: 62 75 74 74 6f 6e 2a 20 23 66 29 0a 28 64 65 66 button* #f).(def
1380: 69 6e 65 20 2a 68 69 64 65 2d 6e 6f 74 2d 68 69 ine *hide-not-hi
1390: 64 65 2d 74 61 62 73 2a 20 23 66 29 0a 0a 28 64 de-tabs* #f)..(d
13a0: 65 66 69 6e 65 20 2a 63 75 72 72 65 6e 74 2d 74 efine *current-t
13b0: 61 62 2d 6e 75 6d 62 65 72 2a 20 30 29 0a 28 64 ab-number* 0).(d
13c0: 65 66 69 6e 65 20 2a 75 70 64 61 74 65 72 73 2a efine *updaters*
13d0: 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c (make-hash-tabl
13e0: 65 29 29 0a 0a 28 64 65 62 75 67 3a 73 65 74 75 e))..(debug:setu
13f0: 70 29 0a 0a 28 64 65 66 69 6e 65 20 75 69 64 61 p)..(define uida
1400: 74 20 23 66 29 0a 0a 28 64 65 66 69 6e 65 2d 69 t #f)..(define-i
1410: 6e 6c 69 6e 65 20 28 64 62 6f 61 72 64 3a 75 69 nline (dboard:ui
1420: 64 61 74 2d 67 65 74 2d 6b 65 79 63 6f 6c 20 20 dat-get-keycol
1430: 76 65 63 29 28 76 65 63 74 6f 72 2d 72 65 66 20 vec)(vector-ref
1440: 76 65 63 20 30 29 29 0a 28 64 65 66 69 6e 65 2d vec 0)).(define-
1450: 69 6e 6c 69 6e 65 20 28 64 62 6f 61 72 64 3a 75 inline (dboard:u
1460: 69 64 61 74 2d 67 65 74 2d 6c 66 74 63 6f 6c 20 idat-get-lftcol
1470: 20 76 65 63 29 28 76 65 63 74 6f 72 2d 72 65 66 vec)(vector-ref
1480: 20 76 65 63 20 31 29 29 0a 28 64 65 66 69 6e 65 vec 1)).(define
1490: 2d 69 6e 6c 69 6e 65 20 28 64 62 6f 61 72 64 3a -inline (dboard:
14a0: 75 69 64 61 74 2d 67 65 74 2d 68 65 61 64 65 72 uidat-get-header
14b0: 20 20 76 65 63 29 28 76 65 63 74 6f 72 2d 72 65 vec)(vector-re
14c0: 66 20 76 65 63 20 32 29 29 0a 28 64 65 66 69 6e f vec 2)).(defin
14d0: 65 2d 69 6e 6c 69 6e 65 20 28 64 62 6f 61 72 64 e-inline (dboard
14e0: 3a 75 69 64 61 74 2d 67 65 74 2d 72 75 6e 73 76 :uidat-get-runsv
14f0: 65 63 20 76 65 63 29 28 76 65 63 74 6f 72 2d 72 ec vec)(vector-r
1500: 65 66 20 76 65 63 20 33 29 29 0a 0a 28 69 66 20 ef vec 3))..(if
1510: 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 (get-environment
1520: 2d 76 61 72 69 61 62 6c 65 20 22 4d 54 5f 52 55 -variable "MT_RU
1530: 4e 5f 41 52 45 41 5f 48 4f 4d 45 22 29 28 63 68 N_AREA_HOME")(ch
1540: 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 28 ange-directory (
1550: 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d get-environment-
1560: 76 61 72 69 61 62 6c 65 20 22 4d 54 5f 52 55 4e variable "MT_RUN
1570: 5f 41 52 45 41 5f 48 4f 4d 45 22 29 29 29 0a 0a _AREA_HOME")))..
1580: 28 64 65 66 69 6e 65 20 28 6d 65 73 73 61 67 65 (define (message
1590: 2d 77 69 6e 64 6f 77 20 6d 73 67 29 0a 20 20 28 -window msg). (
15a0: 69 75 70 3a 73 68 6f 77 0a 20 20 20 28 69 75 70 iup:show. (iup
15b0: 3a 64 69 61 6c 6f 67 0a 20 20 20 20 28 69 75 70 :dialog. (iup
15c0: 3a 76 62 6f 78 20 0a 20 20 20 20 20 28 69 75 70 :vbox . (iup
15d0: 3a 6c 61 62 65 6c 20 6d 73 67 20 23 3a 6d 61 72 :label msg #:mar
15e0: 67 69 6e 20 22 34 30 78 34 30 22 29 29 29 29 29 gin "40x40")))))
15f0: 0a 0a 28 64 65 66 69 6e 65 20 28 69 75 70 6c 69 ..(define (iupli
1600: 73 74 62 6f 78 2d 66 69 6c 6c 2d 6c 69 73 74 20 stbox-fill-list
1610: 6c 62 20 69 74 65 6d 73 20 23 21 6b 65 79 20 28 lb items #!key (
1620: 73 65 6c 65 63 74 65 64 2d 69 74 65 6d 20 23 66 selected-item #f
1630: 29 29 0a 20 20 28 6c 65 74 20 28 28 69 20 31 29 )). (let ((i 1)
1640: 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 ). (for-each
1650: 28 6c 61 6d 62 64 61 20 28 69 74 65 6d 29 0a 09 (lambda (item)..
1660: 09 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d .(iup:attribute-
1670: 73 65 74 21 20 6c 62 20 28 6e 75 6d 62 65 72 2d set! lb (number-
1680: 3e 73 74 72 69 6e 67 20 69 29 20 69 74 65 6d 29 >string i) item)
1690: 0a 09 09 28 69 66 20 73 65 6c 65 63 74 65 64 2d ...(if selected-
16a0: 69 74 65 6d 0a 09 09 20 20 20 20 28 69 66 20 28 item... (if (
16b0: 65 71 75 61 6c 3f 20 73 65 6c 65 63 74 65 64 2d equal? selected-
16c0: 69 74 65 6d 20 69 74 65 6d 29 0a 09 09 09 28 69 item item)....(i
16d0: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 up:attribute-set
16e0: 21 20 6c 62 20 22 56 41 4c 55 45 22 20 69 29 29 ! lb "VALUE" i))
16f0: 29 20 3b 3b 20 28 6e 75 6d 62 65 72 2d 3e 73 74 ) ;; (number->st
1700: 72 69 6e 67 20 69 29 29 29 29 0a 09 09 28 73 65 ring i))))...(se
1710: 74 21 20 69 20 28 2b 20 69 20 31 29 29 29 0a 09 t! i (+ i 1)))..
1720: 20 20 20 20 20 20 69 74 65 6d 73 29 0a 20 20 20 items).
1730: 20 3b 3b 20 28 69 75 70 3a 61 74 74 72 69 62 75 ;; (iup:attribu
1740: 74 65 2d 73 65 74 21 20 6c 62 20 22 56 41 4c 55 te-set! lb "VALU
1750: 45 22 20 28 69 66 20 73 65 6c 65 63 74 65 64 2d E" (if selected-
1760: 69 74 65 6d 20 73 65 6c 65 63 74 65 64 2d 69 74 item selected-it
1770: 65 6d 20 22 22 29 29 0a 20 20 20 20 69 29 29 0a em "")). i)).
1780: 0a 28 64 65 66 69 6e 65 20 28 70 61 64 2d 6c 69 .(define (pad-li
1790: 73 74 20 6c 20 6e 29 28 61 70 70 65 6e 64 20 6c st l n)(append l
17a0: 20 28 6d 61 6b 65 2d 6c 69 73 74 20 28 2d 20 6e (make-list (- n
17b0: 20 28 6c 65 6e 67 74 68 20 6c 29 29 29 29 29 0a (length l))))).
17c0: 0a 28 64 65 66 69 6e 65 20 28 63 6f 6c 6f 72 73 .(define (colors
17d0: 2d 73 69 6d 69 6c 61 72 3f 20 63 6f 6c 6f 72 31 -similar? color1
17e0: 20 63 6f 6c 6f 72 32 29 0a 20 20 28 6c 65 74 2a color2). (let*
17f0: 20 28 28 63 31 20 20 20 20 28 6d 61 70 20 73 74 ((c1 (map st
1800: 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 73 74 ring->number (st
1810: 72 69 6e 67 2d 73 70 6c 69 74 20 63 6f 6c 6f 72 ring-split color
1820: 31 29 29 29 0a 09 20 28 63 32 20 20 20 20 28 6d 1))).. (c2 (m
1830: 61 70 20 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 ap string->numbe
1840: 72 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 r (string-split
1850: 63 6f 6c 6f 72 32 29 29 29 0a 09 20 28 64 65 6c color2))).. (del
1860: 74 61 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 ta (map (lambda
1870: 28 61 20 62 29 28 61 62 73 20 28 2d 20 61 20 62 (a b)(abs (- a b
1880: 29 29 29 20 63 31 20 63 32 29 29 29 0a 20 20 20 ))) c1 c2))).
1890: 20 28 6e 75 6c 6c 3f 20 28 66 69 6c 74 65 72 20 (null? (filter
18a0: 28 6c 61 6d 62 64 61 20 28 78 29 28 3e 20 78 20 (lambda (x)(> x
18b0: 33 29 29 20 64 65 6c 74 61 29 29 29 29 0a 0a 28 3)) delta))))..(
18c0: 64 65 66 69 6e 65 20 28 63 6f 6d 70 61 72 65 2d define (compare-
18d0: 74 65 73 74 73 20 74 65 73 74 31 20 74 65 73 74 tests test1 test
18e0: 32 29 0a 20 20 28 6c 65 74 2a 20 28 28 74 65 73 2). (let* ((tes
18f0: 74 2d 6e 61 6d 65 31 20 20 28 64 62 3a 74 65 73 t-name1 (db:tes
1900: 74 2d 67 65 74 2d 74 65 73 74 6e 61 6d 65 20 20 t-get-testname
1910: 74 65 73 74 31 29 29 0a 09 20 28 69 74 65 6d 2d test1)).. (item-
1920: 70 61 74 68 31 20 20 28 64 62 3a 74 65 73 74 2d path1 (db:test-
1930: 67 65 74 2d 69 74 65 6d 2d 70 61 74 68 20 74 65 get-item-path te
1940: 73 74 31 29 29 0a 09 20 28 65 76 65 6e 74 74 69 st1)).. (eventti
1950: 6d 65 31 20 20 28 64 62 3a 74 65 73 74 2d 67 65 me1 (db:test-ge
1960: 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 74 65 73 t-event_time tes
1970: 74 31 29 29 0a 09 20 28 74 65 73 74 2d 6e 61 6d t1)).. (test-nam
1980: 65 32 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 e2 (db:test-get
1990: 2d 74 65 73 74 6e 61 6d 65 20 20 74 65 73 74 32 -testname test2
19a0: 29 29 0a 09 20 28 69 74 65 6d 2d 70 61 74 68 32 )).. (item-path2
19b0: 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 (db:test-get-i
19c0: 74 65 6d 2d 70 61 74 68 20 74 65 73 74 32 29 29 tem-path test2))
19d0: 0a 09 20 28 65 76 65 6e 74 74 69 6d 65 32 20 20 .. (eventtime2
19e0: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 65 76 65 (db:test-get-eve
19f0: 6e 74 5f 74 69 6d 65 20 74 65 73 74 32 29 29 0a nt_time test2)).
1a00: 09 20 28 73 61 6d 65 2d 6e 61 6d 65 20 20 20 28 . (same-name (
1a10: 65 71 75 61 6c 3f 20 74 65 73 74 2d 6e 61 6d 65 equal? test-name
1a20: 31 20 74 65 73 74 2d 6e 61 6d 65 32 29 29 0a 09 1 test-name2))..
1a30: 20 28 74 65 73 74 31 2d 74 6f 70 20 20 20 28 65 (test1-top (e
1a40: 71 75 61 6c 3f 20 69 74 65 6d 2d 70 61 74 68 31 qual? item-path1
1a50: 20 22 22 29 29 0a 09 20 28 74 65 73 74 32 2d 74 "")).. (test2-t
1a60: 6f 70 20 20 20 28 65 71 75 61 6c 3f 20 69 74 65 op (equal? ite
1a70: 6d 2d 70 61 74 68 32 20 22 22 29 29 0a 09 20 28 m-path2 "")).. (
1a80: 74 65 73 74 31 2d 6f 6c 64 65 72 20 28 3e 20 65 test1-older (> e
1a90: 76 65 6e 74 74 69 6d 65 31 20 65 76 65 6e 74 74 venttime1 eventt
1aa0: 69 6d 65 32 29 29 0a 09 20 28 73 61 6d 65 2d 74 ime2)).. (same-t
1ab0: 69 6d 65 20 20 20 28 65 71 75 61 6c 3f 20 65 76 ime (equal? ev
1ac0: 65 6e 74 74 69 6d 65 31 20 65 76 65 6e 74 74 69 enttime1 eventti
1ad0: 6d 65 32 29 29 29 09 09 09 20 0a 20 20 20 20 28 me2)))... . (
1ae0: 69 66 20 73 61 6d 65 2d 6e 61 6d 65 0a 09 28 69 if same-name..(i
1af0: 66 20 73 61 6d 65 2d 74 69 6d 65 0a 09 20 20 20 f same-time..
1b00: 20 28 73 74 72 69 6e 67 3e 3f 20 69 74 65 6d 2d (string>? item-
1b10: 70 61 74 68 31 20 69 74 65 6d 2d 70 61 74 68 32 path1 item-path2
1b20: 29 0a 09 20 20 20 20 74 65 73 74 31 2d 6f 6c 64 ).. test1-old
1b30: 65 72 29 0a 09 28 69 66 20 73 61 6d 65 2d 74 69 er)..(if same-ti
1b40: 6d 65 0a 09 20 20 20 20 28 73 74 72 69 6e 67 3e me.. (string>
1b50: 3f 20 74 65 73 74 2d 6e 61 6d 65 31 20 74 65 73 ? test-name1 tes
1b60: 74 2d 6e 61 6d 65 32 29 0a 09 20 20 20 20 74 65 t-name2).. te
1b70: 73 74 31 2d 6f 6c 64 65 72 29 29 29 29 0a 20 20 st1-older)))).
1b80: 20 20 0a 3b 3b 20 6b 65 79 70 61 74 74 73 3a 20 .;; keypatts:
1b90: 28 20 28 4b 45 59 31 20 22 61 62 63 25 64 65 66 ( (KEY1 "abc%def
1ba0: 22 29 28 4b 45 59 32 20 22 25 22 29 20 29 0a 28 ")(KEY2 "%") ).(
1bb0: 64 65 66 69 6e 65 20 28 75 70 64 61 74 65 2d 72 define (update-r
1bc0: 75 6e 64 61 74 20 72 75 6e 6e 61 6d 65 70 61 74 undat runnamepat
1bd0: 74 20 6e 75 6d 72 75 6e 73 20 74 65 73 74 6e 61 t numruns testna
1be0: 6d 65 70 61 74 74 20 6b 65 79 70 61 74 74 73 29 mepatt keypatts)
1bf0: 0a 20 20 28 6c 65 74 2a 20 28 28 72 65 66 65 72 . (let* ((refer
1c00: 65 6e 63 65 64 2d 72 75 6e 2d 69 64 73 20 27 28 enced-run-ids '(
1c10: 29 29 0a 09 20 28 61 6c 6c 72 75 6e 73 20 20 20 )).. (allruns
1c20: 20 20 28 69 66 20 2a 75 73 65 73 65 72 76 65 72 (if *useserver
1c30: 2a 0a 09 09 09 20 20 28 72 6d 74 3a 67 65 74 2d *.... (rmt:get-
1c40: 72 75 6e 73 20 72 75 6e 6e 61 6d 65 70 61 74 74 runs runnamepatt
1c50: 20 6e 75 6d 72 75 6e 73 20 2a 73 74 61 72 74 2d numruns *start-
1c60: 72 75 6e 2d 6f 66 66 73 65 74 2a 20 6b 65 79 70 run-offset* keyp
1c70: 61 74 74 73 29 0a 09 09 09 20 20 28 64 62 3a 67 atts).... (db:g
1c80: 65 74 2d 72 75 6e 73 20 2a 64 62 73 74 72 75 63 et-runs *dbstruc
1c90: 74 2d 6c 6f 63 61 6c 2a 20 72 75 6e 6e 61 6d 65 t-local* runname
1ca0: 70 61 74 74 20 6e 75 6d 72 75 6e 73 20 3b 3b 20 patt numruns ;;
1cb0: 28 2b 20 6e 75 6d 72 75 6e 73 20 31 29 20 3b 3b (+ numruns 1) ;;
1cc0: 20 28 2f 20 6e 75 6d 72 75 6e 73 20 32 29 29 0a (/ numruns 2)).
1cd0: 09 09 09 09 20 20 20 20 20 20 2a 73 74 61 72 74 .... *start
1ce0: 2d 72 75 6e 2d 6f 66 66 73 65 74 2a 20 6b 65 79 -run-offset* key
1cf0: 70 61 74 74 73 29 29 29 0a 09 20 28 68 65 61 64 patts))).. (head
1d00: 65 72 20 20 20 20 20 20 28 64 62 3a 67 65 74 2d er (db:get-
1d10: 68 65 61 64 65 72 20 61 6c 6c 72 75 6e 73 29 29 header allruns))
1d20: 0a 09 20 28 72 75 6e 73 20 20 20 20 20 20 20 20 .. (runs
1d30: 28 64 62 3a 67 65 74 2d 72 6f 77 73 20 20 20 61 (db:get-rows a
1d40: 6c 6c 72 75 6e 73 29 29 0a 09 20 28 72 65 73 75 llruns)).. (resu
1d50: 6c 74 20 20 20 20 20 20 27 28 29 29 0a 09 20 28 lt '()).. (
1d60: 6d 61 78 74 65 73 74 73 20 20 20 20 30 29 0a 09 maxtests 0)..
1d70: 20 28 73 74 61 74 65 73 20 20 20 20 20 20 28 68 (states (h
1d80: 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 2a ash-table-keys *
1d90: 73 74 61 74 65 2d 69 67 6e 6f 72 65 2d 68 61 73 state-ignore-has
1da0: 68 2a 29 29 0a 09 20 28 73 74 61 74 75 73 65 73 h*)).. (statuses
1db0: 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (hash-table-
1dc0: 6b 65 79 73 20 2a 73 74 61 74 75 73 2d 69 67 6e keys *status-ign
1dd0: 6f 72 65 2d 68 61 73 68 2a 29 29 0a 09 20 28 73 ore-hash*)).. (s
1de0: 6f 72 74 2d 69 6e 66 6f 20 20 20 28 67 65 74 2d ort-info (get-
1df0: 63 75 72 72 2d 73 6f 72 74 29 29 0a 09 20 28 73 curr-sort)).. (s
1e00: 6f 72 74 2d 62 79 20 20 20 20 20 28 76 65 63 74 ort-by (vect
1e10: 6f 72 2d 72 65 66 20 73 6f 72 74 2d 69 6e 66 6f or-ref sort-info
1e20: 20 31 29 29 0a 09 20 28 73 6f 72 74 2d 6f 72 64 1)).. (sort-ord
1e30: 65 72 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 er (vector-ref
1e40: 73 6f 72 74 2d 69 6e 66 6f 20 32 29 29 0a 09 20 sort-info 2))..
1e50: 28 62 75 62 62 6c 65 2d 74 79 70 65 20 28 69 66 (bubble-type (if
1e60: 20 28 6d 65 6d 62 65 72 20 73 6f 72 74 2d 6f 72 (member sort-or
1e70: 64 65 72 20 27 28 74 65 73 74 6e 61 6d 65 29 29 der '(testname))
1e80: 0a 09 09 09 20 20 27 74 65 73 74 6e 61 6d 65 0a .... 'testname.
1e90: 09 09 09 20 20 27 69 74 65 6d 70 61 74 68 29 29 ... 'itempath))
1ea0: 29 0a 20 20 20 20 3b 3b 20 0a 20 20 20 20 3b 3b ). ;; . ;;
1eb0: 20 74 72 69 6d 20 72 75 6e 73 20 74 6f 20 6f 6e trim runs to on
1ec0: 6c 79 20 74 68 6f 73 65 20 74 68 61 74 20 61 72 ly those that ar
1ed0: 65 20 63 68 61 6e 67 69 6e 67 20 6f 66 74 65 6e e changing often
1ee0: 20 68 65 72 65 0a 20 20 20 20 3b 3b 20 0a 20 20 here. ;; .
1ef0: 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d (for-each (lam
1f00: 62 64 61 20 28 72 75 6e 29 0a 09 09 28 6c 65 74 bda (run)...(let
1f10: 2a 20 28 28 72 75 6e 2d 69 64 20 20 20 20 20 20 * ((run-id
1f20: 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 (db:get-value-by
1f30: 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 -header run head
1f40: 65 72 20 22 69 64 22 29 29 0a 09 09 20 20 20 20 er "id"))...
1f50: 20 20 20 28 74 6d 70 74 65 73 74 73 20 20 20 20 (tmptests
1f60: 28 69 66 20 2a 75 73 65 73 65 72 76 65 72 2a 0a (if *useserver*.
1f70: 09 09 09 09 09 28 72 6d 74 3a 67 65 74 2d 74 65 .....(rmt:get-te
1f80: 73 74 73 2d 66 6f 72 2d 72 75 6e 20 72 75 6e 2d sts-for-run run-
1f90: 69 64 20 74 65 73 74 6e 61 6d 65 70 61 74 74 20 id testnamepatt
1fa0: 73 74 61 74 65 73 20 73 74 61 74 75 73 65 73 0a states statuses.
1fb0: 09 09 09 09 09 09 09 20 20 20 20 20 20 20 23 66 ....... #f
1fc0: 20 23 66 0a 09 09 09 09 09 09 09 20 20 20 20 20 #f........
1fd0: 20 20 2a 68 69 64 65 2d 6e 6f 74 2d 68 69 64 65 *hide-not-hide
1fe0: 2a 0a 09 09 09 09 09 09 09 20 20 20 20 20 20 20 *........
1ff0: 73 6f 72 74 2d 62 79 0a 09 09 09 09 09 09 09 20 sort-by........
2000: 20 20 20 20 20 20 73 6f 72 74 2d 6f 72 64 65 72 sort-order
2010: 0a 09 09 09 09 09 09 09 20 20 20 20 20 20 20 27 ........ '
2020: 73 68 6f 72 74 6c 69 73 74 29 0a 09 09 09 09 09 shortlist)......
2030: 28 64 62 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f (db:get-tests-fo
2040: 72 2d 72 75 6e 20 2a 64 62 73 74 72 75 63 74 2d r-run *dbstruct-
2050: 6c 6f 63 61 6c 2a 20 72 75 6e 2d 69 64 20 74 65 local* run-id te
2060: 73 74 6e 61 6d 65 70 61 74 74 20 73 74 61 74 65 stnamepatt state
2070: 73 20 73 74 61 74 75 73 65 73 0a 09 09 09 09 09 s statuses......
2080: 09 09 20 20 20 20 20 20 23 66 20 23 66 0a 09 09 .. #f #f...
2090: 09 09 09 09 09 20 20 20 20 20 20 2a 68 69 64 65 ..... *hide
20a0: 2d 6e 6f 74 2d 68 69 64 65 2a 0a 09 09 09 09 09 -not-hide*......
20b0: 09 09 20 20 20 20 20 20 73 6f 72 74 2d 62 79 0a .. sort-by.
20c0: 09 09 09 09 09 09 09 20 20 20 20 20 20 73 6f 72 ....... sor
20d0: 74 2d 6f 72 64 65 72 0a 09 09 09 09 09 09 09 20 t-order........
20e0: 20 20 20 20 20 27 73 68 6f 72 74 6c 69 73 74 29 'shortlist)
20f0: 29 29 0a 09 09 20 20 20 20 20 20 20 28 74 65 73 ))... (tes
2100: 74 73 20 20 20 20 20 20 20 28 69 66 20 28 65 71 ts (if (eq
2110: 3f 20 2a 74 65 73 74 73 2d 73 6f 72 74 2d 72 65 ? *tests-sort-re
2120: 76 65 72 73 65 2a 20 33 29 20 3b 3b 20 2b 65 76 verse* 3) ;; +ev
2130: 65 6e 74 5f 74 69 6d 65 0a 09 09 09 09 09 28 73 ent_time......(s
2140: 6f 72 74 20 74 6d 70 74 65 73 74 73 20 63 6f 6d ort tmptests com
2150: 70 61 72 65 2d 74 65 73 74 73 29 0a 09 09 09 09 pare-tests).....
2160: 09 74 6d 70 74 65 73 74 73 29 29 0a 09 09 20 20 .tmptests))...
2170: 20 20 20 20 20 3b 3b 20 4e 4f 54 45 3a 20 62 75 ;; NOTE: bu
2180: 62 62 6c 65 2d 75 70 20 61 6c 73 6f 20 73 65 74 bble-up also set
2190: 73 20 74 68 65 20 67 6c 6f 62 61 6c 20 2a 61 6c s the global *al
21a0: 6c 2d 69 74 65 6d 2d 74 65 73 74 2d 6e 61 6d 65 l-item-test-name
21b0: 73 2a 0a 09 09 20 20 20 20 20 20 20 3b 3b 20 28 s*... ;; (
21c0: 74 65 73 74 73 20 20 20 20 20 20 20 28 62 75 62 tests (bub
21d0: 62 6c 65 2d 75 70 20 74 6d 70 74 65 73 74 73 20 ble-up tmptests
21e0: 70 72 69 6f 72 69 74 79 3a 20 62 75 62 62 6c 65 priority: bubble
21f0: 2d 74 79 70 65 29 29 0a 09 09 20 20 20 20 20 20 -type))...
2200: 20 28 6b 65 79 2d 76 61 6c 73 20 20 20 20 28 69 (key-vals (i
2210: 66 20 2a 75 73 65 73 65 72 76 65 72 2a 20 0a 09 f *useserver* ..
2220: 09 09 09 09 28 72 6d 74 3a 67 65 74 2d 6b 65 79 ....(rmt:get-key
2230: 2d 76 61 6c 73 20 72 75 6e 2d 69 64 29 0a 09 09 -vals run-id)...
2240: 09 09 09 28 64 62 3a 67 65 74 2d 6b 65 79 2d 76 ...(db:get-key-v
2250: 61 6c 73 20 2a 64 62 73 74 72 75 63 74 2d 6c 6f als *dbstruct-lo
2260: 63 61 6c 2a 20 72 75 6e 2d 69 64 29 29 29 29 0a cal* run-id)))).
2270: 09 09 20 20 3b 3b 20 4e 4f 54 45 3a 20 31 31 2f .. ;; NOTE: 11/
2280: 30 31 2f 32 30 31 33 20 54 68 69 73 20 72 6f 75 01/2013 This rou
2290: 74 69 6e 65 20 69 73 20 2a 4e 4f 54 2a 20 67 65 tine is *NOT* ge
22a0: 74 74 69 6e 67 20 63 61 6c 6c 65 64 20 65 78 63 tting called exc
22b0: 65 73 73 69 76 65 6c 79 2e 0a 09 09 20 20 3b 3b essively.... ;;
22c0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
22d0: 22 47 65 74 74 69 6e 67 20 64 61 74 61 20 66 6f "Getting data fo
22e0: 72 20 72 75 6e 20 22 20 72 75 6e 2d 69 64 20 22 r run " run-id "
22f0: 20 77 69 74 68 20 6b 65 79 2d 76 61 6c 73 3d 22 with key-vals="
2300: 20 6b 65 79 2d 76 61 6c 73 29 0a 09 09 20 20 3b key-vals)... ;
2310: 3b 20 4e 6f 74 20 73 75 72 65 20 74 68 69 73 20 ; Not sure this
2320: 69 73 20 6e 65 65 64 65 64 3f 0a 09 09 20 20 28 is needed?... (
2330: 73 65 74 21 20 72 65 66 65 72 65 6e 63 65 64 2d set! referenced-
2340: 72 75 6e 2d 69 64 73 20 28 63 6f 6e 73 20 72 75 run-ids (cons ru
2350: 6e 2d 69 64 20 72 65 66 65 72 65 6e 63 65 64 2d n-id referenced-
2360: 72 75 6e 2d 69 64 73 29 29 0a 09 09 20 20 28 69 run-ids))... (i
2370: 66 20 28 3e 20 28 6c 65 6e 67 74 68 20 74 65 73 f (> (length tes
2380: 74 73 29 20 6d 61 78 74 65 73 74 73 29 0a 09 09 ts) maxtests)...
2390: 20 20 20 20 20 20 28 73 65 74 21 20 6d 61 78 74 (set! maxt
23a0: 65 73 74 73 20 28 6c 65 6e 67 74 68 20 74 65 73 ests (length tes
23b0: 74 73 29 29 29 0a 09 09 20 20 28 69 66 20 28 6f ts)))... (if (o
23c0: 72 20 28 6e 6f 74 20 2a 68 69 64 65 2d 65 6d 70 r (not *hide-emp
23d0: 74 79 2d 72 75 6e 73 2a 29 20 3b 3b 20 74 68 69 ty-runs*) ;; thi
23e0: 73 20 72 65 64 75 63 65 73 20 74 68 65 20 64 61 s reduces the da
23f0: 74 61 20 62 75 72 64 65 6e 20 77 68 65 6e 20 73 ta burden when s
2400: 65 74 0a 09 09 09 20 20 28 6e 6f 74 20 28 6e 75 et.... (not (nu
2410: 6c 6c 3f 20 74 65 73 74 73 29 29 29 0a 09 09 20 ll? tests)))...
2420: 20 20 20 20 20 28 6c 65 74 20 28 28 64 73 74 72 (let ((dstr
2430: 75 63 74 20 28 76 65 63 74 6f 72 20 72 75 6e 20 uct (vector run
2440: 74 65 73 74 73 20 6b 65 79 2d 76 61 6c 73 29 29 tests key-vals))
2450: 29 0a 09 09 09 3b 3b 0a 09 09 09 3b 3b 20 63 6f )....;;....;; co
2460: 6d 70 61 72 65 20 74 68 65 20 74 65 73 74 73 20 mpare the tests
2470: 77 69 74 68 20 74 68 65 20 74 65 73 74 73 20 69 with the tests i
2480: 6e 20 2a 61 6c 6c 72 75 6e 73 2d 62 79 2d 69 64 n *allruns-by-id
2490: 2a 20 73 61 6d 65 20 72 75 6e 2d 69 64 20 0a 09 * same run-id ..
24a0: 09 09 3b 3b 20 69 66 20 64 69 66 66 65 72 65 6e ..;; if differen
24b0: 74 20 74 68 65 6e 20 69 6e 63 72 65 6d 65 6e 74 t then increment
24c0: 20 76 61 6c 75 65 20 69 6e 20 2a 72 75 6e 63 68 value in *runch
24d0: 61 6e 67 65 72 61 74 65 2a 0a 09 09 09 3b 3b 0a angerate*....;;.
24e0: 09 09 09 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 ...(hash-table-s
24f0: 65 74 21 20 2a 61 6c 6c 72 75 6e 73 2d 62 79 2d et! *allruns-by-
2500: 69 64 2a 20 72 75 6e 2d 69 64 20 64 73 74 72 75 id* run-id dstru
2510: 63 74 29 0a 09 09 09 28 73 65 74 21 20 72 65 73 ct)....(set! res
2520: 75 6c 74 20 28 63 6f 6e 73 20 64 73 74 72 75 63 ult (cons dstruc
2530: 74 20 72 65 73 75 6c 74 29 29 29 29 29 29 0a 09 t result))))))..
2540: 20 20 20 20 20 20 72 75 6e 73 29 0a 0a 20 20 20 runs)..
2550: 20 28 73 65 74 21 20 2a 68 65 61 64 65 72 2a 20 (set! *header*
2560: 20 68 65 61 64 65 72 29 0a 20 20 20 20 28 73 65 header). (se
2570: 74 21 20 2a 61 6c 6c 72 75 6e 73 2a 20 72 65 73 t! *allruns* res
2580: 75 6c 74 29 0a 20 20 20 20 28 64 65 62 75 67 3a ult). (debug:
2590: 70 72 69 6e 74 2d 69 6e 66 6f 20 36 20 22 2a 61 print-info 6 "*a
25a0: 6c 6c 72 75 6e 73 2a 20 68 61 73 20 22 20 28 6c llruns* has " (l
25b0: 65 6e 67 74 68 20 2a 61 6c 6c 72 75 6e 73 2a 29 ength *allruns*)
25c0: 20 22 20 72 75 6e 73 22 29 0a 20 20 20 20 6d 61 " runs"). ma
25d0: 78 74 65 73 74 73 29 29 0a 0a 28 64 65 66 69 6e xtests))..(defin
25e0: 65 20 2a 63 6f 6c 6c 61 70 73 65 64 2a 20 28 6d e *collapsed* (m
25f0: 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 ake-hash-table))
2600: 0a 3b 20 28 64 65 66 69 6e 65 20 2a 72 6f 77 2d .; (define *row-
2610: 6c 6f 6f 6b 75 70 2a 20 28 6d 61 6b 65 2d 68 61 lookup* (make-ha
2620: 73 68 2d 74 61 62 6c 65 29 29 20 3b 3b 20 74 65 sh-table)) ;; te
2630: 73 74 6e 61 6d 65 20 3d 3e 20 28 72 6f 77 6e 75 stname => (rownu
2640: 6d 20 6c 61 62 6c 65 6f 62 6a 29 0a 0a 28 64 65 m lableobj)..(de
2650: 66 69 6e 65 20 28 74 6f 67 67 6c 65 2d 68 69 64 fine (toggle-hid
2660: 65 20 6c 6e 75 6d 29 20 3b 20 66 75 6c 6c 74 65 e lnum) ; fullte
2670: 73 74 6e 61 6d 65 29 0a 20 20 28 6c 65 74 2a 20 stname). (let*
2680: 28 28 62 74 6e 20 28 76 65 63 74 6f 72 2d 72 65 ((btn (vector-re
2690: 66 20 28 64 62 6f 61 72 64 3a 75 69 64 61 74 2d f (dboard:uidat-
26a0: 67 65 74 2d 6c 66 74 63 6f 6c 20 75 69 64 61 74 get-lftcol uidat
26b0: 29 20 6c 6e 75 6d 29 29 0a 09 20 28 66 75 6c 6c ) lnum)).. (full
26c0: 74 65 73 74 6e 61 6d 65 20 28 69 75 70 3a 61 74 testname (iup:at
26d0: 74 72 69 62 75 74 65 20 62 74 6e 20 22 54 49 54 tribute btn "TIT
26e0: 4c 45 22 29 29 0a 09 20 28 70 61 72 74 73 20 20 LE")).. (parts
26f0: 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d 73 70 (string-sp
2700: 6c 69 74 20 66 75 6c 6c 74 65 73 74 6e 61 6d 65 lit fulltestname
2710: 20 22 28 22 29 29 0a 09 20 28 62 61 73 65 74 65 "(")).. (basete
2720: 73 74 6e 61 6d 65 20 28 69 66 20 28 6e 75 6c 6c stname (if (null
2730: 3f 20 70 61 72 74 73 29 20 22 22 20 28 63 61 72 ? parts) "" (car
2740: 20 70 61 72 74 73 29 29 29 29 0a 20 20 20 20 3b parts)))). ;
2750: 28 70 72 69 6e 74 20 22 54 6f 67 67 6c 69 6e 67 (print "Toggling
2760: 20 22 20 62 61 73 65 74 65 73 74 6e 61 6d 65 20 " basetestname
2770: 22 20 63 75 72 72 65 6e 74 6c 79 20 22 20 28 68 " currently " (h
2780: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
2790: 66 61 75 6c 74 20 2a 63 6f 6c 6c 61 70 73 65 64 fault *collapsed
27a0: 2a 20 62 61 73 65 74 65 73 74 6e 61 6d 65 20 23 * basetestname #
27b0: 66 29 29 0a 20 20 20 20 28 69 66 20 28 68 61 73 f)). (if (has
27c0: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
27d0: 75 6c 74 20 2a 63 6f 6c 6c 61 70 73 65 64 2a 20 ult *collapsed*
27e0: 62 61 73 65 74 65 73 74 6e 61 6d 65 20 23 66 29 basetestname #f)
27f0: 0a 09 28 62 65 67 69 6e 0a 09 20 20 3b 28 69 75 ..(begin.. ;(iu
2800: 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 p:attribute-set!
2810: 20 62 74 6e 20 22 46 47 43 4f 4c 4f 52 22 20 22 btn "FGCOLOR" "
2820: 30 20 30 20 30 22 29 0a 09 20 20 28 68 61 73 68 0 0 0").. (hash
2830: 2d 74 61 62 6c 65 2d 64 65 6c 65 74 65 21 20 2a -table-delete! *
2840: 63 6f 6c 6c 61 70 73 65 64 2a 20 62 61 73 65 74 collapsed* baset
2850: 65 73 74 6e 61 6d 65 29 29 0a 09 28 62 65 67 69 estname))..(begi
2860: 6e 0a 09 20 20 3b 28 69 75 70 3a 61 74 74 72 69 n.. ;(iup:attri
2870: 62 75 74 65 2d 73 65 74 21 20 62 74 6e 20 22 46 bute-set! btn "F
2880: 47 43 4f 4c 4f 52 22 20 22 30 20 31 39 32 20 31 GCOLOR" "0 192 1
2890: 39 32 22 29 0a 09 20 20 28 68 61 73 68 2d 74 61 92").. (hash-ta
28a0: 62 6c 65 2d 73 65 74 21 20 2a 63 6f 6c 6c 61 70 ble-set! *collap
28b0: 73 65 64 2a 20 62 61 73 65 74 65 73 74 6e 61 6d sed* basetestnam
28c0: 65 20 23 74 29 29 29 29 29 0a 20 20 0a 28 64 65 e #t))))). .(de
28d0: 66 69 6e 65 20 62 6c 61 6e 6b 2d 6c 69 6e 65 2d fine blank-line-
28e0: 72 78 20 28 72 65 67 65 78 70 20 22 5e 5c 5c 73 rx (regexp "^\\s
28f0: 2a 24 22 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 *$"))..(define (
2900: 72 75 6e 2d 69 74 65 6d 2d 6e 61 6d 65 2d 3e 76 run-item-name->v
2910: 65 63 74 6f 72 73 20 6c 73 74 29 0a 20 20 28 6d ectors lst). (m
2920: 61 70 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 ap (lambda (x)..
2930: 20 28 6c 65 74 20 28 28 73 70 6c 73 74 20 28 73 (let ((splst (s
2940: 74 72 69 6e 67 2d 73 70 6c 69 74 20 78 20 22 28 tring-split x "(
2950: 22 29 29 0a 09 20 20 20 20 20 20 20 28 72 65 73 ")).. (res
2960: 20 20 20 28 76 65 63 74 6f 72 20 22 22 20 22 22 (vector "" ""
2970: 29 29 29 0a 09 20 20 20 28 76 65 63 74 6f 72 2d ))).. (vector-
2980: 73 65 74 21 20 72 65 73 20 30 20 28 63 61 72 20 set! res 0 (car
2990: 73 70 6c 73 74 29 29 0a 09 20 20 20 28 69 66 20 splst)).. (if
29a0: 28 3e 20 28 6c 65 6e 67 74 68 20 73 70 6c 73 74 (> (length splst
29b0: 29 20 31 29 0a 09 20 20 20 20 20 20 20 28 76 65 ) 1).. (ve
29c0: 63 74 6f 72 2d 73 65 74 21 20 72 65 73 20 31 20 ctor-set! res 1
29d0: 28 63 61 72 20 28 73 74 72 69 6e 67 2d 73 70 6c (car (string-spl
29e0: 69 74 20 28 63 61 64 72 20 73 70 6c 73 74 29 20 it (cadr splst)
29f0: 22 29 22 29 29 29 29 0a 09 20 20 20 72 65 73 29 ")")))).. res)
2a00: 29 0a 20 20 20 20 20 20 20 6c 73 74 29 29 0a 0a ). lst))..
2a10: 28 64 65 66 69 6e 65 20 28 63 6f 6c 6c 61 70 73 (define (collaps
2a20: 65 2d 72 6f 77 73 20 69 6e 6c 73 74 29 0a 20 20 e-rows inlst).
2a30: 28 6c 65 74 2a 20 28 28 73 6f 72 74 2d 69 6e 66 (let* ((sort-inf
2a40: 6f 20 20 20 28 67 65 74 2d 63 75 72 72 2d 73 6f o (get-curr-so
2a50: 72 74 29 29 0a 09 20 28 73 6f 72 74 2d 62 79 20 rt)).. (sort-by
2a60: 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 (vector-ref
2a70: 73 6f 72 74 2d 69 6e 66 6f 20 31 29 29 0a 09 20 sort-info 1))..
2a80: 28 73 6f 72 74 2d 6f 72 64 65 72 20 20 28 76 65 (sort-order (ve
2a90: 63 74 6f 72 2d 72 65 66 20 73 6f 72 74 2d 69 6e ctor-ref sort-in
2aa0: 66 6f 20 32 29 29 0a 09 20 28 62 75 62 62 6c 65 fo 2)).. (bubble
2ab0: 2d 74 79 70 65 20 28 69 66 20 28 6d 65 6d 62 65 -type (if (membe
2ac0: 72 20 73 6f 72 74 2d 6f 72 64 65 72 20 27 28 74 r sort-order '(t
2ad0: 65 73 74 6e 61 6d 65 29 29 0a 09 09 09 20 20 27 estname)).... '
2ae0: 74 65 73 74 6e 61 6d 65 0a 09 09 09 20 20 27 69 testname.... 'i
2af0: 74 65 6d 70 61 74 68 29 29 0a 09 20 28 6e 65 77 tempath)).. (new
2b00: 6c 73 74 20 20 20 20 20 20 28 66 69 6c 74 65 72 lst (filter
2b10: 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 (lambda (x)....
2b20: 09 28 6c 65 74 2a 20 28 28 74 70 61 72 74 73 20 .(let* ((tparts
2b30: 20 20 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 (string-split
2b40: 20 78 20 22 28 22 29 29 0a 09 09 09 09 20 20 20 x "(")).....
2b50: 20 20 20 20 28 62 61 73 65 74 6e 61 6d 65 20 28 (basetname (
2b60: 69 66 20 28 6e 75 6c 6c 3f 20 74 70 61 72 74 73 if (null? tparts
2b70: 29 20 78 20 28 63 61 72 20 74 70 61 72 74 73 29 ) x (car tparts)
2b80: 29 29 29 0a 09 09 09 09 09 3b 28 70 72 69 6e 74 )))......;(print
2b90: 20 22 78 20 22 20 78 20 22 20 74 70 61 72 74 73 "x " x " tparts
2ba0: 3a 20 22 20 74 70 61 72 74 73 20 22 20 62 61 73 : " tparts " bas
2bb0: 65 74 6e 61 6d 65 3a 20 22 20 62 61 73 65 74 6e etname: " basetn
2bc0: 61 6d 65 29 0a 09 09 09 09 20 20 28 63 6f 6e 64 ame)..... (cond
2bd0: 0a 09 09 09 09 20 20 20 28 28 73 74 72 69 6e 67 ..... ((string
2be0: 2d 6d 61 74 63 68 20 62 6c 61 6e 6b 2d 6c 69 6e -match blank-lin
2bf0: 65 2d 72 78 20 78 29 20 23 66 29 0a 09 09 09 09 e-rx x) #f).....
2c00: 20 20 20 28 28 65 71 75 61 6c 3f 20 78 20 62 61 ((equal? x ba
2c10: 73 65 74 6e 61 6d 65 29 20 23 74 29 0a 09 09 09 setname) #t)....
2c20: 09 20 20 20 28 28 68 61 73 68 2d 74 61 62 6c 65 . ((hash-table
2c30: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 63 6f -ref/default *co
2c40: 6c 6c 61 70 73 65 64 2a 20 62 61 73 65 74 6e 61 llapsed* basetna
2c50: 6d 65 20 23 66 29 20 0a 09 09 09 09 09 3b 28 70 me #f) ......;(p
2c60: 72 69 6e 74 20 22 52 65 6d 6f 76 69 6e 67 20 22 rint "Removing "
2c70: 20 62 61 73 65 74 6e 61 6d 65 20 22 20 66 72 6f basetname " fro
2c80: 6d 20 69 74 65 6d 73 22 29 0a 09 09 09 09 20 20 m items").....
2c90: 20 20 23 66 29 0a 09 09 09 09 20 20 20 28 65 6c #f)..... (el
2ca0: 73 65 20 23 74 29 29 29 29 0a 09 09 09 20 20 20 se #t))))....
2cb0: 20 20 20 69 6e 6c 73 74 29 29 0a 09 20 28 76 6c inlst)).. (vl
2cc0: 73 74 20 20 20 20 20 20 20 20 20 28 72 75 6e 2d st (run-
2cd0: 69 74 65 6d 2d 6e 61 6d 65 2d 3e 76 65 63 74 6f item-name->vecto
2ce0: 72 73 20 6e 65 77 6c 73 74 29 29 0a 09 20 28 76 rs newlst)).. (v
2cf0: 6c 73 74 32 20 20 20 20 20 20 20 20 28 62 75 62 lst2 (bub
2d00: 62 6c 65 2d 75 70 20 76 6c 73 74 20 70 72 69 6f ble-up vlst prio
2d10: 72 69 74 79 3a 20 62 75 62 62 6c 65 2d 74 79 70 rity: bubble-typ
2d20: 65 29 29 29 0a 20 20 20 20 28 6d 61 70 20 28 6c e))). (map (l
2d30: 61 6d 62 64 61 20 28 78 29 0a 09 20 20 20 28 69 ambda (x).. (i
2d40: 66 20 28 65 71 75 61 6c 3f 20 28 76 65 63 74 6f f (equal? (vecto
2d50: 72 2d 72 65 66 20 78 20 31 29 20 22 22 29 0a 09 r-ref x 1) "")..
2d60: 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 (vector-r
2d70: 65 66 20 78 20 30 29 0a 09 20 20 20 20 20 20 20 ef x 0)..
2d80: 28 63 6f 6e 63 20 28 76 65 63 74 6f 72 2d 72 65 (conc (vector-re
2d90: 66 20 78 20 30 29 20 22 28 22 20 28 76 65 63 74 f x 0) "(" (vect
2da0: 6f 72 2d 72 65 66 20 78 20 31 29 20 22 29 22 29 or-ref x 1) ")")
2db0: 29 29 0a 09 20 76 6c 73 74 32 29 29 29 0a 20 20 )).. vlst2))).
2dc0: 20 20 0a 28 64 65 66 69 6e 65 20 28 75 70 64 61 .(define (upda
2dd0: 74 65 2d 6c 61 62 65 6c 73 20 75 69 64 61 74 29 te-labels uidat)
2de0: 0a 20 20 28 6c 65 74 2a 20 28 28 72 6f 77 6e 20 . (let* ((rown
2df0: 20 20 20 30 29 0a 09 20 28 6b 65 79 63 6f 6c 20 0).. (keycol
2e00: 20 28 64 62 6f 61 72 64 3a 75 69 64 61 74 2d 67 (dboard:uidat-g
2e10: 65 74 2d 6b 65 79 63 6f 6c 20 75 69 64 61 74 29 et-keycol uidat)
2e20: 29 0a 09 20 28 6c 66 74 63 6f 6c 20 20 28 64 62 ).. (lftcol (db
2e30: 6f 61 72 64 3a 75 69 64 61 74 2d 67 65 74 2d 6c oard:uidat-get-l
2e40: 66 74 63 6f 6c 20 75 69 64 61 74 29 29 0a 09 20 ftcol uidat))..
2e50: 28 6e 75 6d 63 6f 6c 73 20 28 76 65 63 74 6f 72 (numcols (vector
2e60: 2d 6c 65 6e 67 74 68 20 6c 66 74 63 6f 6c 29 29 -length lftcol))
2e70: 0a 09 20 28 6d 61 78 6e 20 20 20 20 28 2d 20 6e .. (maxn (- n
2e80: 75 6d 63 6f 6c 73 20 31 29 29 0a 09 20 28 61 6c umcols 1)).. (al
2e90: 6c 76 61 6c 73 20 28 6d 61 6b 65 2d 76 65 63 74 lvals (make-vect
2ea0: 6f 72 20 6e 75 6d 63 6f 6c 73 20 22 22 29 29 29 or numcols "")))
2eb0: 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 . (for-each (
2ec0: 6c 61 6d 62 64 61 20 28 6e 61 6d 65 29 0a 09 09 lambda (name)...
2ed0: 28 69 66 20 28 3c 3d 20 72 6f 77 6e 20 6d 61 78 (if (<= rown max
2ee0: 6e 29 0a 09 09 20 20 20 20 28 76 65 63 74 6f 72 n)... (vector
2ef0: 2d 73 65 74 21 20 61 6c 6c 76 61 6c 73 20 72 6f -set! allvals ro
2f00: 77 6e 20 6e 61 6d 65 29 29 20 3b 29 0a 09 09 28 wn name)) ;)...(
2f10: 73 65 74 21 20 72 6f 77 6e 20 28 2b 20 31 20 72 set! rown (+ 1 r
2f20: 6f 77 6e 29 29 29 0a 09 20 20 20 20 20 20 2a 61 own))).. *a
2f30: 6c 6c 74 65 73 74 6e 61 6d 65 6c 73 74 2a 29 0a lltestnamelst*).
2f40: 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 (let loop ((
2f50: 69 20 30 29 29 0a 20 20 20 20 20 20 28 6c 65 74 i 0)). (let
2f60: 2a 20 28 28 6c 62 6c 20 20 20 20 28 76 65 63 74 * ((lbl (vect
2f70: 6f 72 2d 72 65 66 20 6c 66 74 63 6f 6c 20 69 29 or-ref lftcol i)
2f80: 29 0a 09 20 20 20 20 20 28 6b 65 79 76 61 6c 20 ).. (keyval
2f90: 28 76 65 63 74 6f 72 2d 72 65 66 20 6b 65 79 63 (vector-ref keyc
2fa0: 6f 6c 20 69 29 29 0a 09 20 20 20 20 20 28 6f 6c ol i)).. (ol
2fb0: 64 76 61 6c 20 28 69 75 70 3a 61 74 74 72 69 62 dval (iup:attrib
2fc0: 75 74 65 20 6c 62 6c 20 22 54 49 54 4c 45 22 29 ute lbl "TITLE")
2fd0: 29 0a 09 20 20 20 20 20 28 6e 65 77 76 61 6c 20 ).. (newval
2fe0: 28 76 65 63 74 6f 72 2d 72 65 66 20 61 6c 6c 76 (vector-ref allv
2ff0: 61 6c 73 20 69 29 29 29 0a 09 28 69 66 20 28 6e als i)))..(if (n
3000: 6f 74 20 28 65 71 75 61 6c 3f 20 6f 6c 64 76 61 ot (equal? oldva
3010: 6c 20 6e 65 77 76 61 6c 29 29 0a 09 20 20 20 20 l newval))..
3020: 28 6c 65 74 20 28 28 6d 75 6e 67 65 64 2d 76 61 (let ((munged-va
3030: 6c 20 28 6c 65 74 20 28 28 70 61 72 74 73 20 28 l (let ((parts (
3040: 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 6e 65 77 string-split new
3050: 76 61 6c 20 22 28 22 29 29 29 0a 09 09 09 09 28 val "("))).....(
3060: 69 66 20 28 3e 20 28 6c 65 6e 67 74 68 20 70 61 if (> (length pa
3070: 72 74 73 29 20 31 29 28 63 6f 6e 63 20 22 20 20 rts) 1)(conc "
3080: 22 20 28 63 61 72 20 28 73 74 72 69 6e 67 2d 73 " (car (string-s
3090: 70 6c 69 74 20 28 63 61 64 72 20 70 61 72 74 73 plit (cadr parts
30a0: 29 20 22 29 22 29 29 29 20 6e 65 77 76 61 6c 29 ) ")"))) newval)
30b0: 29 29 29 0a 09 20 20 20 20 20 20 28 76 65 63 74 ))).. (vect
30c0: 6f 72 2d 73 65 74 21 20 6b 65 79 63 6f 6c 20 69 or-set! keycol i
30d0: 20 6e 65 77 76 61 6c 29 0a 09 20 20 20 20 20 20 newval)..
30e0: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 (iup:attribute-s
30f0: 65 74 21 20 6c 62 6c 20 22 54 49 54 4c 45 22 20 et! lbl "TITLE"
3100: 6d 75 6e 67 65 64 2d 76 61 6c 29 29 29 0a 09 28 munged-val)))..(
3110: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se
3120: 74 21 20 6c 62 6c 20 22 46 47 43 4f 4c 4f 52 22 t! lbl "FGCOLOR"
3130: 20 28 69 66 20 28 68 61 73 68 2d 74 61 62 6c 65 (if (hash-table
3140: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 63 6f -ref/default *co
3150: 6c 6c 61 70 73 65 64 2a 20 6e 65 77 76 61 6c 20 llapsed* newval
3160: 23 66 29 20 22 30 20 31 31 32 20 31 31 32 22 20 #f) "0 112 112"
3170: 22 30 20 30 20 30 22 29 29 0a 09 28 69 66 20 28 "0 0 0"))..(if (
3180: 3c 20 69 20 6d 61 78 6e 29 0a 09 20 20 20 20 28 < i maxn).. (
3190: 6c 6f 6f 70 20 28 2b 20 69 20 31 29 29 29 29 29 loop (+ i 1)))))
31a0: 29 29 0a 0a 3b 3b 20 0a 28 64 65 66 69 6e 65 20 ))..;; .(define
31b0: 28 67 65 74 2d 69 74 65 6d 69 7a 65 64 2d 74 65 (get-itemized-te
31c0: 73 74 73 20 74 65 73 74 2d 64 61 74 73 29 0a 20 sts test-dats).
31d0: 20 28 6c 65 74 20 28 28 74 6e 61 6d 65 73 20 27 (let ((tnames '
31e0: 28 29 29 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 ())). (for-ea
31f0: 63 68 20 28 6c 61 6d 62 64 61 20 28 74 64 61 74 ch (lambda (tdat
3200: 29 0a 09 09 28 6c 65 74 20 28 28 74 6e 61 6d 65 )...(let ((tname
3210: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 74 64 61 (vector-ref tda
3220: 74 20 30 29 29 20 20 3b 3b 20 28 64 62 3a 74 65 t 0)) ;; (db:te
3230: 73 74 2d 67 65 74 2d 74 65 73 74 6e 61 6d 65 20 st-get-testname
3240: 74 64 61 74 29 29 0a 09 09 20 20 20 20 20 20 28 tdat))... (
3250: 69 70 61 74 68 20 28 76 65 63 74 6f 72 2d 72 65 ipath (vector-re
3260: 66 20 74 64 61 74 20 31 29 29 29 20 3b 3b 20 28 f tdat 1))) ;; (
3270: 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 74 65 6d db:test-get-item
3280: 2d 70 61 74 68 20 74 64 61 74 29 29 29 0a 09 09 -path tdat)))...
3290: 20 20 28 69 66 20 28 6e 6f 74 20 28 65 71 75 61 (if (not (equa
32a0: 6c 3f 20 69 70 61 74 68 20 22 22 29 29 0a 09 09 l? ipath ""))...
32b0: 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 28 (if (and (
32c0: 6c 69 73 74 3f 20 74 6e 61 6d 65 73 29 0a 09 09 list? tnames)...
32d0: 09 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 3f . (string?
32e0: 20 74 6e 61 6d 65 29 0a 09 09 09 20 20 20 20 20 tname)....
32f0: 20 20 28 6e 6f 74 20 28 6d 65 6d 62 65 72 20 74 (not (member t
3300: 6e 61 6d 65 20 74 6e 61 6d 65 73 29 29 29 0a 09 name tnames)))..
3310: 09 09 20 20 28 73 65 74 21 20 74 6e 61 6d 65 73 .. (set! tnames
3320: 20 28 61 70 70 65 6e 64 20 74 6e 61 6d 65 73 20 (append tnames
3330: 28 6c 69 73 74 20 74 6e 61 6d 65 29 29 29 29 29 (list tname)))))
3340: 29 29 0a 09 20 20 20 20 20 20 74 65 73 74 2d 64 )).. test-d
3350: 61 74 73 29 0a 20 20 20 20 74 6e 61 6d 65 73 29 ats). tnames)
3360: 29 0a 0a 3b 3b 20 42 75 62 62 6c 65 20 75 70 20 )..;; Bubble up
3370: 74 68 65 20 74 6f 70 20 74 65 73 74 73 20 74 6f the top tests to
3380: 20 61 62 6f 76 65 20 74 68 65 20 69 74 65 6d 73 above the items
3390: 2c 20 63 6f 6c 6c 65 63 74 20 74 68 65 20 69 74 , collect the it
33a0: 65 6d 73 20 75 6e 64 65 72 6e 65 61 74 68 0a 3b ems underneath.;
33b0: 3b 20 61 6c 6c 20 77 68 69 6c 65 20 70 72 65 73 ; all while pres
33c0: 65 72 76 69 6e 67 20 74 68 65 20 73 6f 72 74 20 erving the sort
33d0: 6f 72 64 65 72 20 66 72 6f 6d 20 74 68 65 20 53 order from the S
33e0: 51 4c 20 71 75 65 72 79 20 61 73 20 62 65 73 74 QL query as best
33f0: 20 61 73 20 70 6f 73 73 69 62 6c 65 2e 0a 3b 3b as possible..;;
3400: 0a 28 64 65 66 69 6e 65 20 28 62 75 62 62 6c 65 .(define (bubble
3410: 2d 75 70 20 74 65 73 74 2d 64 61 74 73 20 23 21 -up test-dats #!
3420: 6b 65 79 20 28 70 72 69 6f 72 69 74 79 20 27 69 key (priority 'i
3430: 74 65 6d 70 61 74 68 29 29 0a 20 20 28 69 66 20 tempath)). (if
3440: 28 6e 75 6c 6c 3f 20 74 65 73 74 2d 64 61 74 73 (null? test-dats
3450: 29 0a 20 20 20 20 20 20 74 65 73 74 2d 64 61 74 ). test-dat
3460: 73 0a 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 s. (begin..
3470: 28 6c 65 74 2a 20 28 28 74 6e 61 6d 65 73 20 20 (let* ((tnames
3480: 20 27 28 29 29 20 20 20 20 20 20 20 20 20 20 20 '())
3490: 20 20 20 20 20 3b 3b 20 6c 69 73 74 20 6f 66 20 ;; list of
34a0: 6e 61 6d 65 73 20 75 73 65 64 20 74 6f 20 72 65 names used to re
34b0: 73 65 72 76 65 20 6f 72 64 65 72 0a 09 20 20 20 serve order..
34c0: 20 20 20 20 28 74 65 73 74 73 20 20 20 20 28 6d (tests (m
34d0: 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 ake-hash-table))
34e0: 20 20 3b 3b 20 68 61 73 68 20 6f 66 20 6c 69 73 ;; hash of lis
34f0: 74 73 2c 20 75 73 65 64 20 74 6f 20 62 75 69 6c ts, used to buil
3500: 64 20 61 73 20 77 65 20 67 6f 0a 09 20 20 20 20 d as we go..
3510: 20 20 20 28 69 74 65 6d 69 7a 65 64 20 28 67 65 (itemized (ge
3520: 74 2d 69 74 65 6d 69 7a 65 64 2d 74 65 73 74 73 t-itemized-tests
3530: 20 74 65 73 74 2d 64 61 74 73 29 29 29 0a 09 20 test-dats)))..
3540: 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 20 20 20 (for-each ..
3550: 28 6c 61 6d 62 64 61 20 28 74 65 73 74 64 61 74 (lambda (testdat
3560: 29 0a 09 20 20 20 20 20 28 6c 65 74 2a 20 28 28 ).. (let* ((
3570: 74 6e 61 6d 65 20 28 76 65 63 74 6f 72 2d 72 65 tname (vector-re
3580: 66 20 74 65 73 74 64 61 74 20 30 29 29 20 20 3b f testdat 0)) ;
3590: 3b 20 64 62 3a 74 65 73 74 2d 67 65 74 2d 74 65 ; db:test-get-te
35a0: 73 74 6e 61 6d 65 20 74 65 73 74 64 61 74 29 29 stname testdat))
35b0: 0a 09 09 20 20 20 20 28 69 70 61 74 68 20 28 76 ... (ipath (v
35c0: 65 63 74 6f 72 2d 72 65 66 20 74 65 73 74 64 61 ector-ref testda
35d0: 74 20 31 29 29 29 20 3b 3b 20 64 62 3a 74 65 73 t 1))) ;; db:tes
35e0: 74 2d 67 65 74 2d 69 74 65 6d 2d 70 61 74 68 20 t-get-item-path
35f0: 74 65 73 74 64 61 74 29 29 29 0a 09 20 20 20 20 testdat)))..
3600: 20 20 20 3b 3b 20 20 20 28 73 65 65 6e 20 20 28 ;; (seen (
3610: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d
3620: 65 66 61 75 6c 74 20 74 65 73 74 73 20 74 6e 61 efault tests tna
3630: 6d 65 20 23 66 29 29 29 0a 09 20 20 20 20 20 20 me #f)))..
3640: 20 28 69 66 20 28 6e 6f 74 20 28 6d 65 6d 62 65 (if (not (membe
3650: 72 20 74 6e 61 6d 65 20 74 6e 61 6d 65 73 29 29 r tname tnames))
3660: 0a 09 09 20 20 20 28 69 66 20 28 6f 72 20 28 61 ... (if (or (a
3670: 6e 64 20 28 65 71 3f 20 70 72 69 6f 72 69 74 79 nd (eq? priority
3680: 20 27 69 74 65 6d 70 61 74 68 29 0a 09 09 09 09 'itempath).....
3690: 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 69 70 61 (not (equal? ipa
36a0: 74 68 20 22 22 29 29 29 0a 09 09 09 20 20 20 28 th ""))).... (
36b0: 61 6e 64 20 28 65 71 3f 20 70 72 69 6f 72 69 74 and (eq? priorit
36c0: 79 20 27 74 65 73 74 6e 61 6d 65 29 0a 09 09 09 y 'testname)....
36d0: 09 28 65 71 75 61 6c 3f 20 69 70 61 74 68 20 22 .(equal? ipath "
36e0: 22 29 29 0a 09 09 09 20 20 20 28 6e 6f 74 20 28 ")).... (not (
36f0: 6d 65 6d 62 65 72 20 74 6e 61 6d 65 20 69 74 65 member tname ite
3700: 6d 69 7a 65 64 29 29 29 0a 09 09 20 20 20 20 20 mized)))...
3710: 20 20 28 73 65 74 21 20 74 6e 61 6d 65 73 20 28 (set! tnames (
3720: 61 70 70 65 6e 64 20 74 6e 61 6d 65 73 20 28 6c append tnames (l
3730: 69 73 74 20 74 6e 61 6d 65 29 29 29 29 29 0a 09 ist tname)))))..
3740: 20 20 20 20 20 20 20 28 69 66 20 28 65 71 75 61 (if (equa
3750: 6c 3f 20 69 70 61 74 68 20 22 22 29 0a 09 09 20 l? ipath "")...
3760: 20 20 3b 3b 20 54 68 69 73 20 61 20 74 6f 70 20 ;; This a top
3770: 6c 65 76 65 6c 2c 20 70 72 65 70 65 6e 64 20 69 level, prepend i
3780: 74 0a 09 09 20 20 20 28 68 61 73 68 2d 74 61 62 t... (hash-tab
3790: 6c 65 2d 73 65 74 21 20 74 65 73 74 73 20 74 6e le-set! tests tn
37a0: 61 6d 65 20 28 63 6f 6e 73 20 74 65 73 74 64 61 ame (cons testda
37b0: 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 t (hash-table-re
37c0: 66 2f 64 65 66 61 75 6c 74 20 74 65 73 74 73 20 f/default tests
37d0: 74 6e 61 6d 65 20 27 28 29 29 29 29 0a 09 09 20 tname '())))...
37e0: 20 20 3b 3b 20 54 68 69 73 20 69 73 20 69 74 65 ;; This is ite
37f0: 6d 2c 20 61 70 70 65 6e 64 20 69 74 0a 09 09 20 m, append it...
3800: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 (hash-table-se
3810: 74 21 20 74 65 73 74 73 20 74 6e 61 6d 65 20 28 t! tests tname (
3820: 61 70 70 65 6e 64 20 28 68 61 73 68 2d 74 61 62 append (hash-tab
3830: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 74 le-ref/default t
3840: 65 73 74 73 20 74 6e 61 6d 65 20 27 28 29 29 28 ests tname '())(
3850: 6c 69 73 74 20 74 65 73 74 64 61 74 29 29 29 29 list testdat))))
3860: 29 29 0a 09 20 20 20 74 65 73 74 2d 64 61 74 73 )).. test-dats
3870: 29 0a 09 20 20 3b 3b 20 53 65 74 20 61 6c 6c 20 ).. ;; Set all
3880: 74 65 73 74 73 20 77 69 74 68 20 69 74 65 6d 73 tests with items
3890: 20 0a 09 20 20 28 73 65 74 21 20 2a 61 6c 6c 2d .. (set! *all-
38a0: 69 74 65 6d 2d 74 65 73 74 2d 6e 61 6d 65 73 2a item-test-names*
38b0: 20 28 61 70 70 65 6e 64 20 28 69 66 20 28 6e 75 (append (if (nu
38c0: 6c 6c 3f 20 74 6e 61 6d 65 73 29 0a 09 09 09 09 ll? tnames).....
38d0: 09 09 20 20 27 28 29 0a 09 09 09 09 09 09 20 20 .. '().......
38e0: 28 66 69 6c 74 65 72 20 28 6c 61 6d 62 64 61 20 (filter (lambda
38f0: 28 74 6e 61 6d 65 29 0a 09 09 09 09 09 09 09 20 (tname)........
3900: 20 20 20 28 6c 65 74 20 28 28 74 6c 73 74 20 28 (let ((tlst (
3910: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 74 hash-table-ref t
3920: 65 73 74 73 20 74 6e 61 6d 65 29 29 29 0a 09 09 ests tname)))...
3930: 09 09 09 09 09 20 20 20 20 20 20 28 61 6e 64 20 ..... (and
3940: 28 6c 69 73 74 20 74 6c 73 74 29 0a 09 09 09 09 (list tlst).....
3950: 09 09 09 09 20 20 20 28 3e 20 28 6c 65 6e 67 74 .... (> (lengt
3960: 68 20 74 6c 73 74 29 20 31 29 29 29 29 0a 09 09 h tlst) 1))))...
3970: 09 09 09 09 09 20 20 74 6e 61 6d 65 73 29 29 0a ..... tnames)).
3980: 09 09 09 09 09 20 20 20 20 20 20 2a 61 6c 6c 2d ..... *all-
3990: 69 74 65 6d 2d 74 65 73 74 2d 6e 61 6d 65 73 2a item-test-names*
39a0: 29 29 0a 09 20 20 28 6c 65 74 20 6c 6f 6f 70 20 )).. (let loop
39b0: 28 28 68 65 64 20 28 63 61 72 20 74 6e 61 6d 65 ((hed (car tname
39c0: 73 29 29 0a 09 09 20 20 20 20 20 28 74 61 6c 20 s))... (tal
39d0: 28 63 64 72 20 74 6e 61 6d 65 73 29 29 0a 09 09 (cdr tnames))...
39e0: 20 20 20 20 20 28 72 65 73 20 27 28 29 29 29 0a (res '())).
39f0: 09 20 20 20 20 28 6c 65 74 20 28 28 6e 65 77 72 . (let ((newr
3a00: 65 73 20 28 61 70 70 65 6e 64 20 72 65 73 20 28 es (append res (
3a10: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 74 hash-table-ref t
3a20: 65 73 74 73 20 68 65 64 29 29 29 29 0a 09 20 20 ests hed))))..
3a30: 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 (if (null? t
3a40: 61 6c 29 0a 09 09 20 20 6e 65 77 72 65 73 0a 09 al)... newres..
3a50: 09 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 . (loop (car ta
3a60: 6c 29 28 63 64 72 20 74 61 6c 29 20 6e 65 77 72 l)(cdr tal) newr
3a70: 65 73 29 29 29 29 29 29 29 29 0a 20 20 20 20 20 es)))))))).
3a80: 20 0a 28 64 65 66 69 6e 65 20 28 75 70 64 61 74 .(define (updat
3a90: 65 2d 62 75 74 74 6f 6e 73 20 75 69 64 61 74 20 e-buttons uidat
3aa0: 6e 75 6d 72 75 6e 73 20 6e 75 6d 74 65 73 74 73 numruns numtests
3ab0: 29 0a 20 20 28 6c 65 74 2a 20 28 28 72 75 6e 73 ). (let* ((runs
3ac0: 20 20 20 20 20 20 20 20 28 69 66 20 28 3e 20 28 (if (> (
3ad0: 6c 65 6e 67 74 68 20 2a 61 6c 6c 72 75 6e 73 2a length *allruns*
3ae0: 29 20 6e 75 6d 72 75 6e 73 29 0a 09 09 09 20 20 ) numruns)....
3af0: 28 74 61 6b 65 2d 72 69 67 68 74 20 2a 61 6c 6c (take-right *all
3b00: 72 75 6e 73 2a 20 6e 75 6d 72 75 6e 73 29 0a 09 runs* numruns)..
3b10: 09 09 20 20 28 70 61 64 2d 6c 69 73 74 20 2a 61 .. (pad-list *a
3b20: 6c 6c 72 75 6e 73 2a 20 6e 75 6d 72 75 6e 73 29 llruns* numruns)
3b30: 29 29 0a 09 20 28 6c 66 74 63 6f 6c 20 20 20 20 )).. (lftcol
3b40: 20 20 28 64 62 6f 61 72 64 3a 75 69 64 61 74 2d (dboard:uidat-
3b50: 67 65 74 2d 6c 66 74 63 6f 6c 20 75 69 64 61 74 get-lftcol uidat
3b60: 29 29 0a 09 20 28 74 61 62 6c 65 68 65 61 64 65 )).. (tableheade
3b70: 72 20 28 64 62 6f 61 72 64 3a 75 69 64 61 74 2d r (dboard:uidat-
3b80: 67 65 74 2d 68 65 61 64 65 72 20 75 69 64 61 74 get-header uidat
3b90: 29 29 0a 09 20 28 74 61 62 6c 65 20 20 20 20 20 )).. (table
3ba0: 20 20 28 64 62 6f 61 72 64 3a 75 69 64 61 74 2d (dboard:uidat-
3bb0: 67 65 74 2d 72 75 6e 73 76 65 63 20 75 69 64 61 get-runsvec uida
3bc0: 74 29 29 0a 09 20 28 63 6f 6c 6e 20 20 20 20 20 t)).. (coln
3bd0: 20 20 20 30 29 29 0a 20 20 20 20 28 73 65 74 21 0)). (set!
3be0: 20 2a 61 6c 6c 74 65 73 74 6e 61 6d 65 6c 73 74 *alltestnamelst
3bf0: 2a 20 27 28 29 29 0a 20 20 20 20 3b 3b 20 63 72 * '()). ;; cr
3c00: 65 61 74 65 20 61 20 63 6f 6e 63 69 73 65 20 6c eate a concise l
3c10: 69 73 74 20 6f 66 20 74 65 73 74 20 6e 61 6d 65 ist of test name
3c20: 73 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 68 0a s. (for-each.
3c30: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 72 75 (lambda (ru
3c40: 6e 64 61 74 29 0a 20 20 20 20 20 20 20 28 69 66 ndat). (if
3c50: 20 28 76 65 63 74 6f 72 3f 20 72 75 6e 64 61 74 (vector? rundat
3c60: 29 0a 09 20 20 20 28 6c 65 74 2a 20 28 28 74 65 ).. (let* ((te
3c70: 73 74 64 61 74 20 20 20 28 76 65 63 74 6f 72 2d stdat (vector-
3c80: 72 65 66 20 72 75 6e 64 61 74 20 31 29 29 0a 09 ref rundat 1))..
3c90: 09 20 20 28 74 65 73 74 6e 61 6d 65 73 20 28 6d . (testnames (m
3ca0: 61 70 20 74 65 73 74 3a 74 65 73 74 2d 67 65 74 ap test:test-get
3cb0: 2d 66 75 6c 6c 6e 61 6d 65 20 74 65 73 74 64 61 -fullname testda
3cc0: 74 29 29 29 0a 09 20 20 20 20 20 28 69 66 20 28 t))).. (if (
3cd0: 6e 6f 74 20 28 61 6e 64 20 2a 68 69 64 65 2d 65 not (and *hide-e
3ce0: 6d 70 74 79 2d 72 75 6e 73 2a 0a 09 09 09 20 20 mpty-runs*....
3cf0: 20 28 6e 75 6c 6c 3f 20 74 65 73 74 6e 61 6d 65 (null? testname
3d00: 73 29 29 29 0a 09 09 20 28 66 6f 72 2d 65 61 63 s)))... (for-eac
3d10: 68 20 28 6c 61 6d 62 64 61 20 28 74 65 73 74 6e h (lambda (testn
3d20: 61 6d 65 29 0a 09 09 09 20 20 20 20 20 28 69 66 ame).... (if
3d30: 20 28 6e 6f 74 20 28 6d 65 6d 62 65 72 20 74 65 (not (member te
3d40: 73 74 6e 61 6d 65 20 2a 61 6c 6c 74 65 73 74 6e stname *alltestn
3d50: 61 6d 65 6c 73 74 2a 29 29 0a 09 09 09 09 20 28 amelst*))..... (
3d60: 62 65 67 69 6e 0a 09 09 09 09 20 20 20 28 73 65 begin..... (se
3d70: 74 21 20 2a 61 6c 6c 74 65 73 74 6e 61 6d 65 6c t! *alltestnamel
3d80: 73 74 2a 20 28 61 70 70 65 6e 64 20 2a 61 6c 6c st* (append *all
3d90: 74 65 73 74 6e 61 6d 65 6c 73 74 2a 20 28 6c 69 testnamelst* (li
3da0: 73 74 20 74 65 73 74 6e 61 6d 65 29 29 29 29 29 st testname)))))
3db0: 29 0a 09 09 09 20 20 20 74 65 73 74 6e 61 6d 65 ).... testname
3dc0: 73 29 29 29 29 29 0a 20 20 20 20 20 72 75 6e 73 s))))). runs
3dd0: 29 0a 0a 20 20 20 20 28 73 65 74 21 20 2a 61 6c ).. (set! *al
3de0: 6c 74 65 73 74 6e 61 6d 65 6c 73 74 2a 20 28 63 ltestnamelst* (c
3df0: 6f 6c 6c 61 70 73 65 2d 72 6f 77 73 20 2a 61 6c ollapse-rows *al
3e00: 6c 74 65 73 74 6e 61 6d 65 6c 73 74 2a 29 29 20 ltestnamelst*))
3e10: 3b 3b 3b 20 61 72 67 68 2e 20 70 6c 65 61 73 65 ;;; argh. please
3e20: 20 63 6c 65 61 6e 20 75 70 20 74 68 69 73 20 73 clean up this s
3e30: 69 6c 6c 79 6e 65 73 73 0a 20 20 20 20 28 73 65 illyness. (se
3e40: 74 21 20 2a 61 6c 6c 74 65 73 74 6e 61 6d 65 6c t! *alltestnamel
3e50: 73 74 2a 20 28 6c 65 74 20 28 28 78 6c 20 28 69 st* (let ((xl (i
3e60: 66 20 28 3e 20 28 6c 65 6e 67 74 68 20 2a 61 6c f (> (length *al
3e70: 6c 74 65 73 74 6e 61 6d 65 6c 73 74 2a 29 20 2a ltestnamelst*) *
3e80: 73 74 61 72 74 2d 74 65 73 74 2d 6f 66 66 73 65 start-test-offse
3e90: 74 2a 29 0a 09 09 09 09 09 20 28 64 72 6f 70 20 t*)...... (drop
3ea0: 2a 61 6c 6c 74 65 73 74 6e 61 6d 65 6c 73 74 2a *alltestnamelst*
3eb0: 20 2a 73 74 61 72 74 2d 74 65 73 74 2d 6f 66 66 *start-test-off
3ec0: 73 65 74 2a 29 0a 09 09 09 09 09 20 27 28 29 29 set*)...... '())
3ed0: 29 29 0a 09 09 09 20 20 20 20 20 28 61 70 70 65 )).... (appe
3ee0: 6e 64 20 78 6c 20 28 6d 61 6b 65 2d 6c 69 73 74 nd xl (make-list
3ef0: 20 28 2d 20 2a 6e 75 6d 2d 74 65 73 74 73 2a 20 (- *num-tests*
3f00: 28 6c 65 6e 67 74 68 20 78 6c 29 29 20 22 22 29 (length xl)) "")
3f10: 29 29 29 0a 20 20 20 20 28 75 70 64 61 74 65 2d ))). (update-
3f20: 6c 61 62 65 6c 73 20 75 69 64 61 74 29 0a 20 20 labels uidat).
3f30: 20 20 28 66 6f 72 2d 65 61 63 68 0a 20 20 20 20 (for-each.
3f40: 20 28 6c 61 6d 62 64 61 20 28 72 75 6e 64 61 74 (lambda (rundat
3f50: 29 0a 20 20 20 20 20 20 20 28 69 66 20 28 6e 6f ). (if (no
3f60: 74 20 72 75 6e 64 61 74 29 20 3b 3b 20 68 61 6e t rundat) ;; han
3f70: 64 6c 65 20 70 61 64 64 65 64 20 72 75 6e 73 0a dle padded runs.
3f80: 09 20 20 20 3b 3b 20 20 20 20 20 20 20 20 20 20 . ;;
3f90: 20 3b 3b 20 69 64 20 72 75 6e 2d 69 64 20 74 65 ;; id run-id te
3fa0: 73 74 6e 61 6d 65 20 73 74 61 74 65 20 73 74 61 stname state sta
3fb0: 74 75 73 20 65 76 65 6e 74 2d 74 69 6d 65 20 68 tus event-time h
3fc0: 6f 73 74 20 63 70 75 6c 6f 61 64 20 64 69 73 6b ost cpuload disk
3fd0: 66 72 65 65 20 75 6e 61 6d 65 20 72 75 6e 64 69 free uname rundi
3fe0: 72 20 69 74 65 6d 2d 70 61 74 68 20 72 75 6e 2d r item-path run-
3ff0: 64 75 72 61 74 69 6f 6e 0a 09 20 20 20 28 73 65 duration.. (se
4000: 74 21 20 72 75 6e 64 61 74 20 28 76 65 63 74 6f t! rundat (vecto
4010: 72 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 32 r (make-vector 2
4020: 30 20 23 66 29 20 27 28 29 20 28 6d 61 70 20 28 0 #f) '() (map (
4030: 6c 61 6d 62 64 61 20 28 78 29 20 22 22 29 20 2a lambda (x) "") *
4040: 6b 65 79 73 2a 29 29 29 29 3b 3b 20 33 29 29 29 keys*))));; 3)))
4050: 0a 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 . (let* ((
4060: 72 75 6e 20 20 20 20 20 20 28 76 65 63 74 6f 72 run (vector
4070: 2d 72 65 66 20 72 75 6e 64 61 74 20 30 29 29 0a -ref rundat 0)).
4080: 09 20 20 20 20 20 20 28 74 65 73 74 73 64 61 74 . (testsdat
4090: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72 75 6e (vector-ref run
40a0: 64 61 74 20 31 29 29 0a 09 20 20 20 20 20 20 28 dat 1)).. (
40b0: 6b 65 79 2d 76 61 6c 2d 64 61 74 20 28 76 65 63 key-val-dat (vec
40c0: 74 6f 72 2d 72 65 66 20 72 75 6e 64 61 74 20 32 tor-ref rundat 2
40d0: 29 29 0a 09 20 20 20 20 20 20 28 72 75 6e 2d 69 )).. (run-i
40e0: 64 20 20 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 d (db:get-valu
40f0: 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 e-by-header run
4100: 2a 68 65 61 64 65 72 2a 20 22 69 64 22 29 29 0a *header* "id")).
4110: 09 20 20 20 20 20 20 28 6b 65 79 2d 76 61 6c 73 . (key-vals
4120: 20 28 61 70 70 65 6e 64 20 6b 65 79 2d 76 61 6c (append key-val
4130: 2d 64 61 74 0a 09 09 09 09 28 6c 69 73 74 20 28 -dat.....(list (
4140: 6c 65 74 20 28 28 78 20 28 64 62 3a 67 65 74 2d let ((x (db:get-
4150: 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 value-by-header
4160: 72 75 6e 20 2a 68 65 61 64 65 72 2a 20 22 72 75 run *header* "ru
4170: 6e 6e 61 6d 65 22 29 29 29 0a 09 09 09 09 09 28 nname")))......(
4180: 69 66 20 78 20 78 20 22 22 29 29 29 29 29 0a 09 if x x "")))))..
4190: 20 20 20 20 20 20 28 72 75 6e 2d 6b 65 79 20 20 (run-key
41a0: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
41b0: 72 73 65 20 6b 65 79 2d 76 61 6c 73 20 22 5c 6e rse key-vals "\n
41c0: 22 29 29 29 0a 09 20 0a 09 20 3b 3b 20 66 69 6c "))).. .. ;; fil
41d0: 6c 20 69 6e 20 74 68 65 20 72 75 6e 20 68 65 61 l in the run hea
41e0: 64 65 72 20 6b 65 79 20 76 61 6c 75 65 73 0a 09 der key values..
41f0: 20 28 6c 65 74 20 28 28 72 6f 77 6e 20 20 20 20 (let ((rown
4200: 20 20 30 29 0a 09 20 20 20 20 20 20 20 28 68 65 0).. (he
4210: 61 64 65 72 63 6f 6c 20 28 76 65 63 74 6f 72 2d adercol (vector-
4220: 72 65 66 20 74 61 62 6c 65 68 65 61 64 65 72 20 ref tableheader
4230: 63 6f 6c 6e 29 29 29 0a 09 20 20 20 28 66 6f 72 coln))).. (for
4240: 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 6b -each (lambda (k
4250: 76 61 6c 29 0a 09 09 20 20 20 20 20 20 20 28 6c val)... (l
4260: 65 74 2a 20 28 28 6c 61 62 6c 20 20 20 20 20 20 et* ((labl
4270: 28 76 65 63 74 6f 72 2d 72 65 66 20 68 65 61 64 (vector-ref head
4280: 65 72 63 6f 6c 20 72 6f 77 6e 29 29 29 0a 09 09 ercol rown)))...
4290: 09 20 28 69 66 20 28 6e 6f 74 20 28 65 71 75 61 . (if (not (equa
42a0: 6c 3f 20 6b 76 61 6c 20 28 69 75 70 3a 61 74 74 l? kval (iup:att
42b0: 72 69 62 75 74 65 20 6c 61 62 6c 20 22 54 49 54 ribute labl "TIT
42c0: 4c 45 22 29 29 29 0a 09 09 09 20 20 20 20 20 28 LE"))).... (
42d0: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se
42e0: 74 21 20 28 76 65 63 74 6f 72 2d 72 65 66 20 68 t! (vector-ref h
42f0: 65 61 64 65 72 63 6f 6c 20 72 6f 77 6e 29 20 22 eadercol rown) "
4300: 54 49 54 4c 45 22 20 6b 76 61 6c 29 29 0a 09 09 TITLE" kval))...
4310: 09 20 28 73 65 74 21 20 72 6f 77 6e 20 28 2b 20 . (set! rown (+
4320: 72 6f 77 6e 20 31 29 29 29 29 0a 09 09 20 20 20 rown 1))))...
4330: 20 20 6b 65 79 2d 76 61 6c 73 29 29 0a 09 20 0a key-vals)).. .
4340: 09 20 3b 3b 20 46 6f 72 20 74 68 69 73 20 72 75 . ;; For this ru
4350: 6e 20 6e 6f 77 20 66 69 6c 6c 20 69 6e 20 74 68 n now fill in th
4360: 65 20 62 75 74 74 6f 6e 73 20 66 6f 72 20 65 61 e buttons for ea
4370: 63 68 20 74 65 73 74 0a 09 20 28 6c 65 74 20 28 ch test.. (let (
4380: 28 72 6f 77 6e 20 30 29 0a 09 20 20 20 20 20 20 (rown 0)..
4390: 20 28 63 6f 6c 75 6d 6e 64 61 74 20 20 28 76 65 (columndat (ve
43a0: 63 74 6f 72 2d 72 65 66 20 74 61 62 6c 65 20 63 ctor-ref table c
43b0: 6f 6c 6e 29 29 29 0a 09 20 20 20 28 66 6f 72 2d oln))).. (for-
43c0: 65 61 63 68 0a 09 20 20 20 20 28 6c 61 6d 62 64 each.. (lambd
43d0: 61 20 28 74 65 73 74 6e 61 6d 65 29 0a 09 20 20 a (testname)..
43e0: 20 20 20 20 28 6c 65 74 20 28 28 62 75 74 74 6f (let ((butto
43f0: 6e 64 61 74 20 20 28 68 61 73 68 2d 74 61 62 6c ndat (hash-tabl
4400: 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 62 e-ref/default *b
4410: 75 74 74 6f 6e 64 61 74 2a 20 28 6d 6b 73 74 72 uttondat* (mkstr
4420: 20 63 6f 6c 6e 20 72 6f 77 6e 29 20 23 66 29 29 coln rown) #f))
4430: 29 0a 09 09 28 69 66 20 62 75 74 74 6f 6e 64 61 )...(if buttonda
4440: 74 0a 09 09 20 20 20 20 28 6c 65 74 2a 20 28 28 t... (let* ((
4450: 74 65 73 74 20 20 20 20 20 20 20 28 6c 65 74 20 test (let
4460: 28 28 6d 61 74 63 68 69 6e 67 20 28 66 69 6c 74 ((matching (filt
4470: 65 72 20 0a 09 09 09 09 09 09 09 28 6c 61 6d 62 er ........(lamb
4480: 64 61 20 28 78 29 28 65 71 75 61 6c 3f 20 28 74 da (x)(equal? (t
4490: 65 73 74 3a 74 65 73 74 2d 67 65 74 2d 66 75 6c est:test-get-ful
44a0: 6c 6e 61 6d 65 20 78 29 20 74 65 73 74 6e 61 6d lname x) testnam
44b0: 65 29 29 0a 09 09 09 09 09 09 09 74 65 73 74 73 e))........tests
44c0: 64 61 74 29 29 29 0a 09 09 09 09 09 20 28 69 66 dat)))...... (if
44d0: 20 28 6e 75 6c 6c 3f 20 6d 61 74 63 68 69 6e 67 (null? matching
44e0: 29 0a 09 09 09 09 09 20 20 20 20 20 28 76 65 63 )...... (vec
44f0: 74 6f 72 20 2d 31 20 2d 31 20 22 22 20 22 22 20 tor -1 -1 "" ""
4500: 22 22 20 30 20 22 22 20 22 22 20 30 20 22 22 20 "" 0 "" "" 0 ""
4510: 22 22 20 22 22 20 30 20 22 22 20 22 22 29 0a 09 "" "" 0 "" "")..
4520: 09 09 09 09 20 20 20 20 20 28 63 61 72 20 6d 61 .... (car ma
4530: 74 63 68 69 6e 67 29 29 29 29 0a 09 09 09 20 20 tching))))....
4540: 20 28 74 65 73 74 6e 61 6d 65 20 20 20 28 64 62 (testname (db
4550: 3a 74 65 73 74 2d 67 65 74 2d 74 65 73 74 6e 61 :test-get-testna
4560: 6d 65 20 20 74 65 73 74 29 29 0a 09 09 09 20 20 me test))....
4570: 20 28 69 74 65 6d 70 61 74 68 20 20 20 28 64 62 (itempath (db
4580: 3a 74 65 73 74 2d 67 65 74 2d 69 74 65 6d 2d 70 :test-get-item-p
4590: 61 74 68 20 74 65 73 74 29 29 0a 09 09 09 20 20 ath test))....
45a0: 20 28 74 65 73 74 66 75 6c 6c 6e 61 6d 65 20 28 (testfullname (
45b0: 74 65 73 74 3a 74 65 73 74 2d 67 65 74 2d 66 75 test:test-get-fu
45c0: 6c 6c 6e 61 6d 65 20 74 65 73 74 29 29 0a 09 09 llname test))...
45d0: 09 20 20 20 28 74 65 73 74 73 74 61 74 75 73 20 . (teststatus
45e0: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 (db:test-get-sta
45f0: 74 75 73 20 20 20 74 65 73 74 29 29 0a 09 09 09 tus test))....
4600: 20 20 20 28 74 65 73 74 73 74 61 74 65 20 20 28 (teststate (
4610: 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 db:test-get-stat
4620: 65 20 20 20 20 74 65 73 74 29 29 0a 09 09 09 20 e test))....
4630: 20 20 3b 3b 28 74 65 73 74 73 74 61 72 74 20 20 ;;(teststart
4640: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 65 76 65 (db:test-get-eve
4650: 6e 74 5f 74 69 6d 65 20 74 65 73 74 29 29 0a 09 nt_time test))..
4660: 09 09 20 20 20 3b 3b 28 72 75 6e 74 69 6d 65 20 .. ;;(runtime
4670: 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d (db:test-get-
4680: 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 74 65 73 run_duration tes
4690: 74 29 29 0a 09 09 09 20 20 20 28 62 75 74 74 6f t)).... (butto
46a0: 6e 74 78 74 20 20 28 63 6f 6e 64 0a 09 09 09 09 ntxt (cond.....
46b0: 09 28 28 6d 65 6d 62 65 72 20 74 65 73 74 73 74 .((member testst
46c0: 61 74 65 20 27 28 22 43 4f 4d 50 4c 45 54 45 44 ate '("COMPLETED
46d0: 22 20 22 41 52 43 48 49 56 45 44 22 29 29 20 74 " "ARCHIVED")) t
46e0: 65 73 74 73 74 61 74 75 73 29 0a 09 09 09 09 09 eststatus)......
46f0: 28 28 61 6e 64 20 28 65 71 75 61 6c 3f 20 74 65 ((and (equal? te
4700: 73 74 73 74 61 74 65 20 22 4e 4f 54 5f 53 54 41 ststate "NOT_STA
4710: 52 54 45 44 22 29 0a 09 09 09 09 09 20 20 20 20 RTED")......
4720: 20 20 28 6d 65 6d 62 65 72 20 74 65 73 74 73 74 (member testst
4730: 61 74 75 73 20 27 28 22 5a 45 52 4f 5f 49 54 45 atus '("ZERO_ITE
4740: 4d 53 22 20 22 42 4c 4f 43 4b 45 44 22 20 22 50 MS" "BLOCKED" "P
4750: 52 45 51 5f 46 41 49 4c 22 20 22 50 52 45 51 5f REQ_FAIL" "PREQ_
4760: 44 49 53 43 41 52 44 45 44 22 20 22 54 49 4d 45 DISCARDED" "TIME
4770: 44 5f 4f 55 54 22 20 22 4b 45 45 50 5f 54 52 59 D_OUT" "KEEP_TRY
4780: 49 4e 47 22 20 22 54 45 4e 5f 53 54 52 49 4b 45 ING" "TEN_STRIKE
4790: 53 22 29 29 29 0a 09 09 09 09 09 20 74 65 73 74 S")))...... test
47a0: 73 74 61 74 75 73 29 0a 09 09 09 09 09 28 65 6c status)......(el
47b0: 73 65 0a 09 09 09 09 09 20 74 65 73 74 73 74 61 se...... teststa
47c0: 74 65 29 29 29 0a 09 09 09 20 20 20 28 62 75 74 te))).... (but
47d0: 74 6f 6e 20 20 20 20 20 28 76 65 63 74 6f 72 2d ton (vector-
47e0: 72 65 66 20 63 6f 6c 75 6d 6e 64 61 74 20 72 6f ref columndat ro
47f0: 77 6e 29 29 0a 09 09 09 20 20 20 28 63 6f 6c 6f wn)).... (colo
4800: 72 20 20 20 20 20 20 28 63 61 72 20 28 67 75 74 r (car (gut
4810: 69 6c 73 3a 67 65 74 2d 63 6f 6c 6f 72 2d 66 6f ils:get-color-fo
4820: 72 2d 73 74 61 74 65 2d 73 74 61 74 75 73 20 74 r-state-status t
4830: 65 73 74 73 74 61 74 65 20 74 65 73 74 73 74 61 eststate teststa
4840: 74 75 73 29 29 29 0a 09 09 09 20 20 20 28 63 75 tus))).... (cu
4850: 72 72 2d 63 6f 6c 6f 72 20 28 76 65 63 74 6f 72 rr-color (vector
4860: 2d 72 65 66 20 62 75 74 74 6f 6e 64 61 74 20 31 -ref buttondat 1
4870: 29 29 20 3b 3b 20 28 69 75 70 3a 61 74 74 72 69 )) ;; (iup:attri
4880: 62 75 74 65 20 62 75 74 74 6f 6e 20 22 42 47 43 bute button "BGC
4890: 4f 4c 4f 52 22 29 29 0a 09 09 09 20 20 20 28 63 OLOR")).... (c
48a0: 75 72 72 2d 74 69 74 6c 65 20 28 76 65 63 74 6f urr-title (vecto
48b0: 72 2d 72 65 66 20 62 75 74 74 6f 6e 64 61 74 20 r-ref buttondat
48c0: 32 29 29 29 20 3b 3b 20 28 69 75 70 3a 61 74 74 2))) ;; (iup:att
48d0: 72 69 62 75 74 65 20 62 75 74 74 6f 6e 20 22 54 ribute button "T
48e0: 49 54 4c 45 22 29 29 29 0a 09 09 20 20 20 20 20 ITLE")))...
48f0: 20 28 69 66 20 28 6e 6f 74 20 28 65 71 75 61 6c (if (not (equal
4900: 3f 20 63 75 72 72 2d 63 6f 6c 6f 72 20 63 6f 6c ? curr-color col
4910: 6f 72 29 29 0a 09 09 09 20 20 28 69 75 70 3a 61 or)).... (iup:a
4920: 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 62 75 ttribute-set! bu
4930: 74 74 6f 6e 20 22 42 47 43 4f 4c 4f 52 22 20 63 tton "BGCOLOR" c
4940: 6f 6c 6f 72 29 29 0a 09 09 20 20 20 20 20 20 28 olor))... (
4950: 69 66 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 if (not (equal?
4960: 63 75 72 72 2d 74 69 74 6c 65 20 62 75 74 74 6f curr-title butto
4970: 6e 74 78 74 29 29 0a 09 09 09 20 20 28 69 75 70 ntxt)).... (iup
4980: 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 :attribute-set!
4990: 62 75 74 74 6f 6e 20 22 54 49 54 4c 45 22 20 20 button "TITLE"
49a0: 20 62 75 74 74 6f 6e 74 78 74 29 29 0a 09 09 20 buttontxt))...
49b0: 20 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 (vector-set
49c0: 21 20 62 75 74 74 6f 6e 64 61 74 20 30 20 72 75 ! buttondat 0 ru
49d0: 6e 2d 69 64 29 0a 09 09 20 20 20 20 20 20 28 76 n-id)... (v
49e0: 65 63 74 6f 72 2d 73 65 74 21 20 62 75 74 74 6f ector-set! butto
49f0: 6e 64 61 74 20 31 20 63 6f 6c 6f 72 29 0a 09 09 ndat 1 color)...
4a00: 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 (vector-se
4a10: 74 21 20 62 75 74 74 6f 6e 64 61 74 20 32 20 62 t! buttondat 2 b
4a20: 75 74 74 6f 6e 74 78 74 29 0a 09 09 20 20 20 20 uttontxt)...
4a30: 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 62 (vector-set! b
4a40: 75 74 74 6f 6e 64 61 74 20 33 20 74 65 73 74 29 uttondat 3 test)
4a50: 0a 09 09 20 20 20 20 20 20 28 76 65 63 74 6f 72 ... (vector
4a60: 2d 73 65 74 21 20 62 75 74 74 6f 6e 64 61 74 20 -set! buttondat
4a70: 34 20 72 75 6e 2d 6b 65 79 29 29 29 0a 09 09 28 4 run-key)))...(
4a80: 73 65 74 21 20 72 6f 77 6e 20 28 2b 20 72 6f 77 set! rown (+ row
4a90: 6e 20 31 29 29 29 29 0a 09 20 20 20 20 2a 61 6c n 1)))).. *al
4aa0: 6c 74 65 73 74 6e 61 6d 65 6c 73 74 2a 29 29 0a ltestnamelst*)).
4ab0: 09 20 28 73 65 74 21 20 63 6f 6c 6e 20 28 2b 20 . (set! coln (+
4ac0: 63 6f 6c 6e 20 31 29 29 29 29 0a 20 20 20 20 20 coln 1)))).
4ad0: 72 75 6e 73 29 29 29 0a 0a 28 64 65 66 69 6e 65 runs)))..(define
4ae0: 20 28 6d 6b 73 74 72 20 2e 20 78 29 0a 20 20 28 (mkstr . x). (
4af0: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
4b00: 73 65 20 28 6d 61 70 20 63 6f 6e 63 20 78 29 20 se (map conc x)
4b10: 22 2c 22 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 ","))..(define (
4b20: 73 65 74 2d 62 67 2d 6f 6e 2d 66 69 6c 74 65 72 set-bg-on-filter
4b30: 29 0a 20 20 28 6c 65 74 20 28 28 73 65 61 72 63 ). (let ((searc
4b40: 68 2d 63 68 61 6e 67 65 64 20 28 6e 6f 74 20 28 h-changed (not (
4b50: 6e 75 6c 6c 3f 20 28 66 69 6c 74 65 72 20 28 6c null? (filter (l
4b60: 61 6d 62 64 61 20 28 6b 65 79 29 0a 09 09 09 09 ambda (key).....
4b70: 09 20 20 20 20 20 20 28 6e 6f 74 20 28 65 71 75 . (not (equ
4b80: 61 6c 3f 20 28 68 61 73 68 2d 74 61 62 6c 65 2d al? (hash-table-
4b90: 72 65 66 20 2a 73 65 61 72 63 68 70 61 74 74 73 ref *searchpatts
4ba0: 2a 20 6b 65 79 29 20 22 25 22 29 29 29 0a 09 09 * key) "%")))...
4bb0: 09 09 09 20 20 20 20 28 68 61 73 68 2d 74 61 62 ... (hash-tab
4bc0: 6c 65 2d 6b 65 79 73 20 2a 73 65 61 72 63 68 70 le-keys *searchp
4bd0: 61 74 74 73 2a 29 29 29 29 29 0a 09 28 73 74 61 atts*)))))..(sta
4be0: 74 65 2d 63 68 61 6e 67 65 64 20 20 28 6e 6f 74 te-changed (not
4bf0: 20 28 6e 75 6c 6c 3f 20 28 68 61 73 68 2d 74 61 (null? (hash-ta
4c00: 62 6c 65 2d 6b 65 79 73 20 2a 73 74 61 74 65 2d ble-keys *state-
4c10: 69 67 6e 6f 72 65 2d 68 61 73 68 2a 29 29 29 29 ignore-hash*))))
4c20: 0a 09 28 73 74 61 74 75 73 2d 63 68 61 6e 67 65 ..(status-change
4c30: 64 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 28 68 d (not (null? (h
4c40: 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 2a ash-table-keys *
4c50: 73 74 61 74 75 73 2d 69 67 6e 6f 72 65 2d 68 61 status-ignore-ha
4c60: 73 68 2a 29 29 29 29 29 0a 20 20 20 20 28 69 75 sh*))))). (iu
4c70: 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 p:attribute-set!
4c80: 20 2a 68 69 64 65 2d 6e 6f 74 2d 68 69 64 65 2d *hide-not-hide-
4c90: 74 61 62 73 2a 20 22 42 47 43 4f 4c 4f 52 22 0a tabs* "BGCOLOR".
4ca0: 09 09 09 28 69 66 20 28 6f 72 20 73 65 61 72 63 ...(if (or searc
4cb0: 68 2d 63 68 61 6e 67 65 64 0a 09 09 09 09 73 74 h-changed.....st
4cc0: 61 74 65 2d 63 68 61 6e 67 65 64 0a 09 09 09 09 ate-changed.....
4cd0: 73 74 61 74 75 73 2d 63 68 61 6e 67 65 64 29 0a status-changed).
4ce0: 09 09 09 20 20 20 20 22 31 39 30 20 31 38 30 20 ... "190 180
4cf0: 31 39 30 22 0a 09 09 09 20 20 20 20 22 31 39 30 190".... "190
4d00: 20 31 39 30 20 31 39 30 22 0a 09 09 09 20 20 20 190 190"....
4d10: 20 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 ))))..(define (
4d20: 75 70 64 61 74 65 2d 73 65 61 72 63 68 20 78 20 update-search x
4d30: 76 61 6c 29 0a 20 20 28 68 61 73 68 2d 74 61 62 val). (hash-tab
4d40: 6c 65 2d 73 65 74 21 20 2a 73 65 61 72 63 68 70 le-set! *searchp
4d50: 61 74 74 73 2a 20 78 20 76 61 6c 29 0a 20 20 28 atts* x val). (
4d60: 73 65 74 2d 62 67 2d 6f 6e 2d 66 69 6c 74 65 72 set-bg-on-filter
4d70: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 6d 61 72 ))..(define (mar
4d80: 6b 2d 66 6f 72 2d 75 70 64 61 74 65 29 0a 20 20 k-for-update).
4d90: 28 73 65 74 21 20 2a 6c 61 73 74 2d 64 62 2d 75 (set! *last-db-u
4da0: 70 64 61 74 65 2d 74 69 6d 65 2a 20 30 29 0a 20 pdate-time* 0).
4db0: 20 28 73 65 74 21 20 2a 64 65 6c 61 79 65 64 2d (set! *delayed-
4dc0: 75 70 64 61 74 65 2a 20 31 29 29 0a 0a 3b 3b 3d update* 1))..;;=
4dd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4de0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4df0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4e00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4e10: 3d 3d 3d 3d 3d 0a 3b 3b 20 52 20 55 20 4e 20 43 =====.;; R U N C
4e20: 20 4f 20 4e 20 54 20 52 20 4f 20 4c 0a 3b 3b 3d O N T R O L.;;=
4e30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4e40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4e50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4e60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4e70: 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 74 61 72 67 65 74 =====..;; target
4e80: 20 70 6f 70 75 6c 61 74 69 6e 67 20 6c 6f 67 69 populating logi
4e90: 63 0a 3b 3b 20 20 0a 3b 3b 20 6c 62 20 20 20 20 c.;; .;; lb
4ea0: 20 20 20 20 20 20 20 20 3d 20 3c 76 65 63 74 6f = <vecto
4eb0: 72 20 63 75 72 72 2d 6c 61 62 65 6c 2d 6f 62 6a r curr-label-obj
4ec0: 65 63 74 20 6e 65 78 74 2d 6c 61 62 65 6c 2d 6f ect next-label-o
4ed0: 62 6a 65 63 74 3e 0a 3b 3b 20 66 69 65 6c 64 20 bject>.;; field
4ee0: 20 20 20 20 20 20 20 20 3d 20 74 61 72 67 65 74 = target
4ef0: 20 66 69 65 6c 64 20 6e 61 6d 65 20 66 6f 72 20 field name for
4f00: 74 68 69 73 20 64 72 6f 70 64 6f 77 6e 0a 3b 3b this dropdown.;;
4f10: 20 72 65 66 65 72 65 6e 74 2d 76 61 6c 73 20 3d referent-vals =
4f20: 20 73 65 6c 65 63 74 65 64 20 76 61 6c 75 65 20 selected value
4f30: 69 6e 20 74 68 65 20 6c 65 66 74 20 64 72 6f 70 in the left drop
4f40: 64 6f 77 6e 0a 3b 3b 20 74 61 72 67 65 74 73 20 down.;; targets
4f50: 20 20 20 20 20 20 3d 20 6c 69 73 74 20 6f 66 20 = list of
4f60: 74 61 72 67 65 74 73 20 74 6f 20 75 73 65 20 74 targets to use t
4f70: 6f 20 62 75 69 6c 64 20 74 68 65 20 64 72 6f 70 o build the drop
4f80: 64 6f 77 6e 0a 3b 3b 20 0a 3b 3b 20 65 61 63 68 down.;; .;; each
4f90: 20 6e 6f 64 65 20 69 73 20 63 68 61 69 6e 65 64 node is chained
4fa0: 3a 20 6b 65 79 31 20 2d 3e 20 6b 65 79 32 20 2d : key1 -> key2 -
4fb0: 3e 20 6b 65 79 33 0a 3b 3b 0a 3b 3b 20 6d 75 73 > key3.;;.;; mus
4fc0: 74 20 73 65 6c 65 63 74 20 76 61 6c 75 65 73 20 t select values
4fd0: 66 72 6f 6d 20 6f 6e 6c 79 20 61 70 72 6f 70 72 from only apropr
4fe0: 69 61 74 65 20 74 61 72 67 65 74 73 0a 3b 3b 20 iate targets.;;
4ff0: 20 20 61 20 62 20 63 0a 3b 3b 20 20 20 61 20 64 a b c.;; a d
5000: 20 65 0a 3b 3b 20 20 20 61 20 62 20 66 0a 3b 3b e.;; a b f.;;
5010: 20 20 20 20 20 20 20 20 61 2f 62 20 3d 3e 20 63 a/b => c
5020: 20 66 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 64 f.;;.(define (d
5030: 61 73 68 62 6f 61 72 64 3a 70 6f 70 75 6c 61 74 ashboard:populat
5040: 65 2d 74 61 72 67 65 74 2d 64 72 6f 70 64 6f 77 e-target-dropdow
5050: 6e 20 6c 62 20 72 65 66 65 72 65 6e 74 2d 76 61 n lb referent-va
5060: 6c 73 20 74 61 72 67 65 74 73 29 20 3b 3b 20 20 ls targets) ;;
5070: 72 75 6e 63 6f 6e 66 2d 74 61 72 67 73 29 0a 20 runconf-targs).
5080: 20 3b 3b 20 69 73 20 74 68 65 20 63 75 72 72 65 ;; is the curre
5090: 6e 74 20 76 61 6c 75 65 20 69 6e 20 74 68 65 20 nt value in the
50a0: 6e 65 77 20 6c 69 73 74 3f 20 63 68 6f 6f 73 65 new list? choose
50b0: 20 6e 65 77 20 64 65 66 61 75 6c 74 20 69 66 20 new default if
50c0: 6e 6f 74 0a 20 20 28 6c 65 74 2a 20 28 28 72 65 not. (let* ((re
50d0: 6d 76 61 6c 75 65 73 20 20 28 6d 61 70 20 28 6c mvalues (map (l
50e0: 61 6d 62 64 61 20 28 72 6f 77 29 0a 09 09 09 20 ambda (row)....
50f0: 20 20 20 28 63 6f 6d 6d 6f 6e 3a 6c 69 73 74 2d (common:list-
5100: 69 73 2d 73 75 62 6c 69 73 74 20 72 65 66 65 72 is-sublist refer
5110: 65 6e 74 2d 76 61 6c 73 20 28 76 65 63 74 6f 72 ent-vals (vector
5120: 2d 3e 6c 69 73 74 20 72 6f 77 29 29 29 0a 09 09 ->list row)))...
5130: 09 20 20 74 61 72 67 65 74 73 29 29 0a 09 20 28 . targets)).. (
5140: 76 61 6c 75 65 73 20 20 20 20 20 28 64 65 6c 65 values (dele
5150: 74 65 2d 64 75 70 6c 69 63 61 74 65 73 20 28 6d te-duplicates (m
5160: 61 70 20 63 61 72 20 28 66 69 6c 74 65 72 20 6c ap car (filter l
5170: 69 73 74 3f 20 72 65 6d 76 61 6c 75 65 73 29 29 ist? remvalues))
5180: 29 29 0a 09 20 28 73 65 6c 2d 76 61 6c 6e 75 6d )).. (sel-valnum
5190: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 (iup:attribute
51a0: 6c 62 20 22 56 41 4c 55 45 22 29 29 0a 09 20 28 lb "VALUE")).. (
51b0: 73 65 6c 2d 76 61 6c 20 20 20 20 28 69 75 70 3a sel-val (iup:
51c0: 61 74 74 72 69 62 75 74 65 20 6c 62 20 73 65 6c attribute lb sel
51d0: 2d 76 61 6c 6e 75 6d 29 29 0a 09 20 28 76 61 6c -valnum)).. (val
51e0: 2d 6e 75 6d 20 20 20 20 31 29 29 0a 20 20 20 20 -num 1)).
51f0: 3b 3b 20 66 69 72 73 74 20 63 68 65 63 6b 20 69 ;; first check i
5200: 66 20 74 68 65 20 63 75 72 72 65 6e 74 20 76 61 f the current va
5210: 6c 75 65 20 69 73 20 69 6e 20 74 68 65 20 6e 65 lue is in the ne
5220: 77 20 6c 69 73 74 2c 20 6f 74 68 65 72 77 69 73 w list, otherwis
5230: 65 20 72 65 70 6c 61 63 65 20 77 69 74 68 20 0a e replace with .
5240: 20 20 20 20 3b 3b 20 66 69 72 73 74 20 76 61 6c ;; first val
5250: 75 65 20 66 72 6f 6d 20 76 61 6c 75 65 73 0a 20 ue from values.
5260: 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 (iup:attribut
5270: 65 2d 73 65 74 21 20 6c 62 20 22 52 45 4d 4f 56 e-set! lb "REMOV
5280: 45 49 54 45 4d 22 20 22 41 4c 4c 22 29 0a 20 20 EITEM" "ALL").
5290: 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d (for-each (lam
52a0: 62 64 61 20 28 76 61 6c 29 0a 09 09 3b 3b 20 28 bda (val)...;; (
52b0: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se
52c0: 74 21 20 6c 62 20 22 41 50 50 45 4e 44 49 54 45 t! lb "APPENDITE
52d0: 4d 22 20 76 61 6c 29 0a 09 09 28 69 75 70 3a 61 M" val)...(iup:a
52e0: 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 6c 62 ttribute-set! lb
52f0: 20 28 63 6f 6e 63 20 76 61 6c 2d 6e 75 6d 29 20 (conc val-num)
5300: 76 61 6c 29 0a 09 09 28 69 66 20 28 65 71 75 61 val)...(if (equa
5310: 6c 3f 20 73 65 6c 2d 76 61 6c 20 76 61 6c 29 0a l? sel-val val).
5320: 09 09 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 .. (iup:attri
5330: 62 75 74 65 2d 73 65 74 21 20 6c 62 20 22 56 41 bute-set! lb "VA
5340: 4c 55 45 22 20 76 61 6c 2d 6e 75 6d 29 29 0a 09 LUE" val-num))..
5350: 09 28 73 65 74 21 20 76 61 6c 2d 6e 75 6d 20 28 .(set! val-num (
5360: 2b 20 76 61 6c 2d 6e 75 6d 20 31 29 29 29 0a 09 + val-num 1)))..
5370: 20 20 20 20 20 20 76 61 6c 75 65 73 29 0a 20 20 values).
5380: 20 20 28 6c 65 74 20 28 28 76 61 6c 20 28 69 75 (let ((val (iu
5390: 70 3a 61 74 74 72 69 62 75 74 65 20 6c 62 20 22 p:attribute lb "
53a0: 56 41 4c 55 45 22 29 29 29 0a 20 20 20 20 20 20 VALUE"))).
53b0: 28 69 66 20 76 61 6c 0a 09 20 20 76 61 6c 0a 09 (if val.. val..
53c0: 20 20 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c (if (not (null
53d0: 3f 20 76 61 6c 75 65 73 29 29 0a 09 20 20 20 20 ? values))..
53e0: 20 20 28 6c 65 74 20 28 28 6e 65 77 76 61 6c 20 (let ((newval
53f0: 28 63 61 72 20 76 61 6c 75 65 73 29 29 29 0a 09 (car values)))..
5400: 09 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d .(iup:attribute-
5410: 73 65 74 21 20 6c 62 20 22 56 41 4c 55 45 22 20 set! lb "VALUE"
5420: 6e 65 77 76 61 6c 29 0a 09 09 6e 65 77 76 61 6c newval)...newval
5430: 29 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 ))))))..(define
5440: 28 64 61 73 68 62 6f 61 72 64 3a 75 70 64 61 74 (dashboard:updat
5450: 65 2d 74 61 72 67 65 74 2d 73 65 6c 65 63 74 6f e-target-selecto
5460: 72 20 6b 65 79 2d 6c 62 73 20 23 21 6b 65 79 20 r key-lbs #!key
5470: 28 61 63 74 69 6f 6e 2d 70 72 6f 63 20 23 66 29 (action-proc #f)
5480: 29 0a 20 20 28 6c 65 74 2a 20 28 28 72 75 6e 63 ). (let* ((runc
5490: 6f 6e 66 2d 74 61 72 67 73 20 28 63 6f 6d 6d 6f onf-targs (commo
54a0: 6e 3a 67 65 74 2d 72 75 6e 63 6f 6e 66 69 67 2d n:get-runconfig-
54b0: 74 61 72 67 65 74 73 29 29 0a 09 20 28 64 62 2d targets)).. (db-
54c0: 74 61 72 67 65 74 2d 64 61 74 20 28 69 66 20 2a target-dat (if *
54d0: 75 73 65 73 65 72 76 65 72 2a 20 0a 09 09 09 20 useserver* ....
54e0: 20 20 20 28 72 6d 74 3a 67 65 74 2d 74 61 72 67 (rmt:get-targ
54f0: 65 74 73 29 0a 09 09 09 20 20 20 20 28 64 62 3a ets).... (db:
5500: 67 65 74 2d 74 61 72 67 65 74 73 20 2a 64 62 73 get-targets *dbs
5510: 74 72 75 63 74 2d 6c 6f 63 61 6c 2a 29 29 29 0a truct-local*))).
5520: 09 20 28 68 65 61 64 65 72 20 20 20 20 20 20 20 . (header
5530: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 64 62 2d (vector-ref db-
5540: 74 61 72 67 65 74 2d 64 61 74 20 30 29 29 0a 09 target-dat 0))..
5550: 20 28 64 62 2d 74 61 72 67 65 74 73 20 20 20 20 (db-targets
5560: 28 76 65 63 74 6f 72 2d 72 65 66 20 64 62 2d 74 (vector-ref db-t
5570: 61 72 67 65 74 2d 64 61 74 20 31 29 29 0a 09 20 arget-dat 1))..
5580: 28 61 6c 6c 2d 74 61 72 67 65 74 73 20 20 20 28 (all-targets (
5590: 61 70 70 65 6e 64 20 64 62 2d 74 61 72 67 65 74 append db-target
55a0: 73 0a 09 09 09 09 28 6d 61 70 20 28 6c 61 6d 62 s.....(map (lamb
55b0: 64 61 20 28 78 29 0a 09 09 09 09 20 20 20 20 20 da (x).....
55c0: 20 20 28 6c 69 73 74 2d 3e 76 65 63 74 6f 72 0a (list->vector.
55d0: 09 09 09 09 09 28 74 61 6b 65 20 28 61 70 70 65 .....(take (appe
55e0: 6e 64 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 nd (string-split
55f0: 20 78 20 22 2f 22 29 0a 09 09 09 09 09 09 20 20 x "/").......
5600: 20 20 20 20 28 6d 61 6b 65 2d 6c 69 73 74 20 28 (make-list (
5610: 6c 65 6e 67 74 68 20 68 65 61 64 65 72 29 20 22 length header) "
5620: 6e 61 22 29 29 0a 09 09 09 09 09 20 20 20 20 20 na"))......
5630: 20 28 6c 65 6e 67 74 68 20 68 65 61 64 65 72 29 (length header)
5640: 29 29 29 0a 09 09 09 09 20 20 20 20 20 72 75 6e )))..... run
5650: 63 6f 6e 66 2d 74 61 72 67 73 29 29 29 0a 09 20 conf-targs)))..
5660: 28 6b 65 79 2d 6c 69 73 74 62 6f 78 65 73 20 28 (key-listboxes (
5670: 69 66 20 6b 65 79 2d 6c 62 73 20 6b 65 79 2d 6c if key-lbs key-l
5680: 62 73 20 28 6d 61 6b 65 2d 6c 69 73 74 20 28 6c bs (make-list (l
5690: 65 6e 67 74 68 20 68 65 61 64 65 72 29 20 23 66 ength header) #f
56a0: 29 29 29 29 0a 20 20 20 20 28 6c 65 74 20 6c 6f )))). (let lo
56b0: 6f 70 20 28 28 6b 65 79 20 20 20 20 20 28 63 61 op ((key (ca
56c0: 72 20 68 65 61 64 65 72 29 29 0a 09 20 20 20 20 r header))..
56d0: 20 20 20 28 72 65 6d 6b 65 79 73 20 28 63 64 72 (remkeys (cdr
56e0: 20 68 65 61 64 65 72 29 29 0a 09 20 20 20 20 20 header))..
56f0: 20 20 28 72 65 66 76 61 6c 73 20 27 28 29 29 0a (refvals '()).
5700: 09 20 20 20 20 20 20 20 28 69 6e 64 78 20 20 20 . (indx
5710: 20 30 29 0a 09 20 20 20 20 20 20 20 28 6c 62 73 0).. (lbs
5720: 20 20 20 20 20 27 28 29 29 29 0a 20 20 20 20 20 '())).
5730: 20 28 6c 65 74 2a 20 28 28 6c 62 20 28 6c 65 74 (let* ((lb (let
5740: 20 28 28 6c 62 20 28 6c 69 73 74 2d 72 65 66 20 ((lb (list-ref
5750: 6b 65 79 2d 6c 69 73 74 62 6f 78 65 73 20 69 6e key-listboxes in
5760: 64 78 29 29 29 0a 09 09 20 20 20 28 69 66 20 6c dx)))... (if l
5770: 62 0a 09 09 20 20 20 20 20 20 20 6c 62 0a 09 09 b... lb...
5780: 20 20 20 20 20 20 20 28 69 75 70 3a 6c 69 73 74 (iup:list
5790: 62 6f 78 20 0a 09 09 09 23 3a 73 69 7a 65 20 22 box ....#:size "
57a0: 34 35 78 35 30 22 20 0a 09 09 09 23 3a 66 6f 6e 45x50" ....#:fon
57b0: 74 73 69 7a 65 20 22 31 30 22 0a 09 09 09 23 3a tsize "10"....#:
57c0: 65 78 70 61 6e 64 20 22 59 45 53 22 20 3b 3b 20 expand "YES" ;;
57d0: 22 56 45 52 54 49 43 41 4c 22 0a 09 09 09 3b 3b "VERTICAL"....;;
57e0: 20 23 3a 64 72 6f 70 64 6f 77 6e 20 22 59 45 53 #:dropdown "YES
57f0: 22 0a 09 09 09 23 3a 65 64 69 74 62 6f 78 20 22 "....#:editbox "
5800: 59 45 53 22 0a 09 09 09 23 3a 61 63 74 69 6f 6e YES"....#:action
5810: 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 20 61 20 (lambda (obj a
5820: 62 20 63 29 0a 09 09 09 09 20 20 20 28 61 63 74 b c)..... (act
5830: 69 6f 6e 2d 70 72 6f 63 29 29 0a 09 09 09 23 3a ion-proc))....#:
5840: 63 61 72 65 74 5f 63 62 20 28 6c 61 6d 62 64 61 caret_cb (lambda
5850: 20 28 6f 62 6a 20 61 20 62 20 63 29 28 61 63 74 (obj a b c)(act
5860: 69 6f 6e 2d 70 72 6f 63 29 29 0a 09 09 09 29 29 ion-proc))....))
5870: 29 29 0a 09 20 20 20 20 20 3b 3b 20 6c 6f 6f 70 )).. ;; loop
5880: 20 74 68 6f 75 67 68 20 61 6c 6c 20 74 68 65 20 though all the
5890: 74 61 72 67 65 74 73 20 61 6e 64 20 62 75 69 6c targets and buil
58a0: 64 20 74 68 65 20 6c 69 73 74 20 66 6f 72 20 74 d the list for t
58b0: 68 69 73 20 64 72 6f 70 64 6f 77 6e 0a 09 20 20 his dropdown..
58c0: 20 20 20 28 73 65 6c 65 63 74 65 64 2d 76 61 6c (selected-val
58d0: 75 65 20 28 64 61 73 68 62 6f 61 72 64 3a 70 6f ue (dashboard:po
58e0: 70 75 6c 61 74 65 2d 74 61 72 67 65 74 2d 64 72 pulate-target-dr
58f0: 6f 70 64 6f 77 6e 20 6c 62 20 72 65 66 76 61 6c opdown lb refval
5900: 73 20 61 6c 6c 2d 74 61 72 67 65 74 73 29 29 29 s all-targets)))
5910: 0a 09 28 69 66 20 28 6e 75 6c 6c 3f 20 72 65 6d ..(if (null? rem
5920: 6b 65 79 73 29 0a 09 20 20 20 20 3b 3b 20 72 65 keys).. ;; re
5930: 74 75 72 6e 20 61 20 6c 69 73 74 20 6f 66 20 74 turn a list of t
5940: 68 65 20 6c 69 73 74 62 6f 78 20 69 74 65 6d 73 he listbox items
5950: 20 61 6e 64 20 61 6e 20 69 75 70 3a 68 62 6f 78 and an iup:hbox
5960: 20 77 69 74 68 20 74 68 65 20 6c 61 62 65 6c 73 with the labels
5970: 20 61 6e 64 20 6c 69 73 74 62 6f 78 65 73 0a 09 and listboxes..
5980: 20 20 20 20 28 6c 65 74 20 28 28 6c 69 73 74 62 (let ((listb
5990: 6f 78 65 73 20 28 61 70 70 65 6e 64 20 6c 62 73 oxes (append lbs
59a0: 20 28 6c 69 73 74 20 6c 62 29 29 29 29 0a 09 20 (list lb))))..
59b0: 20 20 20 20 20 28 6c 69 73 74 20 6c 69 73 74 62 (list listb
59c0: 6f 78 65 73 0a 09 09 20 20 20 20 28 6d 61 70 20 oxes... (map
59d0: 28 6c 61 6d 62 64 61 20 28 68 74 78 74 20 6c 62 (lambda (htxt lb
59e0: 29 0a 09 09 09 20 20 20 28 69 75 70 3a 76 62 6f ).... (iup:vbo
59f0: 78 0a 09 09 09 20 20 20 20 28 69 75 70 3a 6c 61 x.... (iup:la
5a00: 62 65 6c 20 68 74 78 74 29 20 0a 09 09 09 20 20 bel htxt) ....
5a10: 20 20 6c 62 29 29 0a 09 09 09 20 68 65 61 64 65 lb)).... heade
5a20: 72 0a 09 09 09 20 6c 69 73 74 62 6f 78 65 73 29 r.... listboxes)
5a30: 29 29 0a 09 20 20 20 20 28 6c 6f 6f 70 20 28 63 )).. (loop (c
5a40: 61 72 20 72 65 6d 6b 65 79 73 29 0a 09 09 20 20 ar remkeys)...
5a50: 28 63 64 72 20 72 65 6d 6b 65 79 73 29 0a 09 09 (cdr remkeys)...
5a60: 20 20 28 61 70 70 65 6e 64 20 72 65 66 76 61 6c (append refval
5a70: 73 20 28 6c 69 73 74 20 73 65 6c 65 63 74 65 64 s (list selected
5a80: 2d 76 61 6c 75 65 29 29 0a 09 09 20 20 28 2b 20 -value))... (+
5a90: 69 6e 64 78 20 31 29 0a 09 09 20 20 28 61 70 70 indx 1)... (app
5aa0: 65 6e 64 20 6c 62 73 20 28 6c 69 73 74 20 6c 62 end lbs (list lb
5ab0: 29 29 29 29 29 29 29 29 0a 0a 3b 3b 20 4d 61 6b ))))))))..;; Mak
5ac0: 65 20 61 20 76 65 72 74 69 63 61 6c 20 6c 69 73 e a vertical lis
5ad0: 74 20 6f 66 20 74 6f 67 67 6c 65 73 20 75 73 69 t of toggles usi
5ae0: 6e 67 20 69 74 65 6d 73 2c 20 77 68 65 6e 20 74 ng items, when t
5af0: 6f 67 67 6c 65 64 20 63 61 6c 6c 20 70 72 6f 63 oggled call proc
5b00: 20 77 69 74 68 20 74 68 65 20 63 6f 6e 63 27 64 with the conc'd
5b10: 20 73 74 72 69 6e 67 20 0a 3b 3b 20 69 6e 74 65 string .;; inte
5b20: 72 73 70 65 72 73 65 64 20 77 69 74 68 20 63 6f rspersed with co
5b30: 6d 6d 61 73 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 mmas.;;.(define
5b40: 28 64 61 73 68 62 6f 61 72 64 3a 74 65 78 74 2d (dashboard:text-
5b50: 6c 69 73 74 2d 74 6f 67 67 6c 65 2d 62 6f 78 20 list-toggle-box
5b60: 69 74 65 6d 73 20 70 72 6f 63 29 0a 20 20 28 6c items proc). (l
5b70: 65 74 20 28 28 61 6c 6c 74 67 6c 73 20 28 6d 61 et ((alltgls (ma
5b80: 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 29 ke-hash-table)))
5b90: 0a 20 20 20 20 28 61 70 70 6c 79 20 69 75 70 3a . (apply iup:
5ba0: 76 62 6f 78 0a 09 20 20 20 28 6d 61 70 20 28 6c vbox.. (map (l
5bb0: 61 6d 62 64 61 20 28 69 74 65 6d 29 0a 09 09 20 ambda (item)...
5bc0: 20 28 69 75 70 3a 74 6f 67 67 6c 65 20 0a 09 09 (iup:toggle ...
5bd0: 20 20 20 69 74 65 6d 0a 09 09 20 20 20 23 3a 65 item... #:e
5be0: 78 70 61 6e 64 20 22 59 45 53 22 0a 09 09 20 20 xpand "YES"...
5bf0: 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 #:action (lambd
5c00: 61 20 28 6f 62 6a 20 74 73 74 61 74 65 29 0a 09 a (obj tstate)..
5c10: 09 09 20 20 20 20 20 20 28 69 66 20 28 65 71 3f .. (if (eq?
5c20: 20 74 73 74 61 74 65 20 30 29 0a 09 09 09 09 20 tstate 0).....
5c30: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 64 65 6c (hash-table-del
5c40: 65 74 65 21 20 61 6c 6c 74 67 6c 73 20 69 74 65 ete! alltgls ite
5c50: 6d 29 0a 09 09 09 09 20 20 28 68 61 73 68 2d 74 m)..... (hash-t
5c60: 61 62 6c 65 2d 73 65 74 21 20 61 6c 6c 74 67 6c able-set! alltgl
5c70: 73 20 69 74 65 6d 20 23 74 29 29 0a 09 09 09 20 s item #t))....
5c80: 20 20 20 20 20 28 6c 65 74 20 28 28 61 6c 6c 20 (let ((all
5c90: 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 (hash-table-keys
5ca0: 20 61 6c 6c 74 67 6c 73 29 29 29 0a 09 09 09 09 alltgls))).....
5cb0: 28 70 72 6f 63 20 61 6c 6c 29 29 29 29 29 0a 09 (proc all)))))..
5cc0: 09 69 74 65 6d 73 29 29 29 29 0a 0a 3b 3b 20 45 .items))))..;; E
5cd0: 78 74 72 61 63 74 20 74 68 65 20 76 61 72 69 6f xtract the vario
5ce0: 75 73 20 62 69 74 73 20 6f 66 20 64 61 74 61 20 us bits of data
5cf0: 66 72 6f 6d 20 2a 64 61 74 61 2a 20 61 6e 64 20 from *data* and
5d00: 63 72 65 61 74 65 20 74 68 65 20 63 6f 6d 6d 61 create the comma
5d10: 6e 64 20 6c 69 6e 65 20 65 71 75 69 76 61 6c 65 nd line equivale
5d20: 6e 74 20 74 68 61 74 20 77 69 6c 6c 20 62 65 20 nt that will be
5d30: 64 69 73 70 6c 61 79 65 64 0a 3b 3b 0a 28 64 65 displayed.;;.(de
5d40: 66 69 6e 65 20 28 64 61 73 68 62 6f 61 72 64 3a fine (dashboard:
5d50: 75 70 64 61 74 65 2d 72 75 6e 2d 63 6f 6d 6d 61 update-run-comma
5d60: 6e 64 29 0a 20 20 28 6c 65 74 2a 20 28 28 63 6d nd). (let* ((cm
5d70: 64 2d 74 62 20 20 20 20 20 20 20 28 64 62 6f 61 d-tb (dboa
5d80: 72 64 3a 64 61 74 61 2d 67 65 74 2d 63 6f 6d 6d rd:data-get-comm
5d90: 61 6e 64 2d 74 62 20 2a 64 61 74 61 2a 29 29 0a and-tb *data*)).
5da0: 09 20 28 63 6d 64 20 20 20 20 20 20 20 20 20 20 . (cmd
5db0: 28 64 62 6f 61 72 64 3a 64 61 74 61 2d 67 65 74 (dboard:data-get
5dc0: 2d 63 6f 6d 6d 61 6e 64 20 20 20 20 2a 64 61 74 -command *dat
5dd0: 61 2a 29 29 0a 09 20 28 74 65 73 74 2d 70 61 74 a*)).. (test-pat
5de0: 74 20 20 20 20 28 6c 65 74 20 28 28 74 70 20 28 t (let ((tp (
5df0: 64 62 6f 61 72 64 3a 64 61 74 61 2d 67 65 74 2d dboard:data-get-
5e00: 74 65 73 74 2d 70 61 74 74 73 20 2a 64 61 74 61 test-patts *data
5e10: 2a 29 29 29 0a 09 09 09 20 28 69 66 20 28 65 71 *))).... (if (eq
5e20: 75 61 6c 3f 20 74 70 20 22 22 29 20 22 25 22 20 ual? tp "") "%"
5e30: 74 70 29 29 29 0a 09 20 28 73 74 61 74 65 73 20 tp))).. (states
5e40: 20 20 20 20 20 20 28 64 62 6f 61 72 64 3a 64 61 (dboard:da
5e50: 74 61 2d 67 65 74 2d 73 74 61 74 65 73 20 20 20 ta-get-states
5e60: 20 20 2a 64 61 74 61 2a 29 29 0a 09 20 28 73 74 *data*)).. (st
5e70: 61 74 75 73 65 73 20 20 20 20 20 28 64 62 6f 61 atuses (dboa
5e80: 72 64 3a 64 61 74 61 2d 67 65 74 2d 73 74 61 74 rd:data-get-stat
5e90: 75 73 65 73 20 20 20 2a 64 61 74 61 2a 29 29 0a uses *data*)).
5ea0: 09 20 28 74 61 72 67 65 74 20 20 20 20 20 20 20 . (target
5eb0: 28 6c 65 74 20 28 28 74 61 72 67 2d 6c 69 73 74 (let ((targ-list
5ec0: 20 28 64 62 6f 61 72 64 3a 64 61 74 61 2d 67 65 (dboard:data-ge
5ed0: 74 2d 74 61 72 67 65 74 20 20 20 20 20 2a 64 61 t-target *da
5ee0: 74 61 2a 29 29 29 0a 09 09 09 20 28 69 66 20 74 ta*))).... (if t
5ef0: 61 72 67 2d 6c 69 73 74 20 28 73 74 72 69 6e 67 arg-list (string
5f00: 2d 69 6e 74 65 72 73 70 65 72 73 65 20 74 61 72 -intersperse tar
5f10: 67 2d 6c 69 73 74 20 22 2f 22 29 20 22 6e 6f 2d g-list "/") "no-
5f20: 74 61 72 67 65 74 2d 73 65 6c 65 63 74 65 64 22 target-selected"
5f30: 29 29 29 0a 09 20 28 72 75 6e 2d 6e 61 6d 65 20 ))).. (run-name
5f40: 20 20 20 20 28 64 62 6f 61 72 64 3a 64 61 74 61 (dboard:data
5f50: 2d 67 65 74 2d 72 75 6e 2d 6e 61 6d 65 20 20 20 -get-run-name
5f60: 2a 64 61 74 61 2a 29 29 0a 09 20 28 73 74 61 74 *data*)).. (stat
5f70: 65 73 2d 73 74 72 20 20 20 28 69 66 20 28 6f 72 es-str (if (or
5f80: 20 28 6e 6f 74 20 73 74 61 74 65 73 29 0a 09 09 (not states)...
5f90: 09 20 20 20 20 20 20 20 28 6e 75 6c 6c 3f 20 73 . (null? s
5fa0: 74 61 74 65 73 29 29 0a 09 09 09 20 20 20 22 22 tates)).... ""
5fb0: 0a 09 09 09 20 20 20 28 63 6f 6e 63 20 22 20 3a .... (conc " :
5fc0: 73 74 61 74 65 20 22 20 20 28 73 74 72 69 6e 67 state " (string
5fd0: 2d 69 6e 74 65 72 73 70 65 72 73 65 20 73 74 61 -intersperse sta
5fe0: 74 65 73 20 22 2c 22 29 29 29 29 0a 09 20 28 73 tes ",")))).. (s
5ff0: 74 61 74 75 73 65 73 2d 73 74 72 20 28 69 66 20 tatuses-str (if
6000: 28 6f 72 20 28 6e 6f 74 20 73 74 61 74 75 73 65 (or (not statuse
6010: 73 29 0a 09 09 09 20 20 20 20 20 20 20 28 6e 75 s).... (nu
6020: 6c 6c 3f 20 73 74 61 74 75 73 65 73 29 29 0a 09 ll? statuses))..
6030: 09 09 20 20 20 22 22 0a 09 09 09 20 20 20 28 63 .. "".... (c
6040: 6f 6e 63 20 22 20 3a 73 74 61 74 75 73 20 22 20 onc " :status "
6050: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
6060: 72 73 65 20 73 74 61 74 75 73 65 73 20 22 2c 22 rse statuses ","
6070: 29 29 29 29 0a 09 20 28 66 75 6c 6c 2d 63 6d 64 )))).. (full-cmd
6080: 20 20 22 6d 65 67 61 74 65 73 74 22 29 29 0a 20 "megatest")).
6090: 20 20 20 28 63 61 73 65 20 28 73 74 72 69 6e 67 (case (string
60a0: 2d 3e 73 79 6d 62 6f 6c 20 63 6d 64 29 0a 20 20 ->symbol cmd).
60b0: 20 20 20 20 28 28 72 75 6e 74 65 73 74 73 29 0a ((runtests).
60c0: 20 20 20 20 20 20 20 28 73 65 74 21 20 66 75 6c (set! ful
60d0: 6c 2d 63 6d 64 20 28 63 6f 6e 63 20 66 75 6c 6c l-cmd (conc full
60e0: 2d 63 6d 64 20 0a 09 09 09 20 20 20 20 22 20 2d -cmd .... " -
60f0: 72 75 6e 74 65 73 74 73 20 22 0a 09 09 09 20 20 runtests "....
6100: 20 20 74 65 73 74 2d 70 61 74 74 0a 09 09 09 20 test-patt....
6110: 20 20 20 22 20 2d 74 61 72 67 65 74 20 22 0a 09 " -target "..
6120: 09 09 20 20 20 20 74 61 72 67 65 74 0a 09 09 09 .. target....
6130: 20 20 20 20 22 20 2d 72 75 6e 6e 61 6d 65 20 22 " -runname "
6140: 0a 09 09 09 20 20 20 20 72 75 6e 2d 6e 61 6d 65 .... run-name
6150: 0a 09 09 09 20 20 20 20 29 29 29 0a 20 20 20 20 .... ))).
6160: 20 20 28 28 72 65 6d 6f 76 65 2d 72 75 6e 73 29 ((remove-runs)
6170: 0a 20 20 20 20 20 20 20 28 73 65 74 21 20 66 75 . (set! fu
6180: 6c 6c 2d 63 6d 64 20 28 63 6f 6e 63 20 66 75 6c ll-cmd (conc ful
6190: 6c 2d 63 6d 64 0a 09 09 09 20 20 20 20 22 20 2d l-cmd.... " -
61a0: 72 65 6d 6f 76 65 2d 72 75 6e 73 20 2d 72 75 6e remove-runs -run
61b0: 6e 61 6d 65 20 22 0a 09 09 09 20 20 20 20 72 75 name ".... ru
61c0: 6e 2d 6e 61 6d 65 0a 09 09 09 20 20 20 20 22 20 n-name.... "
61d0: 2d 74 61 72 67 65 74 20 22 20 0a 09 09 09 20 20 -target " ....
61e0: 20 20 74 61 72 67 65 74 0a 09 09 09 20 20 20 20 target....
61f0: 22 20 2d 74 65 73 74 70 61 74 74 20 22 0a 09 09 " -testpatt "...
6200: 09 20 20 20 20 74 65 73 74 2d 70 61 74 74 0a 09 . test-patt..
6210: 09 09 20 20 20 20 73 74 61 74 65 73 2d 73 74 72 .. states-str
6220: 0a 09 09 09 20 20 20 20 73 74 61 74 75 73 65 73 .... statuses
6230: 2d 73 74 72 0a 09 09 09 20 20 20 20 29 29 29 0a -str.... ))).
6240: 20 20 20 20 20 20 28 65 6c 73 65 20 28 73 65 74 (else (set
6250: 21 20 66 75 6c 6c 2d 63 6d 64 20 22 20 6e 6f 20 ! full-cmd " no
6260: 76 61 6c 69 64 20 63 6f 6d 6d 61 6e 64 20 22 29 valid command ")
6270: 29 29 0a 20 20 20 20 28 69 75 70 3a 61 74 74 72 )). (iup:attr
6280: 69 62 75 74 65 2d 73 65 74 21 20 63 6d 64 2d 74 ibute-set! cmd-t
6290: 62 20 22 56 41 4c 55 45 22 20 66 75 6c 6c 2d 63 b "VALUE" full-c
62a0: 6d 64 29 29 29 0a 0a 3b 3b 20 44 69 73 70 6c 61 md)))..;; Displa
62b0: 79 20 74 68 65 20 74 65 73 74 73 20 61 73 20 72 y the tests as r
62c0: 6f 77 73 20 6f 66 20 62 6f 78 65 73 20 6f 6e 20 ows of boxes on
62d0: 74 68 65 20 74 65 73 74 2f 74 61 73 6b 20 70 61 the test/task pa
62e0: 6e 65 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 64 ne.;;.(define (d
62f0: 61 73 68 62 6f 61 72 64 3a 64 72 61 77 2d 74 65 ashboard:draw-te
6300: 73 74 73 20 63 6e 76 20 78 61 64 6a 20 79 61 64 sts cnv xadj yad
6310: 6a 20 74 65 73 74 73 2d 64 72 61 77 2d 73 74 61 j tests-draw-sta
6320: 74 65 20 73 6f 72 74 65 64 2d 74 65 73 74 6e 61 te sorted-testna
6330: 6d 65 73 29 0a 20 20 28 63 61 6e 76 61 73 2d 63 mes). (canvas-c
6340: 6c 65 61 72 21 20 63 6e 76 29 0a 20 20 28 63 61 lear! cnv). (ca
6350: 6e 76 61 73 2d 66 6f 6e 74 2d 73 65 74 21 20 63 nvas-font-set! c
6360: 6e 76 20 22 48 65 6c 76 65 74 69 63 61 2c 20 2d nv "Helvetica, -
6370: 31 30 22 29 0a 20 20 28 6c 65 74 2d 76 61 6c 75 10"). (let-valu
6380: 65 73 20 28 28 28 73 69 7a 65 78 20 73 69 7a 65 es (((sizex size
6390: 79 20 73 69 7a 65 78 6d 6d 20 73 69 7a 65 79 6d y sizexmm sizeym
63a0: 6d 29 20 28 63 61 6e 76 61 73 2d 73 69 7a 65 20 m) (canvas-size
63b0: 63 6e 76 29 29 0a 09 20 20 20 20 20 20 20 28 28 cnv)).. ((
63c0: 6f 72 69 67 69 6e 78 20 6f 72 69 67 69 6e 79 29 originx originy)
63d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 61 (ca
63e0: 6e 76 61 73 2d 6f 72 69 67 69 6e 20 63 6e 76 29 nvas-origin cnv)
63f0: 29 29 0a 20 20 20 20 20 20 3b 3b 20 28 70 72 69 )). ;; (pri
6400: 6e 74 20 22 6f 72 69 67 69 6e 78 3a 20 22 20 6f nt "originx: " o
6410: 72 69 67 69 6e 78 20 22 20 6f 72 69 67 69 6e 79 riginx " originy
6420: 3a 20 22 20 6f 72 69 67 69 6e 79 29 0a 20 20 20 : " originy).
6430: 20 20 20 3b 3b 20 28 63 61 6e 76 61 73 2d 6f 72 ;; (canvas-or
6440: 69 67 69 6e 2d 73 65 74 21 20 63 6e 76 20 30 20 igin-set! cnv 0
6450: 28 2d 20 28 2f 20 73 69 7a 65 79 20 32 29 29 29 (- (/ sizey 2)))
6460: 0a 20 20 20 20 20 20 28 69 66 20 28 68 61 73 68 . (if (hash
6470: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau
6480: 6c 74 20 74 65 73 74 73 2d 64 72 61 77 2d 73 74 lt tests-draw-st
6490: 61 74 65 20 27 66 69 72 73 74 2d 74 69 6d 65 20 ate 'first-time
64a0: 23 74 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 #t).. (begin..
64b0: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 (hash-table-s
64c0: 65 74 21 20 74 65 73 74 73 2d 64 72 61 77 2d 73 et! tests-draw-s
64d0: 74 61 74 65 20 27 66 69 72 73 74 2d 74 69 6d 65 tate 'first-time
64e0: 20 23 66 29 0a 09 20 20 20 20 28 68 61 73 68 2d #f).. (hash-
64f0: 74 61 62 6c 65 2d 73 65 74 21 20 74 65 73 74 73 table-set! tests
6500: 2d 64 72 61 77 2d 73 74 61 74 65 20 27 73 63 61 -draw-state 'sca
6510: 6c 65 66 20 38 29 0a 09 20 20 20 20 28 68 61 73 lef 8).. (has
6520: 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 74 65 73 h-table-set! tes
6530: 74 73 2d 64 72 61 77 2d 73 74 61 74 65 20 27 74 ts-draw-state 't
6540: 65 73 74 73 2d 69 6e 66 6f 20 28 6d 61 6b 65 2d ests-info (make-
6550: 68 61 73 68 2d 74 61 62 6c 65 29 29 0a 09 20 20 hash-table))..
6560: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 (hash-table-se
6570: 74 21 20 74 65 73 74 73 2d 64 72 61 77 2d 73 74 t! tests-draw-st
6580: 61 74 65 20 27 73 65 6c 65 63 74 65 64 2d 74 65 ate 'selected-te
6590: 73 74 73 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 sts (make-hash-t
65a0: 61 62 6c 65 29 29 0a 09 20 20 20 20 3b 3b 20 73 able)).. ;; s
65b0: 65 74 20 74 68 65 73 65 20 0a 09 20 20 20 20 28 et these .. (
65c0: 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 hash-table-set!
65d0: 74 65 73 74 73 2d 64 72 61 77 2d 73 74 61 74 65 tests-draw-state
65e0: 20 27 74 65 73 74 2d 62 72 6f 77 73 65 2d 78 6f 'test-browse-xo
65f0: 66 66 73 65 74 20 32 30 29 20 3b 3b 20 28 2d 20 ffset 20) ;; (-
6600: 30 20 28 2a 20 28 2f 20 73 69 7a 65 78 20 32 29 0 (* (/ sizex 2)
6610: 20 28 2a 20 38 20 78 61 64 6a 29 29 29 29 0a 09 (* 8 xadj))))..
6620: 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (hash-table-
6630: 73 65 74 21 20 74 65 73 74 73 2d 64 72 61 77 2d set! tests-draw-
6640: 73 74 61 74 65 20 27 74 65 73 74 2d 62 72 6f 77 state 'test-brow
6650: 73 65 2d 79 6f 66 66 73 65 74 20 32 30 29 20 3b se-yoffset 20) ;
6660: 3b 20 28 2d 20 30 20 28 2a 20 28 2f 20 73 69 7a ; (- 0 (* (/ siz
6670: 65 79 20 32 29 20 28 2a 20 38 20 28 2d 20 31 20 ey 2) (* 8 (- 1
6680: 79 61 64 6a 29 29 29 29 29 29 29 0a 09 20 20 20 yadj)))))))..
6690: 20 28 64 63 6f 6d 6d 6f 6e 3a 69 6e 69 74 69 61 (dcommon:initia
66a0: 6c 2d 64 72 61 77 2d 74 65 73 74 73 20 63 6e 76 l-draw-tests cnv
66b0: 20 78 61 64 6a 20 79 61 64 6a 20 73 69 7a 65 78 xadj yadj sizex
66c0: 20 73 69 7a 65 79 20 73 69 7a 65 78 6d 6d 20 73 sizey sizexmm s
66d0: 69 7a 65 79 6d 6d 20 6f 72 69 67 69 6e 78 20 6f izeymm originx o
66e0: 72 69 67 69 6e 79 20 74 65 73 74 73 2d 64 72 61 riginy tests-dra
66f0: 77 2d 73 74 61 74 65 20 73 6f 72 74 65 64 2d 74 w-state sorted-t
6700: 65 73 74 6e 61 6d 65 73 29 29 0a 09 20 20 28 64 estnames)).. (d
6710: 63 6f 6d 6d 6f 6e 3a 72 65 64 72 61 77 2d 74 65 common:redraw-te
6720: 73 74 73 20 63 6e 76 20 78 61 64 6a 20 79 61 64 sts cnv xadj yad
6730: 6a 20 73 69 7a 65 78 20 73 69 7a 65 79 20 73 69 j sizex sizey si
6740: 7a 65 78 6d 6d 20 73 69 7a 65 79 6d 6d 20 6f 72 zexmm sizeymm or
6750: 69 67 69 6e 78 20 6f 72 69 67 69 6e 79 20 74 65 iginx originy te
6760: 73 74 73 2d 64 72 61 77 2d 73 74 61 74 65 20 73 sts-draw-state s
6770: 6f 72 74 65 64 2d 74 65 73 74 6e 61 6d 65 73 29 orted-testnames)
6780: 29 0a 20 20 20 20 20 20 29 29 0a 0a 3b 3b 3d 3d ). ))..;;==
6790: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
67a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
67b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
67c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
67d0: 3d 3d 3d 3d 0a 3b 3b 20 52 20 55 20 4e 20 20 20 ====.;; R U N
67e0: 43 20 4f 20 4e 20 54 20 52 20 4f 20 4c 20 53 0a C O N T R O L S.
67f0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
6800: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6810: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6820: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6830: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 0a 3b 3b 20 41 ========.;;.;; A
6840: 20 67 75 69 20 66 6f 72 20 6c 61 75 6e 63 68 69 gui for launchi
6850: 6e 67 20 74 65 73 74 73 0a 3b 3b 0a 28 64 65 66 ng tests.;;.(def
6860: 69 6e 65 20 28 64 61 73 68 62 6f 61 72 64 3a 72 ine (dashboard:r
6870: 75 6e 2d 63 6f 6e 74 72 6f 6c 73 29 0a 20 20 28 un-controls). (
6880: 6c 65 74 2a 20 28 28 74 61 72 67 65 74 73 20 20 let* ((targets
6890: 20 20 20 20 20 28 6d 61 6b 65 2d 68 61 73 68 2d (make-hash-
68a0: 74 61 62 6c 65 29 29 0a 09 20 28 74 65 73 74 2d table)).. (test-
68b0: 72 65 63 6f 72 64 73 20 20 28 6d 61 6b 65 2d 68 records (make-h
68c0: 61 73 68 2d 74 61 62 6c 65 29 29 0a 09 20 28 61 ash-table)).. (a
68d0: 6c 6c 2d 74 65 73 74 73 2d 72 65 67 69 73 74 72 ll-tests-registr
68e0: 79 20 28 74 65 73 74 73 3a 67 65 74 2d 61 6c 6c y (tests:get-all
68f0: 29 29 20 3b 3b 20 28 74 65 73 74 73 3a 67 65 74 )) ;; (tests:get
6900: 2d 76 61 6c 69 64 2d 74 65 73 74 73 20 2a 74 6f -valid-tests *to
6910: 70 70 61 74 68 2a 20 27 28 29 29 29 0a 09 20 28 ppath* '())).. (
6920: 74 65 73 74 2d 6e 61 6d 65 73 20 20 20 20 28 68 test-names (h
6930: 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 61 ash-table-keys a
6940: 6c 6c 2d 74 65 73 74 73 2d 72 65 67 69 73 74 72 ll-tests-registr
6950: 79 29 29 0a 09 20 28 73 6f 72 74 65 64 2d 74 65 y)).. (sorted-te
6960: 73 74 6e 61 6d 65 73 20 23 66 29 0a 09 20 28 61 stnames #f).. (a
6970: 63 74 69 6f 6e 20 20 20 20 20 20 20 20 22 2d 72 ction "-r
6980: 75 6e 74 65 73 74 73 22 29 0a 09 20 28 63 6d 64 untests").. (cmd
6990: 6c 6e 20 20 20 20 20 20 20 20 20 22 22 29 0a 09 ln "")..
69a0: 20 28 72 75 6e 6c 6f 67 73 20 20 20 20 20 20 20 (runlogs
69b0: 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 (make-hash-table
69c0: 29 29 0a 09 20 28 6b 65 79 2d 6c 69 73 74 62 6f )).. (key-listbo
69d0: 78 65 73 20 23 66 29 0a 09 20 28 75 70 64 61 74 xes #f).. (updat
69e0: 65 72 2d 66 6f 72 2d 72 75 6e 73 20 23 66 29 0a er-for-runs #f).
69f0: 09 20 28 75 70 64 61 74 65 2d 6b 65 79 76 61 6c . (update-keyval
6a00: 73 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 s (lambda ()....
6a10: 20 20 20 28 6c 65 74 20 28 28 74 61 72 67 20 28 (let ((targ (
6a20: 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 78 29 0a map (lambda (x).
6a30: 09 09 09 09 09 20 20 20 20 20 20 28 69 75 70 3a ..... (iup:
6a40: 61 74 74 72 69 62 75 74 65 20 78 20 22 56 41 4c attribute x "VAL
6a50: 55 45 22 29 29 0a 09 09 09 09 09 20 20 20 20 28 UE"))...... (
6a60: 63 61 72 20 28 64 61 73 68 62 6f 61 72 64 3a 75 car (dashboard:u
6a70: 70 64 61 74 65 2d 74 61 72 67 65 74 2d 73 65 6c pdate-target-sel
6a80: 65 63 74 6f 72 20 6b 65 79 2d 6c 69 73 74 62 6f ector key-listbo
6a90: 78 65 73 29 29 29 29 29 0a 09 09 09 20 20 20 20 xes)))))....
6aa0: 20 28 64 62 6f 61 72 64 3a 64 61 74 61 2d 73 65 (dboard:data-se
6ab0: 74 2d 74 61 72 67 65 74 21 20 2a 64 61 74 61 2a t-target! *data*
6ac0: 20 74 61 72 67 29 0a 09 09 09 20 20 20 20 20 28 targ).... (
6ad0: 69 66 20 75 70 64 61 74 65 72 2d 66 6f 72 2d 72 if updater-for-r
6ae0: 75 6e 73 20 28 75 70 64 61 74 65 72 2d 66 6f 72 uns (updater-for
6af0: 2d 72 75 6e 73 29 29 0a 09 09 09 20 20 20 20 20 -runs))....
6b00: 28 64 61 73 68 62 6f 61 72 64 3a 75 70 64 61 74 (dashboard:updat
6b10: 65 2d 72 75 6e 2d 63 6f 6d 6d 61 6e 64 29 29 29 e-run-command)))
6b20: 29 0a 09 20 28 74 65 73 74 73 2d 64 72 61 77 2d ).. (tests-draw-
6b30: 73 74 61 74 65 20 28 6d 61 6b 65 2d 68 61 73 68 state (make-hash
6b40: 2d 74 61 62 6c 65 29 29 20 3b 3b 20 75 73 65 20 -table)) ;; use
6b50: 66 6f 72 20 6b 65 65 70 69 6e 67 20 73 74 61 74 for keeping stat
6b60: 65 20 6f 66 20 74 68 65 20 74 65 73 74 20 63 61 e of the test ca
6b70: 6e 76 61 73 0a 09 20 28 74 65 73 74 2d 70 61 74 nvas.. (test-pat
6b80: 74 65 72 6e 73 2d 74 65 78 74 62 6f 78 20 20 23 terns-textbox #
6b90: 66 29 29 0a 20 20 20 20 28 68 61 73 68 2d 74 61 f)). (hash-ta
6ba0: 62 6c 65 2d 73 65 74 21 20 74 65 73 74 73 2d 64 ble-set! tests-d
6bb0: 72 61 77 2d 73 74 61 74 65 20 27 66 69 72 73 74 raw-state 'first
6bc0: 2d 74 69 6d 65 20 23 74 29 0a 20 20 20 20 28 68 -time #t). (h
6bd0: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 74 ash-table-set! t
6be0: 65 73 74 73 2d 64 72 61 77 2d 73 74 61 74 65 20 ests-draw-state
6bf0: 27 73 63 61 6c 65 66 20 38 29 0a 20 20 20 20 28 'scalef 8). (
6c00: 74 65 73 74 73 3a 67 65 74 2d 66 75 6c 6c 2d 64 tests:get-full-d
6c10: 61 74 61 20 74 65 73 74 2d 6e 61 6d 65 73 20 74 ata test-names t
6c20: 65 73 74 2d 72 65 63 6f 72 64 73 20 27 28 29 20 est-records '()
6c30: 61 6c 6c 2d 74 65 73 74 73 2d 72 65 67 69 73 74 all-tests-regist
6c40: 72 79 29 0a 20 20 20 20 28 73 65 74 21 20 73 6f ry). (set! so
6c50: 72 74 65 64 2d 74 65 73 74 6e 61 6d 65 73 20 28 rted-testnames (
6c60: 74 65 73 74 73 3a 73 6f 72 74 2d 62 79 2d 70 72 tests:sort-by-pr
6c70: 69 6f 72 69 74 79 2d 61 6e 64 2d 77 61 69 74 6f iority-and-waito
6c80: 6e 20 74 65 73 74 2d 72 65 63 6f 72 64 73 29 29 n test-records))
6c90: 0a 20 20 20 20 0a 20 20 20 20 3b 3b 20 72 65 66 . . ;; ref
6ca0: 65 72 20 74 6f 20 2a 6b 65 79 73 2a 2c 20 2a 64 er to *keys*, *d
6cb0: 62 6b 65 79 73 2a 20 66 6f 72 20 6b 65 79 73 0a bkeys* for keys.
6cc0: 20 20 20 20 28 69 75 70 3a 76 62 6f 78 0a 20 20 (iup:vbox.
6cd0: 20 20 20 3b 3b 20 54 68 65 20 63 6f 6d 6d 61 6e ;; The comman
6ce0: 64 20 6c 69 6e 65 20 64 69 73 70 6c 61 79 2f 65 d line display/e
6cf0: 78 65 63 74 75 74 69 6f 6e 20 63 6f 6e 74 72 6f xectution contro
6d00: 6c 0a 20 20 20 20 20 28 69 75 70 3a 66 72 61 6d l. (iup:fram
6d10: 65 0a 20 20 20 20 20 20 23 3a 74 69 74 6c 65 20 e. #:title
6d20: 22 43 6f 6d 6d 61 6e 64 20 74 6f 20 62 65 20 65 "Command to be e
6d30: 78 65 63 74 75 74 65 64 22 0a 20 20 20 20 20 20 xectuted".
6d40: 28 69 75 70 3a 68 62 6f 78 0a 20 20 20 20 20 20 (iup:hbox.
6d50: 20 28 69 75 70 3a 6c 61 62 65 6c 20 22 52 75 6e (iup:label "Run
6d60: 20 6f 6e 22 20 23 3a 73 69 7a 65 20 22 34 30 78 on" #:size "40x
6d70: 22 29 0a 20 20 20 20 20 20 20 28 69 75 70 3a 72 "). (iup:r
6d80: 61 64 69 6f 20 0a 09 28 69 75 70 3a 68 62 6f 78 adio ..(iup:hbox
6d90: 0a 09 20 28 69 75 70 3a 74 6f 67 67 6c 65 20 22 .. (iup:toggle "
6da0: 4c 6f 63 61 6c 22 20 23 3a 73 69 7a 65 20 22 34 Local" #:size "4
6db0: 30 78 22 29 0a 09 20 28 69 75 70 3a 74 6f 67 67 0x").. (iup:togg
6dc0: 6c 65 20 22 53 65 72 76 65 72 22 20 23 3a 73 69 le "Server" #:si
6dd0: 7a 65 20 22 34 30 78 22 29 29 29 0a 20 20 20 20 ze "40x"))).
6de0: 20 20 20 28 6c 65 74 20 28 28 74 62 20 28 69 75 (let ((tb (iu
6df0: 70 3a 74 65 78 74 62 6f 78 20 0a 09 09 20 20 23 p:textbox ... #
6e00: 3a 76 61 6c 75 65 20 22 6d 65 67 61 74 65 73 74 :value "megatest
6e10: 20 22 0a 09 09 20 20 23 3a 65 78 70 61 6e 64 20 "... #:expand
6e20: 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 09 20 "HORIZONTAL"...
6e30: 20 23 3a 72 65 61 64 6f 6e 6c 79 20 22 59 45 53 #:readonly "YES
6e40: 22 0a 09 09 20 20 23 3a 66 6f 6e 74 20 22 43 6f "... #:font "Co
6e50: 75 72 69 65 72 20 4e 65 77 2c 20 2d 31 32 22 0a urier New, -12".
6e60: 09 09 20 20 29 29 29 0a 09 20 28 64 62 6f 61 72 .. ))).. (dboar
6e70: 64 3a 64 61 74 61 2d 73 65 74 2d 63 6f 6d 6d 61 d:data-set-comma
6e80: 6e 64 2d 74 62 21 20 2a 64 61 74 61 2a 20 74 62 nd-tb! *data* tb
6e90: 29 0a 09 20 74 62 29 0a 20 20 20 20 20 20 20 28 ).. tb). (
6ea0: 69 75 70 3a 62 75 74 74 6f 6e 20 22 45 78 65 63 iup:button "Exec
6eb0: 75 74 65 22 20 23 3a 73 69 7a 65 20 22 35 30 78 ute" #:size "50x
6ec0: 22 0a 09 09 20 20 20 23 3a 61 63 74 69 6f 6e 20 "... #:action
6ed0: 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 0a 09 09 (lambda (obj)...
6ee0: 09 20 20 20 20 20 20 28 6c 65 74 20 28 28 63 6d . (let ((cm
6ef0: 64 20 28 63 6f 6e 63 20 22 78 74 65 72 6d 20 2d d (conc "xterm -
6f00: 67 65 6f 6d 65 74 72 79 20 31 38 30 78 32 30 20 geometry 180x20
6f10: 2d 65 20 5c 22 22 0a 09 09 09 09 09 20 20 20 20 -e \""......
6f20: 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 (iup:attribut
6f30: 65 20 28 64 62 6f 61 72 64 3a 64 61 74 61 2d 67 e (dboard:data-g
6f40: 65 74 2d 63 6f 6d 6d 61 6e 64 2d 74 62 20 2a 64 et-command-tb *d
6f50: 61 74 61 2a 29 20 22 56 41 4c 55 45 22 29 0a 09 ata*) "VALUE")..
6f60: 09 09 09 09 20 20 20 20 20 20 20 22 3b 65 63 68 .... ";ech
6f70: 6f 20 50 72 65 73 73 20 61 6e 79 20 6b 65 79 20 o Press any key
6f80: 74 6f 20 63 6f 6e 74 69 6e 75 65 3b 62 61 73 68 to continue;bash
6f90: 20 2d 63 20 27 72 65 61 64 20 2d 6e 20 31 20 2d -c 'read -n 1 -
6fa0: 73 27 5c 22 20 26 22 29 29 29 0a 09 09 09 09 28 s'\" &"))).....(
6fb0: 73 79 73 74 65 6d 20 63 6d 64 29 29 29 29 29 29 system cmd))))))
6fc0: 0a 0a 20 20 20 20 20 28 69 75 70 3a 73 70 6c 69 .. (iup:spli
6fd0: 74 0a 20 20 20 20 20 20 23 3a 6f 72 69 65 6e 74 t. #:orient
6fe0: 61 74 69 6f 6e 20 22 48 4f 52 49 5a 4f 4e 54 41 ation "HORIZONTA
6ff0: 4c 22 0a 20 20 20 20 20 20 0a 20 20 20 20 20 20 L". .
7000: 28 69 75 70 3a 73 70 6c 69 74 0a 20 20 20 20 20 (iup:split.
7010: 20 20 23 3a 76 61 6c 75 65 20 33 30 30 0a 0a 20 #:value 300..
7020: 20 20 20 20 20 20 3b 3b 20 54 61 72 67 65 74 2c ;; Target,
7030: 20 74 65 73 74 70 61 74 74 2c 20 73 74 61 74 65 testpatt, state
7040: 20 61 6e 64 20 73 74 61 74 75 73 20 69 6e 70 75 and status inpu
7050: 74 20 62 6f 78 65 73 0a 20 20 20 20 20 20 20 3b t boxes. ;
7060: 3b 0a 20 20 20 20 20 20 20 28 69 75 70 3a 76 62 ;. (iup:vb
7070: 6f 78 0a 09 3b 3b 20 43 6f 6d 6d 61 6e 64 20 74 ox..;; Command t
7080: 6f 20 72 75 6e 0a 09 28 69 75 70 3a 66 72 61 6d o run..(iup:fram
7090: 65 0a 09 20 23 3a 74 69 74 6c 65 20 22 53 65 74 e.. #:title "Set
70a0: 20 74 68 65 20 61 63 74 69 6f 6e 20 74 6f 20 74 the action to t
70b0: 61 6b 65 22 0a 09 20 28 69 75 70 3a 68 62 6f 78 ake".. (iup:hbox
70c0: 0a 09 20 20 3b 3b 20 28 69 75 70 3a 6c 61 62 65 .. ;; (iup:labe
70d0: 6c 20 22 43 6f 6d 6d 61 6e 64 20 74 6f 20 72 75 l "Command to ru
70e0: 6e 22 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 n" #:expand "HOR
70f0: 49 5a 4f 4e 54 41 4c 22 20 23 3a 73 69 7a 65 20 IZONTAL" #:size
7100: 22 37 30 78 22 20 23 3a 61 6c 69 67 6e 6d 65 6e "70x" #:alignmen
7110: 74 20 22 4c 45 46 54 3a 41 43 45 4e 54 45 52 22 t "LEFT:ACENTER"
7120: 29 0a 09 20 20 28 6c 65 74 2a 20 28 28 63 6d 64 ).. (let* ((cmd
7130: 73 2d 6c 69 73 74 20 27 28 22 72 75 6e 74 65 73 s-list '("runtes
7140: 74 73 22 20 22 72 65 6d 6f 76 65 2d 72 75 6e 73 ts" "remove-runs
7150: 22 20 22 73 65 74 2d 73 74 61 74 65 2d 73 74 61 " "set-state-sta
7160: 74 75 73 22 20 22 6c 6f 63 6b 2d 72 75 6e 73 22 tus" "lock-runs"
7170: 20 22 75 6e 6c 6f 63 6b 2d 72 75 6e 73 22 29 29 "unlock-runs"))
7180: 0a 09 09 20 28 6c 62 20 20 20 20 20 20 20 20 20 ... (lb
7190: 28 69 75 70 3a 6c 69 73 74 62 6f 78 20 23 3a 65 (iup:listbox #:e
71a0: 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 xpand "HORIZONTA
71b0: 4c 22 0a 09 09 09 09 09 20 20 23 3a 64 72 6f 70 L"...... #:drop
71c0: 64 6f 77 6e 20 22 59 45 53 22 0a 09 09 09 09 09 down "YES"......
71d0: 20 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 #:action (lamb
71e0: 64 61 20 28 6f 62 6a 20 76 61 6c 20 69 6e 64 65 da (obj val inde
71f0: 78 20 6c 62 73 74 61 74 65 29 0a 09 09 09 09 09 x lbstate)......
7200: 09 20 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 . ;; (print
7210: 6f 62 6a 20 22 20 22 20 76 61 6c 20 22 20 22 20 obj " " val " "
7220: 69 6e 64 65 78 20 22 20 22 20 6c 62 73 74 61 74 index " " lbstat
7230: 65 29 0a 09 09 09 09 09 09 20 20 20 20 20 28 64 e)....... (d
7240: 62 6f 61 72 64 3a 64 61 74 61 2d 73 65 74 2d 63 board:data-set-c
7250: 6f 6d 6d 61 6e 64 21 20 2a 64 61 74 61 2a 20 76 ommand! *data* v
7260: 61 6c 29 0a 09 09 09 09 09 09 20 20 20 20 20 28 al)....... (
7270: 64 61 73 68 62 6f 61 72 64 3a 75 70 64 61 74 65 dashboard:update
7280: 2d 72 75 6e 2d 63 6f 6d 6d 61 6e 64 29 29 29 29 -run-command))))
7290: 0a 09 09 20 28 64 65 66 61 75 6c 74 2d 63 6d 64 ... (default-cmd
72a0: 20 28 63 61 72 20 63 6d 64 73 2d 6c 69 73 74 29 (car cmds-list)
72b0: 29 29 0a 09 20 20 20 20 28 69 75 70 6c 69 73 74 )).. (iuplist
72c0: 62 6f 78 2d 66 69 6c 6c 2d 6c 69 73 74 20 6c 62 box-fill-list lb
72d0: 20 63 6d 64 73 2d 6c 69 73 74 20 73 65 6c 65 63 cmds-list selec
72e0: 74 65 64 2d 69 74 65 6d 3a 20 64 65 66 61 75 6c ted-item: defaul
72f0: 74 2d 63 6d 64 29 0a 09 20 20 20 20 28 64 62 6f t-cmd).. (dbo
7300: 61 72 64 3a 64 61 74 61 2d 73 65 74 2d 63 6f 6d ard:data-set-com
7310: 6d 61 6e 64 21 20 2a 64 61 74 61 2a 20 64 65 66 mand! *data* def
7320: 61 75 6c 74 2d 63 6d 64 29 0a 09 20 20 20 20 6c ault-cmd).. l
7330: 62 29 29 29 0a 0a 09 28 69 75 70 3a 66 72 61 6d b)))...(iup:fram
7340: 65 0a 09 20 23 3a 74 69 74 6c 65 20 22 52 75 6e e.. #:title "Run
7350: 6e 61 6d 65 22 0a 09 20 28 6c 65 74 2a 20 28 28 name".. (let* ((
7360: 64 65 66 61 75 6c 74 2d 72 75 6e 2d 6e 61 6d 65 default-run-name
7370: 20 28 73 65 63 6f 6e 64 73 2d 3e 77 6f 72 6b 2d (seconds->work-
7380: 77 65 65 6b 2f 64 61 79 20 28 63 75 72 72 65 6e week/day (curren
7390: 74 2d 73 65 63 6f 6e 64 73 29 29 29 0a 09 09 28 t-seconds)))...(
73a0: 74 62 20 28 69 75 70 3a 74 65 78 74 62 6f 78 20 tb (iup:textbox
73b0: 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f #:expand "HORIZO
73c0: 4e 54 41 4c 22 0a 09 09 09 09 20 23 3a 61 63 74 NTAL"..... #:act
73d0: 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a ion (lambda (obj
73e0: 20 76 61 6c 20 74 78 74 29 0a 09 09 09 09 09 20 val txt)......
73f0: 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 6f 62 ;; (print "ob
7400: 6a 3a 20 22 20 6f 62 6a 20 22 20 76 61 6c 3a 20 j: " obj " val:
7410: 22 20 76 61 6c 20 22 20 75 6e 6b 3a 20 22 20 75 " val " unk: " u
7420: 6e 6b 29 0a 09 09 09 09 09 20 20 20 20 28 64 62 nk)...... (db
7430: 6f 61 72 64 3a 64 61 74 61 2d 73 65 74 2d 72 75 oard:data-set-ru
7440: 6e 2d 6e 61 6d 65 21 20 2a 64 61 74 61 2a 20 74 n-name! *data* t
7450: 78 74 29 20 3b 3b 20 28 69 75 70 3a 61 74 74 72 xt) ;; (iup:attr
7460: 69 62 75 74 65 20 6f 62 6a 20 22 56 41 4c 55 45 ibute obj "VALUE
7470: 22 29 29 0a 09 09 09 09 09 20 20 20 20 28 64 61 "))...... (da
7480: 73 68 62 6f 61 72 64 3a 75 70 64 61 74 65 2d 72 shboard:update-r
7490: 75 6e 2d 63 6f 6d 6d 61 6e 64 29 29 0a 09 09 09 un-command))....
74a0: 09 20 23 3a 76 61 6c 75 65 20 64 65 66 61 75 6c . #:value defaul
74b0: 74 2d 72 75 6e 2d 6e 61 6d 65 29 29 0a 09 09 28 t-run-name))...(
74c0: 6c 62 20 28 69 75 70 3a 6c 69 73 74 62 6f 78 20 lb (iup:listbox
74d0: 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f #:expand "HORIZO
74e0: 4e 54 41 4c 22 0a 09 09 09 09 20 23 3a 64 72 6f NTAL"..... #:dro
74f0: 70 64 6f 77 6e 20 22 59 45 53 22 0a 09 09 09 09 pdown "YES".....
7500: 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 #:action (lambd
7510: 61 20 28 6f 62 6a 20 76 61 6c 20 69 6e 64 65 78 a (obj val index
7520: 20 6c 62 73 74 61 74 65 29 0a 09 09 09 09 09 20 lbstate)......
7530: 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 (iup:attribut
7540: 65 2d 73 65 74 21 20 74 62 20 22 56 41 4c 55 45 e-set! tb "VALUE
7550: 22 20 76 61 6c 29 0a 09 09 09 09 09 20 20 20 20 " val)......
7560: 28 64 62 6f 61 72 64 3a 64 61 74 61 2d 73 65 74 (dboard:data-set
7570: 2d 72 75 6e 2d 6e 61 6d 65 21 20 2a 64 61 74 61 -run-name! *data
7580: 2a 20 76 61 6c 29 0a 09 09 09 09 09 20 20 20 20 * val)......
7590: 28 64 61 73 68 62 6f 61 72 64 3a 75 70 64 61 74 (dashboard:updat
75a0: 65 2d 72 75 6e 2d 63 6f 6d 6d 61 6e 64 29 29 29 e-run-command)))
75b0: 29 0a 09 09 28 72 65 66 72 65 73 68 2d 72 75 6e )...(refresh-run
75c0: 73 2d 6c 69 73 74 20 28 6c 61 6d 62 64 61 20 28 s-list (lambda (
75d0: 29 0a 09 09 09 09 20 20 20 20 20 28 6c 65 74 2a )..... (let*
75e0: 20 28 28 74 61 72 67 65 74 20 20 20 20 20 20 20 ((target
75f0: 20 28 64 62 6f 61 72 64 3a 64 61 74 61 2d 67 65 (dboard:data-ge
7600: 74 2d 74 61 72 67 65 74 2d 73 74 72 69 6e 67 20 t-target-string
7610: 2a 64 61 74 61 2a 29 29 0a 09 09 09 09 09 20 20 *data*))......
7620: 20 20 28 72 75 6e 73 2d 66 6f 72 2d 74 61 72 67 (runs-for-targ
7630: 20 28 69 66 20 2a 75 73 65 73 65 72 76 65 72 2a (if *useserver*
7640: 0a 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 ........ (
7650: 72 6d 74 3a 67 65 74 2d 72 75 6e 73 2d 62 79 2d rmt:get-runs-by-
7660: 70 61 74 74 20 2a 6b 65 79 73 2a 20 22 25 22 20 patt *keys* "%"
7670: 74 61 72 67 65 74 20 23 66 20 23 66 20 23 66 29 target #f #f #f)
7680: 0a 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 ........ (
7690: 64 62 3a 67 65 74 2d 72 75 6e 73 2d 62 79 2d 70 db:get-runs-by-p
76a0: 61 74 74 20 2a 64 62 73 74 72 75 63 74 2d 6c 6f att *dbstruct-lo
76b0: 63 61 6c 2a 20 2a 6b 65 79 73 2a 20 22 25 22 20 cal* *keys* "%"
76c0: 74 61 72 67 65 74 20 23 66 20 23 66 20 23 66 29 target #f #f #f)
76d0: 29 29 0a 09 09 09 09 09 20 20 20 20 28 72 75 6e ))...... (run
76e0: 73 2d 68 65 61 64 65 72 20 20 20 28 76 65 63 74 s-header (vect
76f0: 6f 72 2d 72 65 66 20 72 75 6e 73 2d 66 6f 72 2d or-ref runs-for-
7700: 74 61 72 67 20 30 29 29 0a 09 09 09 09 09 20 20 targ 0))......
7710: 20 20 28 72 75 6e 73 2d 64 61 74 20 20 20 20 20 (runs-dat
7720: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72 75 6e (vector-ref run
7730: 73 2d 66 6f 72 2d 74 61 72 67 20 31 29 29 0a 09 s-for-targ 1))..
7740: 09 09 09 09 20 20 20 20 28 72 75 6e 2d 6e 61 6d .... (run-nam
7750: 65 73 20 20 20 20 20 28 63 6f 6e 73 20 64 65 66 es (cons def
7760: 61 75 6c 74 2d 72 75 6e 2d 6e 61 6d 65 20 0a 09 ault-run-name ..
7770: 09 09 09 09 09 09 09 20 28 6d 61 70 20 28 6c 61 ....... (map (la
7780: 6d 62 64 61 20 28 78 29 0a 09 09 09 09 09 09 09 mbda (x)........
7790: 09 09 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d ..(db:get-value-
77a0: 62 79 2d 68 65 61 64 65 72 20 78 20 72 75 6e 73 by-header x runs
77b0: 2d 68 65 61 64 65 72 20 22 72 75 6e 6e 61 6d 65 -header "runname
77c0: 22 29 29 0a 09 09 09 09 09 09 09 09 20 20 20 20 ")).........
77d0: 20 20 72 75 6e 73 2d 64 61 74 29 29 29 29 0a 09 runs-dat))))..
77e0: 09 09 09 20 20 20 20 20 20 20 28 69 75 70 3a 61 ... (iup:a
77f0: 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 6c 62 ttribute-set! lb
7800: 20 22 52 45 4d 4f 56 45 49 54 45 4d 22 20 22 41 "REMOVEITEM" "A
7810: 4c 4c 22 29 0a 09 09 09 09 20 20 20 20 20 20 20 LL").....
7820: 28 69 75 70 6c 69 73 74 62 6f 78 2d 66 69 6c 6c (iuplistbox-fill
7830: 2d 6c 69 73 74 20 6c 62 20 72 75 6e 2d 6e 61 6d -list lb run-nam
7840: 65 73 20 73 65 6c 65 63 74 65 64 2d 69 74 65 6d es selected-item
7850: 3a 20 64 65 66 61 75 6c 74 2d 72 75 6e 2d 6e 61 : default-run-na
7860: 6d 65 29 29 29 29 29 0a 09 20 20 20 28 73 65 74 me))))).. (set
7870: 21 20 75 70 64 61 74 65 72 2d 66 6f 72 2d 72 75 ! updater-for-ru
7880: 6e 73 20 72 65 66 72 65 73 68 2d 72 75 6e 73 2d ns refresh-runs-
7890: 6c 69 73 74 29 0a 09 20 20 20 28 72 65 66 72 65 list).. (refre
78a0: 73 68 2d 72 75 6e 73 2d 6c 69 73 74 29 0a 09 20 sh-runs-list)..
78b0: 20 20 28 64 62 6f 61 72 64 3a 64 61 74 61 2d 73 (dboard:data-s
78c0: 65 74 2d 72 75 6e 2d 6e 61 6d 65 21 20 2a 64 61 et-run-name! *da
78d0: 74 61 2a 20 64 65 66 61 75 6c 74 2d 72 75 6e 2d ta* default-run-
78e0: 6e 61 6d 65 29 0a 09 20 20 20 28 69 75 70 3a 68 name).. (iup:h
78f0: 62 6f 78 0a 09 20 20 20 20 74 62 0a 09 20 20 20 box.. tb..
7900: 20 6c 62 29 29 29 0a 0a 09 28 69 75 70 3a 66 72 lb)))...(iup:fr
7910: 61 6d 65 0a 09 20 23 3a 74 69 74 6c 65 20 22 53 ame.. #:title "S
7920: 45 4c 45 43 54 4f 52 53 22 0a 09 20 28 69 75 70 ELECTORS".. (iup
7930: 3a 76 62 6f 78 0a 09 20 20 3b 3b 20 54 65 78 74 :vbox.. ;; Text
7940: 20 62 6f 78 20 66 6f 72 20 74 65 73 74 20 70 61 box for test pa
7950: 74 74 65 72 6e 73 0a 09 20 20 28 69 75 70 3a 66 tterns.. (iup:f
7960: 72 61 6d 65 0a 09 20 20 20 23 3a 74 69 74 6c 65 rame.. #:title
7970: 20 22 54 65 73 74 20 70 61 74 74 65 72 6e 73 20 "Test patterns
7980: 28 6f 6e 65 20 70 65 72 20 6c 69 6e 65 29 22 0a (one per line)".
7990: 09 20 20 20 28 6c 65 74 20 28 28 74 62 20 28 69 . (let ((tb (i
79a0: 75 70 3a 74 65 78 74 62 6f 78 20 23 3a 61 63 74 up:textbox #:act
79b0: 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 76 61 6c ion (lambda (val
79c0: 20 61 20 62 29 0a 09 09 09 09 09 20 20 20 20 20 a b)......
79d0: 28 64 62 6f 61 72 64 3a 64 61 74 61 2d 73 65 74 (dboard:data-set
79e0: 2d 74 65 73 74 2d 70 61 74 74 73 21 0a 09 09 09 -test-patts!....
79f0: 09 09 20 20 20 20 20 20 2a 64 61 74 61 2a 0a 09 .. *data*..
7a00: 09 09 09 09 20 20 20 20 20 20 28 64 62 6f 61 72 .... (dboar
7a10: 64 3a 6c 69 6e 65 73 2d 3e 74 65 73 74 2d 70 61 d:lines->test-pa
7a20: 74 74 20 62 29 29 0a 09 09 09 09 09 20 20 20 20 tt b))......
7a30: 20 28 64 61 73 68 62 6f 61 72 64 3a 75 70 64 61 (dashboard:upda
7a40: 74 65 2d 72 75 6e 2d 63 6f 6d 6d 61 6e 64 29 29 te-run-command))
7a50: 0a 09 09 09 09 20 20 23 3a 76 61 6c 75 65 20 28 ..... #:value (
7a60: 64 62 6f 61 72 64 3a 74 65 73 74 2d 70 61 74 74 dboard:test-patt
7a70: 2d 3e 6c 69 6e 65 73 0a 09 09 09 09 09 20 20 20 ->lines......
7a80: 28 64 62 6f 61 72 64 3a 64 61 74 61 2d 67 65 74 (dboard:data-get
7a90: 2d 74 65 73 74 2d 70 61 74 74 73 20 2a 64 61 74 -test-patts *dat
7aa0: 61 2a 29 29 0a 09 09 09 09 20 20 23 3a 65 78 70 a*))..... #:exp
7ab0: 61 6e 64 20 22 59 45 53 22 0a 09 09 09 09 20 20 and "YES".....
7ac0: 23 3a 73 69 7a 65 20 22 78 35 30 22 0a 09 09 09 #:size "x50"....
7ad0: 09 20 20 23 3a 6d 75 6c 74 69 6c 69 6e 65 20 22 . #:multiline "
7ae0: 59 45 53 22 29 29 29 0a 09 20 20 20 20 20 28 73 YES"))).. (s
7af0: 65 74 21 20 74 65 73 74 2d 70 61 74 74 65 72 6e et! test-pattern
7b00: 73 2d 74 65 78 74 62 6f 78 20 74 62 29 0a 09 20 s-textbox tb)..
7b10: 20 20 20 20 74 62 29 29 0a 09 20 20 28 69 75 70 tb)).. (iup
7b20: 3a 66 72 61 6d 65 0a 09 20 20 20 23 3a 74 69 74 :frame.. #:tit
7b30: 6c 65 20 22 54 61 72 67 65 74 22 0a 09 20 20 20 le "Target"..
7b40: 3b 3b 20 54 61 72 67 65 74 20 73 65 6c 65 63 74 ;; Target select
7b50: 6f 72 73 0a 09 20 20 20 28 61 70 70 6c 79 20 69 ors.. (apply i
7b60: 75 70 3a 68 62 6f 78 0a 09 09 20 20 28 6c 65 74 up:hbox... (let
7b70: 2a 20 28 28 64 61 74 20 20 20 20 20 20 28 64 61 * ((dat (da
7b80: 73 68 62 6f 61 72 64 3a 75 70 64 61 74 65 2d 74 shboard:update-t
7b90: 61 72 67 65 74 2d 73 65 6c 65 63 74 6f 72 20 6b arget-selector k
7ba0: 65 79 2d 6c 69 73 74 62 6f 78 65 73 20 61 63 74 ey-listboxes act
7bb0: 69 6f 6e 2d 70 72 6f 63 3a 20 75 70 64 61 74 65 ion-proc: update
7bc0: 2d 6b 65 79 76 61 6c 73 29 29 0a 09 09 09 20 28 -keyvals)).... (
7bd0: 6b 65 79 2d 6c 62 20 20 20 28 63 61 72 20 64 61 key-lb (car da
7be0: 74 29 29 0a 09 09 09 20 28 63 6f 6d 62 6f 73 20 t)).... (combos
7bf0: 20 20 28 63 61 64 72 20 64 61 74 29 29 29 0a 09 (cadr dat)))..
7c00: 09 20 20 20 20 28 73 65 74 21 20 6b 65 79 2d 6c . (set! key-l
7c10: 69 73 74 62 6f 78 65 73 20 6b 65 79 2d 6c 62 29 istboxes key-lb)
7c20: 0a 09 09 20 20 20 20 63 6f 6d 62 6f 73 29 29 29 ... combos)))
7c30: 0a 09 20 20 28 69 75 70 3a 68 62 6f 78 0a 09 20 .. (iup:hbox..
7c40: 20 20 3b 3b 20 54 65 78 74 20 62 6f 78 20 66 6f ;; Text box fo
7c50: 72 20 53 54 41 54 45 53 0a 09 20 20 20 28 69 75 r STATES.. (iu
7c60: 70 3a 66 72 61 6d 65 0a 09 20 20 20 20 23 3a 74 p:frame.. #:t
7c70: 69 74 6c 65 20 22 53 74 61 74 65 73 22 0a 09 20 itle "States"..
7c80: 20 20 20 28 64 61 73 68 62 6f 61 72 64 3a 74 65 (dashboard:te
7c90: 78 74 2d 6c 69 73 74 2d 74 6f 67 67 6c 65 2d 62 xt-list-toggle-b
7ca0: 6f 78 20 0a 09 20 20 20 20 20 3b 3b 20 4d 6f 76 ox .. ;; Mov
7cb0: 65 20 74 68 65 73 65 20 64 65 66 69 6e 69 74 69 e these definiti
7cc0: 6f 6e 73 20 74 6f 20 63 6f 6d 6d 6f 6e 20 61 6e ons to common an
7cd0: 64 20 66 69 6e 64 20 74 68 65 20 6f 74 68 65 72 d find the other
7ce0: 20 75 73 65 61 67 65 73 20 61 6e 64 20 72 65 70 useages and rep
7cf0: 6c 61 63 65 21 0a 09 20 20 20 20 20 28 6d 61 70 lace!.. (map
7d00: 20 63 61 64 72 20 2a 63 6f 6d 6d 6f 6e 3a 73 74 cadr *common:st
7d10: 64 2d 73 74 61 74 65 73 2a 29 20 3b 3b 20 27 28 d-states*) ;; '(
7d20: 22 43 4f 4d 50 4c 45 54 45 44 22 20 22 52 55 4e "COMPLETED" "RUN
7d30: 4e 49 4e 47 22 20 22 53 54 55 43 4b 22 20 22 49 NING" "STUCK" "I
7d40: 4e 43 4f 4d 50 4c 45 54 45 22 20 22 4c 41 55 4e NCOMPLETE" "LAUN
7d50: 43 48 45 44 22 20 22 52 45 4d 4f 54 45 48 4f 53 CHED" "REMOTEHOS
7d60: 54 53 54 41 52 54 22 20 22 4b 49 4c 4c 45 44 22 TSTART" "KILLED"
7d70: 29 0a 09 20 20 20 20 20 28 6c 61 6d 62 64 61 20 ).. (lambda
7d80: 28 61 6c 6c 29 0a 09 20 20 20 20 20 20 20 28 64 (all).. (d
7d90: 62 6f 61 72 64 3a 64 61 74 61 2d 73 65 74 2d 73 board:data-set-s
7da0: 74 61 74 65 73 21 20 2a 64 61 74 61 2a 20 61 6c tates! *data* al
7db0: 6c 29 0a 09 20 20 20 20 20 20 20 28 64 61 73 68 l).. (dash
7dc0: 62 6f 61 72 64 3a 75 70 64 61 74 65 2d 72 75 6e board:update-run
7dd0: 2d 63 6f 6d 6d 61 6e 64 29 29 29 29 0a 09 20 20 -command))))..
7de0: 20 3b 3b 20 54 65 78 74 20 62 6f 78 20 66 6f 72 ;; Text box for
7df0: 20 53 54 41 54 45 53 0a 09 20 20 20 28 69 75 70 STATES.. (iup
7e00: 3a 66 72 61 6d 65 0a 09 20 20 20 20 23 3a 74 69 :frame.. #:ti
7e10: 74 6c 65 20 22 53 74 61 74 75 73 65 73 22 0a 09 tle "Statuses"..
7e20: 20 20 20 20 28 64 61 73 68 62 6f 61 72 64 3a 74 (dashboard:t
7e30: 65 78 74 2d 6c 69 73 74 2d 74 6f 67 67 6c 65 2d ext-list-toggle-
7e40: 62 6f 78 20 0a 09 20 20 20 20 20 28 6d 61 70 20 box .. (map
7e50: 63 61 64 72 20 2a 63 6f 6d 6d 6f 6e 3a 73 74 64 cadr *common:std
7e60: 2d 73 74 61 74 75 73 65 73 2a 29 20 3b 3b 20 27 -statuses*) ;; '
7e70: 28 22 50 41 53 53 22 20 22 46 41 49 4c 22 20 22 ("PASS" "FAIL" "
7e80: 6e 2f 61 22 20 22 43 48 45 43 4b 22 20 22 57 41 n/a" "CHECK" "WA
7e90: 49 56 45 44 22 20 22 53 4b 49 50 22 20 22 44 45 IVED" "SKIP" "DE
7ea0: 4c 45 54 45 44 22 20 22 53 54 55 43 4b 2f 44 45 LETED" "STUCK/DE
7eb0: 41 44 22 29 0a 09 20 20 20 20 20 28 6c 61 6d 62 AD").. (lamb
7ec0: 64 61 20 28 61 6c 6c 29 0a 09 20 20 20 20 20 20 da (all)..
7ed0: 20 28 64 62 6f 61 72 64 3a 64 61 74 61 2d 73 65 (dboard:data-se
7ee0: 74 2d 73 74 61 74 75 73 65 73 21 20 2a 64 61 74 t-statuses! *dat
7ef0: 61 2a 20 61 6c 6c 29 0a 09 20 20 20 20 20 20 20 a* all)..
7f00: 28 64 61 73 68 62 6f 61 72 64 3a 75 70 64 61 74 (dashboard:updat
7f10: 65 2d 72 75 6e 2d 63 6f 6d 6d 61 6e 64 29 29 29 e-run-command)))
7f20: 29 29 29 29 29 0a 20 20 20 20 20 20 0a 20 20 20 ))))). .
7f30: 20 20 20 20 28 69 75 70 3a 66 72 61 6d 65 0a 09 (iup:frame..
7f40: 23 3a 74 69 74 6c 65 20 22 54 65 73 74 73 20 61 #:title "Tests a
7f50: 6e 64 20 54 61 73 6b 73 22 0a 09 28 6c 65 74 2a nd Tasks"..(let*
7f60: 20 28 28 75 70 64 61 74 65 72 20 23 66 29 0a 09 ((updater #f)..
7f70: 20 20 20 20 20 20 20 28 6c 61 73 74 2d 78 61 64 (last-xad
7f80: 6a 20 30 29 0a 09 20 20 20 20 20 20 20 28 6c 61 j 0).. (la
7f90: 73 74 2d 79 61 64 6a 20 30 29 0a 09 20 20 20 20 st-yadj 0)..
7fa0: 20 20 20 28 74 68 65 2d 63 6e 76 20 20 20 23 66 (the-cnv #f
7fb0: 29 0a 09 20 20 20 20 20 20 20 28 63 61 6e 76 61 ).. (canva
7fc0: 73 2d 6f 62 6a 20 0a 20 20 20 20 20 20 20 20 20 s-obj .
7fd0: 20 20 20 20 20 20 20 28 69 75 70 3a 63 61 6e 76 (iup:canv
7fe0: 61 73 20 23 3a 61 63 74 69 6f 6e 20 28 6d 61 6b as #:action (mak
7ff0: 65 2d 63 61 6e 76 61 73 2d 61 63 74 69 6f 6e 0a e-canvas-action.
8000: 09 09 09 09 20 20 20 20 20 20 28 6c 61 6d 62 64 .... (lambd
8010: 61 20 28 63 6e 76 20 78 61 64 6a 20 79 61 64 6a a (cnv xadj yadj
8020: 29 0a 09 09 09 09 09 28 69 66 20 28 6e 6f 74 20 )......(if (not
8030: 75 70 64 61 74 65 72 29 0a 09 09 09 09 09 20 20 updater)......
8040: 20 20 28 73 65 74 21 20 75 70 64 61 74 65 72 20 (set! updater
8050: 28 6c 61 6d 62 64 61 20 28 78 61 64 6a 20 79 61 (lambda (xadj ya
8060: 64 6a 29 0a 09 09 09 09 09 09 09 20 20 20 20 3b dj)........ ;
8070: 3b 20 28 70 72 69 6e 74 20 22 63 6e 76 3a 20 22 ; (print "cnv: "
8080: 20 63 6e 76 20 22 20 78 61 64 6a 3a 20 22 20 78 cnv " xadj: " x
8090: 61 64 6a 20 22 20 79 61 64 6a 3a 20 22 20 79 61 adj " yadj: " ya
80a0: 64 6a 29 0a 09 09 09 09 09 09 09 20 20 20 20 28 dj)........ (
80b0: 64 61 73 68 62 6f 61 72 64 3a 64 72 61 77 2d 74 dashboard:draw-t
80c0: 65 73 74 73 20 63 6e 76 20 78 61 64 6a 20 79 61 ests cnv xadj ya
80d0: 64 6a 20 74 65 73 74 73 2d 64 72 61 77 2d 73 74 dj tests-draw-st
80e0: 61 74 65 20 73 6f 72 74 65 64 2d 74 65 73 74 6e ate sorted-testn
80f0: 61 6d 65 73 29 0a 09 09 09 09 09 09 09 20 20 20 ames)........
8100: 20 28 73 65 74 21 20 6c 61 73 74 2d 78 61 64 6a (set! last-xadj
8110: 20 78 61 64 6a 29 0a 09 09 09 09 09 09 09 20 20 xadj)........
8120: 20 20 28 73 65 74 21 20 6c 61 73 74 2d 79 61 64 (set! last-yad
8130: 6a 20 79 61 64 6a 29 29 29 29 0a 09 09 09 09 09 j yadj))))......
8140: 28 75 70 64 61 74 65 72 20 78 61 64 6a 20 79 61 (updater xadj ya
8150: 64 6a 29 0a 09 09 09 09 09 28 73 65 74 21 20 74 dj)......(set! t
8160: 68 65 2d 63 6e 76 20 63 6e 76 29 0a 09 09 09 09 he-cnv cnv).....
8170: 09 29 29 0a 09 09 09 20 20 20 20 3b 3b 20 46 6f .)).... ;; Fo
8180: 6c 6c 6f 77 69 6e 67 20 64 6f 65 73 6e 27 74 20 llowing doesn't
8190: 77 6f 72 6b 20 0a 09 09 09 20 20 20 20 23 3a 77 work .... #:w
81a0: 68 65 65 6c 2d 63 62 20 28 6c 61 6d 62 64 61 20 heel-cb (lambda
81b0: 28 6f 62 6a 20 73 74 65 70 20 78 20 79 20 64 69 (obj step x y di
81c0: 72 29 20 3b 3b 20 64 69 72 20 69 73 20 34 20 66 r) ;; dir is 4 f
81d0: 6f 72 20 75 70 20 61 6e 64 20 35 20 66 6f 72 20 or up and 5 for
81e0: 64 6f 77 6e 2e 20 49 20 74 68 69 6e 6b 2e 0a 09 down. I think...
81f0: 09 09 09 09 20 28 6c 65 74 20 28 28 78 61 64 6a .... (let ((xadj
8200: 20 6c 61 73 74 2d 78 61 64 6a 29 0a 09 09 09 09 last-xadj).....
8210: 09 20 20 20 20 20 20 20 28 79 61 64 6a 20 28 2b . (yadj (+
8220: 20 6c 61 73 74 2d 79 61 64 6a 20 28 69 66 20 28 last-yadj (if (
8230: 3e 20 73 74 65 70 20 30 29 0a 09 09 09 09 09 09 > step 0).......
8240: 09 09 20 20 20 20 20 20 2d 30 2e 30 31 0a 09 09 .. -0.01...
8250: 09 09 09 09 09 09 20 20 20 20 20 20 30 2e 30 31 ...... 0.01
8260: 29 29 29 29 0a 09 09 09 09 09 20 20 20 3b 3b 20 ))))...... ;;
8270: 28 70 72 69 6e 74 20 22 73 74 65 70 3a 20 22 20 (print "step: "
8280: 73 74 65 70 20 22 20 78 3a 20 22 20 78 20 22 20 step " x: " x "
8290: 79 3a 20 22 20 79 20 22 20 64 69 72 3a 20 5c 22 y: " y " dir: \"
82a0: 22 20 64 69 72 20 22 5c 22 22 29 0a 09 09 09 09 " dir "\"").....
82b0: 09 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 74 . ;; (print "t
82c0: 68 65 2d 63 6e 76 3a 20 22 20 74 68 65 2d 63 6e he-cnv: " the-cn
82d0: 76 20 22 20 6f 62 6a 3a 20 22 20 6f 62 6a 20 22 v " obj: " obj "
82e0: 20 78 61 64 6a 3a 20 22 20 78 61 64 6a 20 22 20 xadj: " xadj "
82f0: 79 61 64 6a 3a 20 22 20 79 61 64 6a 20 22 20 64 yadj: " yadj " d
8300: 69 72 3a 20 22 20 64 69 72 29 0a 09 09 09 09 09 ir: " dir)......
8310: 20 20 20 28 69 66 20 74 68 65 2d 63 6e 76 0a 09 (if the-cnv..
8320: 09 09 09 09 20 20 20 20 20 20 20 28 64 61 73 68 .... (dash
8330: 62 6f 61 72 64 3a 64 72 61 77 2d 74 65 73 74 73 board:draw-tests
8340: 20 74 68 65 2d 63 6e 76 20 78 61 64 6a 20 79 61 the-cnv xadj ya
8350: 64 6a 20 74 65 73 74 73 2d 64 72 61 77 2d 73 74 dj tests-draw-st
8360: 61 74 65 20 73 6f 72 74 65 64 2d 74 65 73 74 6e ate sorted-testn
8370: 61 6d 65 73 29 29 0a 09 09 09 09 09 20 20 20 28 ames))...... (
8380: 73 65 74 21 20 6c 61 73 74 2d 78 61 64 6a 20 78 set! last-xadj x
8390: 61 64 6a 29 0a 09 09 09 09 09 20 20 20 28 73 65 adj)...... (se
83a0: 74 21 20 6c 61 73 74 2d 79 61 64 6a 20 79 61 64 t! last-yadj yad
83b0: 6a 29 0a 09 09 09 09 09 20 20 20 29 29 0a 09 09 j)...... ))...
83c0: 09 20 20 20 20 3b 3b 20 23 3a 73 69 7a 65 20 22 . ;; #:size "
83d0: 35 30 78 35 30 22 0a 09 09 09 20 20 20 20 23 3a 50x50".... #:
83e0: 65 78 70 61 6e 64 20 22 59 45 53 22 0a 09 09 09 expand "YES"....
83f0: 20 20 20 20 23 3a 73 63 72 6f 6c 6c 62 61 72 20 #:scrollbar
8400: 22 59 45 53 22 0a 09 09 09 20 20 20 20 23 3a 70 "YES".... #:p
8410: 6f 73 78 20 22 30 2e 35 22 0a 09 09 09 20 20 20 osx "0.5"....
8420: 20 23 3a 70 6f 73 79 20 22 30 2e 35 22 0a 09 09 #:posy "0.5"...
8430: 09 20 20 20 20 23 3a 62 75 74 74 6f 6e 2d 63 62 . #:button-cb
8440: 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 20 62 74 (lambda (obj bt
8450: 6e 20 70 72 65 73 73 65 64 20 78 20 79 20 73 74 n pressed x y st
8460: 61 74 75 73 29 0a 09 09 09 09 09 20 20 3b 3b 20 atus)...... ;;
8470: 28 70 72 69 6e 74 20 22 6f 62 6a 3a 20 22 20 6f (print "obj: " o
8480: 62 6a 29 0a 09 09 09 09 09 20 20 28 6c 65 74 20 bj)...... (let
8490: 28 28 74 65 73 74 73 2d 69 6e 66 6f 20 20 20 20 ((tests-info
84a0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
84b0: 20 74 65 73 74 73 2d 64 72 61 77 2d 73 74 61 74 tests-draw-stat
84c0: 65 20 20 27 74 65 73 74 73 2d 69 6e 66 6f 29 29 e 'tests-info))
84d0: 0a 09 09 09 09 09 09 28 73 65 6c 65 63 74 65 64 .......(selected
84e0: 2d 74 65 73 74 73 20 28 68 61 73 68 2d 74 61 62 -tests (hash-tab
84f0: 6c 65 2d 72 65 66 20 74 65 73 74 73 2d 64 72 61 le-ref tests-dra
8500: 77 2d 73 74 61 74 65 20 20 27 73 65 6c 65 63 74 w-state 'select
8510: 65 64 2d 74 65 73 74 73 29 29 29 0a 09 09 09 09 ed-tests))).....
8520: 09 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 . ;; (print "
8530: 78 5c 74 79 5c 74 6c 6c 78 5c 74 6c 6c 79 5c 74 x\ty\tllx\tlly\t
8540: 75 72 78 5c 74 75 72 79 22 29 0a 09 09 09 09 09 urx\tury")......
8550: 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c (for-each (l
8560: 61 6d 62 64 61 20 28 74 65 73 74 2d 6e 61 6d 65 ambda (test-name
8570: 29 0a 09 09 09 09 09 09 09 28 6c 65 74 2a 20 28 )........(let* (
8580: 28 72 65 63 2d 63 6f 6f 72 64 73 20 28 68 61 73 (rec-coords (has
8590: 68 2d 74 61 62 6c 65 2d 72 65 66 20 74 65 73 74 h-table-ref test
85a0: 73 2d 69 6e 66 6f 20 74 65 73 74 2d 6e 61 6d 65 s-info test-name
85b0: 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 20 ))........
85c0: 20 28 6c 6c 78 20 20 20 20 20 20 20 20 28 6c 69 (llx (li
85d0: 73 74 2d 72 65 66 20 72 65 63 2d 63 6f 6f 72 64 st-ref rec-coord
85e0: 73 20 30 29 29 0a 09 09 09 09 09 09 09 20 20 20 s 0))........
85f0: 20 20 20 20 28 75 72 78 20 20 20 20 20 20 20 20 (urx
8600: 28 6c 69 73 74 2d 72 65 66 20 72 65 63 2d 63 6f (list-ref rec-co
8610: 6f 72 64 73 20 31 29 29 0a 09 09 09 09 09 09 09 ords 1))........
8620: 20 20 20 20 20 20 20 28 6c 6c 79 20 20 20 20 20 (lly
8630: 20 20 20 28 6c 69 73 74 2d 72 65 66 20 72 65 63 (list-ref rec
8640: 2d 63 6f 6f 72 64 73 20 32 29 29 0a 09 09 09 09 -coords 2)).....
8650: 09 09 09 20 20 20 20 20 20 20 28 75 72 79 20 20 ... (ury
8660: 20 20 20 20 20 20 28 6c 69 73 74 2d 72 65 66 20 (list-ref
8670: 72 65 63 2d 63 6f 6f 72 64 73 20 33 29 29 29 0a rec-coords 3))).
8680: 09 09 09 09 09 09 09 20 20 3b 3b 20 28 70 72 69 ....... ;; (pri
8690: 6e 74 20 78 20 22 5c 74 22 20 79 20 22 5c 74 22 nt x "\t" y "\t"
86a0: 20 6c 6c 78 20 22 5c 74 22 20 6c 6c 79 20 22 5c llx "\t" lly "\
86b0: 74 22 20 75 72 78 20 22 5c 74 22 20 75 72 79 20 t" urx "\t" ury
86c0: 22 5c 74 22 20 74 65 73 74 2d 6e 61 6d 65 20 22 "\t" test-name "
86d0: 20 22 0a 09 09 09 09 09 09 09 20 20 28 69 66 20 "........ (if
86e0: 28 61 6e 64 20 28 65 71 3f 20 70 72 65 73 73 65 (and (eq? presse
86f0: 64 20 31 29 0a 09 09 09 09 09 09 09 09 20 20 20 d 1).........
8700: 28 3e 20 78 20 6c 6c 78 29 0a 09 09 09 09 09 09 (> x llx).......
8710: 09 09 20 20 20 28 3e 20 79 20 6c 6c 79 29 0a 09 .. (> y lly)..
8720: 09 09 09 09 09 09 09 20 20 20 28 3c 20 78 20 75 ....... (< x u
8730: 72 78 29 0a 09 09 09 09 09 09 09 09 20 20 20 28 rx)......... (
8740: 3c 20 79 20 75 72 79 29 29 0a 09 09 09 09 09 09 < y ury)).......
8750: 09 20 20 20 20 20 20 28 6c 65 74 20 28 28 70 61 . (let ((pa
8760: 74 74 65 72 6e 73 20 28 73 74 72 69 6e 67 2d 73 tterns (string-s
8770: 70 6c 69 74 20 28 69 75 70 3a 61 74 74 72 69 62 plit (iup:attrib
8780: 75 74 65 20 74 65 73 74 2d 70 61 74 74 65 72 6e ute test-pattern
8790: 73 2d 74 65 78 74 62 6f 78 20 22 56 41 4c 55 45 s-textbox "VALUE
87a0: 22 29 29 29 29 0a 09 09 09 09 09 09 09 09 28 6c ")))).........(l
87b0: 65 74 2a 20 28 28 73 65 6c 65 63 74 65 64 20 20 et* ((selected
87c0: 20 20 20 28 6e 6f 74 20 28 6d 65 6d 62 65 72 20 (not (member
87d0: 74 65 73 74 2d 6e 61 6d 65 20 70 61 74 74 65 72 test-name patter
87e0: 6e 73 29 29 29 0a 09 09 09 09 09 09 09 09 20 20 ns))).........
87f0: 20 20 20 20 20 28 6e 65 77 70 61 74 74 2d 6c 69 (newpatt-li
8800: 73 74 20 28 69 66 20 73 65 6c 65 63 74 65 64 0a st (if selected.
8810: 09 09 09 09 09 09 09 09 09 09 09 20 28 63 6f 6e ........... (con
8820: 73 20 74 65 73 74 2d 6e 61 6d 65 20 70 61 74 74 s test-name patt
8830: 65 72 6e 73 29 0a 09 09 09 09 09 09 09 09 09 09 erns)...........
8840: 09 20 28 64 65 6c 65 74 65 20 74 65 73 74 2d 6e . (delete test-n
8850: 61 6d 65 20 70 61 74 74 65 72 6e 73 29 29 29 0a ame patterns))).
8860: 09 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 ........ (
8870: 6e 65 77 70 61 74 74 20 20 20 20 20 20 28 73 74 newpatt (st
8880: 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 ring-intersperse
8890: 20 6e 65 77 70 61 74 74 2d 6c 69 73 74 20 22 5c newpatt-list "\
88a0: 6e 22 29 29 29 0a 09 09 09 09 09 09 09 09 20 20 n"))).........
88b0: 3b 3b 20 28 69 66 20 63 6e 76 2d 6f 62 6a 0a 09 ;; (if cnv-obj..
88c0: 09 09 09 09 09 09 09 20 20 3b 3b 20 20 20 20 28 ....... ;; (
88d0: 64 61 73 68 62 6f 61 72 64 3a 64 72 61 77 2d 74 dashboard:draw-t
88e0: 65 73 74 73 20 63 6e 76 2d 6f 62 6a 20 30 20 30 ests cnv-obj 0 0
88f0: 20 74 65 73 74 73 2d 64 72 61 77 2d 73 74 61 74 tests-draw-stat
8900: 65 20 73 6f 72 74 65 64 2d 74 65 73 74 6e 61 6d e sorted-testnam
8910: 65 73 29 29 0a 09 09 09 09 09 09 09 09 20 20 28 es))......... (
8920: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se
8930: 74 21 20 6f 62 6a 20 22 52 45 44 52 41 57 22 20 t! obj "REDRAW"
8940: 22 41 4c 4c 22 29 0a 09 09 09 09 09 09 09 09 20 "ALL").........
8950: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 (hash-table-set
8960: 21 20 73 65 6c 65 63 74 65 64 2d 74 65 73 74 73 ! selected-tests
8970: 20 74 65 73 74 2d 6e 61 6d 65 20 73 65 6c 65 63 test-name selec
8980: 74 65 64 29 0a 09 09 09 09 09 09 09 09 20 20 28 ted)......... (
8990: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se
89a0: 74 21 20 74 65 73 74 2d 70 61 74 74 65 72 6e 73 t! test-patterns
89b0: 2d 74 65 78 74 62 6f 78 20 22 56 41 4c 55 45 22 -textbox "VALUE"
89c0: 20 6e 65 77 70 61 74 74 29 0a 09 09 09 09 09 09 newpatt).......
89d0: 09 09 20 20 28 64 62 6f 61 72 64 3a 64 61 74 61 .. (dboard:data
89e0: 2d 73 65 74 2d 74 65 73 74 2d 70 61 74 74 73 21 -set-test-patts!
89f0: 20 2a 64 61 74 61 2a 20 28 64 62 6f 61 72 64 3a *data* (dboard:
8a00: 6c 69 6e 65 73 2d 3e 74 65 73 74 2d 70 61 74 74 lines->test-patt
8a10: 20 6e 65 77 70 61 74 74 29 29 0a 09 09 09 09 09 newpatt))......
8a20: 09 09 09 20 20 28 64 61 73 68 62 6f 61 72 64 3a ... (dashboard:
8a30: 75 70 64 61 74 65 2d 72 75 6e 2d 63 6f 6d 6d 61 update-run-comma
8a40: 6e 64 29 0a 09 09 09 09 09 09 09 09 20 20 28 69 nd)......... (i
8a50: 66 20 75 70 64 61 74 65 72 20 28 75 70 64 61 74 f updater (updat
8a60: 65 72 20 6c 61 73 74 2d 78 61 64 6a 20 6c 61 73 er last-xadj las
8a70: 74 2d 79 61 64 6a 29 29 29 29 29 29 29 0a 09 09 t-yadj)))))))...
8a80: 09 09 09 09 20 20 20 20 20 20 28 68 61 73 68 2d .... (hash-
8a90: 74 61 62 6c 65 2d 6b 65 79 73 20 74 65 73 74 73 table-keys tests
8aa0: 2d 69 6e 66 6f 29 29 29 29 29 29 29 0a 09 20 20 -info)))))))..
8ab0: 63 61 6e 76 61 73 2d 6f 62 6a 29 29 29 0a 20 20 canvas-obj))).
8ac0: 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 6f ;; (print "o
8ad0: 62 6a 3a 20 22 20 6f 62 6a 20 22 20 62 74 6e 3a bj: " obj " btn:
8ae0: 20 22 20 62 74 6e 20 22 20 70 72 65 73 73 65 64 " btn " pressed
8af0: 3a 20 22 20 70 72 65 73 73 65 64 20 22 20 78 3a : " pressed " x:
8b00: 20 22 20 78 20 22 20 79 3a 20 22 20 79 20 22 20 " x " y: " y "
8b10: 73 74 61 74 75 73 3a 20 22 20 73 74 61 74 75 73 status: " status
8b20: 29 29 0a 20 20 20 20 20 20 20 0a 20 20 20 20 20 )). .
8b30: 20 28 69 75 70 3a 66 72 61 6d 65 0a 20 20 20 20 (iup:frame.
8b40: 20 20 20 23 3a 74 69 74 6c 65 20 22 4c 6f 67 73 #:title "Logs
8b50: 22 20 3b 3b 20 54 6f 20 62 65 20 72 65 70 6c 61 " ;; To be repla
8b60: 63 65 64 20 77 69 74 68 20 74 61 62 73 0a 20 20 ced with tabs.
8b70: 20 20 20 20 20 28 6c 65 74 20 28 28 6c 6f 67 73 (let ((logs
8b80: 2d 74 62 20 28 69 75 70 3a 74 65 78 74 62 6f 78 -tb (iup:textbox
8b90: 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 0a #:expand "YES".
8ba0: 09 09 09 09 20 20 20 23 3a 6d 75 6c 74 69 6c 69 .... #:multili
8bb0: 6e 65 20 22 59 45 53 22 29 29 29 0a 09 20 28 64 ne "YES"))).. (d
8bc0: 62 6f 61 72 64 3a 64 61 74 61 2d 73 65 74 2d 6c board:data-set-l
8bd0: 6f 67 73 2d 74 65 78 74 62 6f 78 21 20 2a 64 61 ogs-textbox! *da
8be0: 74 61 2a 20 6c 6f 67 73 2d 74 62 29 0a 09 20 6c ta* logs-tb).. l
8bf0: 6f 67 73 2d 74 62 29 29 29 29 29 29 0a 0a 0a 3b ogs-tb))))))...;
8c00: 3b 20 28 74 72 61 63 65 20 64 61 73 68 62 6f 61 ; (trace dashboa
8c10: 72 64 3a 70 6f 70 75 6c 61 74 65 2d 74 61 72 67 rd:populate-targ
8c20: 65 74 2d 64 72 6f 70 64 6f 77 6e 0a 3b 3b 20 20 et-dropdown.;;
8c30: 20 20 20 20 20 20 63 6f 6d 6d 6f 6e 3a 6c 69 73 common:lis
8c40: 74 2d 69 73 2d 73 75 62 6c 69 73 74 29 0a 3b 3b t-is-sublist).;;
8c50: 20 0a 3b 3b 20 20 20 20 20 20 20 3b 3b 20 6b 65 .;; ;; ke
8c60: 79 31 20 6b 65 79 32 20 6b 65 79 33 20 2e 2e 2e y1 key2 key3 ...
8c70: 0a 3b 3b 20 20 20 20 20 20 20 3b 3b 20 74 61 72 .;; ;; tar
8c80: 67 65 74 20 65 6e 74 72 79 20 28 77 69 6c 64 20 get entry (wild
8c90: 63 61 72 64 73 20 61 6c 6c 6f 77 65 64 29 0a 3b cards allowed).;
8ca0: 3b 20 20 20 20 20 20 20 0a 3b 3b 20 20 20 20 20 ; .;;
8cb0: 20 20 3b 3b 20 54 68 65 20 61 63 74 69 6f 6e 0a ;; The action.
8cc0: 3b 3b 20 20 20 20 20 20 20 28 69 75 70 3a 68 62 ;; (iup:hb
8cd0: 6f 78 0a 3b 3b 20 20 20 20 20 20 20 20 3b 3b 20 ox.;; ;;
8ce0: 6c 61 62 65 6c 20 41 63 74 69 6f 6e 20 7c 20 61 label Action | a
8cf0: 63 74 69 6f 6e 20 73 65 6c 65 63 74 6f 72 0a 3b ction selector.;
8d00: 3b 20 20 20 20 20 20 20 20 29 29 0a 3b 3b 20 20 ; )).;;
8d10: 20 20 20 20 3b 3b 20 54 65 73 74 2f 69 74 65 6d ;; Test/item
8d20: 73 20 73 65 6c 65 63 74 6f 72 0a 3b 3b 20 20 20 s selector.;;
8d30: 20 20 20 28 69 75 70 3a 68 62 6f 78 0a 3b 3b 20 (iup:hbox.;;
8d40: 20 20 20 20 20 20 3b 3b 20 74 65 73 74 73 0a 3b ;; tests.;
8d50: 3b 20 20 20 20 20 20 20 3b 3b 20 69 74 65 6d 73 ; ;; items
8d60: 0a 3b 3b 20 20 20 20 20 20 20 29 29 0a 3b 3b 20 .;; )).;;
8d70: 20 20 20 20 3b 3b 20 54 68 65 20 63 6f 6d 6d 61 ;; The comma
8d80: 6e 64 20 6c 69 6e 65 0a 3b 3b 20 20 20 20 20 28 nd line.;; (
8d90: 69 75 70 3a 68 62 6f 78 0a 3b 3b 20 20 20 20 20 iup:hbox.;;
8da0: 20 3b 3b 20 63 6f 6d 6d 61 6e 64 6c 69 6e 65 20 ;; commandline
8db0: 65 6e 74 72 79 0a 3b 3b 20 20 20 20 20 20 3b 3b entry.;; ;;
8dc0: 20 47 4f 20 62 75 74 74 6f 6e 0a 3b 3b 20 20 20 GO button.;;
8dd0: 20 20 20 29 0a 3b 3b 20 20 20 20 20 3b 3b 20 54 ).;; ;; T
8de0: 68 65 20 63 6f 6d 6d 61 6e 64 20 6c 6f 67 20 6d he command log m
8df0: 6f 6e 69 74 6f 72 0a 3b 3b 20 20 20 20 20 28 69 onitor.;; (i
8e00: 75 70 3a 74 61 62 73 0a 3b 3b 20 20 20 20 20 20 up:tabs.;;
8e10: 3b 3b 20 6c 6f 67 20 6d 6f 6e 69 74 6f 72 0a 3b ;; log monitor.;
8e20: 3b 20 20 20 20 20 20 29 29 29 0a 0a 3b 3b 3d 3d ; )))..;;==
8e30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8e40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8e50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8e60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8e70: 3d 3d 3d 3d 0a 3b 3b 20 53 20 55 20 4d 20 4d 20 ====.;; S U M M
8e80: 41 20 52 20 59 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d A R Y .;;=======
8e90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8ea0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8eb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8ec0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
8ed0: 3b 3b 0a 3b 3b 20 47 65 6e 65 72 61 6c 20 69 6e ;;.;; General in
8ee0: 66 6f 20 61 62 6f 75 74 20 74 68 65 20 72 75 6e fo about the run
8ef0: 28 73 29 20 61 6e 64 20 6d 65 67 61 74 65 73 74 (s) and megatest
8f00: 20 61 72 65 61 0a 28 64 65 66 69 6e 65 20 28 64 area.(define (d
8f10: 61 73 68 62 6f 61 72 64 3a 73 75 6d 6d 61 72 79 ashboard:summary
8f20: 20 64 62 29 0a 20 20 28 6c 65 74 20 28 28 72 61 db). (let ((ra
8f30: 77 63 6f 6e 66 69 67 20 20 20 20 20 20 20 20 28 wconfig (
8f40: 72 65 61 64 2d 63 6f 6e 66 69 67 20 28 63 6f 6e read-config (con
8f50: 63 20 2a 74 6f 70 70 61 74 68 2a 20 22 2f 6d 65 c *toppath* "/me
8f60: 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 22 29 20 gatest.config")
8f70: 23 66 20 23 66 29 29 29 20 3b 3b 20 63 68 61 6e #f #f))) ;; chan
8f80: 67 65 64 20 74 6f 20 23 66 20 73 69 6e 63 65 20 ged to #f since
8f90: 49 20 77 61 6e 74 20 23 7b 7d 20 74 6f 20 62 65 I want #{} to be
8fa0: 20 65 78 70 61 6e 64 65 64 20 62 79 20 5b 73 79 expanded by [sy
8fb0: 73 74 65 6d 20 2e 2e 2e 5d 20 74 6f 20 4e 4f 54 stem ...] to NOT
8fc0: 20 62 65 20 65 78 70 61 6e 64 65 64 2e 20 57 41 be expanded. WA
8fd0: 53 3a 20 27 72 65 74 75 72 6e 2d 73 74 72 69 6e S: 'return-strin
8fe0: 67 29 29 29 0a 20 20 20 20 28 69 75 70 3a 76 62 g))). (iup:vb
8ff0: 6f 78 0a 20 20 20 20 20 28 69 75 70 3a 73 70 6c ox. (iup:spl
9000: 69 74 0a 20 20 20 20 20 20 23 3a 76 61 6c 75 65 it. #:value
9010: 20 35 30 30 0a 20 20 20 20 20 20 28 69 75 70 3a 500. (iup:
9020: 66 72 61 6d 65 20 0a 20 20 20 20 20 20 20 23 3a frame . #:
9030: 74 69 74 6c 65 20 22 47 65 6e 65 72 61 6c 20 49 title "General I
9040: 6e 66 6f 22 0a 20 20 20 20 20 20 20 28 69 75 70 nfo". (iup
9050: 3a 76 62 6f 78 0a 09 28 69 75 70 3a 68 62 6f 78 :vbox..(iup:hbox
9060: 0a 09 20 28 69 75 70 3a 6c 61 62 65 6c 20 22 41 .. (iup:label "A
9070: 72 65 61 20 50 61 74 68 22 29 0a 09 20 28 69 75 rea Path").. (iu
9080: 70 3a 74 65 78 74 62 6f 78 20 23 3a 76 61 6c 75 p:textbox #:valu
9090: 65 20 2a 74 6f 70 70 61 74 68 2a 20 23 3a 65 78 e *toppath* #:ex
90a0: 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c pand "HORIZONTAL
90b0: 22 29 29 0a 09 28 69 75 70 3a 68 62 6f 78 20 0a "))..(iup:hbox .
90c0: 09 20 28 64 63 6f 6d 6d 6f 6e 3a 6b 65 79 73 2d . (dcommon:keys-
90d0: 6d 61 74 72 69 78 20 72 61 77 63 6f 6e 66 69 67 matrix rawconfig
90e0: 29 0a 09 20 28 64 63 6f 6d 6d 6f 6e 3a 67 65 6e ).. (dcommon:gen
90f0: 65 72 61 6c 2d 69 6e 66 6f 29 0a 09 20 29 29 29 eral-info).. )))
9100: 0a 20 20 20 20 20 20 28 69 75 70 3a 66 72 61 6d . (iup:fram
9110: 65 0a 20 20 20 20 20 20 20 23 3a 74 69 74 6c 65 e. #:title
9120: 20 22 53 65 72 76 65 72 22 0a 20 20 20 20 20 20 "Server".
9130: 20 28 64 63 6f 6d 6d 6f 6e 3a 73 65 72 76 65 72 (dcommon:server
9140: 73 2d 74 61 62 6c 65 29 29 29 0a 20 20 20 20 20 s-table))).
9150: 28 69 75 70 3a 66 72 61 6d 65 20 0a 20 20 20 20 (iup:frame .
9160: 20 20 23 3a 74 69 74 6c 65 20 22 4d 65 67 61 74 #:title "Megat
9170: 65 73 74 20 63 6f 6e 66 69 67 20 73 65 74 74 69 est config setti
9180: 6e 67 73 22 0a 20 20 20 20 20 20 28 69 75 70 3a ngs". (iup:
9190: 68 62 6f 78 0a 20 20 20 20 20 20 20 28 64 63 6f hbox. (dco
91a0: 6d 6d 6f 6e 3a 73 65 63 74 69 6f 6e 2d 6d 61 74 mmon:section-mat
91b0: 72 69 78 20 72 61 77 63 6f 6e 66 69 67 20 22 73 rix rawconfig "s
91c0: 65 74 75 70 22 20 22 56 61 72 6e 61 6d 65 22 20 etup" "Varname"
91d0: 22 56 61 6c 75 65 22 29 0a 20 20 20 20 20 20 20 "Value").
91e0: 28 69 75 70 3a 76 62 6f 78 0a 09 28 64 63 6f 6d (iup:vbox..(dcom
91f0: 6d 6f 6e 3a 73 65 63 74 69 6f 6e 2d 6d 61 74 72 mon:section-matr
9200: 69 78 20 72 61 77 63 6f 6e 66 69 67 20 22 73 65 ix rawconfig "se
9210: 72 76 65 72 22 20 22 56 61 72 6e 61 6d 65 22 20 rver" "Varname"
9220: 22 56 61 6c 75 65 22 29 0a 09 3b 3b 20 28 69 75 "Value")..;; (iu
9230: 70 3a 66 72 61 6d 65 0a 09 3b 3b 20 23 3a 74 69 p:frame..;; #:ti
9240: 74 6c 65 20 22 44 69 73 6b 73 20 41 72 65 61 73 tle "Disks Areas
9250: 22 0a 09 28 64 63 6f 6d 6d 6f 6e 3a 73 65 63 74 "..(dcommon:sect
9260: 69 6f 6e 2d 6d 61 74 72 69 78 20 72 61 77 63 6f ion-matrix rawco
9270: 6e 66 69 67 20 22 64 69 73 6b 73 22 20 22 44 69 nfig "disks" "Di
9280: 73 6b 20 61 72 65 61 22 20 22 50 61 74 68 22 29 sk area" "Path")
9290: 29 29 29 0a 20 20 20 20 20 28 69 75 70 3a 66 72 ))). (iup:fr
92a0: 61 6d 65 0a 20 20 20 20 20 20 23 3a 74 69 74 6c ame. #:titl
92b0: 65 20 22 52 75 6e 20 73 74 61 74 69 73 74 69 63 e "Run statistic
92c0: 73 22 0a 20 20 20 20 20 20 28 64 63 6f 6d 6d 6f s". (dcommo
92d0: 6e 3a 72 75 6e 2d 73 74 61 74 73 20 64 62 29 29 n:run-stats db))
92e0: 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
92f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9300: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9310: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9320: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
9330: 20 52 20 55 20 4e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d R U N.;;=======
9340: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9350: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9360: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9370: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
9380: 3b 3b 0a 3b 3b 20 64 69 73 70 6c 61 79 20 61 6e ;;.;; display an
9390: 64 20 6d 61 6e 61 67 65 20 61 20 73 69 6e 67 6c d manage a singl
93a0: 65 20 72 75 6e 20 61 74 20 61 20 74 69 6d 65 0a e run at a time.
93b0: 0a 28 64 65 66 69 6e 65 20 28 74 72 65 65 2d 70 .(define (tree-p
93c0: 61 74 68 2d 3e 72 75 6e 2d 69 64 20 70 61 74 68 ath->run-id path
93d0: 29 0a 20 20 28 69 66 20 28 6e 6f 74 20 28 6e 75 ). (if (not (nu
93e0: 6c 6c 3f 20 70 61 74 68 29 29 0a 20 20 20 20 20 ll? path)).
93f0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
9400: 2f 64 65 66 61 75 6c 74 20 28 64 62 6f 61 72 64 /default (dboard
9410: 3a 64 61 74 61 2d 67 65 74 2d 70 61 74 68 2d 72 :data-get-path-r
9420: 75 6e 2d 69 64 73 20 2a 64 61 74 61 2a 29 20 70 un-ids *data*) p
9430: 61 74 68 20 23 66 29 0a 20 20 20 20 20 20 23 66 ath #f). #f
9440: 29 29 0a 0a 28 64 65 66 69 6e 65 20 64 61 73 68 ))..(define dash
9450: 62 6f 61 72 64 3a 75 70 64 61 74 65 2d 72 75 6e board:update-run
9460: 2d 73 75 6d 6d 61 72 79 2d 74 61 62 20 23 66 29 -summary-tab #f)
9470: 0a 0a 3b 3b 20 28 64 65 66 69 6e 65 20 28 74 65 ..;; (define (te
9480: 73 74 73 20 77 69 6e 64 6f 77 2d 69 64 29 0a 28 sts window-id).(
9490: 64 65 66 69 6e 65 20 28 64 61 73 68 62 6f 61 72 define (dashboar
94a0: 64 3a 6f 6e 65 2d 72 75 6e 20 64 62 29 0a 20 20 d:one-run db).
94b0: 28 6c 65 74 2a 20 28 28 74 62 20 20 20 20 20 20 (let* ((tb
94c0: 28 69 75 70 3a 74 72 65 65 62 6f 78 0a 09 09 20 (iup:treebox...
94d0: 20 20 23 3a 76 61 6c 75 65 20 30 0a 09 09 20 20 #:value 0...
94e0: 20 23 3a 6e 61 6d 65 20 22 52 75 6e 73 22 0a 09 #:name "Runs"..
94f0: 09 20 20 20 23 3a 65 78 70 61 6e 64 20 22 59 45 . #:expand "YE
9500: 53 22 0a 09 09 20 20 20 23 3a 61 64 64 65 78 70 S"... #:addexp
9510: 61 6e 64 65 64 20 22 4e 4f 22 0a 09 09 20 20 20 anded "NO"...
9520: 23 3a 73 65 6c 65 63 74 69 6f 6e 2d 63 62 0a 09 #:selection-cb..
9530: 09 20 20 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a . (lambda (obj
9540: 20 69 64 20 73 74 61 74 65 29 0a 09 09 20 20 20 id state)...
9550: 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 6f 62 6a ;; (print "obj
9560: 3a 20 22 20 6f 62 6a 20 22 2c 20 69 64 3a 20 22 : " obj ", id: "
9570: 20 69 64 20 22 2c 20 73 74 61 74 65 3a 20 22 20 id ", state: "
9580: 73 74 61 74 65 29 0a 09 09 20 20 20 20 20 28 6c state)... (l
9590: 65 74 2a 20 28 28 72 75 6e 2d 70 61 74 68 20 28 et* ((run-path (
95a0: 74 72 65 65 3a 6e 6f 64 65 2d 3e 70 61 74 68 20 tree:node->path
95b0: 6f 62 6a 20 69 64 29 29 0a 09 09 09 20 20 20 20 obj id))....
95c0: 28 72 75 6e 2d 69 64 20 20 20 28 74 72 65 65 2d (run-id (tree-
95d0: 70 61 74 68 2d 3e 72 75 6e 2d 69 64 20 28 63 64 path->run-id (cd
95e0: 72 20 72 75 6e 2d 70 61 74 68 29 29 29 29 0a 09 r run-path))))..
95f0: 09 20 20 20 20 20 20 20 28 69 66 20 28 6e 75 6d . (if (num
9600: 62 65 72 3f 20 72 75 6e 2d 69 64 29 0a 09 09 09 ber? run-id)....
9610: 20 20 20 28 62 65 67 69 6e 0a 09 09 09 20 20 20 (begin....
9620: 20 20 28 64 62 6f 61 72 64 3a 64 61 74 61 2d 73 (dboard:data-s
9630: 65 74 2d 63 75 72 72 2d 72 75 6e 2d 69 64 21 20 et-curr-run-id!
9640: 2a 64 61 74 61 2a 20 72 75 6e 2d 69 64 29 0a 09 *data* run-id)..
9650: 09 09 20 20 20 20 20 28 64 61 73 68 62 6f 61 72 .. (dashboar
9660: 64 3a 75 70 64 61 74 65 2d 72 75 6e 2d 73 75 6d d:update-run-sum
9670: 6d 61 72 79 2d 74 61 62 29 29 0a 09 09 09 20 20 mary-tab))....
9680: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
9690: 22 45 52 52 4f 52 3a 20 74 72 65 65 2d 70 61 74 "ERROR: tree-pat
96a0: 68 2d 3e 72 75 6e 2d 69 64 20 72 65 74 75 72 6e h->run-id return
96b0: 65 64 20 6e 6f 6e 2d 6e 75 6d 62 65 72 20 22 20 ed non-number "
96c0: 72 75 6e 2d 69 64 29 29 29 0a 09 09 20 20 20 20 run-id)))...
96d0: 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 70 61 ;; (print "pa
96e0: 74 68 3a 20 22 20 28 74 72 65 65 3a 6e 6f 64 65 th: " (tree:node
96f0: 2d 3e 70 61 74 68 20 6f 62 6a 20 69 64 29 20 22 ->path obj id) "
9700: 20 72 75 6e 2d 69 64 3a 20 22 20 72 75 6e 2d 69 run-id: " run-i
9710: 64 29 0a 09 09 20 20 20 20 20 20 20 29 29 29 0a d)... ))).
9720: 09 20 28 63 65 6c 6c 2d 6c 6f 6f 6b 75 70 20 28 . (cell-lookup (
9730: 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 make-hash-table)
9740: 29 0a 09 20 28 72 75 6e 2d 6d 61 74 72 69 78 20 ).. (run-matrix
9750: 28 69 75 70 3a 6d 61 74 72 69 78 0a 09 09 20 20 (iup:matrix...
9760: 20 20 20 20 23 3a 65 78 70 61 6e 64 20 22 59 45 #:expand "YE
9770: 53 22 0a 09 09 20 20 20 20 20 20 23 3a 63 6c 69 S"... #:cli
9780: 63 6b 2d 63 62 0a 09 09 20 20 20 20 20 20 28 6c ck-cb... (l
9790: 61 6d 62 64 61 20 28 6f 62 6a 20 6c 69 6e 20 63 ambda (obj lin c
97a0: 6f 6c 20 73 74 61 74 75 73 29 0a 09 09 09 28 6c ol status)....(l
97b0: 65 74 2a 20 28 28 74 6f 6f 6c 70 61 74 68 20 28 et* ((toolpath (
97c0: 63 61 72 20 28 61 72 67 76 29 29 29 0a 09 09 09 car (argv)))....
97d0: 20 20 20 20 20 20 20 28 6b 65 79 20 20 20 20 20 (key
97e0: 20 28 63 6f 6e 63 20 6c 69 6e 20 22 3a 22 20 63 (conc lin ":" c
97f0: 6f 6c 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 ol)).... (
9800: 74 65 73 74 2d 69 64 20 20 28 68 61 73 68 2d 74 test-id (hash-t
9810: 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 able-ref/default
9820: 20 63 65 6c 6c 2d 6c 6f 6f 6b 75 70 20 6b 65 79 cell-lookup key
9830: 20 2d 31 29 29 0a 09 09 09 20 20 20 20 20 20 20 -1))....
9840: 28 63 6d 64 20 20 20 20 20 20 28 63 6f 6e 63 20 (cmd (conc
9850: 74 6f 6f 6c 70 61 74 68 20 22 20 2d 74 65 73 74 toolpath " -test
9860: 20 22 20 28 64 62 6f 61 72 64 3a 64 61 74 61 2d " (dboard:data-
9870: 67 65 74 2d 63 75 72 72 2d 72 75 6e 2d 69 64 20 get-curr-run-id
9880: 2a 64 61 74 61 2a 29 20 22 2c 22 20 74 65 73 74 *data*) "," test
9890: 2d 69 64 20 22 26 22 29 29 29 0a 09 09 09 20 20 -id "&")))....
98a0: 28 73 79 73 74 65 6d 20 63 6d 64 29 29 29 29 29 (system cmd)))))
98b0: 0a 09 20 28 75 70 64 61 74 65 72 20 20 28 6c 61 .. (updater (la
98c0: 6d 62 64 61 20 28 29 0a 09 09 20 20 20 20 20 28 mbda ()... (
98d0: 6c 65 74 2a 20 28 28 72 75 6e 73 2d 64 61 74 20 let* ((runs-dat
98e0: 20 20 20 20 28 64 62 3a 67 65 74 2d 72 75 6e 73 (db:get-runs
98f0: 2d 62 79 2d 70 61 74 74 20 64 62 20 2a 6b 65 79 -by-patt db *key
9900: 73 2a 20 22 25 22 20 23 66 20 23 66 20 23 66 20 s* "%" #f #f #f
9910: 23 66 29 29 0a 09 09 09 20 20 20 20 28 72 75 6e #f)).... (run
9920: 73 2d 68 65 61 64 65 72 20 20 28 76 65 63 74 6f s-header (vecto
9930: 72 2d 72 65 66 20 72 75 6e 73 2d 64 61 74 20 30 r-ref runs-dat 0
9940: 29 29 20 3b 3b 20 30 20 69 73 20 68 65 61 64 65 )) ;; 0 is heade
9950: 72 2c 20 31 20 69 73 20 6c 69 73 74 20 6f 66 20 r, 1 is list of
9960: 72 65 63 6f 72 64 73 0a 09 09 09 20 20 20 20 28 records.... (
9970: 72 75 6e 2d 69 64 20 20 20 20 20 20 20 28 64 62 run-id (db
9980: 6f 61 72 64 3a 64 61 74 61 2d 67 65 74 2d 63 75 oard:data-get-cu
9990: 72 72 2d 72 75 6e 2d 69 64 20 2a 64 61 74 61 2a rr-run-id *data*
99a0: 29 29 0a 09 09 09 20 20 20 20 28 74 65 73 74 73 )).... (tests
99b0: 2d 64 61 74 20 20 20 20 28 6c 65 74 20 28 28 74 -dat (let ((t
99c0: 64 61 74 20 28 64 62 3a 67 65 74 2d 74 65 73 74 dat (db:get-test
99d0: 73 2d 66 6f 72 2d 72 75 6e 20 64 62 20 72 75 6e s-for-run db run
99e0: 2d 69 64 20 0a 09 09 09 09 09 09 09 09 09 20 20 -id ..........
99f0: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 (hash-table-re
9a00: 66 2f 64 65 66 61 75 6c 74 20 2a 73 65 61 72 63 f/default *searc
9a10: 68 70 61 74 74 73 2a 20 22 74 65 73 74 2d 6e 61 hpatts* "test-na
9a20: 6d 65 22 20 22 25 2f 25 22 29 0a 09 09 09 09 09 me" "%/%")......
9a30: 09 09 09 09 20 20 20 20 28 68 61 73 68 2d 74 61 .... (hash-ta
9a40: 62 6c 65 2d 6b 65 79 73 20 2a 73 74 61 74 65 2d ble-keys *state-
9a50: 69 67 6e 6f 72 65 2d 68 61 73 68 2a 29 20 3b 3b ignore-hash*) ;;
9a60: 20 27 28 29 0a 09 09 09 09 09 09 09 09 09 20 20 '()..........
9a70: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 (hash-table-ke
9a80: 79 73 20 2a 73 74 61 74 75 73 2d 69 67 6e 6f 72 ys *status-ignor
9a90: 65 2d 68 61 73 68 2a 29 20 3b 3b 20 27 28 29 0a e-hash*) ;; '().
9aa0: 09 09 09 09 09 09 09 09 09 20 20 20 20 23 66 20 ......... #f
9ab0: 23 66 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 #f..........
9ac0: 2a 68 69 64 65 2d 6e 6f 74 2d 68 69 64 65 2a 0a *hide-not-hide*.
9ad0: 09 09 09 09 09 09 09 09 09 20 20 20 20 23 66 20 ......... #f
9ae0: 23 66 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 #f..........
9af0: 22 69 64 2c 74 65 73 74 6e 61 6d 65 2c 69 74 65 "id,testname,ite
9b00: 6d 5f 70 61 74 68 2c 73 74 61 74 65 2c 73 74 61 m_path,state,sta
9b10: 74 75 73 22 29 29 29 20 3b 3b 20 67 65 74 20 27 tus"))) ;; get '
9b20: 65 6d 20 61 6c 6c 0a 09 09 09 09 09 20 20 20 20 em all......
9b30: 28 73 6f 72 74 20 74 64 61 74 20 28 6c 61 6d 62 (sort tdat (lamb
9b40: 64 61 20 28 61 20 62 29 0a 09 09 09 09 09 09 09 da (a b)........
9b50: 20 28 6c 65 74 2a 20 28 28 61 76 61 6c 20 28 76 (let* ((aval (v
9b60: 65 63 74 6f 72 2d 72 65 66 20 61 20 32 29 29 0a ector-ref a 2)).
9b70: 09 09 09 09 09 09 09 09 28 62 76 61 6c 20 28 76 ........(bval (v
9b80: 65 63 74 6f 72 2d 72 65 66 20 62 20 32 29 29 0a ector-ref b 2)).
9b90: 09 09 09 09 09 09 09 09 28 61 6e 75 6d 20 28 73 ........(anum (s
9ba0: 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 61 76 tring->number av
9bb0: 61 6c 29 29 0a 09 09 09 09 09 09 09 09 28 62 6e al)).........(bn
9bc0: 75 6d 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 um (string->numb
9bd0: 65 72 20 62 76 61 6c 29 29 29 0a 09 09 09 09 09 er bval)))......
9be0: 09 09 20 20 20 28 69 66 20 28 61 6e 64 20 61 6e .. (if (and an
9bf0: 75 6d 20 62 6e 75 6d 29 0a 09 09 09 09 09 09 09 um bnum)........
9c00: 20 20 20 20 20 20 20 28 3c 20 61 6e 75 6d 20 62 (< anum b
9c10: 6e 75 6d 29 0a 09 09 09 09 09 09 09 20 20 20 20 num)........
9c20: 20 20 20 28 73 74 72 69 6e 67 3c 3d 20 61 76 61 (string<= ava
9c30: 6c 20 62 76 61 6c 29 29 29 29 29 29 29 0a 09 09 l bval)))))))...
9c40: 09 20 20 20 20 28 74 65 73 74 73 2d 6d 69 6e 64 . (tests-mind
9c50: 61 74 20 28 64 63 6f 6d 6d 6f 6e 3a 6d 69 6e 69 at (dcommon:mini
9c60: 6d 69 7a 65 2d 74 65 73 74 2d 64 61 74 61 20 74 mize-test-data t
9c70: 65 73 74 73 2d 64 61 74 29 29 0a 09 09 09 20 20 ests-dat))....
9c80: 20 20 28 69 6e 64 69 63 65 73 20 20 20 20 20 20 (indices
9c90: 28 63 6f 6d 6d 6f 6e 3a 73 70 61 72 73 65 2d 6c (common:sparse-l
9ca0: 69 73 74 2d 67 65 6e 65 72 61 74 65 2d 69 6e 64 ist-generate-ind
9cb0: 65 78 20 74 65 73 74 73 2d 6d 69 6e 64 61 74 29 ex tests-mindat)
9cc0: 29 20 3b 3b 20 20 70 72 6f 63 3a 20 73 65 74 2d ) ;; proc: set-
9cd0: 63 65 6c 6c 29 29 0a 09 09 09 20 20 20 20 28 72 cell)).... (r
9ce0: 6f 77 2d 69 6e 64 69 63 65 73 20 20 28 63 61 64 ow-indices (cad
9cf0: 72 20 69 6e 64 69 63 65 73 29 29 0a 09 09 09 20 r indices))....
9d00: 20 20 20 28 63 6f 6c 2d 69 6e 64 69 63 65 73 20 (col-indices
9d10: 20 28 63 61 72 20 69 6e 64 69 63 65 73 29 29 0a (car indices)).
9d20: 09 09 09 20 20 20 20 28 6d 61 78 2d 72 6f 77 20 ... (max-row
9d30: 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 (if (null?
9d40: 72 6f 77 2d 69 6e 64 69 63 65 73 29 20 31 20 28 row-indices) 1 (
9d50: 63 6f 6d 6d 6f 6e 3a 6d 61 78 20 28 6d 61 70 20 common:max (map
9d60: 63 61 64 72 20 72 6f 77 2d 69 6e 64 69 63 65 73 cadr row-indices
9d70: 29 29 29 29 0a 09 09 09 20 20 20 20 28 6d 61 78 )))).... (max
9d80: 2d 63 6f 6c 20 20 20 20 20 20 28 69 66 20 28 6e -col (if (n
9d90: 75 6c 6c 3f 20 63 6f 6c 2d 69 6e 64 69 63 65 73 ull? col-indices
9da0: 29 20 31 20 28 63 6f 6d 6d 6f 6e 3a 6d 61 78 20 ) 1 (common:max
9db0: 28 6d 61 70 20 63 61 64 72 20 63 6f 6c 2d 69 6e (map cadr col-in
9dc0: 64 69 63 65 73 29 29 29 29 0a 09 09 09 20 20 20 dices))))....
9dd0: 20 28 6d 61 78 2d 76 69 73 69 62 6c 65 20 20 28 (max-visible (
9de0: 6d 61 78 20 28 2d 20 2a 6e 75 6d 2d 74 65 73 74 max (- *num-test
9df0: 73 2a 20 31 35 29 20 33 29 29 20 3b 3b 20 2a 6e s* 15) 3)) ;; *n
9e00: 75 6d 2d 74 65 73 74 73 2a 20 69 73 20 70 72 6f um-tests* is pro
9e10: 70 6f 72 74 69 6f 6e 61 6c 20 74 6f 20 74 68 65 portional to the
9e20: 20 73 69 7a 65 20 6f 66 20 74 68 65 20 77 69 6e size of the win
9e30: 64 6f 77 0a 09 09 09 20 20 20 20 28 6e 75 6d 72 dow.... (numr
9e40: 6f 77 73 20 20 20 20 20 20 31 29 0a 09 09 09 20 ows 1)....
9e50: 20 20 20 28 6e 75 6d 63 6f 6c 73 20 20 20 20 20 (numcols
9e60: 20 31 29 0a 09 09 09 20 20 20 20 28 63 68 61 6e 1).... (chan
9e70: 67 65 64 20 20 20 20 20 20 23 66 29 0a 09 09 09 ged #f)....
9e80: 20 20 20 20 28 72 75 6e 73 2d 68 61 73 68 20 20 (runs-hash
9e90: 20 20 28 6c 65 74 20 28 28 68 74 20 28 6d 61 6b (let ((ht (mak
9ea0: 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 29 0a e-hash-table))).
9eb0: 09 09 09 09 09 20 20 20 20 28 66 6f 72 2d 65 61 ..... (for-ea
9ec0: 63 68 20 28 6c 61 6d 62 64 61 20 28 72 75 6e 29 ch (lambda (run)
9ed0: 0a 09 09 09 09 09 09 09 28 68 61 73 68 2d 74 61 ........(hash-ta
9ee0: 62 6c 65 2d 73 65 74 21 20 68 74 20 28 64 62 3a ble-set! ht (db:
9ef0: 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 get-value-by-hea
9f00: 64 65 72 20 72 75 6e 20 72 75 6e 73 2d 68 65 61 der run runs-hea
9f10: 64 65 72 20 22 69 64 22 29 20 72 75 6e 29 29 0a der "id") run)).
9f20: 09 09 09 09 09 09 20 20 20 20 20 20 28 76 65 63 ...... (vec
9f30: 74 6f 72 2d 72 65 66 20 72 75 6e 73 2d 64 61 74 tor-ref runs-dat
9f40: 20 31 29 29 0a 09 09 09 09 09 20 20 20 20 68 74 1))...... ht
9f50: 29 29 0a 09 09 09 20 20 20 20 28 72 75 6e 2d 69 )).... (run-i
9f60: 64 73 20 20 20 20 20 20 28 73 6f 72 74 20 28 66 ds (sort (f
9f70: 69 6c 74 65 72 20 6e 75 6d 62 65 72 3f 20 28 68 ilter number? (h
9f80: 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 72 ash-table-keys r
9f90: 75 6e 73 2d 68 61 73 68 29 29 0a 09 09 09 09 09 uns-hash))......
9fa0: 09 28 6c 61 6d 62 64 61 20 28 61 20 62 29 0a 09 .(lambda (a b)..
9fb0: 09 09 09 09 09 20 20 28 6c 65 74 2a 20 28 28 72 ..... (let* ((r
9fc0: 65 63 6f 72 64 2d 61 20 28 68 61 73 68 2d 74 61 ecord-a (hash-ta
9fd0: 62 6c 65 2d 72 65 66 20 72 75 6e 73 2d 68 61 73 ble-ref runs-has
9fe0: 68 20 61 29 29 0a 09 09 09 09 09 09 09 20 28 72 h a))........ (r
9ff0: 65 63 6f 72 64 2d 62 20 28 68 61 73 68 2d 74 61 ecord-b (hash-ta
a000: 62 6c 65 2d 72 65 66 20 72 75 6e 73 2d 68 61 73 ble-ref runs-has
a010: 68 20 62 29 29 0a 09 09 09 09 09 09 09 20 28 74 h b))........ (t
a020: 69 6d 65 2d 61 20 20 20 28 64 62 3a 67 65 74 2d ime-a (db:get-
a030: 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 value-by-header
a040: 72 65 63 6f 72 64 2d 61 20 72 75 6e 73 2d 68 65 record-a runs-he
a050: 61 64 65 72 20 22 65 76 65 6e 74 5f 74 69 6d 65 ader "event_time
a060: 22 29 29 0a 09 09 09 09 09 09 09 20 28 74 69 6d "))........ (tim
a070: 65 2d 62 20 20 20 28 64 62 3a 67 65 74 2d 76 61 e-b (db:get-va
a080: 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 65 lue-by-header re
a090: 63 6f 72 64 2d 62 20 72 75 6e 73 2d 68 65 61 64 cord-b runs-head
a0a0: 65 72 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 29 er "event_time")
a0b0: 29 29 0a 09 09 09 09 09 09 20 20 20 20 28 3c 20 ))....... (<
a0c0: 74 69 6d 65 2d 61 20 74 69 6d 65 2d 62 29 29 29 time-a time-b)))
a0d0: 29 29 29 0a 09 09 20 20 20 20 20 20 20 0a 09 09 )))... ...
a0e0: 20 20 20 20 20 20 20 3b 3b 20 28 69 75 70 3a 61 ;; (iup:a
a0f0: 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 74 62 ttribute-set! tb
a100: 20 22 56 41 4c 55 45 22 20 22 30 22 29 0a 09 09 "VALUE" "0")...
a110: 20 20 20 20 20 20 20 3b 3b 20 28 69 75 70 3a 61 ;; (iup:a
a120: 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 74 62 ttribute-set! tb
a130: 20 22 4e 41 4d 45 22 20 22 52 75 6e 73 22 29 0a "NAME" "Runs").
a140: 09 09 20 20 20 20 20 20 20 3b 3b 20 55 70 64 61 .. ;; Upda
a150: 74 65 20 74 68 65 20 72 75 6e 73 20 74 72 65 65 te the runs tree
a160: 0a 09 09 20 20 20 20 20 20 20 28 66 6f 72 2d 65 ... (for-e
a170: 61 63 68 20 28 6c 61 6d 62 64 61 20 28 72 75 6e ach (lambda (run
a180: 2d 69 64 29 0a 09 09 09 09 20 20 20 28 6c 65 74 -id)..... (let
a190: 2a 20 28 28 72 75 6e 2d 72 65 63 6f 72 64 20 28 * ((run-record (
a1a0: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d
a1b0: 65 66 61 75 6c 74 20 72 75 6e 73 2d 68 61 73 68 efault runs-hash
a1c0: 20 72 75 6e 2d 69 64 20 23 66 29 29 0a 09 09 09 run-id #f))....
a1d0: 09 09 20 20 28 6b 65 79 2d 76 61 6c 73 20 20 20 .. (key-vals
a1e0: 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 6b 65 (map (lambda (ke
a1f0: 79 29 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d y)(db:get-value-
a200: 62 79 2d 68 65 61 64 65 72 20 72 75 6e 2d 72 65 by-header run-re
a210: 63 6f 72 64 20 72 75 6e 73 2d 68 65 61 64 65 72 cord runs-header
a220: 20 6b 65 79 29 29 0a 09 09 09 09 09 09 09 20 20 key))........
a230: 20 2a 6b 65 79 73 2a 29 29 0a 09 09 09 09 09 20 *keys*))......
a240: 20 28 72 75 6e 2d 6e 61 6d 65 20 20 20 28 64 62 (run-name (db
a250: 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 :get-value-by-he
a260: 61 64 65 72 20 72 75 6e 2d 72 65 63 6f 72 64 20 ader run-record
a270: 72 75 6e 73 2d 68 65 61 64 65 72 20 22 72 75 6e runs-header "run
a280: 6e 61 6d 65 22 29 29 0a 09 09 09 09 09 20 20 28 name"))...... (
a290: 63 6f 6c 2d 6e 61 6d 65 20 20 20 28 63 6f 6e 63 col-name (conc
a2a0: 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 (string-intersp
a2b0: 65 72 73 65 20 6b 65 79 2d 76 61 6c 73 20 22 5c erse key-vals "\
a2c0: 6e 22 29 20 22 5c 6e 22 20 72 75 6e 2d 6e 61 6d n") "\n" run-nam
a2d0: 65 29 29 0a 09 09 09 09 09 20 20 28 72 75 6e 2d e))...... (run-
a2e0: 70 61 74 68 20 20 20 28 61 70 70 65 6e 64 20 6b path (append k
a2f0: 65 79 2d 76 61 6c 73 20 28 6c 69 73 74 20 72 75 ey-vals (list ru
a300: 6e 2d 6e 61 6d 65 29 29 29 0a 09 09 09 09 09 20 n-name)))......
a310: 20 28 65 78 69 73 74 69 6e 67 20 20 20 28 74 72 (existing (tr
a320: 65 65 3a 66 69 6e 64 2d 6e 6f 64 65 20 74 62 20 ee:find-node tb
a330: 72 75 6e 2d 70 61 74 68 29 29 29 0a 09 09 09 09 run-path))).....
a340: 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 68 (if (not (h
a350: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
a360: 66 61 75 6c 74 20 28 64 62 6f 61 72 64 3a 64 61 fault (dboard:da
a370: 74 61 2d 67 65 74 2d 70 61 74 68 2d 72 75 6e 2d ta-get-path-run-
a380: 69 64 73 20 2a 64 61 74 61 2a 29 20 72 75 6e 2d ids *data*) run-
a390: 70 61 74 68 20 23 66 29 29 0a 09 09 09 09 09 20 path #f))......
a3a0: 28 62 65 67 69 6e 0a 09 09 09 09 09 20 20 20 28 (begin...... (
a3b0: 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 hash-table-set!
a3c0: 28 64 62 6f 61 72 64 3a 64 61 74 61 2d 67 65 74 (dboard:data-get
a3d0: 2d 72 75 6e 2d 6b 65 79 73 20 2a 64 61 74 61 2a -run-keys *data*
a3e0: 29 20 72 75 6e 2d 69 64 20 72 75 6e 2d 70 61 74 ) run-id run-pat
a3f0: 68 29 0a 09 09 09 09 09 20 20 20 3b 3b 20 28 69 h)...... ;; (i
a400: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 up:attribute-set
a410: 21 20 28 64 62 6f 61 72 64 3a 64 61 74 61 2d 67 ! (dboard:data-g
a420: 65 74 2d 72 75 6e 73 2d 6d 61 74 72 69 78 20 2a et-runs-matrix *
a430: 64 61 74 61 2a 29 0a 09 09 09 09 09 20 20 20 3b data*)...... ;
a440: 3b 20 20 20 20 09 09 20 28 63 6f 6e 63 20 72 6f ; .. (conc ro
a450: 77 6e 75 6d 20 22 3a 22 20 63 6f 6c 6e 75 6d 29 wnum ":" colnum)
a460: 20 63 6f 6c 2d 6e 61 6d 65 29 0a 09 09 09 09 09 col-name)......
a470: 20 20 20 3b 3b 20 28 68 61 73 68 2d 74 61 62 6c ;; (hash-tabl
a480: 65 2d 73 65 74 21 20 72 75 6e 69 64 2d 74 6f 2d e-set! runid-to-
a490: 63 6f 6c 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 col run-id (list
a4a0: 20 63 6f 6c 6e 75 6d 20 72 75 6e 2d 72 65 63 6f colnum run-reco
a4b0: 72 64 29 29 0a 09 09 09 09 09 20 20 20 3b 3b 20 rd))...... ;;
a4c0: 48 65 72 65 20 77 65 20 75 70 64 61 74 65 20 74 Here we update t
a4d0: 68 65 20 74 65 73 74 73 20 74 72 65 65 62 6f 78 he tests treebox
a4e0: 20 61 6e 64 20 74 72 65 65 20 6b 65 79 73 0a 09 and tree keys..
a4f0: 09 09 09 09 20 20 20 28 74 72 65 65 3a 61 64 64 .... (tree:add
a500: 2d 6e 6f 64 65 20 74 62 20 22 52 75 6e 73 22 20 -node tb "Runs"
a510: 72 75 6e 2d 70 61 74 68 20 3b 3b 20 28 61 70 70 run-path ;; (app
a520: 65 6e 64 20 6b 65 79 2d 76 61 6c 73 20 28 6c 69 end key-vals (li
a530: 73 74 20 72 75 6e 2d 6e 61 6d 65 29 29 0a 09 09 st run-name))...
a540: 09 09 09 09 09 20 20 75 73 65 72 64 61 74 61 3a ..... userdata:
a550: 20 28 63 6f 6e 63 20 22 72 75 6e 2d 69 64 3a 20 (conc "run-id:
a560: 22 20 72 75 6e 2d 69 64 29 29 0a 09 09 09 09 09 " run-id))......
a570: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 (hash-table-s
a580: 65 74 21 20 28 64 62 6f 61 72 64 3a 64 61 74 61 et! (dboard:data
a590: 2d 67 65 74 2d 70 61 74 68 2d 72 75 6e 2d 69 64 -get-path-run-id
a5a0: 73 20 2a 64 61 74 61 2a 29 20 72 75 6e 2d 70 61 s *data*) run-pa
a5b0: 74 68 20 72 75 6e 2d 69 64 29 0a 09 09 09 09 09 th run-id)......
a5c0: 20 20 20 3b 3b 20 28 73 65 74 21 20 63 6f 6c 6e ;; (set! coln
a5d0: 75 6d 20 28 2b 20 63 6f 6c 6e 75 6d 20 31 29 29 um (+ colnum 1))
a5e0: 0a 09 09 09 09 09 20 20 20 29 29 29 29 0a 09 09 ...... ))))...
a5f0: 09 09 20 72 75 6e 2d 69 64 73 29 0a 09 09 20 20 .. run-ids)...
a600: 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 (iup:attrib
a610: 75 74 65 2d 73 65 74 21 20 72 75 6e 2d 6d 61 74 ute-set! run-mat
a620: 72 69 78 20 22 43 4c 45 41 52 56 41 4c 55 45 22 rix "CLEARVALUE"
a630: 20 22 41 4c 4c 22 29 20 3b 3b 20 4e 4f 54 45 3a "ALL") ;; NOTE:
a640: 20 57 61 73 20 43 4f 4e 54 45 4e 54 53 0a 09 09 Was CONTENTS...
a650: 20 20 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 (iup:attr
a660: 69 62 75 74 65 2d 73 65 74 21 20 72 75 6e 2d 6d ibute-set! run-m
a670: 61 74 72 69 78 20 22 43 4c 45 41 52 41 54 54 52 atrix "CLEARATTR
a680: 49 42 22 20 22 43 4f 4e 54 45 4e 54 53 22 29 0a IB" "CONTENTS").
a690: 09 09 20 20 20 20 20 20 20 28 69 75 70 3a 61 74 .. (iup:at
a6a0: 74 72 69 62 75 74 65 2d 73 65 74 21 20 72 75 6e tribute-set! run
a6b0: 2d 6d 61 74 72 69 78 20 22 52 45 53 49 5a 45 4d -matrix "RESIZEM
a6c0: 41 54 52 49 58 22 20 22 59 45 53 22 29 0a 09 09 ATRIX" "YES")...
a6d0: 20 20 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 (iup:attr
a6e0: 69 62 75 74 65 2d 73 65 74 21 20 72 75 6e 2d 6d ibute-set! run-m
a6f0: 61 74 72 69 78 20 22 4e 55 4d 43 4f 4c 22 20 6d atrix "NUMCOL" m
a700: 61 78 2d 63 6f 6c 20 29 0a 09 09 20 20 20 20 20 ax-col )...
a710: 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 (iup:attribute
a720: 2d 73 65 74 21 20 72 75 6e 2d 6d 61 74 72 69 78 -set! run-matrix
a730: 20 22 4e 55 4d 4c 49 4e 22 20 28 69 66 20 28 3c "NUMLIN" (if (<
a740: 20 6d 61 78 2d 72 6f 77 20 6d 61 78 2d 76 69 73 max-row max-vis
a750: 69 62 6c 65 29 20 6d 61 78 2d 76 69 73 69 62 6c ible) max-visibl
a760: 65 20 6d 61 78 2d 72 6f 77 29 29 20 3b 3b 20 6d e max-row)) ;; m
a770: 69 6e 20 6f 66 20 32 30 0a 09 09 20 20 20 20 20 in of 20...
a780: 20 20 3b 3b 20 28 69 75 70 3a 61 74 74 72 69 62 ;; (iup:attrib
a790: 75 74 65 2d 73 65 74 21 20 72 75 6e 2d 6d 61 74 ute-set! run-mat
a7a0: 72 69 78 20 22 4e 55 4d 43 4f 4c 5f 56 49 53 49 rix "NUMCOL_VISI
a7b0: 42 4c 45 22 20 6d 61 78 2d 63 6f 6c 29 0a 09 09 BLE" max-col)...
a7c0: 20 20 20 20 20 20 20 3b 3b 20 28 69 75 70 3a 61 ;; (iup:a
a7d0: 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 72 75 ttribute-set! ru
a7e0: 6e 2d 6d 61 74 72 69 78 20 22 4e 55 4d 4c 49 4e n-matrix "NUMLIN
a7f0: 5f 56 49 53 49 42 4c 45 22 20 28 69 66 20 28 3e _VISIBLE" (if (>
a800: 20 6d 61 78 2d 72 6f 77 20 6d 61 78 2d 76 69 73 max-row max-vis
a810: 69 62 6c 65 29 20 6d 61 78 2d 76 69 73 69 62 6c ible) max-visibl
a820: 65 20 6d 61 78 2d 72 6f 77 29 29 0a 09 09 20 20 e max-row))...
a830: 20 20 20 20 20 0a 09 09 20 20 20 20 20 20 20 3b ... ;
a840: 3b 20 52 6f 77 20 6c 61 62 65 6c 73 0a 09 09 20 ; Row labels...
a850: 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 (for-each
a860: 28 6c 61 6d 62 64 61 20 28 69 6e 64 29 0a 09 09 (lambda (ind)...
a870: 09 09 20 20 20 28 6c 65 74 2a 20 28 28 6e 61 6d .. (let* ((nam
a880: 65 20 28 63 61 72 20 69 6e 64 29 29 0a 09 09 09 e (car ind))....
a890: 09 09 20 20 28 6e 75 6d 20 20 28 63 61 64 72 20 .. (num (cadr
a8a0: 69 6e 64 29 29 0a 09 09 09 09 09 20 20 28 6b 65 ind))...... (ke
a8b0: 79 20 20 28 63 6f 6e 63 20 6e 75 6d 20 22 3a 30 y (conc num ":0
a8c0: 22 29 29 29 0a 09 09 09 09 20 20 20 20 20 28 69 ")))..... (i
a8d0: 66 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 28 f (not (equal? (
a8e0: 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 72 75 iup:attribute ru
a8f0: 6e 2d 6d 61 74 72 69 78 20 6b 65 79 29 20 6e 61 n-matrix key) na
a900: 6d 65 29 29 0a 09 09 09 09 09 20 28 62 65 67 69 me))...... (begi
a910: 6e 0a 09 09 09 09 09 20 20 20 28 73 65 74 21 20 n...... (set!
a920: 63 68 61 6e 67 65 64 20 23 74 29 0a 09 09 09 09 changed #t).....
a930: 09 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 . (iup:attribu
a940: 74 65 2d 73 65 74 21 20 72 75 6e 2d 6d 61 74 72 te-set! run-matr
a950: 69 78 20 6b 65 79 20 6e 61 6d 65 29 29 29 29 29 ix key name)))))
a960: 0a 09 09 09 09 20 72 6f 77 2d 69 6e 64 69 63 65 ..... row-indice
a970: 73 29 0a 09 09 20 20 20 20 20 20 20 0a 09 09 20 s)... ...
a980: 20 20 20 20 20 20 3b 3b 20 43 65 6c 6c 20 63 6f ;; Cell co
a990: 6e 74 65 6e 74 73 0a 09 09 20 20 20 20 20 20 20 ntents...
a9a0: 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 (for-each (lambd
a9b0: 61 20 28 65 6e 74 72 79 29 0a 09 09 09 09 20 20 a (entry).....
a9c0: 20 28 6c 65 74 2a 20 28 28 72 6f 77 2d 6e 61 6d (let* ((row-nam
a9d0: 65 20 20 28 63 61 64 72 20 65 6e 74 72 79 29 29 e (cadr entry))
a9e0: 0a 09 09 09 09 09 20 20 28 63 6f 6c 2d 6e 61 6d ...... (col-nam
a9f0: 65 20 20 28 63 61 72 20 65 6e 74 72 79 29 29 0a e (car entry)).
aa00: 09 09 09 09 09 20 20 28 76 61 6c 75 65 64 61 74 ..... (valuedat
aa10: 20 20 28 63 61 64 64 72 20 65 6e 74 72 79 29 29 (caddr entry))
aa20: 0a 09 09 09 09 09 20 20 28 74 65 73 74 2d 69 64 ...... (test-id
aa30: 20 20 20 28 6c 69 73 74 2d 72 65 66 20 76 61 6c (list-ref val
aa40: 75 65 64 61 74 20 30 29 29 0a 09 09 09 09 09 20 uedat 0))......
aa50: 20 28 74 65 73 74 2d 6e 61 6d 65 20 72 6f 77 2d (test-name row-
aa60: 6e 61 6d 65 29 20 3b 3b 20 28 6c 69 73 74 2d 72 name) ;; (list-r
aa70: 65 66 20 76 61 6c 75 65 64 61 74 20 31 29 29 0a ef valuedat 1)).
aa80: 09 09 09 09 09 20 20 28 69 74 65 6d 2d 70 61 74 ..... (item-pat
aa90: 68 20 63 6f 6c 2d 6e 61 6d 65 29 20 3b 3b 20 28 h col-name) ;; (
aaa0: 6c 69 73 74 2d 72 65 66 20 76 61 6c 75 65 64 61 list-ref valueda
aab0: 74 20 32 29 29 0a 09 09 09 09 09 20 20 28 73 74 t 2))...... (st
aac0: 61 74 65 20 20 20 20 20 28 6c 69 73 74 2d 72 65 ate (list-re
aad0: 66 20 76 61 6c 75 65 64 61 74 20 31 29 29 0a 09 f valuedat 1))..
aae0: 09 09 09 09 20 20 28 73 74 61 74 75 73 20 20 20 .... (status
aaf0: 20 28 6c 69 73 74 2d 72 65 66 20 76 61 6c 75 65 (list-ref value
ab00: 64 61 74 20 32 29 29 0a 09 09 09 09 09 20 20 28 dat 2))...... (
ab10: 76 61 6c 75 65 20 20 20 20 20 28 67 75 74 69 6c value (gutil
ab20: 73 3a 67 65 74 2d 63 6f 6c 6f 72 2d 66 6f 72 2d s:get-color-for-
ab30: 73 74 61 74 65 2d 73 74 61 74 75 73 20 73 74 61 state-status sta
ab40: 74 65 20 73 74 61 74 75 73 29 29 0a 09 09 09 09 te status)).....
ab50: 09 20 20 28 72 6f 77 2d 6e 75 6d 20 20 20 28 63 . (row-num (c
ab60: 61 64 72 20 28 61 73 73 6f 63 20 72 6f 77 2d 6e adr (assoc row-n
ab70: 61 6d 65 20 72 6f 77 2d 69 6e 64 69 63 65 73 29 ame row-indices)
ab80: 29 29 0a 09 09 09 09 09 20 20 28 63 6f 6c 2d 6e ))...... (col-n
ab90: 75 6d 20 20 20 28 63 61 64 72 20 28 61 73 73 6f um (cadr (asso
aba0: 63 20 63 6f 6c 2d 6e 61 6d 65 20 63 6f 6c 2d 69 c col-name col-i
abb0: 6e 64 69 63 65 73 29 29 29 0a 09 09 09 09 09 20 ndices)))......
abc0: 20 28 6b 65 79 20 20 20 20 20 20 20 28 63 6f 6e (key (con
abd0: 63 20 72 6f 77 2d 6e 75 6d 20 22 3a 22 20 63 6f c row-num ":" co
abe0: 6c 2d 6e 75 6d 29 29 29 0a 09 09 09 09 20 20 20 l-num))).....
abf0: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 (hash-table-se
ac00: 74 21 20 63 65 6c 6c 2d 6c 6f 6f 6b 75 70 20 6b t! cell-lookup k
ac10: 65 79 20 74 65 73 74 2d 69 64 29 0a 09 09 09 09 ey test-id).....
ac20: 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 65 (if (not (e
ac30: 71 75 61 6c 3f 20 28 69 75 70 3a 61 74 74 72 69 qual? (iup:attri
ac40: 62 75 74 65 20 72 75 6e 2d 6d 61 74 72 69 78 20 bute run-matrix
ac50: 6b 65 79 29 20 28 63 61 64 72 20 76 61 6c 75 65 key) (cadr value
ac60: 29 29 29 0a 09 09 09 09 09 20 28 62 65 67 69 6e )))...... (begin
ac70: 0a 09 09 09 09 09 20 20 20 28 73 65 74 21 20 63 ...... (set! c
ac80: 68 61 6e 67 65 64 20 23 74 29 0a 09 09 09 09 09 hanged #t)......
ac90: 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 (iup:attribut
aca0: 65 2d 73 65 74 21 20 72 75 6e 2d 6d 61 74 72 69 e-set! run-matri
acb0: 78 20 6b 65 79 20 28 63 61 64 72 20 76 61 6c 75 x key (cadr valu
acc0: 65 29 29 0a 09 09 09 09 09 20 20 20 28 69 75 70 e))...... (iup
acd0: 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 :attribute-set!
ace0: 72 75 6e 2d 6d 61 74 72 69 78 20 28 63 6f 6e 63 run-matrix (conc
acf0: 20 22 42 47 43 4f 4c 4f 52 22 20 6b 65 79 29 20 "BGCOLOR" key)
ad00: 28 63 61 72 20 76 61 6c 75 65 29 29 29 29 29 29 (car value))))))
ad10: 0a 09 09 09 09 20 74 65 73 74 73 2d 6d 69 6e 64 ..... tests-mind
ad20: 61 74 29 0a 09 09 20 20 20 20 20 20 20 0a 09 09 at)... ...
ad30: 20 20 20 20 20 20 20 3b 3b 20 43 6f 6c 20 6c 61 ;; Col la
ad40: 62 65 6c 73 20 2d 20 64 6f 20 61 66 74 65 72 20 bels - do after
ad50: 73 65 74 74 69 6e 67 20 43 65 6c 6c 20 63 6f 6e setting Cell con
ad60: 74 65 6e 74 73 20 73 6f 20 74 68 65 79 20 61 72 tents so they ar
ad70: 65 20 61 63 63 6f 75 6e 74 65 64 20 66 6f 72 20 e accounted for
ad80: 69 6e 20 74 68 65 20 73 69 7a 65 20 63 61 6c 63 in the size calc
ad90: 2e 0a 0a 09 09 20 20 20 20 20 20 20 28 66 6f 72 ..... (for
ada0: 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 69 -each (lambda (i
adb0: 6e 64 29 0a 09 09 09 09 20 20 20 28 6c 65 74 2a nd)..... (let*
adc0: 20 28 28 6e 61 6d 65 20 28 63 61 72 20 69 6e 64 ((name (car ind
add0: 29 29 0a 09 09 09 09 09 20 20 28 6e 75 6d 20 20 ))...... (num
ade0: 28 63 61 64 72 20 69 6e 64 29 29 0a 09 09 09 09 (cadr ind)).....
adf0: 09 20 20 28 6b 65 79 20 20 28 63 6f 6e 63 20 22 . (key (conc "
ae00: 30 3a 22 20 6e 75 6d 29 29 29 0a 09 09 09 09 20 0:" num))).....
ae10: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 65 71 (if (not (eq
ae20: 75 61 6c 3f 20 28 69 75 70 3a 61 74 74 72 69 62 ual? (iup:attrib
ae30: 75 74 65 20 72 75 6e 2d 6d 61 74 72 69 78 20 6b ute run-matrix k
ae40: 65 79 29 20 6e 61 6d 65 29 29 0a 09 09 09 09 09 ey) name))......
ae50: 20 28 62 65 67 69 6e 0a 09 09 09 09 09 20 20 20 (begin......
ae60: 28 73 65 74 21 20 63 68 61 6e 67 65 64 20 23 74 (set! changed #t
ae70: 29 0a 09 09 09 09 09 20 20 20 28 69 75 70 3a 61 )...... (iup:a
ae80: 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 72 75 ttribute-set! ru
ae90: 6e 2d 6d 61 74 72 69 78 20 6b 65 79 20 6e 61 6d n-matrix key nam
aea0: 65 29 0a 09 09 09 09 09 20 20 20 28 69 75 70 3a e)...... (iup:
aeb0: 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 72 attribute-set! r
aec0: 75 6e 2d 6d 61 74 72 69 78 20 22 46 49 54 54 4f un-matrix "FITTO
aed0: 54 45 58 54 22 20 28 63 6f 6e 63 20 22 43 22 20 TEXT" (conc "C"
aee0: 6e 75 6d 29 29 29 29 29 29 0a 09 09 09 09 20 63 num))))))..... c
aef0: 6f 6c 2d 69 6e 64 69 63 65 73 29 0a 09 09 20 20 ol-indices)...
af00: 20 20 20 20 20 28 69 66 20 63 68 61 6e 67 65 64 (if changed
af10: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d (iup:attribute-
af20: 73 65 74 21 20 72 75 6e 2d 6d 61 74 72 69 78 20 set! run-matrix
af30: 22 52 45 44 52 41 57 22 20 22 41 4c 4c 22 29 29 "REDRAW" "ALL"))
af40: 29 29 29 29 0a 20 20 20 20 0a 20 20 20 20 28 73 )))). . (s
af50: 65 74 21 20 64 61 73 68 62 6f 61 72 64 3a 75 70 et! dashboard:up
af60: 64 61 74 65 2d 72 75 6e 2d 73 75 6d 6d 61 72 79 date-run-summary
af70: 2d 74 61 62 20 75 70 64 61 74 65 72 29 0a 20 20 -tab updater).
af80: 20 20 28 64 62 6f 61 72 64 3a 64 61 74 61 2d 73 (dboard:data-s
af90: 65 74 2d 72 75 6e 73 2d 74 72 65 65 21 20 2a 64 et-runs-tree! *d
afa0: 61 74 61 2a 20 74 62 29 0a 20 20 20 20 28 69 75 ata* tb). (iu
afb0: 70 3a 73 70 6c 69 74 0a 20 20 20 20 20 74 62 0a p:split. tb.
afc0: 20 20 20 20 20 72 75 6e 2d 6d 61 74 72 69 78 29 run-matrix)
afd0: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
afe0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
aff0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b000: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
b020: 52 20 55 20 4e 20 53 20 0a 3b 3b 3d 3d 3d 3d 3d R U N S .;;=====
b030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b040: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b050: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b060: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b070: 3d 0a 0a 28 64 65 66 69 6e 65 20 28 6d 61 6b 65 =..(define (make
b080: 2d 64 61 73 68 62 6f 61 72 64 2d 62 75 74 74 6f -dashboard-butto
b090: 6e 73 20 64 62 20 6e 72 75 6e 73 20 6e 74 65 73 ns db nruns ntes
b0a0: 74 73 20 6b 65 79 6e 61 6d 65 73 29 0a 20 20 28 ts keynames). (
b0b0: 6c 65 74 2a 20 28 28 6e 6b 65 79 73 20 20 20 28 let* ((nkeys (
b0c0: 6c 65 6e 67 74 68 20 6b 65 79 6e 61 6d 65 73 29 length keynames)
b0d0: 29 0a 09 20 28 72 75 6e 73 76 65 63 20 28 6d 61 ).. (runsvec (ma
b0e0: 6b 65 2d 76 65 63 74 6f 72 20 6e 72 75 6e 73 29 ke-vector nruns)
b0f0: 29 0a 09 20 28 68 65 61 64 65 72 20 20 28 6d 61 ).. (header (ma
b100: 6b 65 2d 76 65 63 74 6f 72 20 6e 72 75 6e 73 29 ke-vector nruns)
b110: 29 0a 09 20 28 6c 66 74 63 6f 6c 20 20 28 6d 61 ).. (lftcol (ma
b120: 6b 65 2d 76 65 63 74 6f 72 20 6e 74 65 73 74 73 ke-vector ntests
b130: 29 29 0a 09 20 28 6b 65 79 63 6f 6c 20 20 28 6d )).. (keycol (m
b140: 61 6b 65 2d 76 65 63 74 6f 72 20 6e 74 65 73 74 ake-vector ntest
b150: 73 29 29 0a 09 20 28 63 6f 6e 74 72 6f 6c 73 20 s)).. (controls
b160: 27 28 29 29 0a 09 20 28 6c 66 74 6c 73 74 20 20 '()).. (lftlst
b170: 27 28 29 29 0a 09 20 28 68 64 72 6c 73 74 20 20 '()).. (hdrlst
b180: 27 28 29 29 0a 09 20 28 62 64 79 6c 73 74 20 20 '()).. (bdylst
b190: 27 28 29 29 0a 09 20 28 72 65 73 75 6c 74 20 20 '()).. (result
b1a0: 27 28 29 29 0a 09 20 28 69 20 20 20 20 20 20 20 '()).. (i
b1b0: 30 29 29 0a 20 20 20 20 3b 3b 20 63 6f 6e 74 72 0)). ;; contr
b1c0: 6f 6c 73 20 28 61 6c 6f 6e 67 20 62 6f 74 74 6f ols (along botto
b1d0: 6d 29 0a 20 20 20 20 28 73 65 74 21 20 63 6f 6e m). (set! con
b1e0: 74 72 6f 6c 73 0a 09 20 20 28 69 75 70 3a 68 62 trols.. (iup:hb
b1f0: 6f 78 0a 09 20 20 20 28 69 75 70 3a 76 62 6f 78 ox.. (iup:vbox
b200: 0a 09 20 20 20 20 28 69 75 70 3a 66 72 61 6d 65 .. (iup:frame
b210: 20 0a 09 20 20 20 20 20 23 3a 74 69 74 6c 65 20 .. #:title
b220: 22 66 69 6c 74 65 72 20 74 65 73 74 20 61 6e 64 "filter test and
b230: 20 69 74 65 6d 73 22 0a 09 20 20 20 20 20 28 69 items".. (i
b240: 75 70 3a 68 62 6f 78 0a 09 20 20 20 20 20 20 28 up:hbox.. (
b250: 69 75 70 3a 74 65 78 74 62 6f 78 20 23 3a 73 69 iup:textbox #:si
b260: 7a 65 20 22 31 32 30 78 31 35 22 20 23 3a 66 6f ze "120x15" #:fo
b270: 6e 74 73 69 7a 65 20 22 31 30 22 20 23 3a 76 61 ntsize "10" #:va
b280: 6c 75 65 20 22 25 22 0a 09 09 09 20 20 20 23 3a lue "%".... #:
b290: 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 action (lambda (
b2a0: 6f 62 6a 20 75 6e 6b 20 76 61 6c 29 0a 09 09 09 obj unk val)....
b2b0: 09 20 20 20 20 20 20 28 6d 61 72 6b 2d 66 6f 72 . (mark-for
b2c0: 2d 75 70 64 61 74 65 29 0a 09 09 09 09 20 20 20 -update).....
b2d0: 20 20 20 28 75 70 64 61 74 65 2d 73 65 61 72 63 (update-searc
b2e0: 68 20 22 74 65 73 74 2d 6e 61 6d 65 22 20 76 61 h "test-name" va
b2f0: 6c 29 29 29 0a 09 20 20 20 20 20 20 3b 3b 28 69 l))).. ;;(i
b300: 75 70 3a 74 65 78 74 62 6f 78 20 23 3a 73 69 7a up:textbox #:siz
b310: 65 20 22 36 30 78 31 35 22 20 23 3a 66 6f 6e 74 e "60x15" #:font
b320: 73 69 7a 65 20 22 31 30 22 20 23 3a 76 61 6c 75 size "10" #:valu
b330: 65 20 22 25 22 0a 09 20 20 20 20 20 20 3b 3b 20 e "%".. ;;
b340: 20 09 20 20 20 23 3a 61 63 74 69 6f 6e 20 28 6c . #:action (l
b350: 61 6d 62 64 61 20 28 6f 62 6a 20 75 6e 6b 20 76 ambda (obj unk v
b360: 61 6c 29 0a 09 20 20 20 20 20 20 3b 3b 20 20 09 al).. ;; .
b370: 09 20 20 20 20 20 20 28 6d 61 72 6b 2d 66 6f 72 . (mark-for
b380: 2d 75 70 64 61 74 65 29 0a 09 20 20 20 20 20 20 -update)..
b390: 3b 3b 20 20 09 09 20 20 20 20 20 20 28 75 70 64 ;; .. (upd
b3a0: 61 74 65 2d 73 65 61 72 63 68 20 22 69 74 65 6d ate-search "item
b3b0: 2d 6e 61 6d 65 22 20 76 61 6c 29 29 0a 09 20 20 -name" val))..
b3c0: 20 20 20 20 29 29 0a 09 20 20 20 20 28 69 75 70 )).. (iup
b3d0: 3a 76 62 6f 78 0a 09 20 20 20 20 20 28 69 75 70 :vbox.. (iup
b3e0: 3a 68 62 6f 78 0a 09 20 20 20 20 20 20 28 6c 65 :hbox.. (le
b3f0: 74 2a 20 28 28 63 6d 64 73 2d 6c 69 73 74 20 27 t* ((cmds-list '
b400: 28 22 2b 74 65 73 74 6e 61 6d 65 22 20 22 2d 74 ("+testname" "-t
b410: 65 73 74 6e 61 6d 65 22 20 22 2b 65 76 65 6e 74 estname" "+event
b420: 5f 74 69 6d 65 22 20 22 2d 65 76 65 6e 74 5f 74 _time" "-event_t
b430: 69 6d 65 22 20 22 2b 73 74 61 74 65 73 74 61 74 ime" "+statestat
b440: 75 73 22 20 22 2d 73 74 61 74 65 73 74 61 74 75 us" "-statestatu
b450: 73 22 29 29 0a 09 09 20 20 20 20 20 28 6c 62 20 s"))... (lb
b460: 20 20 20 20 20 20 20 20 28 69 75 70 3a 6c 69 73 (iup:lis
b470: 74 62 6f 78 20 23 3a 65 78 70 61 6e 64 20 22 48 tbox #:expand "H
b480: 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 09 09 09 09 ORIZONTAL"......
b490: 20 20 20 20 20 20 23 3a 64 72 6f 70 64 6f 77 6e #:dropdown
b4a0: 20 22 59 45 53 22 0a 09 09 09 09 09 20 20 20 20 "YES"......
b4b0: 20 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 #:action (lamb
b4c0: 64 61 20 28 6f 62 6a 20 76 61 6c 20 69 6e 64 65 da (obj val inde
b4d0: 78 20 6c 62 73 74 61 74 65 29 0a 09 09 09 09 09 x lbstate)......
b4e0: 09 09 20 28 73 65 74 21 20 2a 74 65 73 74 73 2d .. (set! *tests-
b4f0: 73 6f 72 74 2d 72 65 76 65 72 73 65 2a 20 69 6e sort-reverse* in
b500: 64 65 78 29 0a 09 09 09 09 09 09 09 20 28 6d 61 dex)........ (ma
b510: 72 6b 2d 66 6f 72 2d 75 70 64 61 74 65 29 29 29 rk-for-update)))
b520: 29 0a 09 09 20 20 20 20 20 28 64 65 66 61 75 6c )... (defaul
b530: 74 2d 63 6d 64 20 28 63 61 72 20 28 6c 69 73 74 t-cmd (car (list
b540: 2d 72 65 66 20 2a 74 65 73 74 73 2d 73 6f 72 74 -ref *tests-sort
b550: 2d 74 79 70 65 2d 69 6e 64 65 78 2a 20 2a 74 65 -type-index* *te
b560: 73 74 73 2d 73 6f 72 74 2d 72 65 76 65 72 73 65 sts-sort-reverse
b570: 2a 29 29 29 29 0a 09 09 28 69 75 70 6c 69 73 74 *))))...(iuplist
b580: 62 6f 78 2d 66 69 6c 6c 2d 6c 69 73 74 20 6c 62 box-fill-list lb
b590: 20 63 6d 64 73 2d 6c 69 73 74 20 73 65 6c 65 63 cmds-list selec
b5a0: 74 65 64 2d 69 74 65 6d 3a 20 64 65 66 61 75 6c ted-item: defaul
b5b0: 74 2d 63 6d 64 29 0a 09 09 28 6d 61 72 6b 2d 66 t-cmd)...(mark-f
b5c0: 6f 72 2d 75 70 64 61 74 65 29 0a 09 09 3b 3b 20 or-update)...;;
b5d0: 28 73 65 74 21 20 2a 74 65 73 74 73 2d 73 6f 72 (set! *tests-sor
b5e0: 74 2d 72 65 76 65 72 73 65 2a 20 2a 74 65 73 74 t-reverse* *test
b5f0: 73 2d 73 6f 72 74 2d 72 65 76 65 72 73 65 2a 30 s-sort-reverse*0
b600: 29 0a 09 09 6c 62 29 0a 09 20 20 20 20 20 20 3b )...lb).. ;
b610: 3b 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 53 ; (iup:button "S
b620: 6f 72 74 20 2d 74 22 20 20 20 23 3a 61 63 74 69 ort -t" #:acti
b630: 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 on (lambda (obj)
b640: 0a 09 20 20 20 20 20 20 3b 3b 20 20 20 09 09 09 .. ;; ...
b650: 09 20 28 6e 65 78 74 2d 73 6f 72 74 2d 6f 70 74 . (next-sort-opt
b660: 69 6f 6e 29 0a 09 20 20 20 20 20 20 3b 3b 20 20 ion).. ;;
b670: 20 09 09 09 09 20 28 69 75 70 3a 61 74 74 72 69 .... (iup:attri
b680: 62 75 74 65 2d 73 65 74 21 20 6f 62 6a 20 22 54 bute-set! obj "T
b690: 49 54 4c 45 22 20 28 76 65 63 74 6f 72 2d 72 65 ITLE" (vector-re
b6a0: 66 20 28 76 65 63 74 6f 72 2d 72 65 66 20 2a 74 f (vector-ref *t
b6b0: 65 73 74 73 2d 73 6f 72 74 2d 6f 70 74 69 6f 6e ests-sort-option
b6c0: 73 2a 20 2a 74 65 73 74 73 2d 73 6f 72 74 2d 72 s* *tests-sort-r
b6d0: 65 76 65 72 73 65 2a 29 20 30 29 29 0a 09 20 20 everse*) 0))..
b6e0: 20 20 20 20 3b 3b 20 20 20 09 09 09 09 20 28 6d ;; .... (m
b6f0: 61 72 6b 2d 66 6f 72 2d 75 70 64 61 74 65 29 29 ark-for-update))
b700: 29 0a 09 20 20 20 20 20 20 28 69 75 70 3a 62 75 ).. (iup:bu
b710: 74 74 6f 6e 20 22 48 69 64 65 45 6d 70 74 79 22 tton "HideEmpty"
b720: 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 #:action (lambd
b730: 61 20 28 6f 62 6a 29 0a 09 09 09 09 09 09 20 28 a (obj)....... (
b740: 73 65 74 21 20 2a 68 69 64 65 2d 65 6d 70 74 79 set! *hide-empty
b750: 2d 72 75 6e 73 2a 20 28 6e 6f 74 20 2a 68 69 64 -runs* (not *hid
b760: 65 2d 65 6d 70 74 79 2d 72 75 6e 73 2a 29 29 0a e-empty-runs*)).
b770: 09 09 09 09 09 09 20 28 69 75 70 3a 61 74 74 72 ...... (iup:attr
b780: 69 62 75 74 65 2d 73 65 74 21 20 6f 62 6a 20 22 ibute-set! obj "
b790: 54 49 54 4c 45 22 20 28 69 66 20 2a 68 69 64 65 TITLE" (if *hide
b7a0: 2d 65 6d 70 74 79 2d 72 75 6e 73 2a 20 22 2b 48 -empty-runs* "+H
b7b0: 69 64 65 45 22 20 22 2d 48 69 64 65 45 22 29 29 ideE" "-HideE"))
b7c0: 0a 09 09 09 09 09 09 20 28 6d 61 72 6b 2d 66 6f ....... (mark-fo
b7d0: 72 2d 75 70 64 61 74 65 29 29 29 0a 09 20 20 20 r-update)))..
b7e0: 20 20 20 28 6c 65 74 20 28 28 68 69 64 65 69 74 (let ((hideit
b7f0: 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 48 69 (iup:button "Hi
b800: 64 65 54 65 73 74 73 22 20 23 3a 61 63 74 69 6f deTests" #:actio
b810: 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 0a n (lambda (obj).
b820: 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 73 ....... (s
b830: 65 74 21 20 2a 68 69 64 65 2d 6e 6f 74 2d 68 69 et! *hide-not-hi
b840: 64 65 2a 20 28 6e 6f 74 20 2a 68 69 64 65 2d 6e de* (not *hide-n
b850: 6f 74 2d 68 69 64 65 2a 29 29 0a 09 09 09 09 09 ot-hide*))......
b860: 09 09 20 20 20 20 20 20 20 28 69 75 70 3a 61 74 .. (iup:at
b870: 74 72 69 62 75 74 65 2d 73 65 74 21 20 6f 62 6a tribute-set! obj
b880: 20 22 54 49 54 4c 45 22 20 28 69 66 20 2a 68 69 "TITLE" (if *hi
b890: 64 65 2d 6e 6f 74 2d 68 69 64 65 2a 20 22 48 69 de-not-hide* "Hi
b8a0: 64 65 54 65 73 74 73 22 20 22 4e 6f 74 48 69 64 deTests" "NotHid
b8b0: 65 22 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 e"))........
b8c0: 20 20 20 28 6d 61 72 6b 2d 66 6f 72 2d 75 70 64 (mark-for-upd
b8d0: 61 74 65 29 29 29 29 29 0a 09 09 28 73 65 74 21 ate)))))...(set!
b8e0: 20 2a 68 69 64 65 2d 6e 6f 74 2d 68 69 64 65 2d *hide-not-hide-
b8f0: 62 75 74 74 6f 6e 2a 20 68 69 64 65 69 74 29 0a button* hideit).
b900: 09 09 68 69 64 65 69 74 29 29 0a 09 20 20 20 20 ..hideit))..
b910: 20 28 69 75 70 3a 68 62 6f 78 0a 09 20 20 20 20 (iup:hbox..
b920: 20 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 51 (iup:button "Q
b930: 75 69 74 22 20 20 20 20 20 20 23 3a 61 63 74 69 uit" #:acti
b940: 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 on (lambda (obj)
b950: 0a 09 09 09 09 09 09 20 3b 3b 20 28 69 66 20 2a ....... ;; (if *
b960: 64 62 73 74 72 75 63 74 2d 6c 6f 63 61 6c 2a 20 dbstruct-local*
b970: 28 64 62 3a 63 6c 6f 73 65 2d 61 6c 6c 20 2a 64 (db:close-all *d
b980: 62 73 74 72 75 63 74 2d 6c 6f 63 61 6c 2a 29 29 bstruct-local*))
b990: 0a 09 09 09 09 09 09 20 28 65 78 69 74 29 29 29 ....... (exit)))
b9a0: 0a 09 20 20 20 20 20 20 28 69 75 70 3a 62 75 74 .. (iup:but
b9b0: 74 6f 6e 20 22 52 65 66 72 65 73 68 22 20 20 20 ton "Refresh"
b9c0: 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 #:action (lambda
b9d0: 20 28 6f 62 6a 29 0a 09 09 09 09 09 09 20 28 6d (obj)....... (m
b9e0: 61 72 6b 2d 66 6f 72 2d 75 70 64 61 74 65 29 29 ark-for-update))
b9f0: 29 0a 09 20 20 20 20 20 20 28 69 75 70 3a 62 75 ).. (iup:bu
ba00: 74 74 6f 6e 20 22 43 6f 6c 6c 61 70 73 65 22 20 tton "Collapse"
ba10: 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 #:action (lambd
ba20: 61 20 28 6f 62 6a 29 0a 09 09 09 09 09 09 20 28 a (obj)....... (
ba30: 6c 65 74 20 28 28 6d 79 6e 61 6d 65 20 28 69 75 let ((myname (iu
ba40: 70 3a 61 74 74 72 69 62 75 74 65 20 6f 62 6a 20 p:attribute obj
ba50: 22 54 49 54 4c 45 22 29 29 29 0a 09 09 09 09 09 "TITLE")))......
ba60: 09 20 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 . (if (equal?
ba70: 6d 79 6e 61 6d 65 20 22 43 6f 6c 6c 61 70 73 65 myname "Collapse
ba80: 22 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 ").......
ba90: 28 62 65 67 69 6e 0a 09 09 09 09 09 09 09 20 28 (begin........ (
baa0: 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 for-each (lambda
bab0: 20 28 74 6e 61 6d 65 29 0a 09 09 09 09 09 09 09 (tname)........
bac0: 09 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c . (hash-tabl
bad0: 65 2d 73 65 74 21 20 2a 63 6f 6c 6c 61 70 73 65 e-set! *collapse
bae0: 64 2a 20 74 6e 61 6d 65 20 23 74 29 29 0a 09 09 d* tname #t))...
baf0: 09 09 09 09 09 09 20 20 20 2a 61 6c 6c 2d 69 74 ...... *all-it
bb00: 65 6d 2d 74 65 73 74 2d 6e 61 6d 65 73 2a 29 0a em-test-names*).
bb10: 09 09 09 09 09 09 09 20 28 69 75 70 3a 61 74 74 ....... (iup:att
bb20: 72 69 62 75 74 65 2d 73 65 74 21 20 6f 62 6a 20 ribute-set! obj
bb30: 22 54 49 54 4c 45 22 20 22 45 78 70 61 6e 64 22 "TITLE" "Expand"
bb40: 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 )).......
bb50: 28 62 65 67 69 6e 0a 09 09 09 09 09 09 09 20 28 (begin........ (
bb60: 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 for-each (lambda
bb70: 20 28 74 6e 61 6d 65 29 0a 09 09 09 09 09 09 09 (tname)........
bb80: 09 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c . (hash-tabl
bb90: 65 2d 64 65 6c 65 74 65 21 20 2a 63 6f 6c 6c 61 e-delete! *colla
bba0: 70 73 65 64 2a 20 74 6e 61 6d 65 29 29 0a 09 09 psed* tname))...
bbb0: 09 09 09 09 09 09 20 20 20 28 68 61 73 68 2d 74 ...... (hash-t
bbc0: 61 62 6c 65 2d 6b 65 79 73 20 2a 63 6f 6c 6c 61 able-keys *colla
bbd0: 70 73 65 64 2a 29 29 0a 09 09 09 09 09 09 09 20 psed*))........
bbe0: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 (iup:attribute-s
bbf0: 65 74 21 20 6f 62 6a 20 22 54 49 54 4c 45 22 20 et! obj "TITLE"
bc00: 22 43 6f 6c 6c 61 70 73 65 22 29 29 29 29 0a 09 "Collapse"))))..
bc10: 09 09 09 09 09 20 28 6d 61 72 6b 2d 66 6f 72 2d ..... (mark-for-
bc20: 75 70 64 61 74 65 29 29 29 29 29 29 0a 09 20 20 update))))))..
bc30: 20 28 69 75 70 3a 66 72 61 6d 65 20 0a 09 20 20 (iup:frame ..
bc40: 20 20 23 3a 74 69 74 6c 65 20 22 73 74 61 74 65 #:title "state
bc50: 2f 73 74 61 74 75 73 20 66 69 6c 74 65 72 22 0a /status filter".
bc60: 09 20 20 20 20 28 69 75 70 3a 76 62 6f 78 0a 09 . (iup:vbox..
bc70: 20 20 20 20 20 28 61 70 70 6c 79 20 0a 09 20 20 (apply ..
bc80: 20 20 20 20 69 75 70 3a 68 62 6f 78 0a 09 20 20 iup:hbox..
bc90: 20 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 (map (lambda
bca0: 20 28 73 74 61 74 75 73 29 0a 09 09 20 20 20 20 (status)...
bcb0: 20 28 69 75 70 3a 74 6f 67 67 6c 65 20 73 74 61 (iup:toggle sta
bcc0: 74 75 73 20 20 23 3a 61 63 74 69 6f 6e 20 20 20 tus #:action
bcd0: 28 6c 61 6d 62 64 61 20 28 6f 62 6a 20 76 61 6c (lambda (obj val
bce0: 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 28 6d )....... (m
bcf0: 61 72 6b 2d 66 6f 72 2d 75 70 64 61 74 65 29 0a ark-for-update).
bd00: 09 09 09 09 09 09 20 20 20 20 20 20 28 69 66 20 ...... (if
bd10: 28 65 71 3f 20 76 61 6c 20 31 29 0a 09 09 09 09 (eq? val 1).....
bd20: 09 09 09 20 20 28 68 61 73 68 2d 74 61 62 6c 65 ... (hash-table
bd30: 2d 73 65 74 21 20 2a 73 74 61 74 75 73 2d 69 67 -set! *status-ig
bd40: 6e 6f 72 65 2d 68 61 73 68 2a 20 73 74 61 74 75 nore-hash* statu
bd50: 73 20 23 74 29 0a 09 09 09 09 09 09 09 20 20 28 s #t)........ (
bd60: 68 61 73 68 2d 74 61 62 6c 65 2d 64 65 6c 65 74 hash-table-delet
bd70: 65 21 20 2a 73 74 61 74 75 73 2d 69 67 6e 6f 72 e! *status-ignor
bd80: 65 2d 68 61 73 68 2a 20 73 74 61 74 75 73 29 29 e-hash* status))
bd90: 0a 09 09 09 09 09 09 20 20 20 20 20 20 28 73 65 ....... (se
bda0: 74 2d 62 67 2d 6f 6e 2d 66 69 6c 74 65 72 29 29 t-bg-on-filter))
bdb0: 29 29 0a 09 09 20 20 20 28 6d 61 70 20 63 61 64 ))... (map cad
bdc0: 72 20 2a 63 6f 6d 6d 6f 6e 3a 73 74 64 2d 73 74 r *common:std-st
bdd0: 61 74 75 73 65 73 2a 29 29 29 20 3b 3b 20 27 28 atuses*))) ;; '(
bde0: 22 50 41 53 53 22 20 22 46 41 49 4c 22 20 22 57 "PASS" "FAIL" "W
bdf0: 41 52 4e 22 20 22 43 48 45 43 4b 22 20 22 57 41 ARN" "CHECK" "WA
be00: 49 56 45 44 22 20 22 53 54 55 43 4b 2f 44 45 41 IVED" "STUCK/DEA
be10: 44 22 20 22 6e 2f 61 22 20 22 53 4b 49 50 22 29 D" "n/a" "SKIP")
be20: 29 29 0a 09 20 20 20 20 20 28 61 70 70 6c 79 20 )).. (apply
be30: 0a 09 20 20 20 20 20 20 69 75 70 3a 68 62 6f 78 .. iup:hbox
be40: 0a 09 20 20 20 20 20 20 28 6d 61 70 20 28 6c 61 .. (map (la
be50: 6d 62 64 61 20 28 73 74 61 74 65 29 0a 09 09 20 mbda (state)...
be60: 20 20 20 20 28 69 75 70 3a 74 6f 67 67 6c 65 20 (iup:toggle
be70: 73 74 61 74 65 20 20 20 23 3a 61 63 74 69 6f 6e state #:action
be80: 20 20 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 20 (lambda (obj
be90: 76 61 6c 29 0a 09 09 09 09 09 09 20 20 20 20 20 val).......
bea0: 20 28 6d 61 72 6b 2d 66 6f 72 2d 75 70 64 61 74 (mark-for-updat
beb0: 65 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 28 e)....... (
bec0: 69 66 20 28 65 71 3f 20 76 61 6c 20 31 29 0a 09 if (eq? val 1)..
bed0: 09 09 09 09 09 09 20 20 28 68 61 73 68 2d 74 61 ...... (hash-ta
bee0: 62 6c 65 2d 73 65 74 21 20 2a 73 74 61 74 65 2d ble-set! *state-
bef0: 69 67 6e 6f 72 65 2d 68 61 73 68 2a 20 73 74 61 ignore-hash* sta
bf00: 74 65 20 23 74 29 0a 09 09 09 09 09 09 09 20 20 te #t)........
bf10: 28 68 61 73 68 2d 74 61 62 6c 65 2d 64 65 6c 65 (hash-table-dele
bf20: 74 65 21 20 2a 73 74 61 74 65 2d 69 67 6e 6f 72 te! *state-ignor
bf30: 65 2d 68 61 73 68 2a 20 73 74 61 74 65 29 29 0a e-hash* state)).
bf40: 09 09 09 09 09 09 20 20 20 20 20 20 28 73 65 74 ...... (set
bf50: 2d 62 67 2d 6f 6e 2d 66 69 6c 74 65 72 29 29 29 -bg-on-filter)))
bf60: 29 0a 09 09 20 20 20 28 6d 61 70 20 63 61 64 72 )... (map cadr
bf70: 20 2a 63 6f 6d 6d 6f 6e 3a 73 74 64 2d 73 74 61 *common:std-sta
bf80: 74 65 73 2a 29 29 29 20 3b 3b 20 27 28 22 52 55 tes*))) ;; '("RU
bf90: 4e 4e 49 4e 47 22 20 22 43 4f 4d 50 4c 45 54 45 NNING" "COMPLETE
bfa0: 44 22 20 22 49 4e 43 4f 4d 50 4c 45 54 45 22 20 D" "INCOMPLETE"
bfb0: 22 4c 41 55 4e 43 48 45 44 22 20 22 4e 4f 54 5f "LAUNCHED" "NOT_
bfc0: 53 54 41 52 54 45 44 22 20 22 4b 49 4c 4c 45 44 STARTED" "KILLED
bfd0: 22 20 22 44 45 4c 45 54 45 44 22 29 29 29 0a 09 " "DELETED")))..
bfe0: 20 20 20 20 20 28 69 75 70 3a 76 61 6c 75 61 74 (iup:valuat
bff0: 6f 72 20 23 3a 76 61 6c 75 65 63 68 61 6e 67 65 or #:valuechange
c000: 64 5f 63 62 20 28 6c 61 6d 62 64 61 20 28 6f 62 d_cb (lambda (ob
c010: 6a 29 0a 09 09 09 09 09 20 20 20 20 20 20 20 28 j)...... (
c020: 6c 65 74 20 28 28 76 61 6c 20 28 69 6e 65 78 61 let ((val (inexa
c030: 63 74 2d 3e 65 78 61 63 74 20 28 72 6f 75 6e 64 ct->exact (round
c040: 20 28 2f 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d (/ (string->num
c050: 62 65 72 20 28 69 75 70 3a 61 74 74 72 69 62 75 ber (iup:attribu
c060: 74 65 20 6f 62 6a 20 22 56 41 4c 55 45 22 29 29 te obj "VALUE"))
c070: 20 31 30 29 29 29 29 0a 09 09 09 09 09 09 20 20 10)))).......
c080: 20 20 20 28 6f 6c 64 6d 61 78 20 20 20 28 73 74 (oldmax (st
c090: 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 69 75 ring->number (iu
c0a0: 70 3a 61 74 74 72 69 62 75 74 65 20 6f 62 6a 20 p:attribute obj
c0b0: 22 4d 41 58 22 29 29 29 0a 09 09 09 09 09 09 20 "MAX"))).......
c0c0: 20 20 20 20 28 6d 61 78 72 75 6e 73 20 20 2a 74 (maxruns *t
c0d0: 6f 74 2d 72 75 6e 2d 63 6f 75 6e 74 2a 29 29 0a ot-run-count*)).
c0e0: 09 09 09 09 09 09 20 28 73 65 74 21 20 2a 73 74 ...... (set! *st
c0f0: 61 72 74 2d 72 75 6e 2d 6f 66 66 73 65 74 2a 20 art-run-offset*
c100: 76 61 6c 29 0a 09 09 09 09 09 09 20 28 6d 61 72 val)....... (mar
c110: 6b 2d 66 6f 72 2d 75 70 64 61 74 65 29 0a 09 09 k-for-update)...
c120: 09 09 09 09 20 28 64 65 62 75 67 3a 70 72 69 6e .... (debug:prin
c130: 74 20 36 20 22 2a 73 74 61 72 74 2d 72 75 6e 2d t 6 "*start-run-
c140: 6f 66 66 73 65 74 2a 20 22 20 2a 73 74 61 72 74 offset* " *start
c150: 2d 72 75 6e 2d 6f 66 66 73 65 74 2a 20 22 20 6d -run-offset* " m
c160: 61 78 72 75 6e 73 3a 20 22 20 6d 61 78 72 75 6e axruns: " maxrun
c170: 73 20 22 2c 20 76 61 6c 3a 20 22 20 76 61 6c 20 s ", val: " val
c180: 22 20 6f 6c 64 6d 61 78 3a 20 22 20 6f 6c 64 6d " oldmax: " oldm
c190: 61 78 29 0a 09 09 09 09 09 09 20 28 69 75 70 3a ax)....... (iup:
c1a0: 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 6f attribute-set! o
c1b0: 62 6a 20 22 4d 41 58 22 20 28 2a 20 6d 61 78 72 bj "MAX" (* maxr
c1c0: 75 6e 73 20 31 30 29 29 29 29 0a 09 09 09 20 20 uns 10))))....
c1d0: 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a #:expand "HORIZ
c1e0: 4f 4e 54 41 4c 22 0a 09 09 09 20 20 20 23 3a 6d ONTAL".... #:m
c1f0: 61 78 20 28 2a 20 31 30 20 28 6c 65 6e 67 74 68 ax (* 10 (length
c200: 20 2a 61 6c 6c 72 75 6e 73 2a 29 29 0a 09 09 09 *allruns*))....
c210: 20 20 20 23 3a 6d 69 6e 20 30 0a 09 09 09 20 20 #:min 0....
c220: 20 23 3a 73 74 65 70 20 30 2e 30 31 29 29 29 0a #:step 0.01))).
c230: 09 09 09 09 09 3b 28 69 75 70 3a 62 75 74 74 6f .....;(iup:butto
c240: 6e 20 22 69 6e 63 20 72 6f 77 73 22 20 23 3a 61 n "inc rows" #:a
c250: 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f ction (lambda (o
c260: 62 6a 29 28 73 65 74 21 20 2a 6e 75 6d 2d 74 65 bj)(set! *num-te
c270: 73 74 73 2a 20 28 2b 20 2a 6e 75 6d 2d 74 65 73 sts* (+ *num-tes
c280: 74 73 2a 20 31 29 29 29 29 0a 09 09 09 09 09 3b ts* 1))))......;
c290: 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 64 65 63 (iup:button "dec
c2a0: 20 72 6f 77 73 22 20 23 3a 61 63 74 69 6f 6e 20 rows" #:action
c2b0: 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 28 73 65 (lambda (obj)(se
c2c0: 74 21 20 2a 6e 75 6d 2d 74 65 73 74 73 2a 20 28 t! *num-tests* (
c2d0: 69 66 20 28 3e 20 2a 6e 75 6d 2d 74 65 73 74 73 if (> *num-tests
c2e0: 2a 20 30 29 28 2d 20 2a 6e 75 6d 2d 74 65 73 74 * 0)(- *num-test
c2f0: 73 2a 20 31 29 20 30 29 29 29 29 0a 09 20 20 20 s* 1) 0))))..
c300: 29 0a 09 20 20 29 0a 20 20 20 20 0a 20 20 20 20 ).. ). .
c310: 3b 3b 20 63 72 65 61 74 65 20 74 68 65 20 6c 65 ;; create the le
c320: 66 74 20 6d 6f 73 74 20 63 6f 6c 75 6d 6e 20 66 ft most column f
c330: 6f 72 20 74 68 65 20 72 75 6e 20 6b 65 79 20 6e or the run key n
c340: 61 6d 65 73 20 61 6e 64 20 74 68 65 20 74 65 73 ames and the tes
c350: 74 20 6e 61 6d 65 73 20 0a 20 20 20 20 28 73 65 t names . (se
c360: 74 21 20 6c 66 74 6c 73 74 20 28 6c 69 73 74 20 t! lftlst (list
c370: 28 69 75 70 3a 68 62 6f 78 0a 09 09 09 28 69 75 (iup:hbox....(iu
c380: 70 3a 6c 61 62 65 6c 29 20 3b 3b 20 28 69 75 70 p:label) ;; (iup
c390: 3a 76 61 6c 75 61 74 6f 72 29 0a 09 09 09 28 61 :valuator)....(a
c3a0: 70 70 6c 79 20 69 75 70 3a 76 62 6f 78 20 0a 09 pply iup:vbox ..
c3b0: 09 09 20 20 20 20 20 20 20 28 6d 61 70 20 28 6c .. (map (l
c3c0: 61 6d 62 64 61 20 28 78 29 09 09 0a 09 09 09 09 ambda (x).......
c3d0: 20 20 20 20 20 20 28 6c 65 74 20 28 28 72 65 73 (let ((res
c3e0: 20 28 69 75 70 3a 68 62 6f 78 20 23 3a 65 78 70 (iup:hbox #:exp
c3f0: 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 and "HORIZONTAL"
c400: 0a 09 09 09 09 09 09 09 20 20 20 28 69 75 70 3a ........ (iup:
c410: 6c 61 62 65 6c 20 78 20 23 3a 73 69 7a 65 20 22 label x #:size "
c420: 78 31 35 22 20 23 3a 66 6f 6e 74 73 69 7a 65 20 x15" #:fontsize
c430: 22 31 30 22 20 23 3a 65 78 70 61 6e 64 20 22 48 "10" #:expand "H
c440: 4f 52 49 5a 4f 4e 54 41 4c 22 29 0a 09 09 09 09 ORIZONTAL").....
c450: 09 09 09 20 20 20 28 69 75 70 3a 74 65 78 74 62 ... (iup:textb
c460: 6f 78 20 23 3a 73 69 7a 65 20 22 78 31 35 22 20 ox #:size "x15"
c470: 23 3a 66 6f 6e 74 73 69 7a 65 20 22 31 30 22 20 #:fontsize "10"
c480: 23 3a 76 61 6c 75 65 20 22 25 22 20 23 3a 65 78 #:value "%" #:ex
c490: 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c pand "HORIZONTAL
c4a0: 22 0a 09 09 09 09 09 09 09 09 09 23 3a 61 63 74 "..........#:act
c4b0: 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a ion (lambda (obj
c4c0: 20 75 6e 6b 20 76 61 6c 29 0a 09 09 09 09 09 09 unk val).......
c4d0: 09 09 09 09 20 20 20 28 6d 61 72 6b 2d 66 6f 72 .... (mark-for
c4e0: 2d 75 70 64 61 74 65 29 0a 09 09 09 09 09 09 09 -update)........
c4f0: 09 09 09 20 20 20 28 75 70 64 61 74 65 2d 73 65 ... (update-se
c500: 61 72 63 68 20 78 20 76 61 6c 29 29 29 29 29 29 arch x val))))))
c510: 0a 09 09 09 09 09 28 73 65 74 21 20 69 20 28 2b ......(set! i (+
c520: 20 69 20 31 29 29 0a 09 09 09 09 09 72 65 73 29 i 1))......res)
c530: 29 0a 09 09 09 09 20 20 20 20 6b 65 79 6e 61 6d )..... keynam
c540: 65 73 29 29 29 29 29 0a 20 20 20 20 28 6c 65 74 es))))). (let
c550: 20 6c 6f 6f 70 20 28 28 74 65 73 74 6e 75 6d 20 loop ((testnum
c560: 20 30 29 0a 09 20 20 20 20 20 20 20 28 72 65 73 0).. (res
c570: 20 20 20 20 20 20 27 28 29 29 29 0a 20 20 20 20 '())).
c580: 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 28 (cond. (
c590: 28 3e 3d 20 74 65 73 74 6e 75 6d 20 6e 74 65 73 (>= testnum ntes
c5a0: 74 73 29 0a 09 3b 3b 20 6e 6f 77 20 6c 66 74 6c ts)..;; now lftl
c5b0: 73 74 20 77 69 6c 6c 20 62 65 20 61 6e 20 68 62 st will be an hb
c5c0: 6f 78 20 77 69 74 68 20 74 68 65 20 74 65 73 74 ox with the test
c5d0: 20 6b 65 79 73 20 61 6e 64 20 74 68 65 20 74 65 keys and the te
c5e0: 73 74 20 6e 61 6d 65 20 6c 61 62 65 6c 73 0a 09 st name labels..
c5f0: 28 73 65 74 21 20 6c 66 74 6c 73 74 20 28 61 70 (set! lftlst (ap
c600: 70 65 6e 64 20 6c 66 74 6c 73 74 20 28 6c 69 73 pend lftlst (lis
c610: 74 20 28 69 75 70 3a 68 62 6f 78 20 20 23 3a 65 t (iup:hbox #:e
c620: 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 xpand "HORIZONTA
c630: 4c 22 0a 09 09 09 09 09 09 20 20 20 20 20 28 69 L"....... (i
c640: 75 70 3a 76 61 6c 75 61 74 6f 72 20 23 3a 76 61 up:valuator #:va
c650: 6c 75 65 63 68 61 6e 67 65 64 5f 63 62 20 28 6c luechanged_cb (l
c660: 61 6d 62 64 61 20 28 6f 62 6a 29 0a 09 09 09 09 ambda (obj).....
c670: 09 09 09 09 09 09 20 20 20 20 20 20 20 28 6c 65 ...... (le
c680: 74 20 28 28 76 61 6c 20 28 73 74 72 69 6e 67 2d t ((val (string-
c690: 3e 6e 75 6d 62 65 72 20 28 69 75 70 3a 61 74 74 >number (iup:att
c6a0: 72 69 62 75 74 65 20 6f 62 6a 20 22 56 41 4c 55 ribute obj "VALU
c6b0: 45 22 29 29 29 0a 09 09 09 09 09 09 09 09 09 09 E")))...........
c6c0: 09 20 20 20 20 20 28 6f 6c 64 6d 61 78 20 20 28 . (oldmax (
c6d0: 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 string->number (
c6e0: 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 6f 62 iup:attribute ob
c6f0: 6a 20 22 4d 41 58 22 29 29 29 0a 09 09 09 09 09 j "MAX")))......
c700: 09 09 09 09 09 09 20 20 20 20 20 28 6e 65 77 6d ...... (newm
c710: 61 78 20 20 28 2a 20 31 30 20 28 6c 65 6e 67 74 ax (* 10 (lengt
c720: 68 20 2a 61 6c 6c 74 65 73 74 6e 61 6d 65 6c 73 h *alltestnamels
c730: 74 2a 29 29 29 29 0a 09 09 09 09 09 09 09 09 09 t*))))..........
c740: 09 09 20 28 73 65 74 21 20 2a 70 6c 65 61 73 65 .. (set! *please
c750: 2d 75 70 64 61 74 65 2d 62 75 74 74 6f 6e 73 2a -update-buttons*
c760: 20 23 74 29 0a 09 09 09 09 09 09 09 09 09 09 09 #t)............
c770: 20 28 73 65 74 21 20 2a 73 74 61 72 74 2d 74 65 (set! *start-te
c780: 73 74 2d 6f 66 66 73 65 74 2a 20 28 69 6e 65 78 st-offset* (inex
c790: 61 63 74 2d 3e 65 78 61 63 74 20 28 72 6f 75 6e act->exact (roun
c7a0: 64 20 28 2f 20 76 61 6c 20 31 30 29 29 29 29 0a d (/ val 10)))).
c7b0: 09 09 09 09 09 09 09 09 09 09 09 20 28 64 65 62 ........... (deb
c7c0: 75 67 3a 70 72 69 6e 74 20 36 20 22 2a 73 74 61 ug:print 6 "*sta
c7d0: 72 74 2d 74 65 73 74 2d 6f 66 66 73 65 74 2a 20 rt-test-offset*
c7e0: 22 20 2a 73 74 61 72 74 2d 74 65 73 74 2d 6f 66 " *start-test-of
c7f0: 66 73 65 74 2a 20 22 20 76 61 6c 3a 20 22 20 76 fset* " val: " v
c800: 61 6c 20 22 20 6e 65 77 6d 61 78 3a 20 22 20 6e al " newmax: " n
c810: 65 77 6d 61 78 20 22 20 6f 6c 64 6d 61 78 3a 20 ewmax " oldmax:
c820: 22 20 6f 6c 64 6d 61 78 29 0a 09 09 09 09 09 09 " oldmax).......
c830: 09 09 09 09 09 20 28 69 66 20 28 3c 20 76 61 6c ..... (if (< val
c840: 20 31 30 29 0a 09 09 09 09 09 09 09 09 09 09 09 10)............
c850: 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 (iup:attrib
c860: 75 74 65 2d 73 65 74 21 20 6f 62 6a 20 22 4d 41 ute-set! obj "MA
c870: 58 22 20 6e 65 77 6d 61 78 29 29 0a 09 09 09 09 X" newmax)).....
c880: 09 09 09 09 09 09 09 20 29 29 0a 09 09 09 09 09 ....... ))......
c890: 09 09 09 20 20 20 23 3a 65 78 70 61 6e 64 20 22 ... #:expand "
c8a0: 56 45 52 54 49 43 41 4c 22 20 0a 09 09 09 09 09 VERTICAL" ......
c8b0: 09 09 09 20 20 20 23 3a 6f 72 69 65 6e 74 61 74 ... #:orientat
c8c0: 69 6f 6e 20 22 56 45 52 54 49 43 41 4c 22 0a 09 ion "VERTICAL"..
c8d0: 09 09 09 09 09 09 09 20 20 20 23 3a 6d 69 6e 20 ....... #:min
c8e0: 30 0a 09 09 09 09 09 09 09 09 20 20 20 23 3a 73 0......... #:s
c8f0: 74 65 70 20 30 2e 30 31 29 0a 09 09 09 09 09 09 tep 0.01).......
c900: 20 20 20 20 20 28 61 70 70 6c 79 20 69 75 70 3a (apply iup:
c910: 76 62 6f 78 20 28 72 65 76 65 72 73 65 20 72 65 vbox (reverse re
c920: 73 29 29 29 29 29 29 29 0a 20 20 20 20 20 20 20 s))))))).
c930: 28 65 6c 73 65 0a 09 28 6c 65 74 20 28 28 6c 61 (else..(let ((la
c940: 62 6c 20 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 bl (iup:button
c950: 22 22 20 0a 09 09 09 09 20 23 3a 66 6c 61 74 20 "" ..... #:flat
c960: 22 59 45 53 22 20 0a 09 09 09 09 20 23 3a 61 6c "YES" ..... #:al
c970: 69 67 6e 6d 65 6e 74 20 22 41 4c 45 46 54 22 0a ignment "ALEFT".
c980: 09 09 09 09 09 3b 20 23 3a 69 6d 61 67 65 20 69 .....; #:image i
c990: 6d 67 31 0a 09 09 09 09 09 3b 20 23 3a 69 6d 70 mg1......; #:imp
c9a0: 72 65 73 73 20 69 6d 67 32 0a 09 09 09 09 20 23 ress img2..... #
c9b0: 3a 73 69 7a 65 20 22 78 31 35 22 0a 09 09 09 09 :size "x15".....
c9c0: 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a #:expand "HORIZ
c9d0: 4f 4e 54 41 4c 22 0a 09 09 09 09 20 23 3a 66 6f ONTAL"..... #:fo
c9e0: 6e 74 73 69 7a 65 20 22 31 30 22 0a 09 09 09 09 ntsize "10".....
c9f0: 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 #:action (lambd
ca00: 61 20 28 6f 62 6a 29 0a 09 09 09 09 09 20 20 20 a (obj)......
ca10: 20 28 6d 61 72 6b 2d 66 6f 72 2d 75 70 64 61 74 (mark-for-updat
ca20: 65 29 0a 09 09 09 09 09 20 20 20 20 28 74 6f 67 e)...... (tog
ca30: 67 6c 65 2d 68 69 64 65 20 74 65 73 74 6e 75 6d gle-hide testnum
ca40: 29 29 29 29 29 20 3b 3b 20 28 69 75 70 3a 61 74 ))))) ;; (iup:at
ca50: 74 72 69 62 75 74 65 20 6f 62 6a 20 22 54 49 54 tribute obj "TIT
ca60: 4c 45 22 29 29 29 29 0a 09 20 20 28 76 65 63 74 LE")))).. (vect
ca70: 6f 72 2d 73 65 74 21 20 6c 66 74 63 6f 6c 20 74 or-set! lftcol t
ca80: 65 73 74 6e 75 6d 20 6c 61 62 6c 29 0a 09 20 20 estnum labl)..
ca90: 28 6c 6f 6f 70 20 28 2b 20 74 65 73 74 6e 75 6d (loop (+ testnum
caa0: 20 31 29 28 63 6f 6e 73 20 6c 61 62 6c 20 72 65 1)(cons labl re
cab0: 73 29 29 29 29 29 29 0a 20 20 20 20 3b 3b 20 0a s)))))). ;; .
cac0: 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 (let loop ((
cad0: 72 75 6e 6e 75 6d 20 20 30 29 0a 09 20 20 20 20 runnum 0)..
cae0: 20 20 20 28 6b 65 79 6e 75 6d 20 20 30 29 0a 09 (keynum 0)..
caf0: 20 20 20 20 20 20 20 28 6b 65 79 76 65 63 20 20 (keyvec
cb00: 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 6e 6b 65 (make-vector nke
cb10: 79 73 29 29 0a 09 20 20 20 20 20 20 20 28 72 65 ys)).. (re
cb20: 73 20 20 20 20 27 28 29 29 29 0a 20 20 20 20 20 s '())).
cb30: 20 28 63 6f 6e 64 20 3b 3b 20 6e 62 2f 2f 20 6e (cond ;; nb// n
cb40: 6f 20 65 6c 73 65 20 66 6f 72 20 74 68 69 73 20 o else for this
cb50: 61 70 70 72 6f 61 63 68 2e 0a 20 20 20 20 20 20 approach..
cb60: 20 28 28 3e 3d 20 72 75 6e 6e 75 6d 20 6e 72 75 ((>= runnum nru
cb70: 6e 73 29 20 23 66 29 0a 20 20 20 20 20 20 20 28 ns) #f). (
cb80: 28 3e 3d 20 6b 65 79 6e 75 6d 20 6e 6b 65 79 73 (>= keynum nkeys
cb90: 29 20 0a 09 28 76 65 63 74 6f 72 2d 73 65 74 21 ) ..(vector-set!
cba0: 20 68 65 61 64 65 72 20 72 75 6e 6e 75 6d 20 6b header runnum k
cbb0: 65 79 76 65 63 29 0a 09 28 73 65 74 21 20 68 64 eyvec)..(set! hd
cbc0: 72 6c 73 74 20 28 63 6f 6e 73 20 28 61 70 70 6c rlst (cons (appl
cbd0: 79 20 69 75 70 3a 76 62 6f 78 20 28 72 65 76 65 y iup:vbox (reve
cbe0: 72 73 65 20 72 65 73 29 29 20 68 64 72 6c 73 74 rse res)) hdrlst
cbf0: 29 29 0a 09 28 6c 6f 6f 70 20 28 2b 20 72 75 6e ))..(loop (+ run
cc00: 6e 75 6d 20 31 29 20 30 20 28 6d 61 6b 65 2d 76 num 1) 0 (make-v
cc10: 65 63 74 6f 72 20 6e 6b 65 79 73 29 20 27 28 29 ector nkeys) '()
cc20: 29 29 0a 20 20 20 20 20 20 20 28 65 6c 73 65 0a )). (else.
cc30: 09 28 6c 65 74 20 28 28 6c 61 62 6c 20 20 28 69 .(let ((labl (i
cc40: 75 70 3a 6c 61 62 65 6c 20 22 22 20 23 3a 73 69 up:label "" #:si
cc50: 7a 65 20 22 36 30 78 31 35 22 20 23 3a 66 6f 6e ze "60x15" #:fon
cc60: 74 73 69 7a 65 20 22 31 30 22 20 23 3a 65 78 70 tsize "10" #:exp
cc70: 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 and "HORIZONTAL"
cc80: 29 29 29 20 3b 3b 20 23 3a 65 78 70 61 6e 64 20 ))) ;; #:expand
cc90: 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 20 20 "HORIZONTAL"..
cca0: 28 76 65 63 74 6f 72 2d 73 65 74 21 20 6b 65 79 (vector-set! key
ccb0: 76 65 63 20 6b 65 79 6e 75 6d 20 6c 61 62 6c 29 vec keynum labl)
ccc0: 0a 09 20 20 28 6c 6f 6f 70 20 72 75 6e 6e 75 6d .. (loop runnum
ccd0: 20 28 2b 20 6b 65 79 6e 75 6d 20 31 29 20 6b 65 (+ keynum 1) ke
cce0: 79 76 65 63 20 28 63 6f 6e 73 20 6c 61 62 6c 20 yvec (cons labl
ccf0: 72 65 73 29 29 29 29 29 29 0a 20 20 20 20 3b 3b res)))))). ;;
cd00: 20 42 79 20 68 65 72 65 20 74 68 65 20 68 64 72 By here the hdr
cd10: 6c 73 74 20 63 6f 6e 74 61 69 6e 73 20 61 20 6c lst contains a l
cd20: 69 73 74 20 6f 66 20 76 62 6f 78 65 73 20 63 6f ist of vboxes co
cd30: 6e 74 61 69 6e 69 6e 67 20 6e 6b 65 79 73 20 6c ntaining nkeys l
cd40: 61 62 65 6c 73 0a 20 20 20 20 28 6c 65 74 20 6c abels. (let l
cd50: 6f 6f 70 20 28 28 72 75 6e 6e 75 6d 20 20 30 29 oop ((runnum 0)
cd60: 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 6e 75 .. (testnu
cd70: 6d 20 30 29 0a 09 20 20 20 20 20 20 20 28 74 65 m 0).. (te
cd80: 73 74 76 65 63 20 20 28 6d 61 6b 65 2d 76 65 63 stvec (make-vec
cd90: 74 6f 72 20 6e 74 65 73 74 73 29 29 0a 09 20 20 tor ntests))..
cda0: 20 20 20 20 20 28 72 65 73 20 20 20 20 27 28 29 (res '()
cdb0: 29 29 0a 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 )). (cond.
cdc0: 20 20 20 20 20 20 28 28 3e 3d 20 72 75 6e 6e 75 ((>= runnu
cdd0: 6d 20 6e 72 75 6e 73 29 20 23 66 29 20 3b 3b 20 m nruns) #f) ;;
cde0: 20 28 76 65 63 74 6f 72 20 74 61 62 6c 65 68 65 (vector tablehe
cdf0: 61 64 65 72 20 72 75 6e 73 76 65 63 29 29 0a 20 ader runsvec)).
ce00: 20 20 20 20 20 20 28 28 3e 3d 20 74 65 73 74 6e ((>= testn
ce10: 75 6d 20 6e 74 65 73 74 73 29 20 0a 09 28 76 65 um ntests) ..(ve
ce20: 63 74 6f 72 2d 73 65 74 21 20 72 75 6e 73 76 65 ctor-set! runsve
ce30: 63 20 72 75 6e 6e 75 6d 20 74 65 73 74 76 65 63 c runnum testvec
ce40: 29 0a 09 28 73 65 74 21 20 62 64 79 6c 73 74 20 )..(set! bdylst
ce50: 28 63 6f 6e 73 20 28 61 70 70 6c 79 20 69 75 70 (cons (apply iup
ce60: 3a 76 62 6f 78 20 28 72 65 76 65 72 73 65 20 72 :vbox (reverse r
ce70: 65 73 29 29 20 62 64 79 6c 73 74 29 29 0a 09 28 es)) bdylst))..(
ce80: 6c 6f 6f 70 20 28 2b 20 72 75 6e 6e 75 6d 20 31 loop (+ runnum 1
ce90: 29 20 30 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 ) 0 (make-vector
cea0: 20 6e 74 65 73 74 73 29 20 27 28 29 29 29 0a 20 ntests) '())).
ceb0: 20 20 20 20 20 20 28 65 6c 73 65 0a 09 28 6c 65 (else..(le
cec0: 74 2a 20 28 28 62 75 74 74 6f 6e 2d 6b 65 79 20 t* ((button-key
ced0: 28 6d 6b 73 74 72 20 72 75 6e 6e 75 6d 20 74 65 (mkstr runnum te
cee0: 73 74 6e 75 6d 29 29 0a 09 20 20 20 20 20 20 20 stnum))..
cef0: 28 62 75 74 6e 20 20 20 20 20 20 20 28 69 75 70 (butn (iup
cf00: 3a 62 75 74 74 6f 6e 20 22 22 20 3b 3b 20 62 75 :button "" ;; bu
cf10: 74 74 6f 6e 2d 6b 65 79 20 0a 09 09 09 09 20 20 tton-key .....
cf20: 20 20 20 20 20 23 3a 73 69 7a 65 20 22 36 30 78 #:size "60x
cf30: 31 35 22 20 0a 09 09 09 09 20 20 20 20 20 20 20 15" .....
cf40: 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f #:expand "HORIZO
cf50: 4e 54 41 4c 22 0a 09 09 09 09 20 20 20 20 20 20 NTAL".....
cf60: 20 23 3a 66 6f 6e 74 73 69 7a 65 20 22 31 30 22 #:fontsize "10"
cf70: 20 0a 09 09 09 09 20 20 20 20 20 20 20 23 3a 61 ..... #:a
cf80: 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 78 ction (lambda (x
cf90: 29 0a 09 09 09 09 09 09 20 20 28 6c 65 74 2a 20 )....... (let*
cfa0: 28 28 74 6f 6f 6c 70 61 74 68 20 28 63 61 72 20 ((toolpath (car
cfb0: 28 61 72 67 76 29 29 29 0a 09 09 09 09 09 09 09 (argv)))........
cfc0: 20 28 62 75 74 74 6e 64 61 74 20 28 68 61 73 68 (buttndat (hash
cfd0: 2d 74 61 62 6c 65 2d 72 65 66 20 2a 62 75 74 74 -table-ref *butt
cfe0: 6f 6e 64 61 74 2a 20 62 75 74 74 6f 6e 2d 6b 65 ondat* button-ke
cff0: 79 29 29 0a 09 09 09 09 09 09 09 20 28 74 65 73 y))........ (tes
d000: 74 2d 69 64 20 20 28 64 62 3a 74 65 73 74 2d 67 t-id (db:test-g
d010: 65 74 2d 69 64 20 28 76 65 63 74 6f 72 2d 72 65 et-id (vector-re
d020: 66 20 62 75 74 74 6e 64 61 74 20 33 29 29 29 0a f buttndat 3))).
d030: 09 09 09 09 09 09 09 20 28 72 75 6e 2d 69 64 20 ....... (run-id
d040: 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 (db:test-get-r
d050: 75 6e 5f 69 64 20 28 76 65 63 74 6f 72 2d 72 65 un_id (vector-re
d060: 66 20 62 75 74 74 6e 64 61 74 20 33 29 29 29 0a f buttndat 3))).
d070: 09 09 09 09 09 09 09 20 28 63 6d 64 20 20 28 63 ....... (cmd (c
d080: 6f 6e 63 20 74 6f 6f 6c 70 61 74 68 20 22 20 2d onc toolpath " -
d090: 74 65 73 74 20 22 20 72 75 6e 2d 69 64 20 22 2c test " run-id ",
d0a0: 22 20 74 65 73 74 2d 69 64 20 22 26 22 29 29 29 " test-id "&")))
d0b0: 0a 09 09 09 09 09 3b 28 70 72 69 6e 74 20 22 4c ......;(print "L
d0c0: 61 75 6e 63 68 69 6e 67 20 22 20 63 6d 64 29 0a aunching " cmd).
d0d0: 09 09 09 09 09 09 20 20 20 20 28 73 79 73 74 65 ...... (syste
d0e0: 6d 20 63 6d 64 29 29 29 29 29 29 0a 09 20 20 28 m cmd)))))).. (
d0f0: 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 hash-table-set!
d100: 2a 62 75 74 74 6f 6e 64 61 74 2a 20 62 75 74 74 *buttondat* butt
d110: 6f 6e 2d 6b 65 79 20 28 76 65 63 74 6f 72 20 30 on-key (vector 0
d120: 20 22 31 30 30 20 31 30 30 20 31 30 30 22 20 62 "100 100 100" b
d130: 75 74 74 6f 6e 2d 6b 65 79 20 23 66 20 23 66 29 utton-key #f #f)
d140: 29 20 0a 09 20 20 28 76 65 63 74 6f 72 2d 73 65 ) .. (vector-se
d150: 74 21 20 74 65 73 74 76 65 63 20 74 65 73 74 6e t! testvec testn
d160: 75 6d 20 62 75 74 6e 29 0a 09 20 20 28 6c 6f 6f um butn).. (loo
d170: 70 20 72 75 6e 6e 75 6d 20 28 2b 20 74 65 73 74 p runnum (+ test
d180: 6e 75 6d 20 31 29 20 74 65 73 74 76 65 63 20 28 num 1) testvec (
d190: 63 6f 6e 73 20 62 75 74 6e 20 72 65 73 29 29 29 cons butn res)))
d1a0: 29 29 29 0a 20 20 20 20 3b 3b 20 6e 6f 77 20 61 ))). ;; now a
d1b0: 73 73 65 6d 62 6c 65 20 74 68 65 20 68 64 72 6c ssemble the hdrl
d1c0: 73 74 20 61 6e 64 20 62 64 79 6c 73 74 20 61 6e st and bdylst an
d1d0: 64 20 6b 69 63 6b 20 6f 66 66 20 74 68 65 20 64 d kick off the d
d1e0: 69 61 6c 6f 67 0a 20 20 20 20 28 69 75 70 3a 73 ialog. (iup:s
d1f0: 68 6f 77 0a 20 20 20 20 20 28 69 75 70 3a 64 69 how. (iup:di
d200: 61 6c 6f 67 20 0a 20 20 20 20 20 20 23 3a 74 69 alog . #:ti
d210: 74 6c 65 20 28 63 6f 6e 63 20 22 4d 65 67 61 74 tle (conc "Megat
d220: 65 73 74 20 64 61 73 68 62 6f 61 72 64 20 22 20 est dashboard "
d230: 28 63 75 72 72 65 6e 74 2d 75 73 65 72 2d 6e 61 (current-user-na
d240: 6d 65 29 20 22 3a 22 20 2a 74 6f 70 70 61 74 68 me) ":" *toppath
d250: 2a 29 0a 20 20 20 20 20 20 23 3a 6d 65 6e 75 20 *). #:menu
d260: 28 64 63 6f 6d 6d 6f 6e 3a 6d 61 69 6e 2d 6d 65 (dcommon:main-me
d270: 6e 75 29 0a 20 20 20 20 20 20 28 6c 65 74 2a 20 nu). (let*
d280: 28 28 72 75 6e 73 2d 76 69 65 77 20 28 69 75 70 ((runs-view (iup
d290: 3a 76 62 6f 78 0a 09 09 09 20 28 61 70 70 6c 79 :vbox.... (apply
d2a0: 20 69 75 70 3a 68 62 6f 78 20 0a 09 09 09 09 28 iup:hbox .....(
d2b0: 63 6f 6e 73 20 28 61 70 70 6c 79 20 69 75 70 3a cons (apply iup:
d2c0: 76 62 6f 78 20 6c 66 74 6c 73 74 29 0a 09 09 09 vbox lftlst)....
d2d0: 09 20 20 20 20 20 20 28 6c 69 73 74 20 0a 09 09 . (list ...
d2e0: 09 09 20 20 20 20 20 20 20 28 69 75 70 3a 76 62 .. (iup:vb
d2f0: 6f 78 0a 09 09 09 09 09 3b 3b 20 74 68 65 20 68 ox......;; the h
d300: 65 61 64 65 72 0a 09 09 09 09 09 28 61 70 70 6c eader......(appl
d310: 79 20 69 75 70 3a 68 62 6f 78 20 28 72 65 76 65 y iup:hbox (reve
d320: 72 73 65 20 68 64 72 6c 73 74 29 29 0a 09 09 09 rse hdrlst))....
d330: 09 09 28 61 70 70 6c 79 20 69 75 70 3a 68 62 6f ..(apply iup:hbo
d340: 78 20 28 72 65 76 65 72 73 65 20 62 64 79 6c 73 x (reverse bdyls
d350: 74 29 29 29 29 29 29 0a 09 09 09 20 63 6f 6e 74 t)))))).... cont
d360: 72 6f 6c 73 29 29 0a 09 20 20 20 20 20 28 74 61 rols)).. (ta
d370: 62 73 20 28 69 75 70 3a 74 61 62 73 0a 09 09 20 bs (iup:tabs...
d380: 20 20 20 23 3a 74 61 62 63 68 61 6e 67 65 70 6f #:tabchangepo
d390: 73 2d 63 62 20 28 6c 61 6d 62 64 61 20 28 6f 62 s-cb (lambda (ob
d3a0: 6a 20 63 75 72 72 20 70 72 65 76 29 0a 09 09 09 j curr prev)....
d3b0: 09 09 28 73 65 74 21 20 2a 70 6c 65 61 73 65 2d ..(set! *please-
d3c0: 75 70 64 61 74 65 2d 62 75 74 74 6f 6e 73 2a 20 update-buttons*
d3d0: 23 74 29 0a 09 09 09 09 09 28 73 65 74 21 20 2a #t)......(set! *
d3e0: 63 75 72 72 65 6e 74 2d 74 61 62 2d 6e 75 6d 62 current-tab-numb
d3f0: 65 72 2a 20 63 75 72 72 29 29 0a 09 09 20 20 20 er* curr))...
d400: 20 28 64 61 73 68 62 6f 61 72 64 3a 73 75 6d 6d (dashboard:summ
d410: 61 72 79 20 64 62 29 0a 09 09 20 20 20 20 72 75 ary db)... ru
d420: 6e 73 2d 76 69 65 77 0a 09 09 20 20 20 20 28 64 ns-view... (d
d430: 61 73 68 62 6f 61 72 64 3a 6f 6e 65 2d 72 75 6e ashboard:one-run
d440: 20 64 62 29 0a 09 09 20 20 20 20 28 64 61 73 68 db)... (dash
d450: 62 6f 61 72 64 3a 72 75 6e 2d 63 6f 6e 74 72 6f board:run-contro
d460: 6c 73 29 0a 09 09 20 20 20 20 29 29 29 0a 09 3b ls)... )))..;
d470: 3b 20 28 73 65 74 21 20 28 69 75 70 3a 63 61 6c ; (set! (iup:cal
d480: 6c 62 61 63 6b 20 74 61 62 73 20 74 61 62 63 68 lback tabs tabch
d490: 61 6e 67 65 2d 63 62 3a 29 20 28 6c 61 6d 62 64 ange-cb:) (lambd
d4a0: 61 20 28 61 20 62 20 63 29 28 70 72 69 6e 74 20 a (a b c)(print
d4b0: 22 53 57 49 54 43 48 45 44 20 54 4f 20 54 41 42 "SWITCHED TO TAB
d4c0: 3a 20 22 20 61 20 22 20 22 20 62 20 22 20 22 20 : " a " " b " "
d4d0: 63 29 29 29 0a 09 28 69 75 70 3a 61 74 74 72 69 c)))..(iup:attri
d4e0: 62 75 74 65 2d 73 65 74 21 20 74 61 62 73 20 22 bute-set! tabs "
d4f0: 54 41 42 54 49 54 4c 45 30 22 20 22 53 75 6d 6d TABTITLE0" "Summ
d500: 61 72 79 22 29 0a 09 28 69 75 70 3a 61 74 74 72 ary")..(iup:attr
d510: 69 62 75 74 65 2d 73 65 74 21 20 74 61 62 73 20 ibute-set! tabs
d520: 22 54 41 42 54 49 54 4c 45 31 22 20 22 52 75 6e "TABTITLE1" "Run
d530: 73 22 29 0a 09 28 69 75 70 3a 61 74 74 72 69 62 s")..(iup:attrib
d540: 75 74 65 2d 73 65 74 21 20 74 61 62 73 20 22 54 ute-set! tabs "T
d550: 41 42 54 49 54 4c 45 32 22 20 22 52 75 6e 20 53 ABTITLE2" "Run S
d560: 75 6d 6d 61 72 79 22 29 0a 09 28 69 75 70 3a 61 ummary")..(iup:a
d570: 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 74 61 ttribute-set! ta
d580: 62 73 20 22 54 41 42 54 49 54 4c 45 33 22 20 22 bs "TABTITLE3" "
d590: 52 75 6e 20 43 6f 6e 74 72 6f 6c 22 29 0a 09 28 Run Control")..(
d5a0: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se
d5b0: 74 21 20 74 61 62 73 20 22 42 47 43 4f 4c 4f 52 t! tabs "BGCOLOR
d5c0: 22 20 22 31 39 30 20 31 39 30 20 31 39 30 22 29 " "190 190 190")
d5d0: 0a 09 28 73 65 74 21 20 2a 68 69 64 65 2d 6e 6f ..(set! *hide-no
d5e0: 74 2d 68 69 64 65 2d 74 61 62 73 2a 20 74 61 62 t-hide-tabs* tab
d5f0: 73 29 0a 09 74 61 62 73 29 29 29 0a 20 20 20 20 s)..tabs))).
d600: 28 76 65 63 74 6f 72 20 6b 65 79 63 6f 6c 20 6c (vector keycol l
d610: 66 74 63 6f 6c 20 68 65 61 64 65 72 20 72 75 6e ftcol header run
d620: 73 76 65 63 29 29 29 0a 0a 28 69 66 20 28 6f 72 svec)))..(if (or
d630: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
d640: 2d 72 6f 77 73 22 29 0a 09 28 67 65 74 2d 65 6e -rows")..(get-en
d650: 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 vironment-variab
d660: 6c 65 20 22 44 41 53 48 42 4f 41 52 44 52 4f 57 le "DASHBOARDROW
d670: 53 22 20 29 29 0a 20 20 20 20 28 62 65 67 69 6e S" )). (begin
d680: 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 6e 75 . (set! *nu
d690: 6d 2d 74 65 73 74 73 2a 20 28 73 74 72 69 6e 67 m-tests* (string
d6a0: 2d 3e 6e 75 6d 62 65 72 20 28 6f 72 20 28 61 72 ->number (or (ar
d6b0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 6f 77 gs:get-arg "-row
d6c0: 73 22 29 0a 09 09 09 09 09 20 20 20 20 28 67 65 s")...... (ge
d6d0: 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 t-environment-va
d6e0: 72 69 61 62 6c 65 20 22 44 41 53 48 42 4f 41 52 riable "DASHBOAR
d6f0: 44 52 4f 57 53 22 29 29 29 29 0a 20 20 20 20 20 DROWS")))).
d700: 20 28 75 70 64 61 74 65 2d 72 75 6e 64 61 74 20 (update-rundat
d710: 22 25 22 20 2a 6e 75 6d 2d 72 75 6e 73 2a 20 22 "%" *num-runs* "
d720: 25 2f 25 22 20 27 28 29 29 29 0a 20 20 20 20 28 %/%" '())). (
d730: 73 65 74 21 20 2a 6e 75 6d 2d 74 65 73 74 73 2a set! *num-tests*
d740: 20 28 6d 69 6e 20 28 6d 61 78 20 28 75 70 64 61 (min (max (upda
d750: 74 65 2d 72 75 6e 64 61 74 20 22 25 22 20 2a 6e te-rundat "%" *n
d760: 75 6d 2d 72 75 6e 73 2a 20 22 25 2f 25 22 20 27 um-runs* "%/%" '
d770: 28 29 29 20 38 29 20 32 30 29 29 29 0a 0a 28 64 ()) 8) 20)))..(d
d780: 65 66 69 6e 65 20 2a 74 69 6d 2a 20 28 69 75 70 efine *tim* (iup
d790: 3a 74 69 6d 65 72 29 29 0a 28 64 65 66 69 6e 65 :timer)).(define
d7a0: 20 2a 6f 72 64 2a 20 23 66 29 0a 28 69 75 70 3a *ord* #f).(iup:
d7b0: 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 2a attribute-set! *
d7c0: 74 69 6d 2a 20 22 54 49 4d 45 22 20 33 30 30 29 tim* "TIME" 300)
d7d0: 0a 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d .(iup:attribute-
d7e0: 73 65 74 21 20 2a 74 69 6d 2a 20 22 52 55 4e 22 set! *tim* "RUN"
d7f0: 20 22 59 45 53 22 29 0a 0a 3b 3b 20 4d 6f 76 65 "YES")..;; Move
d800: 20 74 68 69 73 20 73 74 75 66 66 20 74 6f 20 64 this stuff to d
d810: 62 2e 73 63 6d 3f 20 49 27 6d 20 6e 6f 74 20 73 b.scm? I'm not s
d820: 75 72 65 20 74 68 61 74 20 69 73 20 74 68 65 20 ure that is the
d830: 72 69 67 68 74 20 74 68 69 6e 67 20 74 6f 20 64 right thing to d
d840: 6f 2e 2e 2e 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 o....;;.(define
d850: 2a 6c 61 73 74 2d 64 62 2d 75 70 64 61 74 65 2d *last-db-update-
d860: 74 69 6d 65 2a 20 28 66 69 6c 65 2d 6d 6f 64 69 time* (file-modi
d870: 66 69 63 61 74 69 6f 6e 2d 74 69 6d 65 20 2a 64 fication-time *d
d880: 62 2d 66 69 6c 65 2d 70 61 74 68 2a 29 29 20 3b b-file-path*)) ;
d890: 3b 20 28 63 6f 6e 63 20 2a 74 6f 70 70 61 74 68 ; (conc *toppath
d8a0: 2a 20 22 2f 64 62 2f 6d 61 69 6e 2e 64 62 22 29 * "/db/main.db")
d8b0: 29 29 0a 28 64 65 66 69 6e 65 20 2a 6c 61 73 74 )).(define *last
d8c0: 2d 72 65 63 61 6c 63 2d 65 6e 64 65 64 2d 74 69 -recalc-ended-ti
d8d0: 6d 65 2a 20 30 29 0a 0a 28 64 65 66 69 6e 65 20 me* 0)..(define
d8e0: 28 64 61 73 68 62 6f 61 72 64 3a 62 65 65 6e 2d (dashboard:been-
d8f0: 63 68 61 6e 67 65 64 29 0a 20 20 28 3e 20 28 66 changed). (> (f
d900: 69 6c 65 2d 6d 6f 64 69 66 69 63 61 74 69 6f 6e ile-modification
d910: 2d 74 69 6d 65 20 2a 64 62 2d 66 69 6c 65 2d 70 -time *db-file-p
d920: 61 74 68 2a 29 20 2a 6c 61 73 74 2d 64 62 2d 75 ath*) *last-db-u
d930: 70 64 61 74 65 2d 74 69 6d 65 2a 29 29 0a 0a 28 pdate-time*))..(
d940: 64 65 66 69 6e 65 20 28 64 61 73 68 62 6f 61 72 define (dashboar
d950: 64 3a 73 65 74 2d 64 62 2d 75 70 64 61 74 65 2d d:set-db-update-
d960: 74 69 6d 65 29 0a 20 20 28 73 65 74 21 20 2a 6c time). (set! *l
d970: 61 73 74 2d 64 62 2d 75 70 64 61 74 65 2d 74 69 ast-db-update-ti
d980: 6d 65 2a 20 28 66 69 6c 65 2d 6d 6f 64 69 66 69 me* (file-modifi
d990: 63 61 74 69 6f 6e 2d 74 69 6d 65 20 2a 64 62 2d cation-time *db-
d9a0: 66 69 6c 65 2d 70 61 74 68 2a 29 29 29 0a 0a 28 file-path*)))..(
d9b0: 64 65 66 69 6e 65 20 28 64 61 73 68 62 6f 61 72 define (dashboar
d9c0: 64 3a 72 65 63 61 6c 63 20 6d 6f 64 74 69 6d 65 d:recalc modtime
d9d0: 20 70 6c 65 61 73 65 2d 75 70 64 61 74 65 2d 62 please-update-b
d9e0: 75 74 74 6f 6e 73 20 6c 61 73 74 2d 64 62 2d 75 uttons last-db-u
d9f0: 70 64 61 74 65 2d 74 69 6d 65 29 0a 20 20 28 6f pdate-time). (o
da00: 72 20 70 6c 65 61 73 65 2d 75 70 64 61 74 65 2d r please-update-
da10: 62 75 74 74 6f 6e 73 0a 20 20 20 20 20 20 28 61 buttons. (a
da20: 6e 64 20 28 3e 20 28 63 75 72 72 65 6e 74 2d 6d nd (> (current-m
da30: 69 6c 6c 69 73 65 63 6f 6e 64 73 29 28 2b 20 2a illiseconds)(+ *
da40: 6c 61 73 74 2d 72 65 63 61 6c 63 2d 65 6e 64 65 last-recalc-ende
da50: 64 2d 74 69 6d 65 2a 20 31 35 30 29 29 0a 09 20 d-time* 150))..
da60: 20 20 28 3e 20 6d 6f 64 74 69 6d 65 20 6c 61 73 (> modtime las
da70: 74 2d 64 62 2d 75 70 64 61 74 65 2d 74 69 6d 65 t-db-update-time
da80: 29 0a 09 20 20 20 28 3e 20 28 63 75 72 72 65 6e ).. (> (curren
da90: 74 2d 73 65 63 6f 6e 64 73 29 28 2b 20 6c 61 73 t-seconds)(+ las
daa0: 74 2d 64 62 2d 75 70 64 61 74 65 2d 74 69 6d 65 t-db-update-time
dab0: 20 31 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 1)))))..(define
dac0: 20 2a 6d 6f 6e 69 74 6f 72 2d 64 62 2d 70 61 74 *monitor-db-pat
dad0: 68 2a 20 28 63 6f 6e 63 20 2a 64 62 64 69 72 2a h* (conc *dbdir*
dae0: 20 22 2f 6d 6f 6e 69 74 6f 72 2e 64 62 22 29 29 "/monitor.db"))
daf0: 0a 28 64 65 66 69 6e 65 20 2a 6c 61 73 74 2d 6d .(define *last-m
db00: 6f 6e 69 74 6f 72 2d 75 70 64 61 74 65 2d 74 69 onitor-update-ti
db10: 6d 65 2a 20 30 29 0a 0a 3b 3b 20 46 6f 72 63 65 me* 0)..;; Force
db20: 20 63 72 65 61 74 69 6f 6e 20 6f 66 20 74 68 65 creation of the
db30: 20 64 62 20 69 6e 20 63 61 73 65 20 69 74 20 69 db in case it i
db40: 73 6e 27 74 20 61 6c 72 65 61 64 79 20 74 68 65 sn't already the
db50: 72 65 2e 0a 28 74 61 73 6b 73 3a 6f 70 65 6e 2d re..(tasks:open-
db60: 64 62 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 61 db)..(define (da
db70: 73 68 62 6f 61 72 64 3a 67 65 74 2d 79 6f 75 6e shboard:get-youn
db80: 67 65 73 74 2d 72 75 6e 2d 64 62 2d 6d 6f 64 2d gest-run-db-mod-
db90: 74 69 6d 65 29 0a 20 20 28 68 61 6e 64 6c 65 2d time). (handle-
dba0: 65 78 63 65 70 74 69 6f 6e 73 0a 20 20 20 65 78 exceptions. ex
dbb0: 6e 0a 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 n. (begin.
dbc0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
dbd0: 22 57 41 52 4e 49 4e 47 3a 20 65 72 72 6f 72 20 "WARNING: error
dbe0: 69 6e 20 61 63 63 65 73 73 69 6e 67 20 64 61 74 in accessing dat
dbf0: 61 62 61 73 65 73 20 69 6e 20 67 65 74 2d 79 6f abases in get-yo
dc00: 75 6e 67 65 73 74 2d 72 75 6e 2d 64 62 2d 6d 6f ungest-run-db-mo
dc10: 64 2d 74 69 6d 65 3a 20 22 20 28 28 63 6f 6e 64 d-time: " ((cond
dc20: 69 74 69 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 ition-property-a
dc30: 63 63 65 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 ccessor 'exn 'me
dc40: 73 73 61 67 65 29 20 65 78 6e 29 29 0a 20 20 20 ssage) exn)).
dc50: 20 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e (current-secon
dc60: 64 73 29 29 20 3b 3b 20 73 6f 6d 65 74 68 69 6e ds)) ;; somethin
dc70: 67 20 77 65 6e 74 20 77 72 6f 6e 67 20 2d 20 6a g went wrong - j
dc80: 75 73 74 20 70 72 69 6e 74 20 61 6e 20 65 72 72 ust print an err
dc90: 6f 72 20 61 6e 64 20 72 65 74 75 72 6e 20 63 75 or and return cu
dca0: 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 0a 20 20 rrent-seconds.
dcb0: 20 28 61 70 70 6c 79 20 6d 61 78 20 28 6d 61 70 (apply max (map
dcc0: 20 28 6c 61 6d 62 64 61 20 28 66 69 6c 65 6e 29 (lambda (filen)
dcd0: 0a 09 09 20 20 20 20 20 28 66 69 6c 65 2d 6d 6f ... (file-mo
dce0: 64 69 66 69 63 61 74 69 6f 6e 2d 74 69 6d 65 20 dification-time
dcf0: 66 69 6c 65 6e 29 29 0a 09 09 20 20 20 28 67 6c filen))... (gl
dd00: 6f 62 20 28 63 6f 6e 63 20 2a 64 62 64 69 72 2a ob (conc *dbdir*
dd10: 20 22 2f 2a 2e 64 62 22 29 29 29 29 29 29 0a 0a "/*.db"))))))..
dd20: 28 64 65 66 69 6e 65 20 28 64 61 73 68 62 6f 61 (define (dashboa
dd30: 72 64 3a 72 75 6e 2d 75 70 64 61 74 65 20 78 29 rd:run-update x)
dd40: 0a 20 20 28 6c 65 74 2a 20 28 28 6d 6f 64 74 69 . (let* ((modti
dd50: 6d 65 20 20 20 20 20 20 20 20 20 28 64 61 73 68 me (dash
dd60: 62 6f 61 72 64 3a 67 65 74 2d 79 6f 75 6e 67 65 board:get-younge
dd70: 73 74 2d 72 75 6e 2d 64 62 2d 6d 6f 64 2d 74 69 st-run-db-mod-ti
dd80: 6d 65 29 29 20 3b 3b 20 28 66 69 6c 65 2d 6d 6f me)) ;; (file-mo
dd90: 64 69 66 69 63 61 74 69 6f 6e 2d 74 69 6d 65 20 dification-time
dda0: 2a 64 62 2d 66 69 6c 65 2d 70 61 74 68 2a 29 29 *db-file-path*))
ddb0: 0a 09 20 28 6d 6f 6e 69 74 6f 72 2d 6d 6f 64 74 .. (monitor-modt
ddc0: 69 6d 65 20 28 69 66 20 28 66 69 6c 65 2d 65 78 ime (if (file-ex
ddd0: 69 73 74 73 3f 20 2a 6d 6f 6e 69 74 6f 72 2d 64 ists? *monitor-d
dde0: 62 2d 70 61 74 68 2a 29 0a 09 09 09 20 20 20 20 b-path*)....
ddf0: 20 20 28 66 69 6c 65 2d 6d 6f 64 69 66 69 63 61 (file-modifica
de00: 74 69 6f 6e 2d 74 69 6d 65 20 2a 6d 6f 6e 69 74 tion-time *monit
de10: 6f 72 2d 64 62 2d 70 61 74 68 2a 29 0a 09 09 09 or-db-path*)....
de20: 20 20 20 20 20 20 2d 31 29 29 0a 09 20 28 72 75 -1)).. (ru
de30: 6e 2d 75 70 64 61 74 65 2d 74 69 6d 65 20 28 63 n-update-time (c
de40: 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 urrent-seconds))
de50: 0a 09 20 28 72 65 63 61 6c 63 20 20 20 20 20 20 .. (recalc
de60: 20 20 20 20 28 64 61 73 68 62 6f 61 72 64 3a 72 (dashboard:r
de70: 65 63 61 6c 63 20 6d 6f 64 74 69 6d 65 20 2a 70 ecalc modtime *p
de80: 6c 65 61 73 65 2d 75 70 64 61 74 65 2d 62 75 74 lease-update-but
de90: 74 6f 6e 73 2a 20 2a 6c 61 73 74 2d 64 62 2d 75 tons* *last-db-u
dea0: 70 64 61 74 65 2d 74 69 6d 65 2a 29 29 29 0a 20 pdate-time*))).
deb0: 20 20 20 28 69 66 20 28 61 6e 64 20 28 65 71 3f (if (and (eq?
dec0: 20 2a 63 75 72 72 65 6e 74 2d 74 61 62 2d 6e 75 *current-tab-nu
ded0: 6d 62 65 72 2a 20 30 29 0a 09 20 20 20 20 20 28 mber* 0).. (
dee0: 6f 72 20 28 3e 20 6d 6f 6e 69 74 6f 72 2d 6d 6f or (> monitor-mo
def0: 64 74 69 6d 65 20 2a 6c 61 73 74 2d 6d 6f 6e 69 dtime *last-moni
df00: 74 6f 72 2d 75 70 64 61 74 65 2d 74 69 6d 65 2a tor-update-time*
df10: 29 0a 09 09 20 28 3e 20 28 2d 20 72 75 6e 2d 75 )... (> (- run-u
df20: 70 64 61 74 65 2d 74 69 6d 65 20 2a 6c 61 73 74 pdate-time *last
df30: 2d 6d 6f 6e 69 74 6f 72 2d 75 70 64 61 74 65 2d -monitor-update-
df40: 74 69 6d 65 2a 29 20 35 29 29 29 20 3b 3b 20 75 time*) 5))) ;; u
df50: 70 64 61 74 65 20 65 76 65 72 79 20 31 2f 32 20 pdate every 1/2
df60: 6d 69 6e 75 74 65 20 6a 75 73 74 20 69 6e 20 63 minute just in c
df70: 61 73 65 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 ase..(begin.. (
df80: 73 65 74 21 20 2a 6c 61 73 74 2d 6d 6f 6e 69 74 set! *last-monit
df90: 6f 72 2d 75 70 64 61 74 65 2d 74 69 6d 65 2a 20 or-update-time*
dfa0: 72 75 6e 2d 75 70 64 61 74 65 2d 74 69 6d 65 29 run-update-time)
dfb0: 20 3b 3b 20 6d 6f 6e 69 74 6f 72 2d 6d 6f 64 74 ;; monitor-modt
dfc0: 69 6d 65 29 0a 09 20 20 28 69 66 20 64 61 73 68 ime).. (if dash
dfd0: 62 6f 61 72 64 3a 75 70 64 61 74 65 2d 73 65 72 board:update-ser
dfe0: 76 65 72 73 2d 74 61 62 6c 65 20 28 64 61 73 68 vers-table (dash
dff0: 62 6f 61 72 64 3a 75 70 64 61 74 65 2d 73 65 72 board:update-ser
e000: 76 65 72 73 2d 74 61 62 6c 65 29 29 29 29 0a 20 vers-table)))).
e010: 20 20 20 28 69 66 20 72 65 63 61 6c 63 0a 09 28 (if recalc..(
e020: 62 65 67 69 6e 09 0a 09 20 20 28 63 61 73 65 20 begin... (case
e030: 2a 63 75 72 72 65 6e 74 2d 74 61 62 2d 6e 75 6d *current-tab-num
e040: 62 65 72 2a 20 0a 09 20 20 20 20 28 28 30 29 20 ber* .. ((0)
e050: 0a 09 20 20 20 20 20 28 69 66 20 64 61 73 68 62 .. (if dashb
e060: 6f 61 72 64 3a 75 70 64 61 74 65 2d 73 75 6d 6d oard:update-summ
e070: 61 72 79 2d 74 61 62 20 28 64 61 73 68 62 6f 61 ary-tab (dashboa
e080: 72 64 3a 75 70 64 61 74 65 2d 73 75 6d 6d 61 72 rd:update-summar
e090: 79 2d 74 61 62 29 29 29 0a 09 20 20 20 20 28 28 y-tab))).. ((
e0a0: 31 29 20 3b 3b 20 54 68 65 20 72 75 6e 73 20 74 1) ;; The runs t
e0b0: 61 62 6c 65 20 69 73 20 61 63 74 69 76 65 0a 09 able is active..
e0c0: 20 20 20 20 20 28 75 70 64 61 74 65 2d 72 75 6e (update-run
e0d0: 64 61 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d dat (hash-table-
e0e0: 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 73 65 61 ref/default *sea
e0f0: 72 63 68 70 61 74 74 73 2a 20 22 72 75 6e 6e 61 rchpatts* "runna
e100: 6d 65 22 20 22 25 22 29 20 2a 6e 75 6d 2d 72 75 me" "%") *num-ru
e110: 6e 73 2a 0a 09 09 09 20 20 20 20 28 68 61 73 68 ns*.... (hash
e120: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau
e130: 6c 74 20 2a 73 65 61 72 63 68 70 61 74 74 73 2a lt *searchpatts*
e140: 20 22 74 65 73 74 2d 6e 61 6d 65 22 20 22 25 2f "test-name" "%/
e150: 25 22 29 0a 09 09 09 20 20 20 20 3b 3b 20 28 68 %").... ;; (h
e160: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
e170: 66 61 75 6c 74 20 2a 73 65 61 72 63 68 70 61 74 fault *searchpat
e180: 74 73 2a 20 22 69 74 65 6d 2d 6e 61 6d 65 22 20 ts* "item-name"
e190: 22 25 22 29 0a 09 09 09 20 20 20 20 28 6c 65 74 "%").... (let
e1a0: 20 28 28 72 65 73 20 27 28 29 29 29 0a 09 09 09 ((res '()))....
e1b0: 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 (for-each
e1c0: 28 6c 61 6d 62 64 61 20 28 6b 65 79 29 0a 09 09 (lambda (key)...
e1d0: 09 09 09 20 20 28 69 66 20 28 6e 6f 74 20 28 65 ... (if (not (e
e1e0: 71 75 61 6c 3f 20 6b 65 79 20 22 72 75 6e 6e 61 qual? key "runna
e1f0: 6d 65 22 29 29 0a 09 09 09 09 09 20 20 20 20 20 me"))......
e200: 20 28 6c 65 74 20 28 28 76 61 6c 20 28 68 61 73 (let ((val (has
e210: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
e220: 75 6c 74 20 2a 73 65 61 72 63 68 70 61 74 74 73 ult *searchpatts
e230: 2a 20 6b 65 79 20 23 66 29 29 29 0a 09 09 09 09 * key #f))).....
e240: 09 09 28 69 66 20 76 61 6c 20 28 73 65 74 21 20 ..(if val (set!
e250: 72 65 73 20 28 63 6f 6e 73 20 28 6c 69 73 74 20 res (cons (list
e260: 6b 65 79 20 76 61 6c 29 20 72 65 73 29 29 29 29 key val) res))))
e270: 29 29 0a 09 09 09 09 09 2a 64 62 6b 65 79 73 2a ))......*dbkeys*
e280: 29 0a 09 09 09 20 20 20 20 20 20 72 65 73 29 29 ).... res))
e290: 0a 09 20 20 20 20 20 28 75 70 64 61 74 65 2d 62 .. (update-b
e2a0: 75 74 74 6f 6e 73 20 75 69 64 61 74 20 2a 6e 75 uttons uidat *nu
e2b0: 6d 2d 72 75 6e 73 2a 20 2a 6e 75 6d 2d 74 65 73 m-runs* *num-tes
e2c0: 74 73 2a 29 29 0a 09 20 20 20 20 28 28 32 29 0a ts*)).. ((2).
e2d0: 09 20 20 20 20 20 28 64 61 73 68 62 6f 61 72 64 . (dashboard
e2e0: 3a 75 70 64 61 74 65 2d 72 75 6e 2d 73 75 6d 6d :update-run-summ
e2f0: 61 72 79 2d 74 61 62 29 29 0a 09 20 20 20 20 28 ary-tab)).. (
e300: 65 6c 73 65 0a 09 20 20 20 20 20 28 6c 65 74 20 else.. (let
e310: 28 28 75 70 64 61 74 65 72 20 28 68 61 73 68 2d ((updater (hash-
e320: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
e330: 74 20 2a 75 70 64 61 74 65 72 73 2a 20 2a 63 75 t *updaters* *cu
e340: 72 72 65 6e 74 2d 74 61 62 2d 6e 75 6d 62 65 72 rrent-tab-number
e350: 2a 20 23 66 29 29 29 0a 09 20 20 20 20 20 20 20 * #f)))..
e360: 28 69 66 20 75 70 64 61 74 65 72 20 28 75 70 64 (if updater (upd
e370: 61 74 65 72 29 29 29 29 29 0a 09 20 20 28 73 65 ater))))).. (se
e380: 74 21 20 2a 70 6c 65 61 73 65 2d 75 70 64 61 74 t! *please-updat
e390: 65 2d 62 75 74 74 6f 6e 73 2a 20 23 66 29 0a 09 e-buttons* #f)..
e3a0: 20 20 28 73 65 74 21 20 2a 6c 61 73 74 2d 64 62 (set! *last-db
e3b0: 2d 75 70 64 61 74 65 2d 74 69 6d 65 2a 20 6d 6f -update-time* mo
e3c0: 64 74 69 6d 65 29 0a 09 20 20 28 73 65 74 21 20 dtime).. (set!
e3d0: 2a 6c 61 73 74 2d 75 70 64 61 74 65 2a 20 72 75 *last-update* ru
e3e0: 6e 2d 75 70 64 61 74 65 2d 74 69 6d 65 29 0a 09 n-update-time)..
e3f0: 20 20 28 73 65 74 21 20 2a 6c 61 73 74 2d 72 65 (set! *last-re
e400: 63 61 6c 63 2d 65 6e 64 65 64 2d 74 69 6d 65 2a calc-ended-time*
e410: 20 28 63 75 72 72 65 6e 74 2d 6d 69 6c 6c 69 73 (current-millis
e420: 65 63 6f 6e 64 73 29 29 29 29 29 29 0a 0a 3b 3b econds))))))..;;
e430: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e440: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e450: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e460: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e470: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 54 68 65 20 68 65 ======.;; The he
e480: 61 76 79 20 6c 69 66 74 69 6e 67 20 73 74 61 72 avy lifting star
e490: 74 73 20 68 65 72 65 0a 3b 3b 3d 3d 3d 3d 3d 3d ts here.;;======
e4a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e4b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e4c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e4d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e4e0: 0a 0a 3b 3b 20 65 61 73 65 20 64 65 62 75 67 67 ..;; ease debugg
e4f0: 69 6e 67 20 62 79 20 6c 6f 61 64 69 6e 67 20 7e ing by loading ~
e500: 2f 2e 64 61 73 68 62 6f 61 72 64 72 63 0a 28 6c /.dashboardrc.(l
e510: 65 74 20 28 28 64 65 62 75 67 63 6f 6e 74 72 6f et ((debugcontro
e520: 6c 66 20 28 63 6f 6e 63 20 28 67 65 74 2d 65 6e lf (conc (get-en
e530: 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 vironment-variab
e540: 6c 65 20 22 48 4f 4d 45 22 29 20 22 2f 2e 64 61 le "HOME") "/.da
e550: 73 68 62 6f 61 72 64 72 63 22 29 29 29 0a 20 20 shboardrc"))).
e560: 28 69 66 20 28 66 69 6c 65 2d 65 78 69 73 74 73 (if (file-exists
e570: 3f 20 64 65 62 75 67 63 6f 6e 74 72 6f 6c 66 29 ? debugcontrolf)
e580: 0a 20 20 20 20 20 20 28 6c 6f 61 64 20 64 65 62 . (load deb
e590: 75 67 63 6f 6e 74 72 6f 6c 66 29 29 29 0a 0a 28 ugcontrolf)))..(
e5a0: 63 6f 6e 64 20 0a 20 28 28 61 72 67 73 3a 67 65 cond . ((args:ge
e5b0: 74 2d 61 72 67 20 22 2d 72 75 6e 22 29 0a 20 20 t-arg "-run").
e5c0: 28 6c 65 74 20 28 28 72 75 6e 69 64 20 28 73 74 (let ((runid (st
e5d0: 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 61 72 ring->number (ar
e5e0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e gs:get-arg "-run
e5f0: 22 29 29 29 29 0a 20 20 20 20 28 69 66 20 72 75 ")))). (if ru
e600: 6e 69 64 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 nid..(begin.. (
e610: 6c 61 6d 62 64 61 20 28 78 29 0a 09 20 20 20 20 lambda (x)..
e620: 28 6f 6e 2d 65 78 69 74 20 73 74 64 2d 65 78 69 (on-exit std-exi
e630: 74 2d 70 72 6f 63 65 64 75 72 65 29 0a 09 20 20 t-procedure)..
e640: 20 20 28 65 78 61 6d 69 6e 65 2d 72 75 6e 20 2a (examine-run *
e650: 64 62 73 74 72 75 63 74 2d 6c 6f 63 61 6c 2a 20 dbstruct-local*
e660: 72 75 6e 69 64 29 29 29 0a 09 28 62 65 67 69 6e runid)))..(begin
e670: 0a 09 20 20 28 70 72 69 6e 74 20 22 45 52 52 4f .. (print "ERRO
e680: 52 3a 20 72 75 6e 69 64 20 69 73 20 6e 6f 74 20 R: runid is not
e690: 61 20 6e 75 6d 62 65 72 20 22 20 28 61 72 67 73 a number " (args
e6a0: 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 22 29 :get-arg "-run")
e6b0: 29 0a 09 20 20 28 65 78 69 74 20 31 29 29 29 29 ).. (exit 1))))
e6c0: 29 0a 20 28 28 61 72 67 73 3a 67 65 74 2d 61 72 ). ((args:get-ar
e6d0: 67 20 22 2d 74 65 73 74 22 29 20 3b 3b 20 72 75 g "-test") ;; ru
e6e0: 6e 2d 69 64 2c 74 65 73 74 2d 69 64 0a 20 20 28 n-id,test-id. (
e6f0: 6c 65 74 2a 20 28 28 64 61 74 20 20 20 20 20 28 let* ((dat (
e700: 6c 65 74 20 28 28 64 20 28 6d 61 70 20 73 74 72 let ((d (map str
e710: 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 73 74 72 ing->number (str
e720: 69 6e 67 2d 73 70 6c 69 74 20 28 61 72 67 73 3a ing-split (args:
e730: 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 22 29 get-arg "-test")
e740: 20 22 2c 22 29 29 29 29 0a 09 09 20 20 20 20 28 ","))))... (
e750: 69 66 20 28 3e 20 28 6c 65 6e 67 74 68 20 64 29 if (> (length d)
e760: 20 31 29 0a 09 09 09 64 0a 09 09 09 28 6c 69 73 1)....d....(lis
e770: 74 20 23 66 20 23 66 29 29 29 29 0a 09 20 28 72 t #f #f)))).. (r
e780: 75 6e 2d 69 64 20 20 28 63 61 72 20 64 61 74 29 un-id (car dat)
e790: 29 0a 09 20 28 74 65 73 74 2d 69 64 20 28 63 61 ).. (test-id (ca
e7a0: 64 72 20 64 61 74 29 29 29 0a 20 20 20 20 28 69 dr dat))). (i
e7b0: 66 20 28 61 6e 64 20 28 6e 75 6d 62 65 72 3f 20 f (and (number?
e7c0: 72 75 6e 2d 69 64 29 0a 09 20 20 20 20 20 28 6e run-id).. (n
e7d0: 75 6d 62 65 72 3f 20 74 65 73 74 2d 69 64 29 0a umber? test-id).
e7e0: 09 20 20 20 20 20 28 3e 3d 20 74 65 73 74 2d 69 . (>= test-i
e7f0: 64 20 30 29 29 0a 09 28 65 78 61 6d 69 6e 65 2d d 0))..(examine-
e800: 74 65 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 test run-id test
e810: 2d 69 64 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 -id)..(begin..
e820: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 33 20 22 (debug:print 3 "
e830: 49 4e 46 4f 3a 20 74 72 69 65 64 20 74 6f 20 6f INFO: tried to o
e840: 70 65 6e 20 74 65 73 74 20 77 69 74 68 20 69 6e pen test with in
e850: 76 61 6c 69 64 20 72 75 6e 2d 69 64 2c 74 65 73 valid run-id,tes
e860: 74 2d 69 64 2e 20 22 20 28 61 72 67 73 3a 67 65 t-id. " (args:ge
e870: 74 2d 61 72 67 20 22 2d 74 65 73 74 22 29 29 0a t-arg "-test")).
e880: 09 20 20 28 65 78 69 74 20 31 29 29 29 29 29 0a . (exit 1))))).
e890: 20 28 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ((args:get-arg
e8a0: 22 2d 67 75 69 6d 6f 6e 69 74 6f 72 22 29 0a 20 "-guimonitor").
e8b0: 20 28 67 75 69 2d 6d 6f 6e 69 74 6f 72 20 2a 64 (gui-monitor *d
e8c0: 62 73 74 72 75 63 74 2d 6c 6f 63 61 6c 2a 29 29 bstruct-local*))
e8d0: 0a 20 28 65 6c 73 65 0a 20 20 28 73 65 74 21 20 . (else. (set!
e8e0: 75 69 64 61 74 20 28 6d 61 6b 65 2d 64 61 73 68 uidat (make-dash
e8f0: 62 6f 61 72 64 2d 62 75 74 74 6f 6e 73 20 2a 64 board-buttons *d
e900: 62 73 74 72 75 63 74 2d 6c 6f 63 61 6c 2a 20 2a bstruct-local* *
e910: 6e 75 6d 2d 72 75 6e 73 2a 20 2a 6e 75 6d 2d 74 num-runs* *num-t
e920: 65 73 74 73 2a 20 2a 64 62 6b 65 79 73 2a 29 29 ests* *dbkeys*))
e930: 0a 20 20 28 69 75 70 3a 63 61 6c 6c 62 61 63 6b . (iup:callback
e940: 2d 73 65 74 21 20 2a 74 69 6d 2a 0a 09 09 20 20 -set! *tim*...
e950: 20 20 20 22 41 43 54 49 4f 4e 5f 43 42 22 0a 09 "ACTION_CB"..
e960: 09 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 78 . (lambda (x
e970: 29 0a 09 09 20 20 20 20 20 20 20 28 6c 65 74 20 )... (let
e980: 28 28 75 70 64 61 74 65 2d 69 73 2d 72 75 6e 6e ((update-is-runn
e990: 69 6e 67 20 23 66 29 29 0a 09 09 09 20 28 6d 75 ing #f)).... (mu
e9a0: 74 65 78 2d 6c 6f 63 6b 21 20 2a 75 70 64 61 74 tex-lock! *updat
e9b0: 65 2d 6d 75 74 65 78 2a 29 0a 09 09 09 20 28 73 e-mutex*).... (s
e9c0: 65 74 21 20 75 70 64 61 74 65 2d 69 73 2d 72 75 et! update-is-ru
e9d0: 6e 6e 69 6e 67 20 2a 75 70 64 61 74 65 2d 69 73 nning *update-is
e9e0: 2d 72 75 6e 6e 69 6e 67 2a 29 0a 09 09 09 20 28 -running*).... (
e9f0: 69 66 20 28 6e 6f 74 20 75 70 64 61 74 65 2d 69 if (not update-i
ea00: 73 2d 72 75 6e 6e 69 6e 67 29 0a 09 09 09 20 20 s-running)....
ea10: 20 20 20 28 73 65 74 21 20 2a 75 70 64 61 74 65 (set! *update
ea20: 2d 69 73 2d 72 75 6e 6e 69 6e 67 2a 20 23 74 29 -is-running* #t)
ea30: 29 0a 09 09 09 20 28 6d 75 74 65 78 2d 75 6e 6c ).... (mutex-unl
ea40: 6f 63 6b 21 20 2a 75 70 64 61 74 65 2d 6d 75 74 ock! *update-mut
ea50: 65 78 2a 29 0a 09 09 09 20 28 69 66 20 28 6e 6f ex*).... (if (no
ea60: 74 20 75 70 64 61 74 65 2d 69 73 2d 72 75 6e 6e t update-is-runn
ea70: 69 6e 67 29 0a 09 09 09 20 20 20 28 62 65 67 69 ing).... (begi
ea80: 6e 0a 09 09 09 20 20 20 20 20 28 64 61 73 68 62 n.... (dashb
ea90: 6f 61 72 64 3a 72 75 6e 2d 75 70 64 61 74 65 20 oard:run-update
eaa0: 78 29 0a 09 09 09 20 20 20 20 20 28 6d 75 74 65 x).... (mute
eab0: 78 2d 6c 6f 63 6b 21 20 2a 75 70 64 61 74 65 2d x-lock! *update-
eac0: 6d 75 74 65 78 2a 29 0a 09 09 09 20 20 20 20 20 mutex*)....
ead0: 28 73 65 74 21 20 2a 75 70 64 61 74 65 2d 69 73 (set! *update-is
eae0: 2d 72 75 6e 6e 69 6e 67 2a 20 23 66 29 0a 09 09 -running* #f)...
eaf0: 09 20 20 20 20 20 28 6d 75 74 65 78 2d 75 6e 6c . (mutex-unl
eb00: 6f 63 6b 21 20 2a 75 70 64 61 74 65 2d 6d 75 74 ock! *update-mut
eb10: 65 78 2a 29 29 29 29 0a 09 09 20 20 20 20 20 20 ex*))))...
eb20: 20 31 29 29 29 29 0a 0a 28 6c 65 74 20 28 28 74 1))))..(let ((t
eb30: 68 31 20 28 6d 61 6b 65 2d 74 68 72 65 61 64 20 h1 (make-thread
eb40: 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 20 20 (lambda ()....
eb50: 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 31 (thread-sleep! 1
eb60: 29 0a 09 09 09 20 20 28 73 65 74 21 20 2a 70 6c ).... (set! *pl
eb70: 65 61 73 65 2d 75 70 64 61 74 65 2d 62 75 74 74 ease-update-butt
eb80: 6f 6e 73 2a 20 23 74 29 0a 09 09 09 20 20 28 64 ons* #t).... (d
eb90: 61 73 68 62 6f 61 72 64 3a 72 75 6e 2d 75 70 64 ashboard:run-upd
eba0: 61 74 65 20 31 29 29 20 22 75 70 64 61 74 65 20 ate 1)) "update
ebb0: 62 75 74 74 6f 6e 73 20 6f 6e 63 65 22 29 29 0a buttons once")).
ebc0: 09 09 09 20 20 3b 3b 20 6e 65 65 64 20 74 6f 20 ... ;; need to
ebd0: 77 61 69 74 20 66 6f 72 20 66 69 72 73 74 20 2a wait for first *
ebe0: 75 70 64 61 74 65 2d 69 73 2d 72 75 6e 6e 69 6e update-is-runnin
ebf0: 67 2a 20 23 74 0a 09 09 09 20 20 3b 3b 20 28 6c g* #t.... ;; (l
ec00: 65 74 20 6c 6f 6f 70 20 28 29 0a 09 09 09 20 20 et loop ()....
ec10: 3b 3b 20 20 20 28 6d 75 74 65 78 2d 6c 6f 63 6b ;; (mutex-lock
ec20: 21 20 2a 75 70 64 61 74 65 2d 6d 75 74 65 78 2a ! *update-mutex*
ec30: 29 0a 09 09 09 20 20 3b 3b 20 20 20 28 69 66 20 ).... ;; (if
ec40: 2a 75 70 64 61 74 65 2d 69 73 2d 72 75 6e 6e 69 *update-is-runni
ec50: 6e 67 2a 0a 09 09 09 20 20 3b 3b 20 20 20 20 20 ng*.... ;;
ec60: 20 20 28 62 65 67 69 6e 0a 09 09 09 20 20 3b 3b (begin.... ;;
ec70: 20 20 20 20 20 20 20 20 20 28 73 65 74 21 20 2a (set! *
ec80: 70 6c 65 61 73 65 2d 75 70 64 61 74 65 2d 62 75 please-update-bu
ec90: 74 74 6f 6e 73 2a 20 23 74 29 0a 09 09 09 20 20 ttons* #t)....
eca0: 3b 3b 20 20 20 20 20 20 20 20 20 28 6d 61 72 6b ;; (mark
ecb0: 2d 66 6f 72 2d 75 70 64 61 74 65 29 0a 09 09 09 -for-update)....
ecc0: 20 20 3b 3b 20 20 20 20 20 20 20 20 20 28 70 72 ;; (pr
ecd0: 69 6e 74 20 22 44 69 64 20 72 65 64 72 61 77 20 int "Did redraw
ece0: 74 72 69 67 67 65 72 22 29 29 20 22 46 69 72 73 trigger")) "Firs
ecf0: 74 20 75 70 64 61 74 65 20 61 66 74 65 72 20 73 t update after s
ed00: 74 61 72 74 75 70 22 29 0a 09 09 09 20 20 3b 3b tartup").... ;;
ed10: 20 20 20 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b (mutex-unlock
ed20: 21 20 2a 75 70 64 61 74 65 2d 6d 75 74 65 78 2a ! *update-mutex*
ed30: 29 0a 09 09 09 20 20 3b 3b 20 20 20 28 74 68 72 ).... ;; (thr
ed40: 65 61 64 2d 73 6c 65 65 70 21 20 31 29 0a 09 09 ead-sleep! 1)...
ed50: 09 20 20 3b 3b 20 20 20 28 69 66 20 28 6e 6f 74 . ;; (if (not
ed60: 20 2a 70 6c 65 61 73 65 2d 75 70 64 61 74 65 2d *please-update-
ed70: 62 75 74 74 6f 6e 73 2a 29 0a 09 09 09 20 20 3b buttons*).... ;
ed80: 3b 20 20 20 20 20 20 20 28 6c 6f 6f 70 29 29 29 ; (loop)))
ed90: 29 29 29 0a 20 20 20 20 20 20 28 74 68 32 20 28 ))). (th2 (
eda0: 6d 61 6b 65 2d 74 68 72 65 61 64 20 69 75 70 3a make-thread iup:
edb0: 6d 61 69 6e 2d 6c 6f 6f 70 20 22 4d 61 69 6e 20 main-loop "Main
edc0: 6c 6f 6f 70 22 29 29 29 0a 20 20 28 74 68 72 65 loop"))). (thre
edd0: 61 64 2d 73 74 61 72 74 21 20 74 68 31 29 0a 20 ad-start! th1).
ede0: 20 28 74 68 72 65 61 64 2d 73 74 61 72 74 21 20 (thread-start!
edf0: 74 68 32 29 0a 20 20 28 74 68 72 65 61 64 2d 6a th2). (thread-j
ee00: 6f 69 6e 21 20 74 68 32 29 29 0a 0a 3b 3b 20 28 oin! th2))..;; (
ee10: 69 75 70 3a 6d 61 69 6e 2d 6c 6f 6f 70 29 28 64 iup:main-loop)(d
ee20: 62 3a 63 6c 6f 73 65 2d 61 6c 6c 20 2a 64 62 73 b:close-all *dbs
ee30: 74 72 75 63 74 2d 6c 6f 63 61 6c 2a 29 0a truct-local*).