Artifact
ea99b44dfd6a6586c0d3fc7d88bf0dc51be6d4b8:
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 33 2c right 2006-2013,
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 28 75 73 65 20 63 up iup:)).(use c
0220: 61 6e 76 61 73 2d 64 72 61 77 29 0a 28 75 73 65 anvas-draw).(use
0230: 20 72 65 67 65 78 29 0a 0a 28 64 65 63 6c 61 72 regex)..(declar
0240: 65 20 28 75 6e 69 74 20 64 63 6f 6d 6d 6f 6e 29 e (unit dcommon)
0250: 29 0a 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 )..(declare (use
0260: 73 20 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 s megatest-versi
0270: 6f 6e 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 on)).(declare (u
0280: 73 65 73 20 67 75 74 69 6c 73 29 29 0a 28 64 65 ses gutils)).(de
0290: 63 6c 61 72 65 20 28 75 73 65 73 20 64 62 29 29 clare (uses db))
02a0: 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 .(declare (uses
02b0: 73 79 6e 63 68 61 73 68 29 29 0a 0a 28 69 6e 63 synchash))..(inc
02c0: 6c 75 64 65 20 22 63 6f 6d 6d 6f 6e 5f 72 65 63 lude "common_rec
02d0: 6f 72 64 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c ords.scm").(incl
02e0: 75 64 65 20 22 64 62 5f 72 65 63 6f 72 64 73 2e ude "db_records.
02f0: 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 scm").(include "
0300: 6b 65 79 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 key_records.scm"
0310: 29 0a 0a 3b 3b 20 79 65 73 2c 20 74 68 69 73 20 )..;; yes, this
0320: 69 73 20 6e 6f 6e 2d 69 64 65 61 6c 20 0a 28 64 is non-ideal .(d
0330: 65 66 69 6e 65 20 64 61 73 68 62 6f 61 72 64 3a efine dashboard:
0340: 75 70 64 61 74 65 2d 73 75 6d 6d 61 72 79 2d 74 update-summary-t
0350: 61 62 20 23 66 29 0a 28 64 65 66 69 6e 65 20 64 ab #f).(define d
0360: 61 73 68 62 6f 61 72 64 3a 75 70 64 61 74 65 2d ashboard:update-
0370: 73 65 72 76 65 72 73 2d 74 61 62 6c 65 20 23 66 servers-table #f
0380: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
0390: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 43 ===========.;; C
03d0: 20 4f 20 4d 20 4d 20 4f 20 4e 20 20 20 44 20 41 O M M O N D A
03e0: 20 54 20 41 20 20 20 53 20 54 20 52 20 55 20 43 T A S T R U C
03f0: 20 54 20 55 20 52 20 45 0a 3b 3b 3d 3d 3d 3d 3d T U R E.;;=====
0400: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0410: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0420: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0430: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0440: 3d 0a 3b 3b 20 0a 3b 3b 20 41 20 73 69 6e 67 6c =.;; .;; A singl
0450: 65 20 64 61 74 61 20 73 74 72 75 63 74 75 72 65 e data structure
0460: 20 66 6f 72 20 61 6c 6c 20 74 68 65 20 64 61 74 for all the dat
0470: 61 20 75 73 65 64 20 69 6e 20 61 20 64 61 73 68 a used in a dash
0480: 62 6f 61 72 64 2e 0a 3b 3b 20 53 68 61 72 65 20 board..;; Share
0490: 74 68 69 73 20 73 74 72 75 63 74 75 72 65 20 62 this structure b
04a0: 65 74 77 65 65 6e 20 6e 65 77 64 61 73 68 62 6f etween newdashbo
04b0: 61 72 64 20 61 6e 64 20 64 61 73 68 62 6f 61 72 ard and dashboar
04c0: 64 20 77 69 74 68 20 74 68 65 20 0a 3b 3b 20 69 d with the .;; i
04d0: 6e 74 65 6e 74 20 6f 66 20 63 6f 6e 76 65 72 67 ntent of converg
04e0: 69 6e 67 20 6f 6e 20 61 20 73 69 6e 67 6c 65 20 ing on a single
04f0: 61 70 70 2e 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 app..;;.(define
0500: 2a 64 61 74 61 2a 20 28 6d 61 6b 65 2d 76 65 63 *data* (make-vec
0510: 74 6f 72 20 32 35 20 23 66 29 29 0a 28 64 65 66 tor 25 #f)).(def
0520: 69 6e 65 20 28 64 62 6f 61 72 64 3a 64 61 74 61 ine (dboard:data
0530: 2d 67 65 74 2d 72 75 6e 73 20 20 20 20 20 20 20 -get-runs
0540: 20 20 20 76 65 63 29 20 20 20 20 28 76 65 63 74 vec) (vect
0550: 6f 72 2d 72 65 66 20 20 76 65 63 20 30 29 29 0a or-ref vec 0)).
0560: 28 64 65 66 69 6e 65 20 28 64 62 6f 61 72 64 3a (define (dboard:
0570: 64 61 74 61 2d 67 65 74 2d 74 65 73 74 73 20 20 data-get-tests
0580: 20 20 20 20 20 20 20 76 65 63 29 20 20 20 20 28 vec) (
0590: 76 65 63 74 6f 72 2d 72 65 66 20 20 76 65 63 20 vector-ref vec
05a0: 31 29 29 0a 28 64 65 66 69 6e 65 20 28 64 62 6f 1)).(define (dbo
05b0: 61 72 64 3a 64 61 74 61 2d 67 65 74 2d 72 75 6e ard:data-get-run
05c0: 73 2d 6d 61 74 72 69 78 20 20 20 76 65 63 29 20 s-matrix vec)
05d0: 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 20 (vector-ref
05e0: 76 65 63 20 32 29 29 0a 28 64 65 66 69 6e 65 20 vec 2)).(define
05f0: 28 64 62 6f 61 72 64 3a 64 61 74 61 2d 67 65 74 (dboard:data-get
0600: 2d 74 65 73 74 73 2d 74 72 65 65 20 20 20 20 76 -tests-tree v
0610: 65 63 29 20 20 20 20 28 76 65 63 74 6f 72 2d 72 ec) (vector-r
0620: 65 66 20 20 76 65 63 20 33 29 29 0a 28 64 65 66 ef vec 3)).(def
0630: 69 6e 65 20 28 64 62 6f 61 72 64 3a 64 61 74 61 ine (dboard:data
0640: 2d 67 65 74 2d 72 75 6e 2d 6b 65 79 73 20 20 20 -get-run-keys
0650: 20 20 20 76 65 63 29 20 20 20 20 28 76 65 63 74 vec) (vect
0660: 6f 72 2d 72 65 66 20 20 76 65 63 20 34 29 29 0a or-ref vec 4)).
0670: 28 64 65 66 69 6e 65 20 28 64 62 6f 61 72 64 3a (define (dboard:
0680: 64 61 74 61 2d 67 65 74 2d 63 75 72 72 2d 74 65 data-get-curr-te
0690: 73 74 2d 69 64 73 20 76 65 63 29 20 20 20 20 28 st-ids vec) (
06a0: 76 65 63 74 6f 72 2d 72 65 66 20 20 76 65 63 20 vector-ref vec
06b0: 35 29 29 0a 3b 3b 20 28 64 65 66 69 6e 65 20 28 5)).;; (define (
06c0: 64 62 6f 61 72 64 3a 64 61 74 61 2d 67 65 74 2d dboard:data-get-
06d0: 74 65 73 74 2d 64 65 74 61 69 6c 73 20 20 76 65 test-details ve
06e0: 63 29 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 c) (vector-re
06f0: 66 20 20 76 65 63 20 36 29 29 0a 28 64 65 66 69 f vec 6)).(defi
0700: 6e 65 20 28 64 62 6f 61 72 64 3a 64 61 74 61 2d ne (dboard:data-
0710: 67 65 74 2d 70 61 74 68 2d 74 65 73 74 2d 69 64 get-path-test-id
0720: 73 20 76 65 63 29 20 20 20 20 28 76 65 63 74 6f s vec) (vecto
0730: 72 2d 72 65 66 20 20 76 65 63 20 37 29 29 0a 28 r-ref vec 7)).(
0740: 64 65 66 69 6e 65 20 28 64 62 6f 61 72 64 3a 64 define (dboard:d
0750: 61 74 61 2d 67 65 74 2d 75 70 64 61 74 65 72 73 ata-get-updaters
0760: 20 20 20 20 20 20 76 65 63 29 20 20 20 20 28 76 vec) (v
0770: 65 63 74 6f 72 2d 72 65 66 20 20 76 65 63 20 38 ector-ref vec 8
0780: 29 29 0a 28 64 65 66 69 6e 65 20 28 64 62 6f 61 )).(define (dboa
0790: 72 64 3a 64 61 74 61 2d 67 65 74 2d 70 61 74 68 rd:data-get-path
07a0: 2d 72 75 6e 2d 69 64 73 20 20 76 65 63 29 20 20 -run-ids vec)
07b0: 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 20 76 (vector-ref v
07c0: 65 63 20 39 29 29 0a 28 64 65 66 69 6e 65 20 28 ec 9)).(define (
07d0: 64 62 6f 61 72 64 3a 64 61 74 61 2d 67 65 74 2d dboard:data-get-
07e0: 63 75 72 72 2d 72 75 6e 2d 69 64 20 20 20 76 65 curr-run-id ve
07f0: 63 29 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 c) (vector-re
0800: 66 20 20 76 65 63 20 31 30 29 29 0a 28 64 65 66 f vec 10)).(def
0810: 69 6e 65 20 28 64 62 6f 61 72 64 3a 64 61 74 61 ine (dboard:data
0820: 2d 67 65 74 2d 72 75 6e 73 2d 74 72 65 65 20 20 -get-runs-tree
0830: 20 20 20 76 65 63 29 20 20 20 20 28 76 65 63 74 vec) (vect
0840: 6f 72 2d 72 65 66 20 20 76 65 63 20 31 31 29 29 or-ref vec 11))
0850: 0a 3b 3b 20 46 6f 72 20 74 65 73 74 2d 70 61 74 .;; For test-pat
0860: 74 73 20 63 6f 6e 76 65 72 74 20 23 66 20 74 6f ts convert #f to
0870: 20 22 22 0a 28 64 65 66 69 6e 65 20 28 64 62 6f "".(define (dbo
0880: 61 72 64 3a 64 61 74 61 2d 67 65 74 2d 74 65 73 ard:data-get-tes
0890: 74 2d 70 61 74 74 73 20 20 20 20 76 65 63 29 20 t-patts vec)
08a0: 20 20 20 0a 20 20 28 6c 65 74 20 28 28 76 61 6c . (let ((val
08b0: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 20 76 65 (vector-ref ve
08c0: 63 20 31 32 29 29 29 28 69 66 20 76 61 6c 20 76 c 12)))(if val v
08d0: 61 6c 20 22 22 29 29 29 0a 28 64 65 66 69 6e 65 al ""))).(define
08e0: 20 28 64 62 6f 61 72 64 3a 64 61 74 61 2d 67 65 (dboard:data-ge
08f0: 74 2d 73 74 61 74 65 73 20 20 20 20 20 20 20 20 t-states
0900: 76 65 63 29 20 20 20 20 28 76 65 63 74 6f 72 2d vec) (vector-
0910: 72 65 66 20 76 65 63 20 31 33 29 29 0a 28 64 65 ref vec 13)).(de
0920: 66 69 6e 65 20 28 64 62 6f 61 72 64 3a 64 61 74 fine (dboard:dat
0930: 61 2d 67 65 74 2d 73 74 61 74 75 73 65 73 20 20 a-get-statuses
0940: 20 20 20 20 76 65 63 29 20 20 20 20 28 76 65 63 vec) (vec
0950: 74 6f 72 2d 72 65 66 20 76 65 63 20 31 34 29 29 tor-ref vec 14))
0960: 0a 28 64 65 66 69 6e 65 20 28 64 62 6f 61 72 64 .(define (dboard
0970: 3a 64 61 74 61 2d 67 65 74 2d 6c 6f 67 73 2d 74 :data-get-logs-t
0980: 65 78 74 62 6f 78 20 20 76 65 63 20 76 61 6c 29 extbox vec val)
0990: 28 76 65 63 74 6f 72 2d 72 65 66 20 76 65 63 20 (vector-ref vec
09a0: 31 35 29 29 0a 28 64 65 66 69 6e 65 20 28 64 62 15)).(define (db
09b0: 6f 61 72 64 3a 64 61 74 61 2d 67 65 74 2d 63 6f oard:data-get-co
09c0: 6d 6d 61 6e 64 20 20 20 20 20 20 20 76 65 63 29 mmand vec)
09d0: 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 (vector-ref
09e0: 76 65 63 20 31 36 29 29 0a 28 64 65 66 69 6e 65 vec 16)).(define
09f0: 20 28 64 62 6f 61 72 64 3a 64 61 74 61 2d 67 65 (dboard:data-ge
0a00: 74 2d 63 6f 6d 6d 61 6e 64 2d 74 62 20 20 20 20 t-command-tb
0a10: 76 65 63 29 20 20 20 20 28 76 65 63 74 6f 72 2d vec) (vector-
0a20: 72 65 66 20 76 65 63 20 31 37 29 29 0a 28 64 65 ref vec 17)).(de
0a30: 66 69 6e 65 20 28 64 62 6f 61 72 64 3a 64 61 74 fine (dboard:dat
0a40: 61 2d 67 65 74 2d 74 61 72 67 65 74 20 20 20 20 a-get-target
0a50: 20 20 20 20 76 65 63 29 20 20 20 20 28 76 65 63 vec) (vec
0a60: 74 6f 72 2d 72 65 66 20 76 65 63 20 31 38 29 29 tor-ref vec 18))
0a70: 0a 28 64 65 66 69 6e 65 20 28 64 62 6f 61 72 64 .(define (dboard
0a80: 3a 64 61 74 61 2d 67 65 74 2d 74 61 72 67 65 74 :data-get-target
0a90: 2d 73 74 72 69 6e 67 20 76 65 63 29 0a 20 20 28 -string vec). (
0aa0: 6c 65 74 20 28 28 74 61 72 67 20 28 64 62 6f 61 let ((targ (dboa
0ab0: 72 64 3a 64 61 74 61 2d 67 65 74 2d 74 61 72 67 rd:data-get-targ
0ac0: 65 74 20 76 65 63 29 29 29 0a 20 20 20 20 28 69 et vec))). (i
0ad0: 66 20 28 6c 69 73 74 3f 20 74 61 72 67 29 28 73 f (list? targ)(s
0ae0: 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 tring-interspers
0af0: 65 20 74 61 72 67 20 22 2f 22 29 20 22 6e 6f 2d e targ "/") "no-
0b00: 74 61 72 67 65 74 2d 73 70 65 63 69 66 69 65 64 target-specified
0b10: 22 29 29 29 0a 28 64 65 66 69 6e 65 20 28 64 62 "))).(define (db
0b20: 6f 61 72 64 3a 64 61 74 61 2d 67 65 74 2d 72 75 oard:data-get-ru
0b30: 6e 2d 6e 61 6d 65 20 20 20 20 20 20 76 65 63 29 n-name vec)
0b40: 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 (vector-ref
0b50: 76 65 63 20 31 39 29 29 0a 28 64 65 66 69 6e 65 vec 19)).(define
0b60: 20 28 64 62 6f 61 72 64 3a 64 61 74 61 2d 67 65 (dboard:data-ge
0b70: 74 2d 72 75 6e 73 2d 6c 69 73 74 62 6f 78 20 20 t-runs-listbox
0b80: 76 65 63 29 20 20 20 20 28 76 65 63 74 6f 72 2d vec) (vector-
0b90: 72 65 66 20 76 65 63 20 32 30 29 29 0a 0a 28 64 ref vec 20))..(d
0ba0: 65 66 69 6e 65 20 28 64 62 6f 61 72 64 3a 64 61 efine (dboard:da
0bb0: 74 61 2d 73 65 74 2d 72 75 6e 73 21 20 20 20 20 ta-set-runs!
0bc0: 20 20 20 20 20 20 76 65 63 20 76 61 6c 29 28 76 vec val)(v
0bd0: 65 63 74 6f 72 2d 73 65 74 21 20 76 65 63 20 30 ector-set! vec 0
0be0: 20 76 61 6c 29 29 0a 28 64 65 66 69 6e 65 20 28 val)).(define (
0bf0: 64 62 6f 61 72 64 3a 64 61 74 61 2d 73 65 74 2d dboard:data-set-
0c00: 74 65 73 74 73 21 20 20 20 20 20 20 20 20 20 76 tests! v
0c10: 65 63 20 76 61 6c 29 28 76 65 63 74 6f 72 2d 73 ec val)(vector-s
0c20: 65 74 21 20 76 65 63 20 31 20 76 61 6c 29 29 0a et! vec 1 val)).
0c30: 28 64 65 66 69 6e 65 20 28 64 62 6f 61 72 64 3a (define (dboard:
0c40: 64 61 74 61 2d 73 65 74 2d 72 75 6e 73 2d 6d 61 data-set-runs-ma
0c50: 74 72 69 78 21 20 20 20 76 65 63 20 76 61 6c 29 trix! vec val)
0c60: 28 76 65 63 74 6f 72 2d 73 65 74 21 20 76 65 63 (vector-set! vec
0c70: 20 32 20 76 61 6c 29 29 0a 28 64 65 66 69 6e 65 2 val)).(define
0c80: 20 28 64 62 6f 61 72 64 3a 64 61 74 61 2d 73 65 (dboard:data-se
0c90: 74 2d 74 65 73 74 73 2d 74 72 65 65 21 20 20 20 t-tests-tree!
0ca0: 20 76 65 63 20 76 61 6c 29 28 76 65 63 74 6f 72 vec val)(vector
0cb0: 2d 73 65 74 21 20 76 65 63 20 33 20 76 61 6c 29 -set! vec 3 val)
0cc0: 29 0a 28 64 65 66 69 6e 65 20 28 64 62 6f 61 72 ).(define (dboar
0cd0: 64 3a 64 61 74 61 2d 73 65 74 2d 72 75 6e 2d 6b d:data-set-run-k
0ce0: 65 79 73 21 20 20 20 20 20 20 76 65 63 20 76 61 eys! vec va
0cf0: 6c 29 28 76 65 63 74 6f 72 2d 73 65 74 21 20 76 l)(vector-set! v
0d00: 65 63 20 34 20 76 61 6c 29 29 0a 28 64 65 66 69 ec 4 val)).(defi
0d10: 6e 65 20 28 64 62 6f 61 72 64 3a 64 61 74 61 2d ne (dboard:data-
0d20: 73 65 74 2d 63 75 72 72 2d 74 65 73 74 2d 69 64 set-curr-test-id
0d30: 73 21 20 76 65 63 20 76 61 6c 29 28 76 65 63 74 s! vec val)(vect
0d40: 6f 72 2d 73 65 74 21 20 76 65 63 20 35 20 76 61 or-set! vec 5 va
0d50: 6c 29 29 0a 3b 3b 20 28 64 65 66 69 6e 65 20 28 l)).;; (define (
0d60: 64 62 6f 61 72 64 3a 64 61 74 61 2d 73 65 74 2d dboard:data-set-
0d70: 74 65 73 74 2d 64 65 74 61 69 6c 73 21 20 20 76 test-details! v
0d80: 65 63 20 76 61 6c 29 28 76 65 63 74 6f 72 2d 73 ec val)(vector-s
0d90: 65 74 21 20 76 65 63 20 36 20 76 61 6c 29 29 0a et! vec 6 val)).
0da0: 28 64 65 66 69 6e 65 20 28 64 62 6f 61 72 64 3a (define (dboard:
0db0: 64 61 74 61 2d 73 65 74 2d 70 61 74 68 2d 74 65 data-set-path-te
0dc0: 73 74 2d 69 64 73 21 20 76 65 63 20 76 61 6c 29 st-ids! vec val)
0dd0: 28 76 65 63 74 6f 72 2d 73 65 74 21 20 76 65 63 (vector-set! vec
0de0: 20 37 20 76 61 6c 29 29 0a 28 64 65 66 69 6e 65 7 val)).(define
0df0: 20 28 64 62 6f 61 72 64 3a 64 61 74 61 2d 73 65 (dboard:data-se
0e00: 74 2d 75 70 64 61 74 65 72 73 21 20 20 20 20 20 t-updaters!
0e10: 20 76 65 63 20 76 61 6c 29 28 76 65 63 74 6f 72 vec val)(vector
0e20: 2d 73 65 74 21 20 76 65 63 20 38 20 76 61 6c 29 -set! vec 8 val)
0e30: 29 0a 28 64 65 66 69 6e 65 20 28 64 62 6f 61 72 ).(define (dboar
0e40: 64 3a 64 61 74 61 2d 73 65 74 2d 70 61 74 68 2d d:data-set-path-
0e50: 72 75 6e 2d 69 64 73 21 20 20 76 65 63 20 76 61 run-ids! vec va
0e60: 6c 29 28 76 65 63 74 6f 72 2d 73 65 74 21 20 76 l)(vector-set! v
0e70: 65 63 20 39 20 76 61 6c 29 29 0a 28 64 65 66 69 ec 9 val)).(defi
0e80: 6e 65 20 28 64 62 6f 61 72 64 3a 64 61 74 61 2d ne (dboard:data-
0e90: 73 65 74 2d 63 75 72 72 2d 72 75 6e 2d 69 64 21 set-curr-run-id!
0ea0: 20 20 20 76 65 63 20 76 61 6c 29 28 76 65 63 74 vec val)(vect
0eb0: 6f 72 2d 73 65 74 21 20 76 65 63 20 31 30 20 76 or-set! vec 10 v
0ec0: 61 6c 29 29 0a 28 64 65 66 69 6e 65 20 28 64 62 al)).(define (db
0ed0: 6f 61 72 64 3a 64 61 74 61 2d 73 65 74 2d 72 75 oard:data-set-ru
0ee0: 6e 73 2d 74 72 65 65 21 20 20 20 20 20 76 65 63 ns-tree! vec
0ef0: 20 76 61 6c 29 28 76 65 63 74 6f 72 2d 73 65 74 val)(vector-set
0f00: 21 20 76 65 63 20 31 31 20 76 61 6c 29 29 0a 3b ! vec 11 val)).;
0f10: 3b 20 46 6f 72 20 74 65 73 74 2d 70 61 74 74 73 ; For test-patts
0f20: 20 63 6f 6e 76 65 72 74 20 22 22 20 74 6f 20 23 convert "" to #
0f30: 66 20 0a 28 64 65 66 69 6e 65 20 28 64 62 6f 61 f .(define (dboa
0f40: 72 64 3a 64 61 74 61 2d 73 65 74 2d 74 65 73 74 rd:data-set-test
0f50: 2d 70 61 74 74 73 21 20 20 20 20 76 65 63 20 76 -patts! vec v
0f60: 61 6c 29 0a 20 20 28 76 65 63 74 6f 72 2d 73 65 al). (vector-se
0f70: 74 21 20 76 65 63 20 31 32 20 28 69 66 20 28 65 t! vec 12 (if (e
0f80: 71 75 61 6c 3f 20 76 61 6c 20 22 22 29 20 23 66 qual? val "") #f
0f90: 20 76 61 6c 29 29 29 0a 28 64 65 66 69 6e 65 20 val))).(define
0fa0: 28 64 62 6f 61 72 64 3a 64 61 74 61 2d 73 65 74 (dboard:data-set
0fb0: 2d 73 74 61 74 65 73 21 20 20 20 20 20 20 20 20 -states!
0fc0: 76 65 63 20 76 61 6c 29 28 76 65 63 74 6f 72 2d vec val)(vector-
0fd0: 73 65 74 21 20 76 65 63 20 31 33 20 76 61 6c 29 set! vec 13 val)
0fe0: 29 0a 28 64 65 66 69 6e 65 20 28 64 62 6f 61 72 ).(define (dboar
0ff0: 64 3a 64 61 74 61 2d 73 65 74 2d 73 74 61 74 75 d:data-set-statu
1000: 73 65 73 21 20 20 20 20 20 20 76 65 63 20 76 61 ses! vec va
1010: 6c 29 28 76 65 63 74 6f 72 2d 73 65 74 21 20 76 l)(vector-set! v
1020: 65 63 20 31 34 20 76 61 6c 29 29 0a 28 64 65 66 ec 14 val)).(def
1030: 69 6e 65 20 28 64 62 6f 61 72 64 3a 64 61 74 61 ine (dboard:data
1040: 2d 73 65 74 2d 6c 6f 67 73 2d 74 65 78 74 62 6f -set-logs-textbo
1050: 78 21 20 20 76 65 63 20 76 61 6c 29 28 76 65 63 x! vec val)(vec
1060: 74 6f 72 2d 73 65 74 21 20 76 65 63 20 31 35 20 tor-set! vec 15
1070: 76 61 6c 29 29 0a 28 64 65 66 69 6e 65 20 28 64 val)).(define (d
1080: 62 6f 61 72 64 3a 64 61 74 61 2d 73 65 74 2d 63 board:data-set-c
1090: 6f 6d 6d 61 6e 64 21 20 20 20 20 20 20 20 76 65 ommand! ve
10a0: 63 20 76 61 6c 29 28 76 65 63 74 6f 72 2d 73 65 c val)(vector-se
10b0: 74 21 20 76 65 63 20 31 36 20 76 61 6c 29 29 0a t! vec 16 val)).
10c0: 28 64 65 66 69 6e 65 20 28 64 62 6f 61 72 64 3a (define (dboard:
10d0: 64 61 74 61 2d 73 65 74 2d 63 6f 6d 6d 61 6e 64 data-set-command
10e0: 2d 74 62 21 20 20 20 20 76 65 63 20 76 61 6c 29 -tb! vec val)
10f0: 28 76 65 63 74 6f 72 2d 73 65 74 21 20 76 65 63 (vector-set! vec
1100: 20 31 37 20 76 61 6c 29 29 0a 28 64 65 66 69 6e 17 val)).(defin
1110: 65 20 28 64 62 6f 61 72 64 3a 64 61 74 61 2d 73 e (dboard:data-s
1120: 65 74 2d 74 61 72 67 65 74 21 20 20 20 20 20 20 et-target!
1130: 20 20 76 65 63 20 76 61 6c 29 28 76 65 63 74 6f vec val)(vecto
1140: 72 2d 73 65 74 21 20 76 65 63 20 31 38 20 76 61 r-set! vec 18 va
1150: 6c 29 29 0a 28 64 65 66 69 6e 65 20 28 64 62 6f l)).(define (dbo
1160: 61 72 64 3a 64 61 74 61 2d 73 65 74 2d 72 75 6e ard:data-set-run
1170: 2d 6e 61 6d 65 21 20 20 20 20 20 20 76 65 63 20 -name! vec
1180: 76 61 6c 29 28 76 65 63 74 6f 72 2d 73 65 74 21 val)(vector-set!
1190: 20 76 65 63 20 31 39 20 76 61 6c 29 29 0a 28 64 vec 19 val)).(d
11a0: 65 66 69 6e 65 20 28 64 62 6f 61 72 64 3a 64 61 efine (dboard:da
11b0: 74 61 2d 73 65 74 2d 72 75 6e 73 2d 6c 69 73 74 ta-set-runs-list
11c0: 62 6f 78 21 20 20 76 65 63 20 76 61 6c 29 28 76 box! vec val)(v
11d0: 65 63 74 6f 72 2d 73 65 74 21 20 76 65 63 20 32 ector-set! vec 2
11e0: 30 20 76 61 6c 29 29 0a 0a 28 64 62 6f 61 72 64 0 val))..(dboard
11f0: 3a 64 61 74 61 2d 73 65 74 2d 72 75 6e 2d 6b 65 :data-set-run-ke
1200: 79 73 21 20 2a 64 61 74 61 2a 20 28 6d 61 6b 65 ys! *data* (make
1210: 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a 0a 3b -hash-table))..;
1220: 3b 20 4c 69 73 74 20 6f 66 20 74 65 73 74 20 69 ; List of test i
1230: 64 73 20 62 65 69 6e 67 20 76 69 65 77 65 64 20 ds being viewed
1240: 69 6e 20 76 61 72 69 6f 75 73 20 70 61 6e 65 6c in various panel
1250: 73 0a 28 64 62 6f 61 72 64 3a 64 61 74 61 2d 73 s.(dboard:data-s
1260: 65 74 2d 63 75 72 72 2d 74 65 73 74 2d 69 64 73 et-curr-test-ids
1270: 21 20 2a 64 61 74 61 2a 20 28 6d 61 6b 65 2d 68 ! *data* (make-h
1280: 61 73 68 2d 74 61 62 6c 65 29 29 0a 0a 3b 3b 20 ash-table))..;;
1290: 4c 6f 6f 6b 20 75 70 20 74 65 73 74 2d 69 64 73 Look up test-ids
12a0: 20 62 79 20 28 6b 65 79 31 20 6b 65 79 32 20 2e by (key1 key2 .
12b0: 2e 2e 20 74 65 73 74 6e 61 6d 65 20 5b 69 74 65 .. testname [ite
12c0: 6d 70 61 74 68 5d 29 0a 28 64 62 6f 61 72 64 3a mpath]).(dboard:
12d0: 64 61 74 61 2d 73 65 74 2d 70 61 74 68 2d 74 65 data-set-path-te
12e0: 73 74 2d 69 64 73 21 20 2a 64 61 74 61 2a 20 28 st-ids! *data* (
12f0: 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 make-hash-table)
1300: 29 0a 0a 3b 3b 20 4c 6f 6f 6b 20 75 70 20 72 75 )..;; Look up ru
1310: 6e 2d 69 64 73 20 62 79 20 3f 3f 0a 28 64 62 6f n-ids by ??.(dbo
1320: 61 72 64 3a 64 61 74 61 2d 73 65 74 2d 70 61 74 ard:data-set-pat
1330: 68 2d 72 75 6e 2d 69 64 73 21 20 2a 64 61 74 61 h-run-ids! *data
1340: 2a 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 * (make-hash-tab
1350: 6c 65 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d le))..;;========
1360: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1370: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1380: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1390: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
13a0: 3b 20 54 41 52 47 45 54 20 41 4e 44 20 50 41 54 ; TARGET AND PAT
13b0: 54 45 52 4e 20 4d 41 4e 49 50 55 4c 41 54 49 4f TERN MANIPULATIO
13c0: 4e 53 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d NS.;;===========
13d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1400: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 ===========..;;
1410: 43 6f 6e 76 65 72 74 20 74 6f 20 61 6e 64 20 66 Convert to and f
1420: 72 6f 6d 20 6c 69 73 74 20 6f 66 20 6c 69 6e 65 rom list of line
1430: 73 20 28 66 6f 72 20 61 20 74 65 78 74 20 62 6f s (for a text bo
1440: 78 29 0a 3b 3b 20 22 2c 22 20 3d 3e 20 22 5c 6e x).;; "," => "\n
1450: 22 0a 28 64 65 66 69 6e 65 20 28 64 62 6f 61 72 ".(define (dboar
1460: 64 3a 74 65 73 74 2d 70 61 74 74 2d 3e 6c 69 6e d:test-patt->lin
1470: 65 73 20 74 65 73 74 2d 70 61 74 74 29 0a 20 20 es test-patt).
1480: 28 73 74 72 69 6e 67 2d 73 75 62 73 74 69 74 75 (string-substitu
1490: 74 65 20 28 72 65 67 65 78 70 20 22 2c 22 29 20 te (regexp ",")
14a0: 22 5c 6e 22 20 74 65 73 74 2d 70 61 74 74 29 29 "\n" test-patt))
14b0: 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 6f 61 72 ..(define (dboar
14c0: 64 3a 6c 69 6e 65 73 2d 3e 74 65 73 74 2d 70 61 d:lines->test-pa
14d0: 74 74 20 6c 69 6e 65 73 29 0a 20 20 28 73 74 72 tt lines). (str
14e0: 69 6e 67 2d 73 75 62 73 74 69 74 75 74 65 20 28 ing-substitute (
14f0: 72 65 67 65 78 70 20 22 5c 6e 22 29 20 22 2c 22 regexp "\n") ","
1500: 20 6c 69 6e 65 73 20 23 74 29 29 0a 0a 0a 3b 3b lines #t))...;;
1510: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1520: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1530: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1540: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1550: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 50 20 52 20 4f 20 ======.;; P R O
1560: 43 20 45 20 53 20 53 20 20 20 52 20 55 20 4e 20 C E S S R U N
1570: 53 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d S.;;============
1580: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1590: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 4d ==========..;; M
15c0: 4f 56 45 20 54 48 49 53 20 49 4e 54 4f 20 2a 64 OVE THIS INTO *d
15d0: 61 74 61 2a 0a 28 64 65 66 69 6e 65 20 2a 63 61 ata*.(define *ca
15e0: 63 68 65 64 61 74 61 2a 20 28 6d 61 6b 65 2d 68 chedata* (make-h
15f0: 61 73 68 2d 74 61 62 6c 65 29 29 0a 28 68 61 73 ash-table)).(has
1600: 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a 63 61 h-table-set! *ca
1610: 63 68 65 64 61 74 61 2a 20 22 72 75 6e 69 64 2d chedata* "runid-
1620: 74 6f 2d 63 6f 6c 22 20 20 20 20 28 6d 61 6b 65 to-col" (make
1630: 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a 28 68 -hash-table)).(h
1640: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a ash-table-set! *
1650: 63 61 63 68 65 64 61 74 61 2a 20 22 74 65 73 74 cachedata* "test
1660: 6e 61 6d 65 2d 74 6f 2d 72 6f 77 22 20 28 6d 61 name-to-row" (ma
1670: 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a ke-hash-table)).
1680: 0a 3b 3b 20 54 4f 2d 44 4f 0a 3b 3b 20 20 31 2e .;; TO-DO.;; 1.
1690: 20 4d 61 6b 65 20 22 64 61 74 61 22 20 68 61 73 Make "data" has
16a0: 68 2d 74 61 62 6c 65 20 68 69 65 72 61 72 63 68 h-table hierarch
16b0: 69 61 6c 20 73 74 6f 72 65 20 6f 66 20 61 6c 6c ial store of all
16c0: 20 64 69 73 70 6c 61 79 65 64 20 64 61 74 61 0a displayed data.
16d0: 3b 3b 20 20 32 2e 20 55 70 64 61 74 65 20 73 79 ;; 2. Update sy
16e0: 6e 63 68 61 73 68 20 74 6f 20 75 6e 64 65 72 73 nchash to unders
16f0: 74 61 6e 64 20 22 67 65 74 2d 72 75 6e 73 22 2c tand "get-runs",
1700: 20 22 67 65 74 2d 74 65 73 74 73 22 20 65 74 63 "get-tests" etc
1710: 2e 0a 3b 3b 20 20 33 2e 20 41 64 64 20 65 78 74 ..;; 3. Add ext
1720: 72 61 63 74 69 6f 6e 20 6f 66 20 66 69 6c 74 65 raction of filte
1730: 72 73 20 74 6f 20 73 79 6e 63 68 61 73 68 20 63 rs to synchash c
1740: 61 6c 6c 73 0a 3b 3b 0a 3b 3b 20 4d 6f 64 65 20 alls.;;.;; Mode
1750: 69 73 20 27 66 75 6c 6c 20 6f 72 20 27 69 6e 63 is 'full or 'inc
1760: 72 65 6d 65 6e 74 61 6c 20 66 6f 72 20 66 75 6c remental for ful
1770: 6c 20 72 65 66 72 65 73 68 20 6f 72 20 69 6e 63 l refresh or inc
1780: 72 65 6d 65 6e 74 61 6c 20 72 65 66 72 65 73 68 remental refresh
1790: 0a 28 64 65 66 69 6e 65 20 28 64 63 6f 6d 6d 6f .(define (dcommo
17a0: 6e 3a 72 75 6e 2d 75 70 64 61 74 65 20 6b 65 79 n:run-update key
17b0: 73 20 64 61 74 61 20 72 75 6e 6e 61 6d 65 20 6b s data runname k
17c0: 65 79 70 61 74 74 73 20 74 65 73 74 70 61 74 74 eypatts testpatt
17d0: 20 73 74 61 74 65 73 20 73 74 61 74 75 73 65 73 states statuses
17e0: 20 6d 6f 64 65 20 77 69 6e 64 6f 77 2d 69 64 29 mode window-id)
17f0: 0a 20 20 28 6c 65 74 2a 20 28 3b 3b 20 63 6f 75 . (let* (;; cou
1800: 6e 74 20 61 6e 64 20 6f 66 66 73 65 74 20 3d 3e nt and offset =>
1810: 20 23 66 20 73 6f 20 6e 6f 74 20 75 73 65 64 0a #f so not used.
1820: 09 20 3b 3b 20 74 68 65 20 73 79 6e 63 68 61 73 . ;; the synchas
1830: 68 20 63 61 6c 6c 73 20 6d 6f 64 69 66 79 20 74 h calls modify t
1840: 68 65 20 22 64 61 74 61 22 20 68 61 73 68 0a 09 he "data" hash..
1850: 20 28 67 65 74 2d 72 75 6e 73 2d 73 69 67 20 20 (get-runs-sig
1860: 20 20 28 63 6f 6e 63 20 28 63 6c 69 65 6e 74 3a (conc (client:
1870: 67 65 74 2d 73 69 67 6e 61 74 75 72 65 29 20 22 get-signature) "
1880: 20 67 65 74 2d 72 75 6e 73 22 29 29 0a 09 20 28 get-runs")).. (
1890: 67 65 74 2d 74 65 73 74 73 2d 73 69 67 20 20 20 get-tests-sig
18a0: 28 63 6f 6e 63 20 28 63 6c 69 65 6e 74 3a 67 65 (conc (client:ge
18b0: 74 2d 73 69 67 6e 61 74 75 72 65 29 20 22 20 67 t-signature) " g
18c0: 65 74 2d 74 65 73 74 73 22 29 29 0a 09 20 28 67 et-tests")).. (g
18d0: 65 74 2d 64 65 74 61 69 6c 73 2d 73 69 67 20 28 et-details-sig (
18e0: 63 6f 6e 63 20 28 63 6c 69 65 6e 74 3a 67 65 74 conc (client:get
18f0: 2d 73 69 67 6e 61 74 75 72 65 29 20 22 20 67 65 -signature) " ge
1900: 74 2d 74 65 73 74 2d 64 65 74 61 69 6c 73 22 29 t-test-details")
1910: 29 0a 0a 09 20 3b 3b 20 74 65 73 74 2d 69 64 73 )... ;; test-ids
1920: 20 74 6f 20 67 65 74 20 61 6e 64 20 64 69 73 70 to get and disp
1930: 6c 61 79 20 61 72 65 20 69 6e 64 65 78 65 64 20 lay are indexed
1940: 6f 6e 20 77 69 6e 64 6f 77 2d 69 64 20 69 6e 20 on window-id in
1950: 63 75 72 72 2d 74 65 73 74 2d 69 64 73 20 68 61 curr-test-ids ha
1960: 73 68 0a 09 20 28 74 65 73 74 2d 69 64 73 20 20 sh.. (test-ids
1970: 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c (hash-tabl
1980: 65 2d 76 61 6c 75 65 73 20 28 64 62 6f 61 72 64 e-values (dboard
1990: 3a 64 61 74 61 2d 67 65 74 2d 63 75 72 72 2d 74 :data-get-curr-t
19a0: 65 73 74 2d 69 64 73 20 2a 64 61 74 61 2a 29 29 est-ids *data*))
19b0: 29 0a 09 20 3b 3b 20 72 75 6e 2d 69 64 20 69 73 ).. ;; run-id is
19c0: 20 23 66 20 69 6e 20 6e 65 78 74 20 6c 69 6e 65 #f in next line
19d0: 20 74 6f 20 73 65 6e 64 20 74 68 65 20 71 75 65 to send the que
19e0: 72 79 20 74 6f 20 73 65 72 76 65 72 20 30 0a 20 ry to server 0.
19f0: 09 20 28 72 75 6e 2d 63 68 61 6e 67 65 73 20 20 . (run-changes
1a00: 20 20 20 28 73 79 6e 63 68 61 73 68 3a 63 6c 69 (synchash:cli
1a10: 65 6e 74 2d 67 65 74 20 27 64 62 3a 67 65 74 2d ent-get 'db:get-
1a20: 72 75 6e 73 20 67 65 74 2d 72 75 6e 73 2d 73 69 runs get-runs-si
1a30: 67 20 28 6c 65 6e 67 74 68 20 6b 65 79 70 61 74 g (length keypat
1a40: 74 73 29 20 64 61 74 61 20 23 66 20 72 75 6e 6e ts) data #f runn
1a50: 61 6d 65 20 23 66 20 23 66 20 6b 65 79 70 61 74 ame #f #f keypat
1a60: 74 73 29 29 0a 09 20 28 74 65 73 74 73 2d 64 65 ts)).. (tests-de
1a70: 74 61 69 6c 2d 63 68 61 6e 67 65 73 20 28 69 66 tail-changes (if
1a80: 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 74 65 73 (not (null? tes
1a90: 74 2d 69 64 73 29 29 0a 09 09 09 09 20 20 20 28 t-ids))..... (
1aa0: 73 79 6e 63 68 61 73 68 3a 63 6c 69 65 6e 74 2d synchash:client-
1ab0: 67 65 74 20 27 64 62 3a 67 65 74 2d 74 65 73 74 get 'db:get-test
1ac0: 2d 69 6e 66 6f 2d 62 79 2d 69 64 73 20 67 65 74 -info-by-ids get
1ad0: 2d 64 65 74 61 69 6c 73 2d 73 69 67 20 30 20 20 -details-sig 0
1ae0: 64 61 74 61 20 23 66 20 74 65 73 74 2d 69 64 73 data #f test-ids
1af0: 29 0a 09 09 09 09 20 20 20 27 28 29 29 29 0a 0a )..... '()))..
1b00: 09 20 3b 3b 20 4e 6f 77 20 63 61 6e 20 63 61 6c . ;; Now can cal
1b10: 63 75 6c 61 74 65 20 74 68 65 20 72 75 6e 2d 69 culate the run-i
1b20: 64 73 0a 09 20 28 72 75 6e 2d 68 61 73 68 20 20 ds.. (run-hash
1b30: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 (hash-table-re
1b40: 66 2f 64 65 66 61 75 6c 74 20 64 61 74 61 20 67 f/default data g
1b50: 65 74 2d 72 75 6e 73 2d 73 69 67 20 23 66 29 29 et-runs-sig #f))
1b60: 0a 09 20 28 72 75 6e 2d 69 64 73 20 20 20 20 20 .. (run-ids
1b70: 28 69 66 20 72 75 6e 2d 68 61 73 68 20 28 66 69 (if run-hash (fi
1b80: 6c 74 65 72 20 6e 75 6d 62 65 72 3f 20 28 68 61 lter number? (ha
1b90: 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 72 75 sh-table-keys ru
1ba0: 6e 2d 68 61 73 68 29 29 20 27 28 29 29 29 0a 0a n-hash)) '()))..
1bb0: 09 20 28 61 6c 6c 2d 74 65 73 74 2d 63 68 61 6e . (all-test-chan
1bc0: 67 65 73 20 28 6c 65 74 20 28 28 72 65 73 20 28 ges (let ((res (
1bd0: 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 make-hash-table)
1be0: 29 29 0a 09 09 09 20 20 20 20 20 28 66 6f 72 2d )).... (for-
1bf0: 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 72 75 each (lambda (ru
1c00: 6e 2d 69 64 29 0a 09 09 09 09 09 20 28 69 66 20 n-id)...... (if
1c10: 28 3e 20 72 75 6e 2d 69 64 20 30 29 0a 09 09 09 (> run-id 0)....
1c20: 09 09 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 .. (hash-tab
1c30: 6c 65 2d 73 65 74 21 20 72 65 73 20 72 75 6e 2d le-set! res run-
1c40: 69 64 20 28 73 79 6e 63 68 61 73 68 3a 63 6c 69 id (synchash:cli
1c50: 65 6e 74 2d 67 65 74 20 27 64 62 3a 67 65 74 2d ent-get 'db:get-
1c60: 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e 2d 6d 69 tests-for-run-mi
1c70: 6e 64 61 74 61 20 67 65 74 2d 74 65 73 74 73 2d ndata get-tests-
1c80: 73 69 67 20 30 20 64 61 74 61 20 72 75 6e 2d 69 sig 0 data run-i
1c90: 64 20 31 20 74 65 73 74 70 61 74 74 20 73 74 61 d 1 testpatt sta
1ca0: 74 65 73 20 73 74 61 74 75 73 65 73 20 23 66 29 tes statuses #f)
1cb0: 29 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 72 )))..... r
1cc0: 75 6e 2d 69 64 73 29 0a 09 09 09 20 20 20 20 20 un-ids)....
1cd0: 72 65 73 29 29 0a 09 20 28 72 75 6e 73 2d 68 61 res)).. (runs-ha
1ce0: 73 68 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c sh (hash-tabl
1cf0: 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 64 61 e-ref/default da
1d00: 74 61 20 67 65 74 2d 72 75 6e 73 2d 73 69 67 20 ta get-runs-sig
1d10: 23 66 29 29 0a 09 20 28 68 65 61 64 65 72 20 20 #f)).. (header
1d20: 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 (hash-table
1d30: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 72 75 6e -ref/default run
1d40: 73 2d 68 61 73 68 20 22 68 65 61 64 65 72 22 20 s-hash "header"
1d50: 23 66 29 29 0a 09 20 28 72 75 6e 2d 69 64 73 20 #f)).. (run-ids
1d60: 20 20 20 20 20 28 73 6f 72 74 20 28 66 69 6c 74 (sort (filt
1d70: 65 72 20 6e 75 6d 62 65 72 3f 20 28 68 61 73 68 er number? (hash
1d80: 2d 74 61 62 6c 65 2d 6b 65 79 73 20 72 75 6e 73 -table-keys runs
1d90: 2d 68 61 73 68 29 29 0a 09 09 09 20 20 20 20 20 -hash))....
1da0: 28 6c 61 6d 62 64 61 20 28 61 20 62 29 0a 09 09 (lambda (a b)...
1db0: 09 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 . (let* ((
1dc0: 72 65 63 6f 72 64 2d 61 20 28 68 61 73 68 2d 74 record-a (hash-t
1dd0: 61 62 6c 65 2d 72 65 66 20 72 75 6e 73 2d 68 61 able-ref runs-ha
1de0: 73 68 20 61 29 29 0a 09 09 09 09 20 20 20 20 20 sh a)).....
1df0: 20 28 72 65 63 6f 72 64 2d 62 20 28 68 61 73 68 (record-b (hash
1e00: 2d 74 61 62 6c 65 2d 72 65 66 20 72 75 6e 73 2d -table-ref runs-
1e10: 68 61 73 68 20 62 29 29 0a 09 09 09 09 20 20 20 hash b)).....
1e20: 20 20 20 28 74 69 6d 65 2d 61 20 20 20 28 64 62 (time-a (db
1e30: 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 :get-value-by-he
1e40: 61 64 65 72 20 72 65 63 6f 72 64 2d 61 20 68 65 ader record-a he
1e50: 61 64 65 72 20 22 65 76 65 6e 74 5f 74 69 6d 65 ader "event_time
1e60: 22 29 29 0a 09 09 09 09 20 20 20 20 20 20 28 74 "))..... (t
1e70: 69 6d 65 2d 62 20 20 20 28 64 62 3a 67 65 74 2d ime-b (db:get-
1e80: 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 value-by-header
1e90: 72 65 63 6f 72 64 2d 62 20 68 65 61 64 65 72 20 record-b header
1ea0: 22 65 76 65 6e 74 5f 74 69 6d 65 22 29 29 29 0a "event_time"))).
1eb0: 09 09 09 09 20 28 3e 20 74 69 6d 65 2d 61 20 74 .... (> time-a t
1ec0: 69 6d 65 2d 62 29 29 29 0a 09 09 09 20 20 20 20 ime-b)))....
1ed0: 20 29 29 0a 09 20 28 72 75 6e 69 64 2d 74 6f 2d )).. (runid-to-
1ee0: 63 6f 6c 20 20 20 20 28 68 61 73 68 2d 74 61 62 col (hash-tab
1ef0: 6c 65 2d 72 65 66 20 2a 63 61 63 68 65 64 61 74 le-ref *cachedat
1f00: 61 2a 20 22 72 75 6e 69 64 2d 74 6f 2d 63 6f 6c a* "runid-to-col
1f10: 22 29 29 0a 09 20 28 74 65 73 74 6e 61 6d 65 2d ")).. (testname-
1f20: 74 6f 2d 72 6f 77 20 28 68 61 73 68 2d 74 61 62 to-row (hash-tab
1f30: 6c 65 2d 72 65 66 20 2a 63 61 63 68 65 64 61 74 le-ref *cachedat
1f40: 61 2a 20 22 74 65 73 74 6e 61 6d 65 2d 74 6f 2d a* "testname-to-
1f50: 72 6f 77 22 29 29 20 0a 09 20 28 63 6f 6c 6e 75 row")) .. (colnu
1f60: 6d 20 20 20 20 20 20 20 31 29 0a 09 20 28 72 6f m 1).. (ro
1f70: 77 6e 75 6d 20 20 20 20 20 20 20 30 29 29 20 3b wnum 0)) ;
1f80: 3b 20 72 6f 77 6e 75 6d 20 3d 20 30 20 69 73 20 ; rownum = 0 is
1f90: 74 68 65 20 68 65 61 64 65 72 0a 3b 3b 20 28 64 the header.;; (d
1fa0: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 74 65 ebug:print 0 "te
1fb0: 73 74 2d 69 64 73 20 22 20 74 65 73 74 2d 69 64 st-ids " test-id
1fc0: 73 20 22 2c 20 74 65 73 74 73 2d 64 65 74 61 69 s ", tests-detai
1fd0: 6c 2d 63 68 61 6e 67 65 73 20 22 20 74 65 73 74 l-changes " test
1fe0: 73 2d 64 65 74 61 69 6c 2d 63 68 61 6e 67 65 73 s-detail-changes
1ff0: 29 0a 20 20 20 20 0a 09 20 3b 3b 20 74 65 73 74 ). .. ;; test
2000: 73 20 72 65 6c 61 74 65 64 20 73 74 75 66 66 0a s related stuff.
2010: 09 20 3b 3b 20 28 61 6c 6c 2d 74 65 73 74 6e 61 . ;; (all-testna
2020: 6d 65 73 20 28 64 65 6c 65 74 65 2d 64 75 70 6c mes (delete-dupl
2030: 69 63 61 74 65 73 20 28 6d 61 70 20 64 62 3a 74 icates (map db:t
2040: 65 73 74 2d 67 65 74 2d 74 65 73 74 6e 61 6d 65 est-get-testname
2050: 20 74 65 73 74 2d 63 68 61 6e 67 65 73 29 29 29 test-changes)))
2060: 29 0a 0a 20 20 20 20 3b 3b 20 47 69 76 65 6e 20 ).. ;; Given
2070: 61 20 72 75 6e 2d 69 64 20 61 6e 64 20 74 65 73 a run-id and tes
2080: 74 6e 61 6d 65 2f 69 74 65 6d 5f 70 61 74 68 20 tname/item_path
2090: 63 61 6c 63 75 6c 61 74 65 20 61 20 63 65 6c 6c calculate a cell
20a0: 20 52 3a 43 0a 0a 20 20 20 20 3b 3b 20 4e 4f 54 R:C.. ;; NOT
20b0: 45 3a 20 41 6c 73 6f 20 62 75 69 6c 64 20 74 68 E: Also build th
20c0: 65 20 74 65 73 74 20 74 72 65 65 20 62 72 6f 77 e test tree brow
20d0: 73 65 72 20 61 6e 64 20 6c 6f 6f 6b 20 75 70 20 ser and look up
20e0: 74 61 62 6c 65 0a 20 20 20 20 3b 3b 0a 20 20 20 table. ;;.
20f0: 20 3b 3b 20 45 61 63 68 20 72 75 6e 20 69 73 20 ;; Each run is
2100: 75 6e 69 71 75 65 20 6f 6e 20 69 74 73 20 6b 65 unique on its ke
2110: 79 73 20 61 6e 64 20 72 75 6e 6e 61 6d 65 20 6f ys and runname o
2120: 72 20 72 75 6e 2d 69 64 2c 20 73 74 6f 72 65 20 r run-id, store
2130: 69 6e 20 68 61 73 68 20 6f 6e 20 63 6f 6c 6e 75 in hash on colnu
2140: 6d 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 m. (for-each
2150: 28 6c 61 6d 62 64 61 20 28 72 75 6e 2d 69 64 29 (lambda (run-id)
2160: 0a 09 09 28 6c 65 74 2a 20 28 28 72 75 6e 2d 72 ...(let* ((run-r
2170: 65 63 6f 72 64 20 28 68 61 73 68 2d 74 61 62 6c ecord (hash-tabl
2180: 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 72 75 e-ref/default ru
2190: 6e 73 2d 68 61 73 68 20 72 75 6e 2d 69 64 20 23 ns-hash run-id #
21a0: 66 29 29 0a 09 09 20 20 20 20 20 20 20 28 6b 65 f))... (ke
21b0: 79 2d 76 61 6c 73 20 20 20 28 6d 61 70 20 28 6c y-vals (map (l
21c0: 61 6d 62 64 61 20 28 6b 65 79 29 28 64 62 3a 67 ambda (key)(db:g
21d0: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 et-value-by-head
21e0: 65 72 20 72 75 6e 2d 72 65 63 6f 72 64 20 68 65 er run-record he
21f0: 61 64 65 72 20 6b 65 79 29 29 0a 09 09 09 09 09 ader key))......
2200: 6b 65 79 73 29 29 0a 09 09 20 20 20 20 20 20 20 keys))...
2210: 28 72 75 6e 2d 6e 61 6d 65 20 20 20 28 64 62 3a (run-name (db:
2220: 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 get-value-by-hea
2230: 64 65 72 20 72 75 6e 2d 72 65 63 6f 72 64 20 68 der run-record h
2240: 65 61 64 65 72 20 22 72 75 6e 6e 61 6d 65 22 29 eader "runname")
2250: 29 0a 09 09 20 20 20 20 20 20 20 28 63 6f 6c 2d )... (col-
2260: 6e 61 6d 65 20 20 20 28 63 6f 6e 63 20 28 73 74 name (conc (st
2270: 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 ring-intersperse
2280: 20 6b 65 79 2d 76 61 6c 73 20 22 5c 6e 22 29 20 key-vals "\n")
2290: 22 5c 6e 22 20 72 75 6e 2d 6e 61 6d 65 29 29 0a "\n" run-name)).
22a0: 09 09 20 20 20 20 20 20 20 28 72 75 6e 2d 70 61 .. (run-pa
22b0: 74 68 20 20 20 28 61 70 70 65 6e 64 20 6b 65 79 th (append key
22c0: 2d 76 61 6c 73 20 28 6c 69 73 74 20 72 75 6e 2d -vals (list run-
22d0: 6e 61 6d 65 29 29 29 29 0a 09 09 20 20 28 68 61 name))))... (ha
22e0: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 28 64 sh-table-set! (d
22f0: 62 6f 61 72 64 3a 64 61 74 61 2d 67 65 74 2d 72 board:data-get-r
2300: 75 6e 2d 6b 65 79 73 20 2a 64 61 74 61 2a 29 20 un-keys *data*)
2310: 72 75 6e 2d 69 64 20 72 75 6e 2d 70 61 74 68 29 run-id run-path)
2320: 0a 09 09 20 20 28 69 75 70 3a 61 74 74 72 69 62 ... (iup:attrib
2330: 75 74 65 2d 73 65 74 21 20 28 64 62 6f 61 72 64 ute-set! (dboard
2340: 3a 64 61 74 61 2d 67 65 74 2d 72 75 6e 73 2d 6d :data-get-runs-m
2350: 61 74 72 69 78 20 2a 64 61 74 61 2a 29 0a 09 09 atrix *data*)...
2360: 09 09 20 20 20 20 20 20 28 63 6f 6e 63 20 72 6f .. (conc ro
2370: 77 6e 75 6d 20 22 3a 22 20 63 6f 6c 6e 75 6d 29 wnum ":" colnum)
2380: 20 63 6f 6c 2d 6e 61 6d 65 29 0a 09 09 20 20 28 col-name)... (
2390: 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 hash-table-set!
23a0: 72 75 6e 69 64 2d 74 6f 2d 63 6f 6c 20 72 75 6e runid-to-col run
23b0: 2d 69 64 20 28 6c 69 73 74 20 63 6f 6c 6e 75 6d -id (list colnum
23c0: 20 72 75 6e 2d 72 65 63 6f 72 64 29 29 0a 09 09 run-record))...
23d0: 20 20 3b 3b 20 48 65 72 65 20 77 65 20 75 70 64 ;; Here we upd
23e0: 61 74 65 20 74 68 65 20 74 65 73 74 73 20 74 72 ate the tests tr
23f0: 65 65 62 6f 78 20 61 6e 64 20 74 72 65 65 20 6b eebox and tree k
2400: 65 79 73 0a 09 09 20 20 28 74 72 65 65 3a 61 64 eys... (tree:ad
2410: 64 2d 6e 6f 64 65 20 28 64 62 6f 61 72 64 3a 64 d-node (dboard:d
2420: 61 74 61 2d 67 65 74 2d 74 65 73 74 73 2d 74 72 ata-get-tests-tr
2430: 65 65 20 2a 64 61 74 61 2a 29 20 22 52 75 6e 73 ee *data*) "Runs
2440: 22 20 28 61 70 70 65 6e 64 20 6b 65 79 2d 76 61 " (append key-va
2450: 6c 73 20 28 6c 69 73 74 20 72 75 6e 2d 6e 61 6d ls (list run-nam
2460: 65 29 29 0a 09 09 09 09 20 75 73 65 72 64 61 74 e))..... userdat
2470: 61 3a 20 28 63 6f 6e 63 20 22 72 75 6e 2d 69 64 a: (conc "run-id
2480: 3a 20 22 20 72 75 6e 2d 69 64 29 29 0a 09 09 20 : " run-id))...
2490: 20 28 73 65 74 21 20 63 6f 6c 6e 75 6d 20 28 2b (set! colnum (+
24a0: 20 63 6f 6c 6e 75 6d 20 31 29 29 29 29 0a 09 20 colnum 1))))..
24b0: 20 20 20 20 20 72 75 6e 2d 69 64 73 29 0a 0a 20 run-ids)..
24c0: 20 20 20 3b 3b 20 53 63 61 6e 20 61 6c 6c 20 74 ;; Scan all t
24d0: 65 73 74 73 20 74 6f 20 62 65 20 64 69 73 70 6c ests to be displ
24e0: 61 79 65 64 20 61 6e 64 20 6f 72 67 61 6e 69 73 ayed and organis
24f0: 65 20 61 6c 6c 20 74 68 65 20 74 65 73 74 20 6e e all the test n
2500: 61 6d 65 73 2c 20 72 65 73 70 65 63 74 69 6e 67 ames, respecting
2510: 20 77 68 61 74 20 69 73 20 69 6e 20 74 68 65 20 what is in the
2520: 68 61 73 68 20 74 61 62 6c 65 0a 20 20 20 20 3b hash table. ;
2530: 3b 20 44 6f 20 74 68 69 73 20 61 6e 61 6c 79 73 ; Do this analys
2540: 69 73 20 69 6e 20 74 68 65 20 6f 72 64 65 72 20 is in the order
2550: 6f 66 20 74 68 65 20 72 75 6e 2d 69 64 73 2c 20 of the run-ids,
2560: 74 68 65 20 6d 6f 73 74 20 72 65 63 65 6e 74 20 the most recent
2570: 72 75 6e 20 77 69 6e 73 0a 20 20 20 20 28 66 6f run wins. (fo
2580: 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 r-each (lambda (
2590: 72 75 6e 2d 69 64 29 0a 09 09 28 6c 65 74 2a 20 run-id)...(let*
25a0: 28 28 72 75 6e 2d 70 61 74 68 20 20 20 20 20 20 ((run-path
25b0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
25c0: 20 28 64 62 6f 61 72 64 3a 64 61 74 61 2d 67 65 (dboard:data-ge
25d0: 74 2d 72 75 6e 2d 6b 65 79 73 20 2a 64 61 74 61 t-run-keys *data
25e0: 2a 29 20 72 75 6e 2d 69 64 29 29 0a 09 09 20 20 *) run-id))...
25f0: 20 20 20 20 20 28 74 65 73 74 2d 63 68 61 6e 67 (test-chang
2600: 65 73 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 es (hash-table
2610: 2d 72 65 66 20 61 6c 6c 2d 74 65 73 74 2d 63 68 -ref all-test-ch
2620: 61 6e 67 65 73 20 72 75 6e 2d 69 64 29 29 0a 09 anges run-id))..
2630: 09 20 20 20 20 20 20 20 28 6e 65 77 2d 74 65 73 . (new-tes
2640: 74 2d 64 61 74 20 20 20 28 63 61 72 20 74 65 73 t-dat (car tes
2650: 74 2d 63 68 61 6e 67 65 73 29 29 0a 09 09 20 20 t-changes))...
2660: 20 20 20 20 20 28 72 65 6d 6f 76 65 64 2d 74 65 (removed-te
2670: 73 74 73 20 20 28 63 61 64 72 20 74 65 73 74 2d sts (cadr test-
2680: 63 68 61 6e 67 65 73 29 29 0a 09 09 20 20 20 20 changes))...
2690: 20 20 20 28 74 65 73 74 73 20 20 20 20 20 20 20 (tests
26a0: 20 20 20 28 73 6f 72 74 20 28 6d 61 70 20 63 61 (sort (map ca
26b0: 64 72 20 28 66 69 6c 74 65 72 20 28 6c 61 6d 62 dr (filter (lamb
26c0: 64 61 20 28 74 65 73 74 72 65 63 29 0a 09 09 09 da (testrec)....
26d0: 09 09 09 09 09 20 28 65 71 3f 20 72 75 6e 2d 69 ..... (eq? run-i
26e0: 64 20 28 64 62 3a 6d 69 6e 74 65 73 74 2d 67 65 d (db:mintest-ge
26f0: 74 2d 72 75 6e 5f 69 64 20 28 63 61 64 72 20 74 t-run_id (cadr t
2700: 65 73 74 72 65 63 29 29 29 29 0a 09 09 09 09 09 estrec))))......
2710: 09 09 20 20 20 20 20 20 20 6e 65 77 2d 74 65 73 .. new-tes
2720: 74 2d 64 61 74 29 29 0a 09 09 09 09 09 20 20 20 t-dat))......
2730: 20 20 28 6c 61 6d 62 64 61 20 28 61 20 62 29 0a (lambda (a b).
2740: 09 09 09 09 09 20 20 20 20 20 20 20 28 6c 65 74 ..... (let
2750: 20 28 28 74 69 6d 65 2d 61 20 28 64 62 3a 6d 69 ((time-a (db:mi
2760: 6e 74 65 73 74 2d 67 65 74 2d 65 76 65 6e 74 5f ntest-get-event_
2770: 74 69 6d 65 20 61 29 29 0a 09 09 09 09 09 09 20 time a)).......
2780: 20 20 20 20 28 74 69 6d 65 2d 62 20 28 64 62 3a (time-b (db:
2790: 6d 69 6e 74 65 73 74 2d 67 65 74 2d 65 76 65 6e mintest-get-even
27a0: 74 5f 74 69 6d 65 20 62 29 29 29 0a 09 09 09 09 t_time b))).....
27b0: 09 09 20 28 3e 20 74 69 6d 65 2d 61 20 74 69 6d .. (> time-a tim
27c0: 65 2d 62 29 29 29 29 29 0a 09 09 20 20 20 20 20 e-b)))))...
27d0: 20 20 3b 3b 20 74 65 73 74 2d 63 68 61 6e 67 65 ;; test-change
27e0: 73 20 69 73 20 61 20 6c 69 73 74 20 6f 66 20 28 s is a list of (
27f0: 28 20 69 64 20 72 65 63 6f 72 64 20 29 20 2e 2e ( id record ) ..
2800: 2e 20 29 0a 09 09 20 20 20 20 20 20 20 3b 3b 20 . )... ;;
2810: 47 65 74 20 6c 69 73 74 20 6f 66 20 74 65 73 74 Get list of test
2820: 20 6e 61 6d 65 73 20 73 6f 72 74 65 64 20 62 79 names sorted by
2830: 20 74 69 6d 65 2c 20 72 65 6d 6f 76 65 20 74 65 time, remove te
2840: 73 74 73 0a 09 09 20 20 20 20 20 20 20 28 74 65 sts... (te
2850: 73 74 2d 6e 61 6d 65 73 20 28 64 65 6c 65 74 65 st-names (delete
2860: 2d 64 75 70 6c 69 63 61 74 65 73 20 28 6d 61 70 -duplicates (map
2870: 20 28 6c 61 6d 62 64 61 20 28 74 29 0a 09 09 09 (lambda (t)....
2880: 09 09 09 09 20 20 20 20 20 28 6c 65 74 20 28 28 .... (let ((
2890: 69 20 28 64 62 3a 6d 69 6e 74 65 73 74 2d 67 65 i (db:mintest-ge
28a0: 74 2d 69 74 65 6d 5f 70 61 74 68 20 74 29 29 0a t-item_path t)).
28b0: 09 09 09 09 09 09 09 09 20 20 20 28 6e 20 28 64 ........ (n (d
28c0: 62 3a 6d 69 6e 74 65 73 74 2d 67 65 74 2d 74 65 b:mintest-get-te
28d0: 73 74 6e 61 6d 65 20 20 74 29 29 29 0a 09 09 09 stname t)))....
28e0: 09 09 09 09 20 20 20 20 20 20 20 28 69 66 20 28 .... (if (
28f0: 73 74 72 69 6e 67 3d 3f 20 69 20 22 22 29 0a 09 string=? i "")..
2900: 09 09 09 09 09 09 09 20 20 20 28 63 6f 6e 63 20 ....... (conc
2910: 22 20 20 20 22 20 69 29 0a 09 09 09 09 09 09 09 " " i)........
2920: 09 20 20 20 6e 29 29 29 0a 09 09 09 09 09 09 09 . n)))........
2930: 20 20 20 74 65 73 74 73 29 29 29 0a 09 09 20 20 tests)))...
2940: 20 20 20 20 20 28 63 6f 6c 6e 75 6d 20 20 20 20 (colnum
2950: 20 28 63 61 72 20 28 68 61 73 68 2d 74 61 62 6c (car (hash-tabl
2960: 65 2d 72 65 66 20 72 75 6e 69 64 2d 74 6f 2d 63 e-ref runid-to-c
2970: 6f 6c 20 72 75 6e 2d 69 64 29 29 29 29 0a 09 09 ol run-id))))...
2980: 20 20 3b 3b 20 66 6f 72 20 65 61 63 68 20 74 65 ;; for each te
2990: 73 74 20 6e 61 6d 65 20 67 65 74 20 74 68 65 20 st name get the
29a0: 73 6c 6f 74 20 69 66 20 69 74 20 65 78 69 73 74 slot if it exist
29b0: 73 20 61 6e 64 20 66 69 6c 6c 20 69 6e 20 74 68 s and fill in th
29c0: 65 20 63 65 6c 6c 0a 09 09 20 20 3b 3b 20 6f 72 e cell... ;; or
29d0: 20 74 61 6b 65 20 74 68 65 20 6e 65 78 74 20 73 take the next s
29e0: 6c 6f 74 20 61 6e 64 20 66 69 6c 6c 20 69 6e 20 lot and fill in
29f0: 74 68 65 20 63 65 6c 6c 2c 20 64 65 61 6c 20 77 the cell, deal w
2a00: 69 74 68 20 69 74 65 6d 73 20 69 6e 20 74 68 65 ith items in the
2a10: 0a 09 09 20 20 3b 3b 20 72 75 6e 20 76 69 65 77 ... ;; run view
2a20: 20 70 61 6e 65 6c 3f 20 54 68 65 20 72 75 6e 20 panel? The run
2a30: 76 69 65 77 20 70 61 6e 65 6c 20 63 61 6e 20 68 view panel can h
2a40: 61 76 65 20 61 20 74 72 65 65 20 73 65 6c 65 63 ave a tree selec
2a50: 74 6f 72 20 66 6f 72 0a 09 09 20 20 3b 3b 20 62 tor for... ;; b
2a60: 72 6f 77 73 69 6e 67 20 74 68 65 20 74 65 73 74 rowsing the test
2a70: 73 2f 69 74 65 6d 73 0a 0a 09 09 20 20 3b 3b 20 s/items.... ;;
2a80: 53 57 49 54 43 48 20 54 48 49 53 20 54 4f 20 55 SWITCH THIS TO U
2a90: 53 49 4e 47 20 43 48 41 4e 47 45 44 20 54 45 53 SING CHANGED TES
2aa0: 54 53 20 4f 4e 4c 59 0a 09 09 20 20 28 66 6f 72 TS ONLY... (for
2ab0: 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 74 -each (lambda (t
2ac0: 65 73 74 29 0a 09 09 09 20 20 20 20 20 20 28 6c est).... (l
2ad0: 65 74 2a 20 28 28 74 65 73 74 2d 69 64 20 20 20 et* ((test-id
2ae0: 28 64 62 3a 6d 69 6e 74 65 73 74 2d 67 65 74 2d (db:mintest-get-
2af0: 69 64 20 74 65 73 74 29 29 0a 09 09 09 09 20 20 id test)).....
2b00: 20 20 20 28 73 74 61 74 65 20 20 20 20 20 28 64 (state (d
2b10: 62 3a 6d 69 6e 74 65 73 74 2d 67 65 74 2d 73 74 b:mintest-get-st
2b20: 61 74 65 20 74 65 73 74 29 29 0a 09 09 09 09 20 ate test)).....
2b30: 20 20 20 20 28 73 74 61 74 75 73 20 20 20 20 28 (status (
2b40: 64 62 3a 6d 69 6e 74 65 73 74 2d 67 65 74 2d 73 db:mintest-get-s
2b50: 74 61 74 75 73 20 74 65 73 74 29 29 0a 09 09 09 tatus test))....
2b60: 09 20 20 20 20 20 28 74 65 73 74 6e 61 6d 65 20 . (testname
2b70: 20 28 64 62 3a 6d 69 6e 74 65 73 74 2d 67 65 74 (db:mintest-get
2b80: 2d 74 65 73 74 6e 61 6d 65 20 74 65 73 74 29 29 -testname test))
2b90: 0a 09 09 09 09 20 20 20 20 20 28 69 74 65 6d 70 ..... (itemp
2ba0: 61 74 68 20 20 28 64 62 3a 6d 69 6e 74 65 73 74 ath (db:mintest
2bb0: 2d 67 65 74 2d 69 74 65 6d 5f 70 61 74 68 20 74 -get-item_path t
2bc0: 65 73 74 29 29 0a 09 09 09 09 20 20 20 20 20 28 est))..... (
2bd0: 66 75 6c 6c 6e 61 6d 65 20 20 28 63 6f 6e 63 20 fullname (conc
2be0: 74 65 73 74 6e 61 6d 65 20 22 2f 22 20 69 74 65 testname "/" ite
2bf0: 6d 70 61 74 68 29 29 0a 09 09 09 09 20 20 20 20 mpath)).....
2c00: 20 28 64 69 73 70 6e 61 6d 65 20 20 28 69 66 20 (dispname (if
2c10: 28 73 74 72 69 6e 67 3d 3f 20 69 74 65 6d 70 61 (string=? itempa
2c20: 74 68 20 22 22 29 20 74 65 73 74 6e 61 6d 65 20 th "") testname
2c30: 28 63 6f 6e 63 20 22 20 20 20 22 20 69 74 65 6d (conc " " item
2c40: 70 61 74 68 29 29 29 0a 09 09 09 09 20 20 20 20 path))).....
2c50: 20 28 72 6f 77 6e 75 6d 20 20 20 20 28 68 61 73 (rownum (has
2c60: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
2c70: 75 6c 74 20 74 65 73 74 6e 61 6d 65 2d 74 6f 2d ult testname-to-
2c80: 72 6f 77 20 66 75 6c 6c 6e 61 6d 65 20 23 66 29 row fullname #f)
2c90: 29 0a 09 09 09 09 20 20 20 20 20 28 74 65 73 74 )..... (test
2ca0: 2d 70 61 74 68 20 28 61 70 70 65 6e 64 20 72 75 -path (append ru
2cb0: 6e 2d 70 61 74 68 20 28 69 66 20 28 65 71 75 61 n-path (if (equa
2cc0: 6c 3f 20 69 74 65 6d 70 61 74 68 20 22 22 29 20 l? itempath "")
2cd0: 0a 09 09 09 09 09 09 09 09 20 20 20 20 20 28 6c ......... (l
2ce0: 69 73 74 20 74 65 73 74 6e 61 6d 65 29 0a 09 09 ist testname)...
2cf0: 09 09 09 09 09 09 20 20 20 20 20 28 6c 69 73 74 ...... (list
2d00: 20 74 65 73 74 6e 61 6d 65 20 69 74 65 6d 70 61 testname itempa
2d10: 74 68 29 29 29 29 0a 09 09 09 09 20 20 20 20 20 th)))).....
2d20: 28 74 62 20 20 20 20 20 20 20 20 20 28 64 62 6f (tb (dbo
2d30: 61 72 64 3a 64 61 74 61 2d 67 65 74 2d 74 65 73 ard:data-get-tes
2d40: 74 73 2d 74 72 65 65 20 2a 64 61 74 61 2a 29 29 ts-tree *data*))
2d50: 29 0a 09 09 09 09 28 70 72 69 6e 74 20 22 49 4e ).....(print "IN
2d60: 46 4f 4e 4f 54 45 3a 20 72 75 6e 2d 70 61 74 68 FONOTE: run-path
2d70: 3a 20 22 20 72 75 6e 2d 70 61 74 68 29 0a 09 09 : " run-path)...
2d80: 09 09 28 74 72 65 65 3a 61 64 64 2d 6e 6f 64 65 ..(tree:add-node
2d90: 20 28 64 62 6f 61 72 64 3a 64 61 74 61 2d 67 65 (dboard:data-ge
2da0: 74 2d 74 65 73 74 73 2d 74 72 65 65 20 2a 64 61 t-tests-tree *da
2db0: 74 61 2a 29 20 22 52 75 6e 73 22 20 0a 09 09 09 ta*) "Runs" ....
2dc0: 09 09 20 20 20 20 20 20 20 74 65 73 74 2d 70 61 .. test-pa
2dd0: 74 68 0a 09 09 09 09 09 20 20 20 20 20 20 20 75 th...... u
2de0: 73 65 72 64 61 74 61 3a 20 28 63 6f 6e 63 20 22 serdata: (conc "
2df0: 74 65 73 74 2d 69 64 3a 20 22 20 74 65 73 74 2d test-id: " test-
2e00: 69 64 29 29 0a 09 09 09 09 28 6c 65 74 20 28 28 id)).....(let ((
2e10: 6e 6f 64 65 2d 6e 75 6d 20 28 74 72 65 65 3a 66 node-num (tree:f
2e20: 69 6e 64 2d 6e 6f 64 65 20 74 62 20 28 63 6f 6e ind-node tb (con
2e30: 73 20 22 52 75 6e 73 22 20 74 65 73 74 2d 70 61 s "Runs" test-pa
2e40: 74 68 29 29 29 0a 09 09 09 09 20 20 20 20 20 20 th))).....
2e50: 28 63 6f 6c 6f 72 20 20 20 20 28 63 61 72 20 28 (color (car (
2e60: 67 75 74 69 6c 73 3a 67 65 74 2d 63 6f 6c 6f 72 gutils:get-color
2e70: 2d 66 6f 72 2d 73 74 61 74 65 2d 73 74 61 74 75 -for-state-statu
2e80: 73 20 73 74 61 74 65 20 73 74 61 74 75 73 29 29 s state status))
2e90: 29 29 0a 09 09 09 09 20 20 28 64 65 62 75 67 3a ))..... (debug:
2ea0: 70 72 69 6e 74 20 30 20 22 6e 6f 64 65 2d 6e 75 print 0 "node-nu
2eb0: 6d 3a 20 22 20 6e 6f 64 65 2d 6e 75 6d 20 22 2c m: " node-num ",
2ec0: 20 63 6f 6c 6f 72 3a 20 22 20 63 6f 6c 6f 72 29 color: " color)
2ed0: 0a 09 09 09 09 20 20 28 69 75 70 3a 61 74 74 72 ..... (iup:attr
2ee0: 69 62 75 74 65 2d 73 65 74 21 20 74 62 20 28 63 ibute-set! tb (c
2ef0: 6f 6e 63 20 22 43 4f 4c 4f 52 22 20 6e 6f 64 65 onc "COLOR" node
2f00: 2d 6e 75 6d 29 20 63 6f 6c 6f 72 29 29 0a 09 09 -num) color))...
2f10: 09 09 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 ..(hash-table-se
2f20: 74 21 20 28 64 62 6f 61 72 64 3a 64 61 74 61 2d t! (dboard:data-
2f30: 67 65 74 2d 70 61 74 68 2d 74 65 73 74 2d 69 64 get-path-test-id
2f40: 73 20 2a 64 61 74 61 2a 29 20 74 65 73 74 2d 70 s *data*) test-p
2f50: 61 74 68 20 74 65 73 74 2d 69 64 29 0a 09 09 09 ath test-id)....
2f60: 09 28 69 66 20 28 6e 6f 74 20 72 6f 77 6e 75 6d .(if (not rownum
2f70: 29 0a 09 09 09 09 20 20 20 20 28 6c 65 74 20 28 )..... (let (
2f80: 28 72 6f 77 6e 75 6d 73 20 28 68 61 73 68 2d 74 (rownums (hash-t
2f90: 61 62 6c 65 2d 76 61 6c 75 65 73 20 74 65 73 74 able-values test
2fa0: 6e 61 6d 65 2d 74 6f 2d 72 6f 77 29 29 29 0a 09 name-to-row)))..
2fb0: 09 09 09 20 20 20 20 20 20 28 73 65 74 21 20 72 ... (set! r
2fc0: 6f 77 6e 75 6d 20 28 69 66 20 28 6e 75 6c 6c 3f ownum (if (null?
2fd0: 20 72 6f 77 6e 75 6d 73 29 0a 09 09 09 09 09 09 rownums).......
2fe0: 20 20 20 20 20 20 20 31 0a 09 09 09 09 09 09 20 1.......
2ff0: 20 20 20 20 20 20 28 2b 20 31 20 28 61 70 70 6c (+ 1 (appl
3000: 79 20 6d 61 78 20 72 6f 77 6e 75 6d 73 29 29 29 y max rownums)))
3010: 29 0a 09 09 09 09 20 20 20 20 20 20 28 68 61 73 )..... (has
3020: 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 74 65 73 h-table-set! tes
3030: 74 6e 61 6d 65 2d 74 6f 2d 72 6f 77 20 66 75 6c tname-to-row ful
3040: 6c 6e 61 6d 65 20 72 6f 77 6e 75 6d 29 0a 09 09 lname rownum)...
3050: 09 09 20 20 20 20 20 20 3b 3b 20 63 72 65 61 74 .. ;; creat
3060: 65 20 74 68 65 20 6c 61 62 65 6c 0a 09 09 09 09 e the label.....
3070: 20 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 (iup:attri
3080: 62 75 74 65 2d 73 65 74 21 20 28 64 62 6f 61 72 bute-set! (dboar
3090: 64 3a 64 61 74 61 2d 67 65 74 2d 72 75 6e 73 2d d:data-get-runs-
30a0: 6d 61 74 72 69 78 20 2a 64 61 74 61 2a 29 0a 09 matrix *data*)..
30b0: 09 09 09 09 09 09 20 20 28 63 6f 6e 63 20 72 6f ...... (conc ro
30c0: 77 6e 75 6d 20 22 3a 22 20 30 29 20 64 69 73 70 wnum ":" 0) disp
30d0: 6e 61 6d 65 29 0a 09 09 09 09 20 20 20 20 20 20 name).....
30e0: 29 29 0a 09 09 09 09 3b 3b 20 73 65 74 20 74 68 )).....;; set th
30f0: 65 20 63 65 6c 6c 20 74 65 78 74 20 61 6e 64 20 e cell text and
3100: 63 6f 6c 6f 72 0a 09 09 09 09 3b 3b 20 28 64 65 color.....;; (de
3110: 62 75 67 3a 70 72 69 6e 74 20 32 20 22 72 6f 77 bug:print 2 "row
3120: 6e 75 6d 3a 63 6f 6c 6e 75 6d 3d 22 20 72 6f 77 num:colnum=" row
3130: 6e 75 6d 20 22 3a 22 20 63 6f 6c 6e 75 6d 20 22 num ":" colnum "
3140: 2c 20 73 74 61 74 65 3d 22 20 73 74 61 74 75 73 , state=" status
3150: 29 0a 09 09 09 09 28 69 75 70 3a 61 74 74 72 69 ).....(iup:attri
3160: 62 75 74 65 2d 73 65 74 21 20 28 64 62 6f 61 72 bute-set! (dboar
3170: 64 3a 64 61 74 61 2d 67 65 74 2d 72 75 6e 73 2d d:data-get-runs-
3180: 6d 61 74 72 69 78 20 2a 64 61 74 61 2a 29 0a 09 matrix *data*)..
3190: 09 09 09 09 09 20 20 20 20 28 63 6f 6e 63 20 72 ..... (conc r
31a0: 6f 77 6e 75 6d 20 22 3a 22 20 63 6f 6c 6e 75 6d ownum ":" colnum
31b0: 29 0a 09 09 09 09 09 09 20 20 20 20 28 69 66 20 )....... (if
31c0: 28 6d 65 6d 62 65 72 20 73 74 61 74 65 20 27 28 (member state '(
31d0: 22 41 52 43 48 49 56 45 44 22 20 22 43 4f 4d 50 "ARCHIVED" "COMP
31e0: 4c 45 54 45 44 22 29 29 0a 09 09 09 09 09 09 09 LETED"))........
31f0: 73 74 61 74 75 73 0a 09 09 09 09 09 09 09 73 74 status........st
3200: 61 74 65 29 29 0a 09 09 09 09 28 69 75 70 3a 61 ate)).....(iup:a
3210: 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 28 64 ttribute-set! (d
3220: 62 6f 61 72 64 3a 64 61 74 61 2d 67 65 74 2d 72 board:data-get-r
3230: 75 6e 73 2d 6d 61 74 72 69 78 20 2a 64 61 74 61 uns-matrix *data
3240: 2a 29 0a 09 09 09 09 09 09 20 20 20 20 28 63 6f *)....... (co
3250: 6e 63 20 22 42 47 43 4f 4c 4f 52 22 20 72 6f 77 nc "BGCOLOR" row
3260: 6e 75 6d 20 22 3a 22 20 63 6f 6c 6e 75 6d 29 0a num ":" colnum).
3270: 09 09 09 09 09 09 20 20 20 20 28 63 61 72 20 28 ...... (car (
3280: 67 75 74 69 6c 73 3a 67 65 74 2d 63 6f 6c 6f 72 gutils:get-color
3290: 2d 66 6f 72 2d 73 74 61 74 65 2d 73 74 61 74 75 -for-state-statu
32a0: 73 20 73 74 61 74 65 20 73 74 61 74 75 73 29 29 s state status))
32b0: 29 0a 09 09 09 09 29 29 0a 09 09 09 20 20 20 20 ).....))....
32c0: 74 65 73 74 73 29 29 29 0a 09 20 20 20 20 20 20 tests)))..
32d0: 72 75 6e 2d 69 64 73 29 0a 0a 20 20 20 20 28 6c run-ids).. (l
32e0: 65 74 20 28 28 75 70 64 61 74 65 72 20 28 68 61 et ((updater (ha
32f0: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def
3300: 61 75 6c 74 20 20 28 64 62 6f 61 72 64 3a 64 61 ault (dboard:da
3310: 74 61 2d 67 65 74 2d 75 70 64 61 74 65 72 73 20 ta-get-updaters
3320: 2a 64 61 74 61 2a 29 20 77 69 6e 64 6f 77 2d 69 *data*) window-i
3330: 64 20 23 66 29 29 29 0a 20 20 20 20 20 20 28 69 d #f))). (i
3340: 66 20 75 70 64 61 74 65 72 20 28 75 70 64 61 74 f updater (updat
3350: 65 72 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 er (hash-table-r
3360: 65 66 2f 64 65 66 61 75 6c 74 20 64 61 74 61 20 ef/default data
3370: 67 65 74 2d 64 65 74 61 69 6c 73 2d 73 69 67 20 get-details-sig
3380: 23 66 29 29 29 29 0a 0a 20 20 20 20 28 69 75 70 #f)))).. (iup
3390: 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 :attribute-set!
33a0: 28 64 62 6f 61 72 64 3a 64 61 74 61 2d 67 65 74 (dboard:data-get
33b0: 2d 72 75 6e 73 2d 6d 61 74 72 69 78 20 2a 64 61 -runs-matrix *da
33c0: 74 61 2a 29 20 22 52 45 44 52 41 57 22 20 22 41 ta*) "REDRAW" "A
33d0: 4c 4c 22 29 0a 20 20 20 20 3b 3b 20 28 64 65 62 LL"). ;; (deb
33e0: 75 67 3a 70 72 69 6e 74 20 32 20 22 72 75 6e 2d ug:print 2 "run-
33f0: 63 68 61 6e 67 65 73 3a 20 22 20 72 75 6e 2d 63 changes: " run-c
3400: 68 61 6e 67 65 73 29 0a 20 20 20 20 3b 3b 20 28 hanges). ;; (
3410: 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 74 debug:print 2 "t
3420: 65 73 74 2d 63 68 61 6e 67 65 73 3a 20 22 20 74 est-changes: " t
3430: 65 73 74 2d 63 68 61 6e 67 65 73 29 0a 20 20 20 est-changes).
3440: 20 28 6c 69 73 74 20 72 75 6e 2d 63 68 61 6e 67 (list run-chang
3450: 65 73 20 61 6c 6c 2d 74 65 73 74 2d 63 68 61 6e es all-test-chan
3460: 67 65 73 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d ges)))..;;======
3470: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3480: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3490: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
34a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
34b0: 0a 3b 3b 20 54 45 53 54 53 20 44 41 54 41 0a 3b .;; TESTS DATA.;
34c0: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
34d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
34e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
34f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3500: 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 50 72 6f 64 =======..;; Prod
3510: 75 63 65 20 61 20 6c 69 73 74 20 6f 66 20 6c 69 uce a list of li
3520: 73 74 73 20 72 65 61 64 79 20 66 6f 72 20 63 6f sts ready for co
3530: 6d 6d 6f 6e 3a 73 70 61 72 73 65 2d 6c 69 73 74 mmon:sparse-list
3540: 2d 67 65 6e 65 72 61 74 65 2d 69 6e 64 65 78 0a -generate-index.
3550: 3b 3b 0a 28 64 65 66 69 6e 65 20 28 64 63 6f 6d ;;.(define (dcom
3560: 6d 6f 6e 3a 6d 69 6e 69 6d 69 7a 65 2d 74 65 73 mon:minimize-tes
3570: 74 2d 64 61 74 61 20 74 65 73 74 73 2d 64 61 74 t-data tests-dat
3580: 29 0a 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 ). (if (null? t
3590: 65 73 74 73 2d 64 61 74 29 20 0a 20 20 20 20 20 ests-dat) .
35a0: 20 27 28 29 0a 20 20 20 20 20 20 28 6c 65 74 20 '(). (let
35b0: 6c 6f 6f 70 20 28 28 68 65 64 20 28 63 61 72 20 loop ((hed (car
35c0: 74 65 73 74 73 2d 64 61 74 29 29 0a 09 09 20 28 tests-dat))... (
35d0: 74 61 6c 20 28 63 64 72 20 74 65 73 74 73 2d 64 tal (cdr tests-d
35e0: 61 74 29 29 0a 09 09 20 28 72 65 73 20 27 28 29 at))... (res '()
35f0: 29 29 0a 09 28 6c 65 74 2a 20 28 28 74 65 73 74 ))..(let* ((test
3600: 2d 69 64 20 20 20 20 28 76 65 63 74 6f 72 2d 72 -id (vector-r
3610: 65 66 20 68 65 64 20 30 29 29 20 3b 3b 20 6c 6f ef hed 0)) ;; lo
3620: 6f 6b 20 61 74 20 74 68 65 20 74 65 73 74 73 2d ok at the tests-
3630: 64 61 74 20 73 70 65 63 20 66 6f 72 20 6c 6f 63 dat spec for loc
3640: 61 74 69 6f 6e 73 0a 09 20 20 20 20 20 20 20 28 ations.. (
3650: 74 65 73 74 2d 6e 61 6d 65 20 20 28 76 65 63 74 test-name (vect
3660: 6f 72 2d 72 65 66 20 68 65 64 20 31 29 29 0a 09 or-ref hed 1))..
3670: 20 20 20 20 20 20 20 28 69 74 65 6d 2d 70 61 74 (item-pat
3680: 68 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 68 h (vector-ref h
3690: 65 64 20 32 29 29 0a 09 20 20 20 20 20 20 20 28 ed 2)).. (
36a0: 73 74 61 74 65 20 20 20 20 20 20 28 76 65 63 74 state (vect
36b0: 6f 72 2d 72 65 66 20 68 65 64 20 33 29 29 0a 09 or-ref hed 3))..
36c0: 20 20 20 20 20 20 20 28 73 74 61 74 75 73 20 20 (status
36d0: 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 68 (vector-ref h
36e0: 65 64 20 34 29 29 0a 09 20 20 20 20 20 20 20 28 ed 4)).. (
36f0: 6e 65 77 69 74 65 6d 20 20 20 20 28 6c 69 73 74 newitem (list
3700: 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d test-name item-
3710: 70 61 74 68 20 28 6c 69 73 74 20 74 65 73 74 2d path (list test-
3720: 69 64 20 73 74 61 74 65 20 73 74 61 74 75 73 29 id state status)
3730: 29 29 29 0a 09 20 20 28 69 66 20 28 6e 75 6c 6c ))).. (if (null
3740: 3f 20 74 61 6c 29 0a 09 20 20 20 20 20 20 28 72 ? tal).. (r
3750: 65 76 65 72 73 65 20 28 63 6f 6e 73 20 6e 65 77 everse (cons new
3760: 69 74 65 6d 20 72 65 73 29 29 0a 09 20 20 20 20 item res))..
3770: 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c (loop (car tal
3780: 29 28 63 64 72 20 74 61 6c 29 28 63 6f 6e 73 20 )(cdr tal)(cons
3790: 6e 65 77 69 74 65 6d 20 72 65 73 29 29 29 29 29 newitem res)))))
37a0: 29 29 0a 09 20 20 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d )).. ..;;======
37b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
37c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
37d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
37e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
37f0: 0a 3b 3b 20 44 20 41 20 54 20 41 20 20 20 54 20 .;; D A T A T
3800: 41 20 42 20 4c 20 45 20 53 0a 3b 3b 3d 3d 3d 3d A B L E S.;;====
3810: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3820: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3830: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3840: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3850: 3d 3d 0a 0a 3b 3b 20 54 61 62 6c 65 20 6f 66 20 ==..;; Table of
3860: 6b 65 79 73 0a 28 64 65 66 69 6e 65 20 28 64 63 keys.(define (dc
3870: 6f 6d 6d 6f 6e 3a 6b 65 79 73 2d 6d 61 74 72 69 ommon:keys-matri
3880: 78 20 72 61 77 63 6f 6e 66 69 67 29 0a 20 20 28 x rawconfig). (
3890: 6c 65 74 2a 20 28 28 63 75 72 72 2d 72 6f 77 2d let* ((curr-row-
38a0: 6e 75 6d 20 31 29 0a 09 20 28 6b 65 79 2d 76 61 num 1).. (key-va
38b0: 6c 73 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a ls (configf:
38c0: 73 65 63 74 69 6f 6e 2d 76 61 72 73 20 72 61 77 section-vars raw
38d0: 63 6f 6e 66 69 67 20 22 66 69 65 6c 64 73 22 29 config "fields")
38e0: 29 0a 09 20 28 6b 65 79 73 2d 6d 61 74 72 69 78 ).. (keys-matrix
38f0: 20 20 28 69 75 70 3a 6d 61 74 72 69 78 0a 09 09 (iup:matrix...
3900: 09 23 3a 61 6c 69 67 6e 6d 65 6e 74 31 20 22 41 .#:alignment1 "A
3910: 4c 45 46 54 22 0a 09 09 09 23 3a 65 78 70 61 6e LEFT"....#:expan
3920: 64 20 22 59 45 53 22 20 3b 3b 20 22 48 4f 52 49 d "YES" ;; "HORI
3930: 5a 4f 4e 54 41 4c 22 20 3b 3b 20 22 56 45 52 54 ZONTAL" ;; "VERT
3940: 49 43 41 4c 22 0a 09 09 09 3b 3b 20 23 3a 73 63 ICAL"....;; #:sc
3950: 72 6f 6c 6c 62 61 72 20 22 59 45 53 22 0a 09 09 rollbar "YES"...
3960: 09 23 3a 6e 75 6d 63 6f 6c 20 31 0a 09 09 09 23 .#:numcol 1....#
3970: 3a 6e 75 6d 6c 69 6e 20 28 6c 65 6e 67 74 68 20 :numlin (length
3980: 6b 65 79 2d 76 61 6c 73 29 0a 09 09 09 23 3a 6e key-vals)....#:n
3990: 75 6d 63 6f 6c 2d 76 69 73 69 62 6c 65 20 31 0a umcol-visible 1.
39a0: 09 09 09 23 3a 6e 75 6d 6c 69 6e 2d 76 69 73 69 ...#:numlin-visi
39b0: 62 6c 65 20 28 6c 65 6e 67 74 68 20 6b 65 79 2d ble (length key-
39c0: 76 61 6c 73 29 0a 09 09 09 23 3a 63 6c 69 63 6b vals)....#:click
39d0: 2d 63 62 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a -cb (lambda (obj
39e0: 20 6c 69 6e 20 63 6f 6c 20 73 74 61 74 75 73 29 lin col status)
39f0: 0a 09 09 09 09 20 20 20 20 20 28 70 72 69 6e 74 ..... (print
3a00: 20 22 6f 62 6a 3a 20 22 20 6f 62 6a 20 22 20 6c "obj: " obj " l
3a10: 69 6e 3a 20 22 20 6c 69 6e 20 22 20 63 6f 6c 3a in: " lin " col:
3a20: 20 22 20 63 6f 6c 20 22 20 73 74 61 74 75 73 3a " col " status:
3a30: 20 22 20 73 74 61 74 75 73 29 29 29 29 29 0a 20 " status))))).
3a40: 20 20 20 3b 3b 20 28 69 75 70 3a 61 74 74 72 69 ;; (iup:attri
3a50: 62 75 74 65 2d 73 65 74 21 20 6b 65 79 73 2d 6d bute-set! keys-m
3a60: 61 74 72 69 78 20 22 30 3a 30 22 20 22 52 75 6e atrix "0:0" "Run
3a70: 20 4b 65 79 73 22 29 0a 20 20 20 20 28 69 75 70 Keys"). (iup
3a80: 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 :attribute-set!
3a90: 6b 65 79 73 2d 6d 61 74 72 69 78 20 22 57 49 44 keys-matrix "WID
3aa0: 54 48 30 22 20 30 29 0a 20 20 20 20 28 69 75 70 TH0" 0). (iup
3ab0: 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 :attribute-set!
3ac0: 6b 65 79 73 2d 6d 61 74 72 69 78 20 22 30 3a 31 keys-matrix "0:1
3ad0: 22 20 22 4b 65 79 20 4e 61 6d 65 22 29 0a 20 20 " "Key Name").
3ae0: 20 20 3b 3b 20 28 69 75 70 3a 61 74 74 72 69 62 ;; (iup:attrib
3af0: 75 74 65 2d 73 65 74 21 20 6b 65 79 73 2d 6d 61 ute-set! keys-ma
3b00: 74 72 69 78 20 22 57 49 44 54 48 31 22 20 22 31 trix "WIDTH1" "1
3b10: 30 30 22 29 0a 20 20 20 20 3b 3b 20 66 69 6c 6c 00"). ;; fill
3b20: 20 69 6e 20 6b 65 79 73 0a 20 20 20 20 28 66 6f in keys. (fo
3b30: 72 2d 65 61 63 68 20 0a 20 20 20 20 20 28 6c 61 r-each . (la
3b40: 6d 62 64 61 20 28 76 61 72 29 0a 20 20 20 20 20 mbda (var).
3b50: 20 20 3b 3b 20 28 69 75 70 3a 61 74 74 72 69 62 ;; (iup:attrib
3b60: 75 74 65 2d 73 65 74 21 20 6b 65 79 73 2d 6d 61 ute-set! keys-ma
3b70: 74 72 69 78 20 22 41 44 44 4c 49 4e 22 20 28 63 trix "ADDLIN" (c
3b80: 6f 6e 63 20 63 75 72 72 2d 72 6f 77 2d 6e 75 6d onc curr-row-num
3b90: 29 29 0a 20 20 20 20 20 20 20 28 69 75 70 3a 61 )). (iup:a
3ba0: 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 6b 65 ttribute-set! ke
3bb0: 79 73 2d 6d 61 74 72 69 78 20 28 63 6f 6e 63 20 ys-matrix (conc
3bc0: 63 75 72 72 2d 72 6f 77 2d 6e 75 6d 20 22 3a 30 curr-row-num ":0
3bd0: 22 29 20 63 75 72 72 2d 72 6f 77 2d 6e 75 6d 29 ") curr-row-num)
3be0: 0a 20 20 20 20 20 20 20 28 69 75 70 3a 61 74 74 . (iup:att
3bf0: 72 69 62 75 74 65 2d 73 65 74 21 20 6b 65 79 73 ribute-set! keys
3c00: 2d 6d 61 74 72 69 78 20 28 63 6f 6e 63 20 63 75 -matrix (conc cu
3c10: 72 72 2d 72 6f 77 2d 6e 75 6d 20 22 3a 31 22 29 rr-row-num ":1")
3c20: 20 76 61 72 29 0a 20 20 20 20 20 20 20 28 73 65 var). (se
3c30: 74 21 20 63 75 72 72 2d 72 6f 77 2d 6e 75 6d 20 t! curr-row-num
3c40: 28 2b 20 31 20 63 75 72 72 2d 72 6f 77 2d 6e 75 (+ 1 curr-row-nu
3c50: 6d 29 29 29 20 3b 3b 20 28 63 6f 6e 66 69 67 2d m))) ;; (config-
3c60: 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 lookup *configda
3c70: 74 2a 20 22 66 69 65 6c 64 73 22 20 76 61 72 29 t* "fields" var)
3c80: 29 29 0a 20 20 20 20 20 6b 65 79 2d 76 61 6c 73 )). key-vals
3c90: 29 0a 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 ). (iup:attri
3ca0: 62 75 74 65 2d 73 65 74 21 20 6b 65 79 73 2d 6d bute-set! keys-m
3cb0: 61 74 72 69 78 20 22 57 49 44 54 48 44 45 46 22 atrix "WIDTHDEF"
3cc0: 20 22 34 30 22 29 0a 20 20 20 20 6b 65 79 73 2d "40"). keys-
3cd0: 6d 61 74 72 69 78 29 29 0a 0a 3b 3b 20 53 65 63 matrix))..;; Sec
3ce0: 74 69 6f 6e 20 74 6f 20 74 61 62 6c 65 0a 28 64 tion to table.(d
3cf0: 65 66 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a 73 efine (dcommon:s
3d00: 65 63 74 69 6f 6e 2d 6d 61 74 72 69 78 20 72 61 ection-matrix ra
3d10: 77 63 6f 6e 66 69 67 20 73 65 63 74 69 6f 6e 6e wconfig sectionn
3d20: 61 6d 65 20 76 61 72 63 6f 6c 6e 61 6d 65 20 76 ame varcolname v
3d30: 61 6c 63 6f 6c 6e 61 6d 65 20 23 21 6b 65 79 20 alcolname #!key
3d40: 28 74 69 74 6c 65 20 23 66 29 29 0a 20 20 28 6c (title #f)). (l
3d50: 65 74 2a 20 28 28 63 75 72 72 2d 72 6f 77 2d 6e et* ((curr-row-n
3d60: 75 6d 20 20 20 20 31 29 0a 09 20 28 6b 65 79 2d um 1).. (key-
3d70: 76 61 6c 73 20 20 20 20 20 20 20 20 28 63 6f 6e vals (con
3d80: 66 69 67 66 3a 73 65 63 74 69 6f 6e 2d 76 61 72 figf:section-var
3d90: 73 20 72 61 77 63 6f 6e 66 69 67 20 73 65 63 74 s rawconfig sect
3da0: 69 6f 6e 6e 61 6d 65 29 29 0a 09 20 28 73 65 63 ionname)).. (sec
3db0: 74 69 6f 6e 2d 6d 61 74 72 69 78 20 20 28 69 75 tion-matrix (iu
3dc0: 70 3a 6d 61 74 72 69 78 0a 09 09 09 20 20 20 23 p:matrix.... #
3dd0: 3a 61 6c 69 67 6e 6d 65 6e 74 31 20 22 41 4c 45 :alignment1 "ALE
3de0: 46 54 22 0a 09 09 09 20 20 20 23 3a 65 78 70 61 FT".... #:expa
3df0: 6e 64 20 22 59 45 53 22 20 3b 3b 20 22 48 4f 52 nd "YES" ;; "HOR
3e00: 49 5a 4f 4e 54 41 4c 22 0a 09 09 09 20 20 20 23 IZONTAL".... #
3e10: 3a 6e 75 6d 63 6f 6c 20 31 0a 09 09 09 20 20 20 :numcol 1....
3e20: 23 3a 6e 75 6d 6c 69 6e 20 28 6c 65 6e 67 74 68 #:numlin (length
3e30: 20 6b 65 79 2d 76 61 6c 73 29 0a 09 09 09 20 20 key-vals)....
3e40: 20 23 3a 6e 75 6d 63 6f 6c 2d 76 69 73 69 62 6c #:numcol-visibl
3e50: 65 20 31 0a 09 09 09 20 20 20 23 3a 6e 75 6d 6c e 1.... #:numl
3e60: 69 6e 2d 76 69 73 69 62 6c 65 20 28 6c 65 6e 67 in-visible (leng
3e70: 74 68 20 6b 65 79 2d 76 61 6c 73 29 0a 09 09 09 th key-vals)....
3e80: 20 20 20 23 3a 73 63 72 6f 6c 6c 62 61 72 20 22 #:scrollbar "
3e90: 59 45 53 22 29 29 29 0a 20 20 20 20 28 69 75 70 YES"))). (iup
3ea0: 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 :attribute-set!
3eb0: 73 65 63 74 69 6f 6e 2d 6d 61 74 72 69 78 20 22 section-matrix "
3ec0: 30 3a 30 22 20 76 61 72 63 6f 6c 6e 61 6d 65 29 0:0" varcolname)
3ed0: 0a 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 . (iup:attrib
3ee0: 75 74 65 2d 73 65 74 21 20 73 65 63 74 69 6f 6e ute-set! section
3ef0: 2d 6d 61 74 72 69 78 20 22 30 3a 31 22 20 76 61 -matrix "0:1" va
3f00: 6c 63 6f 6c 6e 61 6d 65 29 0a 20 20 20 20 28 69 lcolname). (i
3f10: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 up:attribute-set
3f20: 21 20 73 65 63 74 69 6f 6e 2d 6d 61 74 72 69 78 ! section-matrix
3f30: 20 22 57 49 44 54 48 31 22 20 22 32 30 30 22 29 "WIDTH1" "200")
3f40: 0a 20 20 20 20 3b 3b 20 66 69 6c 6c 20 69 6e 20 . ;; fill in
3f50: 6b 65 79 73 0a 20 20 20 20 28 66 6f 72 2d 65 61 keys. (for-ea
3f60: 63 68 20 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 ch . (lambda
3f70: 20 28 76 61 72 29 0a 20 20 20 20 20 20 20 3b 3b (var). ;;
3f80: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d (iup:attribute-
3f90: 73 65 74 21 20 6b 65 79 73 2d 6d 61 74 72 69 78 set! keys-matrix
3fa0: 20 22 41 44 44 4c 49 4e 22 20 28 63 6f 6e 63 20 "ADDLIN" (conc
3fb0: 63 75 72 72 2d 72 6f 77 2d 6e 75 6d 29 29 0a 20 curr-row-num)).
3fc0: 20 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 (iup:attri
3fd0: 62 75 74 65 2d 73 65 74 21 20 73 65 63 74 69 6f bute-set! sectio
3fe0: 6e 2d 6d 61 74 72 69 78 20 28 63 6f 6e 63 20 63 n-matrix (conc c
3ff0: 75 72 72 2d 72 6f 77 2d 6e 75 6d 20 22 3a 30 22 urr-row-num ":0"
4000: 29 20 76 61 72 29 0a 20 20 20 20 20 20 20 28 69 ) var). (i
4010: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 up:attribute-set
4020: 21 20 73 65 63 74 69 6f 6e 2d 6d 61 74 72 69 78 ! section-matrix
4030: 20 28 63 6f 6e 63 20 63 75 72 72 2d 72 6f 77 2d (conc curr-row-
4040: 6e 75 6d 20 22 3a 31 22 29 20 28 63 6f 6e 66 69 num ":1") (confi
4050: 67 66 3a 6c 6f 6f 6b 75 70 20 72 61 77 63 6f 6e gf:lookup rawcon
4060: 66 69 67 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20 fig sectionname
4070: 76 61 72 29 29 0a 20 20 20 20 20 20 20 28 73 65 var)). (se
4080: 74 21 20 63 75 72 72 2d 72 6f 77 2d 6e 75 6d 20 t! curr-row-num
4090: 28 2b 20 31 20 63 75 72 72 2d 72 6f 77 2d 6e 75 (+ 1 curr-row-nu
40a0: 6d 29 29 29 20 3b 3b 20 28 63 6f 6e 66 69 67 2d m))) ;; (config-
40b0: 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 lookup *configda
40c0: 74 2a 20 22 66 69 65 6c 64 73 22 20 76 61 72 29 t* "fields" var)
40d0: 29 29 0a 20 20 20 20 20 6b 65 79 2d 76 61 6c 73 )). key-vals
40e0: 29 0a 20 20 20 20 28 69 75 70 3a 76 62 6f 78 0a ). (iup:vbox.
40f0: 20 20 20 20 20 28 69 75 70 3a 6c 61 62 65 6c 20 (iup:label
4100: 28 69 66 20 74 69 74 6c 65 20 74 69 74 6c 65 20 (if title title
4110: 28 63 6f 6e 63 20 22 53 65 74 74 69 6e 67 73 20 (conc "Settings
4120: 66 72 6f 6d 20 5b 22 20 73 65 63 74 69 6f 6e 6e from [" sectionn
4130: 61 6d 65 20 22 5d 22 29 29 20 20 0a 20 20 20 20 ame "]")) .
4140: 20 20 20 20 20 09 3b 3b 20 23 3a 73 69 7a 65 20 .;; #:size
4150: 20 20 22 35 78 22 0a 20 20 20 20 20 20 20 20 20 "5x".
4160: 09 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a .#:expand "HORIZ
4170: 4f 4e 54 41 4c 22 0a 20 20 20 20 20 20 20 20 20 ONTAL".
4180: 09 29 0a 20 20 20 20 20 73 65 63 74 69 6f 6e 2d .). section-
4190: 6d 61 74 72 69 78 29 29 29 0a 20 20 20 20 0a 3b matrix))). .;
41a0: 3b 20 47 65 6e 65 72 61 6c 20 64 61 74 61 0a 3b ; General data.;
41b0: 3b 0a 28 64 65 66 69 6e 65 20 28 64 63 6f 6d 6d ;.(define (dcomm
41c0: 6f 6e 3a 67 65 6e 65 72 61 6c 2d 69 6e 66 6f 29 on:general-info)
41d0: 0a 20 20 28 6c 65 74 20 28 28 67 65 6e 65 72 61 . (let ((genera
41e0: 6c 2d 6d 61 74 72 69 78 20 28 69 75 70 3a 6d 61 l-matrix (iup:ma
41f0: 74 72 69 78 0a 09 09 09 20 23 3a 61 6c 69 67 6e trix.... #:align
4200: 6d 65 6e 74 31 20 22 41 4c 45 46 54 22 0a 09 09 ment1 "ALEFT"...
4210: 09 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 . #:expand "YES"
4220: 20 3b 3b 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 ;; "HORIZONTAL"
4230: 0a 09 09 09 20 23 3a 6e 75 6d 63 6f 6c 20 31 0a .... #:numcol 1.
4240: 09 09 09 20 23 3a 6e 75 6d 6c 69 6e 20 32 0a 09 ... #:numlin 2..
4250: 09 09 20 23 3a 6e 75 6d 63 6f 6c 2d 76 69 73 69 .. #:numcol-visi
4260: 62 6c 65 20 31 0a 09 09 09 20 23 3a 6e 75 6d 6c ble 1.... #:numl
4270: 69 6e 2d 76 69 73 69 62 6c 65 20 32 29 29 29 0a in-visible 2))).
4280: 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 (iup:attribu
4290: 74 65 2d 73 65 74 21 20 67 65 6e 65 72 61 6c 2d te-set! general-
42a0: 6d 61 74 72 69 78 20 22 57 49 44 54 48 31 22 20 matrix "WIDTH1"
42b0: 22 31 35 30 22 29 0a 20 20 20 20 28 69 75 70 3a "150"). (iup:
42c0: 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 67 attribute-set! g
42d0: 65 6e 65 72 61 6c 2d 6d 61 74 72 69 78 20 22 30 eneral-matrix "0
42e0: 3a 31 22 20 22 41 62 6f 75 74 20 74 68 69 73 20 :1" "About this
42f0: 4d 65 67 61 74 65 73 74 20 61 72 65 61 22 29 20 Megatest area")
4300: 0a 20 20 20 20 3b 3b 20 55 73 65 72 20 28 74 68 . ;; User (th
4310: 69 73 20 69 73 20 6e 6f 74 20 61 6c 77 61 79 73 is is not always
4320: 20 6f 62 76 69 6f 75 73 20 2d 20 69 74 20 69 73 obvious - it is
4330: 20 63 6f 6d 6d 6f 6e 20 74 6f 20 72 75 6e 20 61 common to run a
4340: 73 20 61 20 64 69 66 66 65 72 65 6e 74 20 75 73 s a different us
4350: 65 72 0a 20 20 20 20 28 69 75 70 3a 61 74 74 72 er. (iup:attr
4360: 69 62 75 74 65 2d 73 65 74 21 20 67 65 6e 65 72 ibute-set! gener
4370: 61 6c 2d 6d 61 74 72 69 78 20 22 31 3a 30 22 20 al-matrix "1:0"
4380: 22 55 73 65 72 22 29 0a 20 20 20 20 28 69 75 70 "User"). (iup
4390: 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 :attribute-set!
43a0: 67 65 6e 65 72 61 6c 2d 6d 61 74 72 69 78 20 22 general-matrix "
43b0: 31 3a 31 22 20 28 63 75 72 72 65 6e 74 2d 75 73 1:1" (current-us
43c0: 65 72 2d 6e 61 6d 65 29 29 0a 20 20 20 20 3b 3b er-name)). ;;
43d0: 20 4d 65 67 61 74 65 73 74 20 61 72 65 61 0a 20 Megatest area.
43e0: 20 20 20 3b 3b 20 28 69 75 70 3a 61 74 74 72 69 ;; (iup:attri
43f0: 62 75 74 65 2d 73 65 74 21 20 67 65 6e 65 72 61 bute-set! genera
4400: 6c 2d 6d 61 74 72 69 78 20 22 32 3a 30 22 20 22 l-matrix "2:0" "
4410: 41 72 65 61 22 29 0a 20 20 20 20 3b 3b 20 28 69 Area"). ;; (i
4420: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 up:attribute-set
4430: 21 20 67 65 6e 65 72 61 6c 2d 6d 61 74 72 69 78 ! general-matrix
4440: 20 22 32 3a 31 22 20 2a 74 6f 70 70 61 74 68 2a "2:1" *toppath*
4450: 29 0a 20 20 20 20 3b 3b 20 4d 65 67 61 74 65 73 ). ;; Megates
4460: 74 20 76 65 72 73 69 6f 6e 0a 20 20 20 20 28 69 t version. (i
4470: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 up:attribute-set
4480: 21 20 67 65 6e 65 72 61 6c 2d 6d 61 74 72 69 78 ! general-matrix
4490: 20 22 32 3a 30 22 20 22 56 65 72 73 69 6f 6e 22 "2:0" "Version"
44a0: 29 0a 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 ). (iup:attri
44b0: 62 75 74 65 2d 73 65 74 21 20 67 65 6e 65 72 61 bute-set! genera
44c0: 6c 2d 6d 61 74 72 69 78 20 22 32 3a 31 22 20 28 l-matrix "2:1" (
44d0: 63 6f 6e 63 20 6d 65 67 61 74 65 73 74 2d 76 65 conc megatest-ve
44e0: 72 73 69 6f 6e 20 22 2d 22 20 28 73 75 62 73 74 rsion "-" (subst
44f0: 72 69 6e 67 20 6d 65 67 61 74 65 73 74 2d 66 6f ring megatest-fo
4500: 73 73 69 6c 2d 68 61 73 68 20 30 20 34 29 29 29 ssil-hash 0 4)))
4510: 0a 0a 20 20 20 20 67 65 6e 65 72 61 6c 2d 6d 61 .. general-ma
4520: 74 72 69 78 29 29 0a 0a 28 64 65 66 69 6e 65 20 trix))..(define
4530: 28 64 63 6f 6d 6d 6f 6e 3a 72 75 6e 2d 73 74 61 (dcommon:run-sta
4540: 74 73 20 64 62 73 74 72 75 63 74 29 0a 20 20 28 ts dbstruct). (
4550: 6c 65 74 2a 20 28 28 73 74 61 74 73 2d 6d 61 74 let* ((stats-mat
4560: 72 69 78 20 28 69 75 70 3a 6d 61 74 72 69 78 20 rix (iup:matrix
4570: 65 78 70 61 6e 64 3a 20 22 59 45 53 22 29 29 0a expand: "YES")).
4580: 09 20 28 63 68 61 6e 67 65 64 20 20 20 20 20 20 . (changed
4590: 23 66 29 0a 09 20 28 75 70 64 61 74 65 72 20 20 #f).. (updater
45a0: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 (lambda ()..
45b0: 09 09 20 28 6c 65 74 2a 20 28 28 72 75 6e 2d 73 .. (let* ((run-s
45c0: 74 61 74 73 20 20 20 20 28 64 62 3a 67 65 74 2d tats (db:get-
45d0: 72 75 6e 2d 73 74 61 74 73 20 64 62 73 74 72 75 run-stats dbstru
45e0: 63 74 29 29 0a 09 09 09 09 28 69 6e 64 69 63 65 ct)).....(indice
45f0: 73 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 73 s (common:s
4600: 70 61 72 73 65 2d 6c 69 73 74 2d 67 65 6e 65 72 parse-list-gener
4610: 61 74 65 2d 69 6e 64 65 78 20 72 75 6e 2d 73 74 ate-index run-st
4620: 61 74 73 29 29 20 3b 3b 20 20 70 72 6f 63 3a 20 ats)) ;; proc:
4630: 73 65 74 2d 63 65 6c 6c 29 29 0a 09 09 09 09 28 set-cell)).....(
4640: 72 6f 77 2d 69 6e 64 69 63 65 73 20 20 28 63 61 row-indices (ca
4650: 72 20 69 6e 64 69 63 65 73 29 29 0a 09 09 09 09 r indices)).....
4660: 28 63 6f 6c 2d 69 6e 64 69 63 65 73 20 20 28 63 (col-indices (c
4670: 61 64 72 20 69 6e 64 69 63 65 73 29 29 0a 09 09 adr indices))...
4680: 09 09 28 6d 61 78 2d 72 6f 77 20 20 20 20 20 20 ..(max-row
4690: 28 69 66 20 28 6e 75 6c 6c 3f 20 72 6f 77 2d 69 (if (null? row-i
46a0: 6e 64 69 63 65 73 29 20 31 20 28 61 70 70 6c 79 ndices) 1 (apply
46b0: 20 6d 61 78 20 28 6d 61 70 20 63 61 64 72 20 72 max (map cadr r
46c0: 6f 77 2d 69 6e 64 69 63 65 73 29 29 29 29 0a 09 ow-indices))))..
46d0: 09 09 09 28 6d 61 78 2d 63 6f 6c 20 20 20 20 20 ...(max-col
46e0: 20 28 69 66 20 28 6e 75 6c 6c 3f 20 63 6f 6c 2d (if (null? col-
46f0: 69 6e 64 69 63 65 73 29 20 31 20 0a 09 09 09 09 indices) 1 .....
4700: 09 09 20 20 28 61 70 70 6c 79 20 6d 61 78 20 28 .. (apply max (
4710: 6d 61 70 20 63 61 64 72 20 63 6f 6c 2d 69 6e 64 map cadr col-ind
4720: 69 63 65 73 29 29 29 29 0a 09 09 09 09 28 6d 61 ices)))).....(ma
4730: 78 2d 76 69 73 69 62 6c 65 20 20 28 6d 61 78 20 x-visible (max
4740: 28 2d 20 2a 6e 75 6d 2d 74 65 73 74 73 2a 20 31 (- *num-tests* 1
4750: 35 29 20 33 29 29 0a 09 09 09 09 28 6d 61 78 2d 5) 3)).....(max-
4760: 63 6f 6c 2d 76 69 73 20 20 28 69 66 20 28 3e 20 col-vis (if (>
4770: 6d 61 78 2d 63 6f 6c 20 31 30 29 20 31 30 20 6d max-col 10) 10 m
4780: 61 78 2d 63 6f 6c 29 29 0a 09 09 09 09 28 6e 75 ax-col)).....(nu
4790: 6d 72 6f 77 73 20 20 20 20 20 20 31 29 0a 09 09 mrows 1)...
47a0: 09 09 28 6e 75 6d 63 6f 6c 73 20 20 20 20 20 20 ..(numcols
47b0: 31 29 29 0a 09 09 09 20 20 20 28 69 75 70 3a 61 1)).... (iup:a
47c0: 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 73 74 ttribute-set! st
47d0: 61 74 73 2d 6d 61 74 72 69 78 20 22 43 4c 45 41 ats-matrix "CLEA
47e0: 52 56 41 4c 55 45 22 20 22 43 4f 4e 54 45 4e 54 RVALUE" "CONTENT
47f0: 53 22 29 0a 09 09 09 20 20 20 28 69 75 70 3a 61 S").... (iup:a
4800: 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 73 74 ttribute-set! st
4810: 61 74 73 2d 6d 61 74 72 69 78 20 22 4e 55 4d 43 ats-matrix "NUMC
4820: 4f 4c 22 20 6d 61 78 2d 63 6f 6c 20 29 0a 09 09 OL" max-col )...
4830: 09 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 . (iup:attribu
4840: 74 65 2d 73 65 74 21 20 73 74 61 74 73 2d 6d 61 te-set! stats-ma
4850: 74 72 69 78 20 22 4e 55 4d 4c 49 4e 22 20 28 69 trix "NUMLIN" (i
4860: 66 20 28 3c 20 6d 61 78 2d 72 6f 77 20 6d 61 78 f (< max-row max
4870: 2d 76 69 73 69 62 6c 65 29 20 6d 61 78 2d 76 69 -visible) max-vi
4880: 73 69 62 6c 65 20 6d 61 78 2d 72 6f 77 29 29 20 sible max-row))
4890: 3b 3b 20 6d 69 6e 20 6f 66 20 32 30 0a 09 09 09 ;; min of 20....
48a0: 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 (iup:attribut
48b0: 65 2d 73 65 74 21 20 73 74 61 74 73 2d 6d 61 74 e-set! stats-mat
48c0: 72 69 78 20 22 4e 55 4d 43 4f 4c 5f 56 49 53 49 rix "NUMCOL_VISI
48d0: 42 4c 45 22 20 6d 61 78 2d 63 6f 6c 2d 76 69 73 BLE" max-col-vis
48e0: 29 0a 09 09 09 20 20 20 28 69 75 70 3a 61 74 74 ).... (iup:att
48f0: 72 69 62 75 74 65 2d 73 65 74 21 20 73 74 61 74 ribute-set! stat
4900: 73 2d 6d 61 74 72 69 78 20 22 4e 55 4d 4c 49 4e s-matrix "NUMLIN
4910: 5f 56 49 53 49 42 4c 45 22 20 28 69 66 20 28 3e _VISIBLE" (if (>
4920: 20 6d 61 78 2d 72 6f 77 20 6d 61 78 2d 76 69 73 max-row max-vis
4930: 69 62 6c 65 29 20 6d 61 78 2d 76 69 73 69 62 6c ible) max-visibl
4940: 65 20 6d 61 78 2d 72 6f 77 29 29 0a 0a 09 09 09 e max-row)).....
4950: 20 20 20 3b 3b 20 52 6f 77 20 6c 61 62 65 6c 73 ;; Row labels
4960: 0a 09 09 09 20 20 20 28 66 6f 72 2d 65 61 63 68 .... (for-each
4970: 20 28 6c 61 6d 62 64 61 20 28 69 6e 64 29 0a 09 (lambda (ind)..
4980: 09 09 09 20 20 20 20 20 20 20 28 6c 65 74 2a 20 ... (let*
4990: 28 28 6e 61 6d 65 20 28 63 61 72 20 69 6e 64 29 ((name (car ind)
49a0: 29 0a 09 09 09 09 09 20 20 20 20 20 20 28 6e 75 )...... (nu
49b0: 6d 20 20 28 63 61 64 72 20 69 6e 64 29 29 0a 09 m (cadr ind))..
49c0: 09 09 09 09 20 20 20 20 20 20 28 6b 65 79 20 20 .... (key
49d0: 28 63 6f 6e 63 20 6e 75 6d 20 22 3a 30 22 29 29 (conc num ":0"))
49e0: 29 0a 09 09 09 09 09 20 28 69 66 20 28 6e 6f 74 )...... (if (not
49f0: 20 28 65 71 75 61 6c 3f 20 28 69 75 70 3a 61 74 (equal? (iup:at
4a00: 74 72 69 62 75 74 65 20 73 74 61 74 73 2d 6d 61 tribute stats-ma
4a10: 74 72 69 78 20 6b 65 79 29 20 6e 61 6d 65 29 29 trix key) name))
4a20: 0a 09 09 09 09 09 20 20 20 20 20 28 62 65 67 69 ...... (begi
4a30: 6e 0a 09 09 09 09 09 20 20 20 20 20 20 20 28 73 n...... (s
4a40: 65 74 21 20 63 68 61 6e 67 65 64 20 23 74 29 0a et! changed #t).
4a50: 09 09 09 09 09 20 20 20 20 20 20 20 28 69 75 70 ..... (iup
4a60: 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 :attribute-set!
4a70: 73 74 61 74 73 2d 6d 61 74 72 69 78 20 6b 65 79 stats-matrix key
4a80: 20 6e 61 6d 65 29 29 29 29 29 0a 09 09 09 09 20 name))))).....
4a90: 20 20 20 20 72 6f 77 2d 69 6e 64 69 63 65 73 29 row-indices)
4aa0: 0a 0a 09 09 09 20 20 20 3b 3b 20 43 6f 6c 20 6c ..... ;; Col l
4ab0: 61 62 65 6c 73 0a 09 09 09 20 20 20 28 66 6f 72 abels.... (for
4ac0: 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 69 -each (lambda (i
4ad0: 6e 64 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 nd)..... (
4ae0: 6c 65 74 2a 20 28 28 6e 61 6d 65 20 28 63 61 72 let* ((name (car
4af0: 20 69 6e 64 29 29 0a 09 09 09 09 09 20 20 20 20 ind))......
4b00: 20 20 28 6e 75 6d 20 20 28 63 61 64 72 20 69 6e (num (cadr in
4b10: 64 29 29 0a 09 09 09 09 09 20 20 20 20 20 20 28 d))...... (
4b20: 6b 65 79 20 20 28 63 6f 6e 63 20 22 30 3a 22 20 key (conc "0:"
4b30: 6e 75 6d 29 29 29 0a 09 09 09 09 09 20 28 69 66 num)))...... (if
4b40: 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 28 69 (not (equal? (i
4b50: 75 70 3a 61 74 74 72 69 62 75 74 65 20 73 74 61 up:attribute sta
4b60: 74 73 2d 6d 61 74 72 69 78 20 6b 65 79 29 20 6e ts-matrix key) n
4b70: 61 6d 65 29 29 0a 09 09 09 09 09 20 20 20 20 20 ame))......
4b80: 28 62 65 67 69 6e 0a 09 09 09 09 09 20 20 20 20 (begin......
4b90: 20 20 20 28 73 65 74 21 20 63 68 61 6e 67 65 64 (set! changed
4ba0: 20 23 74 29 0a 09 09 09 09 09 20 20 20 20 20 20 #t)......
4bb0: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d (iup:attribute-
4bc0: 73 65 74 21 20 73 74 61 74 73 2d 6d 61 74 72 69 set! stats-matri
4bd0: 78 20 6b 65 79 20 6e 61 6d 65 29 29 29 29 29 0a x key name))))).
4be0: 09 09 09 09 20 20 20 20 20 63 6f 6c 2d 69 6e 64 .... col-ind
4bf0: 69 63 65 73 29 0a 0a 09 09 09 20 20 20 3b 3b 20 ices)..... ;;
4c00: 43 65 6c 6c 20 63 6f 6e 74 65 6e 74 73 0a 09 09 Cell contents...
4c10: 09 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c . (for-each (l
4c20: 61 6d 62 64 61 20 28 65 6e 74 72 79 29 0a 09 09 ambda (entry)...
4c30: 09 09 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 .. (let* (
4c40: 28 72 6f 77 2d 6e 61 6d 65 20 28 63 61 72 20 65 (row-name (car e
4c50: 6e 74 72 79 29 29 0a 09 09 09 09 09 20 20 20 20 ntry))......
4c60: 20 20 28 63 6f 6c 2d 6e 61 6d 65 20 28 63 61 64 (col-name (cad
4c70: 72 20 65 6e 74 72 79 29 29 0a 09 09 09 09 09 20 r entry))......
4c80: 20 20 20 20 20 28 76 61 6c 75 65 20 20 20 20 28 (value (
4c90: 63 61 64 64 72 20 65 6e 74 72 79 29 29 0a 09 09 caddr entry))...
4ca0: 09 09 09 20 20 20 20 20 20 28 72 6f 77 2d 6e 75 ... (row-nu
4cb0: 6d 20 20 28 63 61 64 72 20 28 61 73 73 6f 63 20 m (cadr (assoc
4cc0: 72 6f 77 2d 6e 61 6d 65 20 72 6f 77 2d 69 6e 64 row-name row-ind
4cd0: 69 63 65 73 29 29 29 0a 09 09 09 09 09 20 20 20 ices)))......
4ce0: 20 20 20 28 63 6f 6c 2d 6e 75 6d 20 20 28 63 61 (col-num (ca
4cf0: 64 72 20 28 61 73 73 6f 63 20 63 6f 6c 2d 6e 61 dr (assoc col-na
4d00: 6d 65 20 63 6f 6c 2d 69 6e 64 69 63 65 73 29 29 me col-indices))
4d10: 29 0a 09 09 09 09 09 20 20 20 20 20 20 28 6b 65 )...... (ke
4d20: 79 20 20 20 20 20 20 28 63 6f 6e 63 20 72 6f 77 y (conc row
4d30: 2d 6e 75 6d 20 22 3a 22 20 63 6f 6c 2d 6e 75 6d -num ":" col-num
4d40: 29 29 29 0a 09 09 09 09 09 20 28 69 66 20 28 6e )))...... (if (n
4d50: 6f 74 20 28 65 71 75 61 6c 3f 20 28 69 75 70 3a ot (equal? (iup:
4d60: 61 74 74 72 69 62 75 74 65 20 73 74 61 74 73 2d attribute stats-
4d70: 6d 61 74 72 69 78 20 6b 65 79 29 20 76 61 6c 75 matrix key) valu
4d80: 65 29 29 0a 09 09 09 09 09 20 20 20 20 20 28 62 e))...... (b
4d90: 65 67 69 6e 0a 09 09 09 09 09 20 20 20 20 20 20 egin......
4da0: 20 28 73 65 74 21 20 63 68 61 6e 67 65 64 20 23 (set! changed #
4db0: 74 29 0a 09 09 09 09 09 20 20 20 20 20 20 20 28 t)...... (
4dc0: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se
4dd0: 74 21 20 73 74 61 74 73 2d 6d 61 74 72 69 78 20 t! stats-matrix
4de0: 6b 65 79 20 76 61 6c 75 65 29 29 29 29 29 0a 09 key value)))))..
4df0: 09 09 09 20 20 20 20 20 72 75 6e 2d 73 74 61 74 ... run-stat
4e00: 73 29 0a 09 09 09 20 20 20 28 69 66 20 63 68 61 s).... (if cha
4e10: 6e 67 65 64 20 28 69 75 70 3a 61 74 74 72 69 62 nged (iup:attrib
4e20: 75 74 65 2d 73 65 74 21 20 73 74 61 74 73 2d 6d ute-set! stats-m
4e30: 61 74 72 69 78 20 22 52 45 44 52 41 57 22 20 22 atrix "REDRAW" "
4e40: 41 4c 4c 22 29 29 29 29 29 29 0a 20 20 20 20 28 ALL")))))). (
4e50: 75 70 64 61 74 65 72 29 0a 20 20 20 20 28 73 65 updater). (se
4e60: 74 21 20 64 61 73 68 62 6f 61 72 64 3a 75 70 64 t! dashboard:upd
4e70: 61 74 65 2d 73 75 6d 6d 61 72 79 2d 74 61 62 20 ate-summary-tab
4e80: 75 70 64 61 74 65 72 29 0a 20 20 20 20 28 69 75 updater). (iu
4e90: 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 p:attribute-set!
4ea0: 20 73 74 61 74 73 2d 6d 61 74 72 69 78 20 22 57 stats-matrix "W
4eb0: 49 44 54 48 44 45 46 22 20 22 34 30 22 29 0a 20 IDTHDEF" "40").
4ec0: 20 20 20 28 69 75 70 3a 76 62 6f 78 0a 20 20 20 (iup:vbox.
4ed0: 20 20 3b 3b 20 28 69 75 70 3a 6c 61 62 65 6c 20 ;; (iup:label
4ee0: 22 52 75 6e 20 73 74 61 74 69 73 74 69 63 73 22 "Run statistics"
4ef0: 20 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 #:expand "HORI
4f00: 5a 4f 4e 54 41 4c 22 29 0a 20 20 20 20 20 73 74 ZONTAL"). st
4f10: 61 74 73 2d 6d 61 74 72 69 78 29 29 29 0a 0a 28 ats-matrix)))..(
4f20: 64 65 66 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a define (dcommon:
4f30: 73 65 72 76 65 72 73 2d 74 61 62 6c 65 29 0a 20 servers-table).
4f40: 20 28 6c 65 74 2a 20 28 28 74 64 62 64 61 74 20 (let* ((tdbdat
4f50: 20 20 20 20 20 20 20 20 28 74 61 73 6b 73 3a 6f (tasks:o
4f60: 70 65 6e 2d 64 62 29 29 0a 09 20 28 63 6f 6c 6e pen-db)).. (coln
4f70: 75 6d 20 20 20 20 20 20 20 20 20 30 29 0a 09 20 um 0)..
4f80: 28 72 6f 77 6e 75 6d 20 20 20 20 20 20 20 20 20 (rownum
4f90: 30 29 0a 09 20 28 73 65 72 76 65 72 73 2d 6d 61 0).. (servers-ma
4fa0: 74 72 69 78 20 28 69 75 70 3a 6d 61 74 72 69 78 trix (iup:matrix
4fb0: 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 0a #:expand "YES".
4fc0: 09 09 09 09 20 20 20 20 20 23 3a 6e 75 6d 63 6f .... #:numco
4fd0: 6c 20 37 0a 09 09 09 09 20 20 20 20 20 23 3a 6e l 7..... #:n
4fe0: 75 6d 63 6f 6c 2d 76 69 73 69 62 6c 65 20 37 0a umcol-visible 7.
4ff0: 09 09 09 09 20 20 20 20 20 23 3a 6e 75 6d 6c 69 .... #:numli
5000: 6e 2d 76 69 73 69 62 6c 65 20 35 0a 09 09 09 09 n-visible 5.....
5010: 20 20 20 20 20 29 29 0a 09 20 28 63 6f 6c 6e 61 )).. (colna
5020: 6d 65 73 20 20 20 20 20 20 20 28 6c 69 73 74 20 mes (list
5030: 22 49 64 22 20 22 4d 54 76 65 72 22 20 22 50 69 "Id" "MTver" "Pi
5040: 64 22 20 22 48 6f 73 74 22 20 22 49 6e 74 65 72 d" "Host" "Inter
5050: 66 61 63 65 3a 4f 75 74 50 6f 72 74 22 20 22 52 face:OutPort" "R
5060: 75 6e 54 69 6d 65 22 20 22 53 74 61 74 65 22 20 unTime" "State"
5070: 22 52 75 6e 49 64 22 29 29 0a 09 20 28 75 70 64 "RunId")).. (upd
5080: 61 74 65 72 20 20 20 20 20 20 20 20 28 6c 61 6d ater (lam
5090: 62 64 61 20 28 29 0a 09 09 09 20 20 20 28 6c 65 bda ().... (le
50a0: 74 20 28 28 73 65 72 76 65 72 73 20 28 74 61 73 t ((servers (tas
50b0: 6b 73 3a 67 65 74 2d 61 6c 6c 2d 73 65 72 76 65 ks:get-all-serve
50c0: 72 73 20 28 64 62 3a 64 65 6c 61 79 2d 69 66 2d rs (db:delay-if-
50d0: 62 75 73 79 20 74 64 62 64 61 74 29 29 29 29 0a busy tdbdat)))).
50e0: 09 09 09 20 20 20 20 20 28 69 75 70 3a 61 74 74 ... (iup:att
50f0: 72 69 62 75 74 65 2d 73 65 74 21 20 73 65 72 76 ribute-set! serv
5100: 65 72 73 2d 6d 61 74 72 69 78 20 22 4e 55 4d 4c ers-matrix "NUML
5110: 49 4e 22 20 28 6c 65 6e 67 74 68 20 73 65 72 76 IN" (length serv
5120: 65 72 73 29 29 0a 09 09 09 20 20 20 20 20 3b 3b ers)).... ;;
5130: 20 28 73 65 74 21 20 63 6f 6c 6e 75 6d 20 30 29 (set! colnum 0)
5140: 0a 09 09 09 20 20 20 20 20 3b 3b 20 28 66 6f 72 .... ;; (for
5150: 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 63 -each (lambda (c
5160: 6f 6c 6e 61 6d 65 29 0a 09 09 09 20 20 20 20 20 olname)....
5170: 3b 3b 20 20 20 20 09 20 3b 3b 20 28 70 72 69 6e ;; . ;; (prin
5180: 74 20 22 63 6f 6c 6e 75 6d 3a 20 22 20 63 6f 6c t "colnum: " col
5190: 6e 75 6d 20 22 20 63 6f 6c 6e 61 6d 65 3a 20 22 num " colname: "
51a0: 20 63 6f 6c 6e 61 6d 65 29 0a 09 09 09 20 20 20 colname)....
51b0: 20 20 3b 3b 20 20 20 20 09 20 28 69 75 70 3a 61 ;; . (iup:a
51c0: 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 73 65 ttribute-set! se
51d0: 72 76 65 72 73 2d 6d 61 74 72 69 78 20 28 63 6f rvers-matrix (co
51e0: 6e 63 20 22 30 3a 22 20 63 6f 6c 6e 75 6d 29 20 nc "0:" colnum)
51f0: 63 6f 6c 6e 61 6d 65 29 0a 09 09 09 20 20 20 20 colname)....
5200: 20 3b 3b 20 20 20 20 09 20 28 73 65 74 21 20 63 ;; . (set! c
5210: 6f 6c 6e 75 6d 20 28 2b 20 31 20 63 6f 6c 6e 75 olnum (+ 1 colnu
5220: 6d 29 29 29 0a 09 09 09 20 20 20 20 20 3b 3b 20 m))).... ;;
5230: 20 20 20 20 20 20 20 20 20 20 63 6f 6c 6e 61 6d colnam
5240: 65 73 29 0a 09 09 09 20 20 20 20 20 28 73 65 74 es).... (set
5250: 21 20 72 6f 77 6e 75 6d 20 31 29 0a 09 09 09 20 ! rownum 1)....
5260: 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 (for-each ..
5270: 09 09 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 .. (lambda
5280: 28 73 65 72 76 65 72 29 0a 09 09 09 09 28 73 65 (server).....(se
5290: 74 21 20 63 6f 6c 6e 75 6d 20 30 29 0a 09 09 09 t! colnum 0)....
52a0: 09 28 6c 65 74 2a 20 28 28 76 61 6c 73 20 28 6c .(let* ((vals (l
52b0: 69 73 74 20 28 76 65 63 74 6f 72 2d 72 65 66 20 ist (vector-ref
52c0: 73 65 72 76 65 72 20 30 29 20 3b 3b 20 49 64 0a server 0) ;; Id.
52d0: 09 09 09 09 09 09 20 20 20 28 76 65 63 74 6f 72 ...... (vector
52e0: 2d 72 65 66 20 73 65 72 76 65 72 20 39 29 20 3b -ref server 9) ;
52f0: 3b 20 4d 54 2d 56 65 72 0a 09 09 09 09 09 09 20 ; MT-Ver.......
5300: 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 (vector-ref se
5310: 72 76 65 72 20 31 29 20 3b 3b 20 50 69 64 0a 09 rver 1) ;; Pid..
5320: 09 09 09 09 09 20 20 20 28 76 65 63 74 6f 72 2d ..... (vector-
5330: 72 65 66 20 73 65 72 76 65 72 20 32 29 20 3b 3b ref server 2) ;;
5340: 20 48 6f 73 74 6e 61 6d 65 0a 09 09 09 09 09 09 Hostname.......
5350: 20 20 20 28 63 6f 6e 63 20 28 76 65 63 74 6f 72 (conc (vector
5360: 2d 72 65 66 20 73 65 72 76 65 72 20 33 29 20 22 -ref server 3) "
5370: 3a 22 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 :" (vector-ref s
5380: 65 72 76 65 72 20 34 29 29 20 3b 3b 20 49 50 3a erver 4)) ;; IP:
5390: 50 6f 72 74 0a 09 09 09 09 09 09 20 20 20 28 73 Port....... (s
53a0: 65 63 6f 6e 64 73 2d 3e 68 72 2d 6d 69 6e 2d 73 econds->hr-min-s
53b0: 65 63 20 28 2d 20 28 63 75 72 72 65 6e 74 2d 73 ec (- (current-s
53c0: 65 63 6f 6e 64 73 29 28 76 65 63 74 6f 72 2d 72 econds)(vector-r
53d0: 65 66 20 73 65 72 76 65 72 20 36 29 29 29 0a 09 ef server 6)))..
53e0: 09 09 09 09 09 20 20 20 3b 3b 20 28 76 65 63 74 ..... ;; (vect
53f0: 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 35 29 or-ref server 5)
5400: 20 3b 3b 20 50 75 62 70 6f 72 74 0a 09 09 09 09 ;; Pubport.....
5410: 09 09 20 20 20 3b 3b 20 28 76 65 63 74 6f 72 2d .. ;; (vector-
5420: 72 65 66 20 73 65 72 76 65 72 20 31 30 29 20 3b ref server 10) ;
5430: 3b 20 4c 61 73 74 20 62 65 61 74 0a 09 09 09 09 ; Last beat.....
5440: 09 09 20 20 20 3b 3b 20 28 76 65 63 74 6f 72 2d .. ;; (vector-
5450: 72 65 66 20 73 65 72 76 65 72 20 36 29 20 3b 3b ref server 6) ;;
5460: 20 53 74 61 72 74 20 74 69 6d 65 0a 09 09 09 09 Start time.....
5470: 09 09 20 20 20 3b 3b 20 28 76 65 63 74 6f 72 2d .. ;; (vector-
5480: 72 65 66 20 73 65 72 76 65 72 20 37 29 20 3b 3b ref server 7) ;;
5490: 20 50 72 69 6f 72 69 74 79 0a 09 09 09 09 09 09 Priority.......
54a0: 20 20 20 3b 3b 20 28 76 65 63 74 6f 72 2d 72 65 ;; (vector-re
54b0: 66 20 73 65 72 76 65 72 20 38 29 20 3b 3b 20 53 f server 8) ;; S
54c0: 74 61 74 65 0a 09 09 09 09 09 09 20 20 20 28 76 tate....... (v
54d0: 65 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 ector-ref server
54e0: 20 38 29 20 3b 3b 20 53 74 61 74 65 0a 09 09 09 8) ;; State....
54f0: 09 09 09 20 20 20 28 76 65 63 74 6f 72 2d 72 65 ... (vector-re
5500: 66 20 73 65 72 76 65 72 20 31 32 29 20 20 3b 3b f server 12) ;;
5510: 20 52 75 6e 49 64 0a 09 09 09 09 09 09 20 20 20 RunId.......
5520: 29 29 29 0a 09 09 09 09 20 20 28 66 6f 72 2d 65 )))..... (for-e
5530: 61 63 68 20 28 6c 61 6d 62 64 61 20 28 76 61 6c ach (lambda (val
5540: 29 0a 09 09 09 09 09 20 20 20 20 20 20 28 6c 65 )...... (le
5550: 74 2a 20 28 28 72 6f 77 2d 63 6f 6c 20 28 63 6f t* ((row-col (co
5560: 6e 63 20 72 6f 77 6e 75 6d 20 22 3a 22 20 63 6f nc rownum ":" co
5570: 6c 6e 75 6d 29 29 0a 09 09 09 09 09 09 20 20 20 lnum)).......
5580: 20 20 28 63 75 72 72 2d 76 61 6c 20 28 69 75 70 (curr-val (iup
5590: 3a 61 74 74 72 69 62 75 74 65 20 73 65 72 76 65 :attribute serve
55a0: 72 73 2d 6d 61 74 72 69 78 20 72 6f 77 2d 63 6f rs-matrix row-co
55b0: 6c 29 29 29 0a 09 09 09 09 09 09 28 69 66 20 28 l))).......(if (
55c0: 6e 6f 74 20 28 65 71 75 61 6c 3f 20 28 63 6f 6e not (equal? (con
55d0: 63 20 76 61 6c 29 20 63 75 72 72 2d 76 61 6c 29 c val) curr-val)
55e0: 29 0a 09 09 09 09 09 09 20 20 20 20 28 62 65 67 )....... (beg
55f0: 69 6e 0a 09 09 09 09 09 09 20 20 20 20 20 20 28 in....... (
5600: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se
5610: 74 21 20 73 65 72 76 65 72 73 2d 6d 61 74 72 69 t! servers-matri
5620: 78 20 72 6f 77 2d 63 6f 6c 20 76 61 6c 29 0a 09 x row-col val)..
5630: 09 09 09 09 09 20 20 20 20 20 20 28 69 75 70 3a ..... (iup:
5640: 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 73 attribute-set! s
5650: 65 72 76 65 72 73 2d 6d 61 74 72 69 78 20 22 46 ervers-matrix "F
5660: 49 54 54 4f 54 45 58 54 22 20 28 63 6f 6e 63 20 ITTOTEXT" (conc
5670: 22 43 22 20 63 6f 6c 6e 75 6d 29 29 29 29 0a 09 "C" colnum))))..
5680: 09 09 09 09 09 28 73 65 74 21 20 63 6f 6c 6e 75 .....(set! colnu
5690: 6d 20 28 2b 20 31 20 63 6f 6c 6e 75 6d 29 29 29 m (+ 1 colnum)))
56a0: 29 0a 09 09 09 09 09 20 20 20 20 76 61 6c 73 29 )...... vals)
56b0: 0a 09 09 09 09 20 20 28 73 65 74 21 20 72 6f 77 ..... (set! row
56c0: 6e 75 6d 20 28 2b 20 72 6f 77 6e 75 6d 20 31 29 num (+ rownum 1)
56d0: 29 29 0a 09 09 09 09 20 28 69 75 70 3a 61 74 74 ))..... (iup:att
56e0: 72 69 62 75 74 65 2d 73 65 74 21 20 73 65 72 76 ribute-set! serv
56f0: 65 72 73 2d 6d 61 74 72 69 78 20 22 52 45 44 52 ers-matrix "REDR
5700: 41 57 22 20 22 41 4c 4c 22 29 29 0a 09 09 09 20 AW" "ALL"))....
5710: 20 20 20 20 20 73 65 72 76 65 72 73 29 29 29 29 servers))))
5720: 29 0a 20 20 20 20 28 73 65 74 21 20 63 6f 6c 6e ). (set! coln
5730: 75 6d 20 30 29 0a 20 20 20 20 28 66 6f 72 2d 65 um 0). (for-e
5740: 61 63 68 20 28 6c 61 6d 62 64 61 20 28 63 6f 6c ach (lambda (col
5750: 6e 61 6d 65 29 0a 09 09 28 69 75 70 3a 61 74 74 name)...(iup:att
5760: 72 69 62 75 74 65 2d 73 65 74 21 20 73 65 72 76 ribute-set! serv
5770: 65 72 73 2d 6d 61 74 72 69 78 20 28 63 6f 6e 63 ers-matrix (conc
5780: 20 22 30 3a 22 20 63 6f 6c 6e 75 6d 29 20 63 6f "0:" colnum) co
5790: 6c 6e 61 6d 65 29 0a 09 09 28 69 75 70 3a 61 74 lname)...(iup:at
57a0: 74 72 69 62 75 74 65 2d 73 65 74 21 20 73 65 72 tribute-set! ser
57b0: 76 65 72 73 2d 6d 61 74 72 69 78 20 22 46 49 54 vers-matrix "FIT
57c0: 54 4f 54 45 58 54 22 20 28 63 6f 6e 63 20 22 43 TOTEXT" (conc "C
57d0: 22 20 63 6f 6c 6e 75 6d 29 29 0a 09 09 28 73 65 " colnum))...(se
57e0: 74 21 20 63 6f 6c 6e 75 6d 20 28 2b 20 63 6f 6c t! colnum (+ col
57f0: 6e 75 6d 20 31 29 29 29 0a 09 20 20 20 20 20 20 num 1)))..
5800: 63 6f 6c 6e 61 6d 65 73 29 0a 20 20 20 20 28 73 colnames). (s
5810: 65 74 21 20 64 61 73 68 62 6f 61 72 64 3a 75 70 et! dashboard:up
5820: 64 61 74 65 2d 73 65 72 76 65 72 73 2d 74 61 62 date-servers-tab
5830: 6c 65 20 75 70 64 61 74 65 72 29 20 0a 20 20 20 le updater) .
5840: 20 3b 3b 20 28 69 75 70 3a 61 74 74 72 69 62 75 ;; (iup:attribu
5850: 74 65 2d 73 65 74 21 20 73 65 72 76 65 72 73 2d te-set! servers-
5860: 6d 61 74 72 69 78 20 22 57 49 44 54 48 44 45 46 matrix "WIDTHDEF
5870: 22 20 22 34 30 22 29 0a 20 20 20 3b 3b 20 20 28 " "40"). ;; (
5880: 69 75 70 3a 68 62 6f 78 0a 20 20 20 3b 3b 20 20 iup:hbox. ;;
5890: 20 28 69 75 70 3a 76 62 6f 78 0a 20 20 20 3b 3b (iup:vbox. ;;
58a0: 20 20 20 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 (iup:button
58b0: 22 53 74 61 72 74 22 0a 20 20 20 3b 3b 20 20 20 "Start". ;;
58c0: 20 20 20 09 20 20 3b 3b 20 23 3a 73 69 7a 65 20 . ;; #:size
58d0: 22 35 30 78 22 0a 20 20 20 3b 3b 20 20 20 20 20 "50x". ;;
58e0: 20 09 20 20 23 3a 65 78 70 61 6e 64 20 22 59 45 . #:expand "YE
58f0: 53 22 0a 20 20 20 3b 3b 20 20 20 20 20 20 09 20 S". ;; .
5900: 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 #:action (lambd
5910: 61 20 28 6f 62 6a 29 0a 20 20 20 3b 3b 20 20 20 a (obj). ;;
5920: 20 20 20 09 09 20 20 20 20 20 28 6c 65 74 20 28 .. (let (
5930: 28 63 6d 64 20 28 63 6f 6e 63 20 3b 3b 20 22 78 (cmd (conc ;; "x
5940: 74 65 72 6d 20 2d 67 65 6f 6d 65 74 72 79 20 31 term -geometry 1
5950: 38 30 78 32 30 20 2d 65 20 5c 22 22 0a 20 20 20 80x20 -e \"".
5960: 3b 3b 20 20 20 20 20 20 09 09 09 09 20 20 20 20 ;; ....
5970: 20 20 22 6d 65 67 61 74 65 73 74 20 2d 73 65 72 "megatest -ser
5980: 76 65 72 20 2d 20 26 22 29 29 29 0a 20 20 20 3b ver - &"))). ;
5990: 3b 20 20 20 20 20 20 09 09 09 09 20 20 20 20 20 ; ....
59a0: 20 3b 3b 20 22 3b 65 63 68 6f 20 50 72 65 73 73 ;; ";echo Press
59b0: 20 61 6e 79 20 6b 65 79 20 74 6f 20 63 6f 6e 74 any key to cont
59c0: 69 6e 75 65 3b 62 61 73 68 20 2d 63 20 27 72 65 inue;bash -c 're
59d0: 61 64 20 2d 6e 20 31 20 2d 73 27 5c 22 20 26 22 ad -n 1 -s'\" &"
59e0: 29 29 29 0a 20 20 20 3b 3b 20 20 20 20 20 20 09 ))). ;; .
59f0: 09 20 20 20 20 20 20 20 28 73 79 73 74 65 6d 20 . (system
5a00: 63 6d 64 29 29 29 29 0a 20 20 20 3b 3b 20 20 20 cmd)))). ;;
5a10: 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 53 74 (iup:button "St
5a20: 6f 70 22 0a 20 20 20 3b 3b 20 20 20 20 20 20 09 op". ;; .
5a30: 20 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 #:expand "YES"
5a40: 0a 20 20 20 3b 3b 20 20 20 20 20 20 09 20 20 3b . ;; . ;
5a50: 3b 20 23 3a 73 69 7a 65 20 22 35 30 78 22 0a 20 ; #:size "50x".
5a60: 20 20 3b 3b 20 20 20 20 20 20 09 20 20 23 3a 61 ;; . #:a
5a70: 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f ction (lambda (o
5a80: 62 6a 29 0a 20 20 20 3b 3b 20 20 20 20 20 20 09 bj). ;; .
5a90: 09 20 20 20 20 20 28 6c 65 74 20 28 28 63 6d 64 . (let ((cmd
5aa0: 20 28 63 6f 6e 63 20 3b 3b 20 22 78 74 65 72 6d (conc ;; "xterm
5ab0: 20 2d 67 65 6f 6d 65 74 72 79 20 31 38 30 78 32 -geometry 180x2
5ac0: 30 20 2d 65 20 5c 22 22 0a 20 20 20 3b 3b 20 20 0 -e \"". ;;
5ad0: 20 20 20 20 09 09 09 09 20 20 20 20 20 20 22 6d .... "m
5ae0: 65 67 61 74 65 73 74 20 2d 73 74 6f 70 2d 73 65 egatest -stop-se
5af0: 72 76 65 72 20 30 20 26 22 29 29 29 0a 20 20 20 rver 0 &"))).
5b00: 3b 3b 20 20 20 20 20 20 09 09 09 09 20 20 20 20 ;; ....
5b10: 20 20 3b 3b 20 22 3b 65 63 68 6f 20 50 72 65 73 ;; ";echo Pres
5b20: 73 20 61 6e 79 20 6b 65 79 20 74 6f 20 63 6f 6e s any key to con
5b30: 74 69 6e 75 65 3b 62 61 73 68 20 2d 63 20 27 72 tinue;bash -c 'r
5b40: 65 61 64 20 2d 6e 20 31 20 2d 73 27 5c 22 20 26 ead -n 1 -s'\" &
5b50: 22 29 29 29 0a 20 20 20 3b 3b 20 20 20 20 20 20 "))). ;;
5b60: 09 09 20 20 20 20 20 20 20 28 73 79 73 74 65 6d .. (system
5b70: 20 63 6d 64 29 29 29 29 0a 20 20 20 3b 3b 20 20 cmd)))). ;;
5b80: 20 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 52 (iup:button "R
5b90: 65 73 74 61 72 74 22 0a 20 20 20 3b 3b 20 20 20 estart". ;;
5ba0: 20 20 20 09 20 20 23 3a 65 78 70 61 6e 64 20 22 . #:expand "
5bb0: 59 45 53 22 0a 20 20 20 3b 3b 20 20 20 20 20 20 YES". ;;
5bc0: 09 20 20 3b 3b 20 23 3a 73 69 7a 65 20 22 35 30 . ;; #:size "50
5bd0: 78 22 0a 20 20 20 3b 3b 20 20 20 20 20 20 09 20 x". ;; .
5be0: 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 #:action (lambd
5bf0: 61 20 28 6f 62 6a 29 0a 20 20 20 3b 3b 20 20 20 a (obj). ;;
5c00: 20 20 20 09 09 20 20 20 20 20 28 6c 65 74 20 28 .. (let (
5c10: 28 63 6d 64 20 28 63 6f 6e 63 20 3b 3b 20 22 78 (cmd (conc ;; "x
5c20: 74 65 72 6d 20 2d 67 65 6f 6d 65 74 72 79 20 31 term -geometry 1
5c30: 38 30 78 32 30 20 2d 65 20 5c 22 22 0a 20 20 20 80x20 -e \"".
5c40: 3b 3b 20 20 20 20 20 20 09 09 09 09 20 20 20 20 ;; ....
5c50: 20 20 22 6d 65 67 61 74 65 73 74 20 2d 73 74 6f "megatest -sto
5c60: 70 2d 73 65 72 76 65 72 20 30 3b 6d 65 67 61 74 p-server 0;megat
5c70: 65 73 74 20 2d 73 65 72 76 65 72 20 2d 20 26 22 est -server - &"
5c80: 29 29 29 0a 20 20 20 3b 3b 20 20 20 20 20 20 09 ))). ;; .
5c90: 09 09 09 20 20 20 20 20 20 3b 3b 20 22 3b 65 63 ... ;; ";ec
5ca0: 68 6f 20 50 72 65 73 73 20 61 6e 79 20 6b 65 79 ho Press any key
5cb0: 20 74 6f 20 63 6f 6e 74 69 6e 75 65 3b 62 61 73 to continue;bas
5cc0: 68 20 2d 63 20 27 72 65 61 64 20 2d 6e 20 31 20 h -c 'read -n 1
5cd0: 2d 73 27 5c 22 20 26 22 29 29 29 0a 20 20 20 3b -s'\" &"))). ;
5ce0: 3b 20 20 20 20 20 20 09 09 20 20 20 20 20 20 20 ; ..
5cf0: 28 73 79 73 74 65 6d 20 63 6d 64 29 29 29 29 29 (system cmd)))))
5d00: 0a 20 20 20 3b 3b 20 20 20 20 73 65 72 76 65 72 . ;; server
5d10: 73 2d 6d 61 74 72 69 78 0a 20 20 20 3b 3b 20 20 s-matrix. ;;
5d20: 20 29 29 29 0a 20 20 20 20 73 65 72 76 65 72 73 ))). servers
5d30: 2d 6d 61 74 72 69 78 0a 20 20 20 20 29 29 0a 0a -matrix. ))..
5d40: 3b 3b 20 54 68 65 20 6d 61 69 6e 20 6d 65 6e 75 ;; The main menu
5d50: 0a 28 64 65 66 69 6e 65 20 28 64 63 6f 6d 6d 6f .(define (dcommo
5d60: 6e 3a 6d 61 69 6e 2d 6d 65 6e 75 29 0a 20 20 28 n:main-menu). (
5d70: 69 75 70 3a 6d 65 6e 75 20 3b 3b 20 61 20 6d 65 iup:menu ;; a me
5d80: 6e 75 20 69 73 20 61 20 73 70 65 63 69 61 6c 20 nu is a special
5d90: 61 74 74 72 69 62 75 74 65 20 74 6f 20 61 20 64 attribute to a d
5da0: 69 61 6c 6f 67 20 28 74 68 69 6e 6b 20 47 6e 6f ialog (think Gno
5db0: 6d 65 20 70 75 74 74 69 6e 67 20 74 68 65 20 6d me putting the m
5dc0: 65 6e 75 20 61 74 20 73 63 72 65 65 6e 20 74 6f enu at screen to
5dd0: 70 29 0a 20 20 20 28 69 75 70 3a 6d 65 6e 75 2d p). (iup:menu-
5de0: 69 74 65 6d 20 22 46 69 6c 65 73 22 20 28 69 75 item "Files" (iu
5df0: 70 3a 6d 65 6e 75 20 20 20 3b 3b 20 4e 6f 74 65 p:menu ;; Note
5e00: 20 74 68 61 74 20 79 6f 75 20 63 61 6e 20 75 73 that you can us
5e10: 65 20 65 69 74 68 65 72 20 23 3a 61 63 74 69 6f e either #:actio
5e20: 6e 20 6f 72 20 61 63 74 69 6f 6e 3a 20 66 6f 72 n or action: for
5e30: 20 6f 70 74 69 6f 6e 73 0a 09 09 20 20 20 20 20 options...
5e40: 20 20 28 69 75 70 3a 6d 65 6e 75 2d 69 74 65 6d (iup:menu-item
5e50: 20 22 4f 70 65 6e 22 20 20 61 63 74 69 6f 6e 3a "Open" action:
5e60: 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 0a 09 (lambda (obj)..
5e70: 09 09 09 09 09 09 28 69 75 70 3a 73 68 6f 77 20 ......(iup:show
5e80: 28 69 75 70 3a 66 69 6c 65 2d 64 69 61 6c 6f 67 (iup:file-dialog
5e90: 29 29 0a 09 09 09 09 09 09 09 28 70 72 69 6e 74 ))........(print
5ea0: 20 22 46 69 6c 65 2d 3e 6f 70 65 6e 20 22 20 6f "File->open " o
5eb0: 62 6a 29 29 29 0a 09 09 20 20 20 20 20 20 20 28 bj)))... (
5ec0: 69 75 70 3a 6d 65 6e 75 2d 69 74 65 6d 20 22 53 iup:menu-item "S
5ed0: 61 76 65 22 20 20 23 3a 61 63 74 69 6f 6e 20 28 ave" #:action (
5ee0: 6c 61 6d 62 64 61 20 28 6f 62 6a 29 28 70 72 69 lambda (obj)(pri
5ef0: 6e 74 20 22 46 69 6c 65 2d 3e 73 61 76 65 20 22 nt "File->save "
5f00: 20 6f 62 6a 29 29 29 0a 09 09 20 20 20 20 20 20 obj)))...
5f10: 20 28 69 75 70 3a 6d 65 6e 75 2d 69 74 65 6d 20 (iup:menu-item
5f20: 22 45 78 69 74 22 20 20 23 3a 61 63 74 69 6f 6e "Exit" #:action
5f30: 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 28 65 (lambda (obj)(e
5f40: 78 69 74 29 29 29 29 29 0a 20 20 20 28 69 75 70 xit))))). (iup
5f50: 3a 6d 65 6e 75 2d 69 74 65 6d 20 22 54 6f 6f 6c :menu-item "Tool
5f60: 73 22 20 28 69 75 70 3a 6d 65 6e 75 0a 09 09 20 s" (iup:menu...
5f70: 20 20 20 20 20 20 28 69 75 70 3a 6d 65 6e 75 2d (iup:menu-
5f80: 69 74 65 6d 20 22 43 72 65 61 74 65 20 6e 65 77 item "Create new
5f90: 20 62 6c 61 68 22 20 23 3a 61 63 74 69 6f 6e 20 blah" #:action
5fa0: 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 28 70 72 (lambda (obj)(pr
5fb0: 69 6e 74 20 22 54 6f 6f 6c 73 2d 3e 6e 65 77 20 int "Tools->new
5fc0: 62 6c 61 68 22 29 29 29 0a 09 09 20 20 20 20 20 blah")))...
5fd0: 20 20 3b 3b 20 28 69 75 70 3a 6d 65 6e 75 2d 69 ;; (iup:menu-i
5fe0: 74 65 6d 20 22 53 68 6f 77 20 64 69 61 6c 6f 67 tem "Show dialog
5ff0: 22 20 20 20 20 20 23 3a 61 63 74 69 6f 6e 20 28 " #:action (
6000: 6c 61 6d 62 64 61 20 28 6f 62 6a 29 0a 09 09 20 lambda (obj)...
6010: 20 20 20 20 20 20 3b 3b 20 20 09 09 09 09 09 20 ;; .....
6020: 20 20 28 73 68 6f 77 20 6d 65 73 73 61 67 65 2d (show message-
6030: 77 69 6e 64 6f 77 0a 09 09 20 20 20 20 20 20 20 window...
6040: 3b 3b 20 20 09 09 09 09 09 20 20 20 20 20 23 3a ;; ..... #:
6050: 6d 6f 64 61 6c 3f 20 23 74 0a 09 09 20 20 20 20 modal? #t...
6060: 20 20 20 3b 3b 20 20 09 09 09 09 09 20 20 20 20 ;; .....
6070: 20 3b 3b 20 73 65 74 20 70 6f 73 69 74 6f 6e 20 ;; set positon
6080: 75 73 69 6e 67 20 63 6f 6f 72 64 69 6e 61 74 65 using coordinate
6090: 73 20 6f 72 20 63 65 6e 74 65 72 2c 20 73 74 61 s or center, sta
60a0: 72 74 2c 20 74 6f 70 2c 20 6c 65 66 74 2c 20 65 rt, top, left, e
60b0: 6e 64 2c 20 62 6f 74 74 6f 6d 2c 20 72 69 67 68 nd, bottom, righ
60c0: 74 2c 20 70 61 72 65 6e 74 2d 63 65 6e 74 65 72 t, parent-center
60d0: 2c 20 63 75 72 72 65 6e 74 0a 09 09 20 20 20 20 , current...
60e0: 20 20 20 3b 3b 20 20 09 09 09 09 09 20 20 20 20 ;; .....
60f0: 20 3b 3b 20 23 3a 78 20 27 6d 6f 75 73 65 0a 09 ;; #:x 'mouse..
6100: 09 20 20 20 20 20 20 20 3b 3b 20 20 09 09 09 09 . ;; ....
6110: 09 20 20 20 20 20 3b 3b 20 23 3a 79 20 27 6d 6f . ;; #:y 'mo
6120: 75 73 65 0a 09 09 20 20 20 20 20 20 20 3b 3b 20 use... ;;
6130: 20 29 09 09 09 09 09 20 20 20 20 20 0a 09 09 20 )..... ...
6140: 20 20 20 20 20 20 29 29 29 29 0a 0a 3b 3b 3d 3d ))))..;;==
6150: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6160: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6170: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6180: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6190: 3d 3d 3d 3d 0a 3b 3b 20 43 41 4e 56 41 53 20 53 ====.;; CANVAS S
61a0: 54 55 46 46 20 46 4f 52 20 54 45 53 54 53 0a 3b TUFF FOR TESTS.;
61b0: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
61c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
61d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
61e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
61f0: 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 =======..(define
6200: 20 28 64 63 6f 6d 6d 6f 6e 3a 64 72 61 77 2d 74 (dcommon:draw-t
6210: 65 73 74 20 63 6e 76 20 78 20 79 20 77 20 68 20 est cnv x y w h
6220: 6e 61 6d 65 20 73 65 6c 65 63 74 65 64 29 0a 20 name selected).
6230: 20 28 6c 65 74 2a 20 28 28 6c 6c 78 20 78 29 0a (let* ((llx x).
6240: 09 20 28 6c 6c 79 20 79 29 0a 09 20 28 75 72 78 . (lly y).. (urx
6250: 20 28 2b 20 78 20 77 29 29 0a 09 20 28 75 72 79 (+ x w)).. (ury
6260: 20 28 2b 20 79 20 68 29 29 29 0a 20 20 20 20 28 (+ y h))). (
6270: 63 61 6e 76 61 73 2d 74 65 78 74 21 20 63 6e 76 canvas-text! cnv
6280: 20 28 2b 20 6c 6c 78 20 35 29 28 2b 20 6c 6c 79 (+ llx 5)(+ lly
6290: 20 35 29 20 6e 61 6d 65 29 20 3b 3b 20 28 63 6f 5) name) ;; (co
62a0: 6e 63 20 74 65 73 74 6e 61 6d 65 20 22 20 28 22 nc testname " ("
62b0: 20 78 74 6f 72 69 67 20 22 2c 22 20 79 74 6f 72 xtorig "," ytor
62c0: 69 67 20 22 29 22 29 29 0a 20 20 20 20 28 63 61 ig ")")). (ca
62d0: 6e 76 61 73 2d 72 65 63 74 61 6e 67 6c 65 21 20 nvas-rectangle!
62e0: 63 6e 76 20 6c 6c 78 20 75 72 78 20 6c 6c 79 20 cnv llx urx lly
62f0: 75 72 79 29 0a 20 20 20 20 28 69 66 20 73 65 6c ury). (if sel
6300: 65 63 74 65 64 20 28 63 61 6e 76 61 73 2d 62 6f ected (canvas-bo
6310: 78 21 20 63 6e 76 20 6c 6c 78 20 28 2b 20 6c 6c x! cnv llx (+ ll
6320: 78 20 35 29 20 6c 6c 79 20 28 2b 20 6c 6c 79 20 x 5) lly (+ lly
6330: 35 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 5)))))..(define
6340: 28 64 63 6f 6d 6d 6f 6e 3a 69 6e 69 74 69 61 6c (dcommon:initial
6350: 2d 64 72 61 77 2d 74 65 73 74 73 20 63 6e 76 20 -draw-tests cnv
6360: 78 61 64 6a 20 79 61 64 6a 20 73 69 7a 65 78 20 xadj yadj sizex
6370: 73 69 7a 65 79 20 73 69 7a 65 78 6d 6d 20 73 69 sizey sizexmm si
6380: 7a 65 79 6d 6d 20 6f 72 69 67 69 6e 78 20 6f 72 zeymm originx or
6390: 69 67 69 6e 79 20 74 65 73 74 73 2d 64 72 61 77 iginy tests-draw
63a0: 2d 73 74 61 74 65 20 73 6f 72 74 65 64 2d 74 65 -state sorted-te
63b0: 73 74 6e 61 6d 65 73 29 0a 20 20 20 20 20 20 28 stnames). (
63c0: 6c 65 74 2a 20 28 28 73 63 61 6c 65 66 20 28 68 let* ((scalef (h
63d0: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
63e0: 66 61 75 6c 74 20 74 65 73 74 73 2d 64 72 61 77 fault tests-draw
63f0: 2d 73 74 61 74 65 20 27 73 63 61 6c 65 66 20 38 -state 'scalef 8
6400: 29 29 0a 09 20 20 20 20 20 28 74 65 73 74 2d 62 )).. (test-b
6410: 72 6f 77 73 65 2d 78 6f 66 66 73 65 74 20 28 68 rowse-xoffset (h
6420: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 74 65 ash-table-ref te
6430: 73 74 73 2d 64 72 61 77 2d 73 74 61 74 65 20 27 sts-draw-state '
6440: 74 65 73 74 2d 62 72 6f 77 73 65 2d 78 6f 66 66 test-browse-xoff
6450: 73 65 74 29 29 0a 09 20 20 20 20 20 28 74 65 73 set)).. (tes
6460: 74 2d 62 72 6f 77 73 65 2d 79 6f 66 66 73 65 74 t-browse-yoffset
6470: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
6480: 20 74 65 73 74 73 2d 64 72 61 77 2d 73 74 61 74 tests-draw-stat
6490: 65 20 27 74 65 73 74 2d 62 72 6f 77 73 65 2d 79 e 'test-browse-y
64a0: 6f 66 66 73 65 74 29 29 0a 09 20 20 20 20 20 28 offset)).. (
64b0: 78 74 6f 72 69 67 20 28 2b 20 74 65 73 74 2d 62 xtorig (+ test-b
64c0: 72 6f 77 73 65 2d 78 6f 66 66 73 65 74 20 28 2a rowse-xoffset (*
64d0: 20 28 2f 20 73 69 7a 65 78 20 32 29 20 73 63 61 (/ sizex 2) sca
64e0: 6c 65 66 20 28 2d 20 30 2e 35 20 78 61 64 6a 29 lef (- 0.5 xadj)
64f0: 29 29 29 20 3b 3b 20 20 28 2d 20 78 61 64 6a 20 ))) ;; (- xadj
6500: 31 29 29 29 29 0a 09 20 20 20 20 20 28 79 74 6f 1)))).. (yto
6510: 72 69 67 20 28 2b 20 74 65 73 74 2d 62 72 6f 77 rig (+ test-brow
6520: 73 65 2d 79 6f 66 66 73 65 74 20 28 2a 20 28 2f se-yoffset (* (/
6530: 20 73 69 7a 65 79 20 32 29 20 73 63 61 6c 65 66 sizey 2) scalef
6540: 20 28 2d 20 79 61 64 6a 20 30 2e 35 29 29 29 29 (- yadj 0.5))))
6550: 0a 09 20 20 20 20 20 28 62 6f 78 77 20 20 20 39 .. (boxw 9
6560: 30 29 20 3b 3b 20 64 65 66 61 75 6c 74 2c 20 6f 0) ;; default, o
6570: 76 65 72 72 69 64 65 6e 20 62 79 20 6c 65 6e 67 verriden by leng
6580: 74 68 20 65 73 74 69 6d 61 74 65 20 62 65 6c 6f th estimate belo
6590: 77 0a 09 20 20 20 20 20 28 62 6f 78 68 20 20 20 w.. (boxh
65a0: 32 35 29 0a 09 20 20 20 20 20 28 67 61 70 78 20 25).. (gapx
65b0: 20 20 32 30 29 0a 09 20 20 20 20 20 28 67 61 70 20).. (gap
65c0: 79 20 20 20 33 30 29 0a 09 20 20 20 20 20 28 74 y 30).. (t
65d0: 65 73 74 73 2d 68 61 73 68 20 20 20 20 20 28 68 ests-hash (h
65e0: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 74 65 ash-table-ref te
65f0: 73 74 73 2d 64 72 61 77 2d 73 74 61 74 65 20 27 sts-draw-state '
6600: 74 65 73 74 73 2d 69 6e 66 6f 29 29 0a 09 20 20 tests-info))..
6610: 20 20 20 28 73 65 6c 65 63 74 65 64 2d 74 65 73 (selected-tes
6620: 74 73 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 ts (hash-table-r
6630: 65 66 20 74 65 73 74 73 2d 64 72 61 77 2d 73 74 ef tests-draw-st
6640: 61 74 65 20 27 73 65 6c 65 63 74 65 64 2d 74 65 ate 'selected-te
6650: 73 74 73 20 29 29 29 0a 09 28 68 61 73 68 2d 74 sts )))..(hash-t
6660: 61 62 6c 65 2d 73 65 74 21 20 74 65 73 74 73 2d able-set! tests-
6670: 64 72 61 77 2d 73 74 61 74 65 20 27 78 74 6f 72 draw-state 'xtor
6680: 69 67 20 78 74 6f 72 69 67 29 0a 09 28 68 61 73 ig xtorig)..(has
6690: 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 74 65 73 h-table-set! tes
66a0: 74 73 2d 64 72 61 77 2d 73 74 61 74 65 20 27 79 ts-draw-state 'y
66b0: 74 6f 72 69 67 20 79 74 6f 72 69 67 29 0a 09 28 torig ytorig)..(
66c0: 6c 65 74 20 28 28 6c 6f 6e 67 65 73 74 2d 73 74 let ((longest-st
66d0: 72 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 73 r (if (null? s
66e0: 6f 72 74 65 64 2d 74 65 73 74 6e 61 6d 65 73 29 orted-testnames)
66f0: 20 22 20 20 20 20 20 20 20 20 20 22 20 28 63 61 " " (ca
6700: 72 20 28 73 6f 72 74 20 73 6f 72 74 65 64 2d 74 r (sort sorted-t
6710: 65 73 74 6e 61 6d 65 73 20 28 6c 61 6d 62 64 61 estnames (lambda
6720: 20 28 61 20 62 29 28 3e 3d 20 28 73 74 72 69 6e (a b)(>= (strin
6730: 67 2d 6c 65 6e 67 74 68 20 61 29 28 73 74 72 69 g-length a)(stri
6740: 6e 67 2d 6c 65 6e 67 74 68 20 62 29 29 29 29 29 ng-length b)))))
6750: 29 29 29 0a 09 20 20 28 6c 65 74 2d 76 61 6c 75 ))).. (let-valu
6760: 65 73 20 28 28 28 78 2d 6d 61 78 20 79 2d 6d 61 es (((x-max y-ma
6770: 78 29 20 28 63 61 6e 76 61 73 2d 74 65 78 74 2d x) (canvas-text-
6780: 73 69 7a 65 20 63 6e 76 20 6c 6f 6e 67 65 73 74 size cnv longest
6790: 2d 73 74 72 29 29 29 0a 20 20 20 20 20 20 20 20 -str))).
67a0: 20 20 20 20 20 28 69 66 20 28 3e 20 78 2d 6d 61 (if (> x-ma
67b0: 78 20 62 6f 78 77 29 28 73 65 74 21 20 62 6f 78 x boxw)(set! box
67c0: 77 20 28 2b 20 31 30 20 78 2d 6d 61 78 29 29 29 w (+ 10 x-max)))
67d0: 29 29 0a 09 3b 3b 20 28 70 72 69 6e 74 20 22 73 ))..;; (print "s
67e0: 69 7a 65 78 3a 20 22 20 73 69 7a 65 78 20 22 20 izex: " sizex "
67f0: 73 69 7a 65 79 3a 20 22 20 73 69 7a 65 79 20 22 sizey: " sizey "
6800: 20 66 6f 6e 74 3a 20 22 20 28 63 61 6e 76 61 73 font: " (canvas
6810: 2d 66 6f 6e 74 20 63 6e 76 29 20 22 20 6f 72 69 -font cnv) " ori
6820: 67 69 6e 78 3a 20 22 20 6f 72 69 67 69 6e 78 20 ginx: " originx
6830: 22 20 6f 72 69 67 69 6e 79 3a 20 22 20 6f 72 69 " originy: " ori
6840: 67 69 6e 79 20 22 20 78 74 6f 72 69 67 3a 20 22 giny " xtorig: "
6850: 20 78 74 6f 72 69 67 20 22 20 79 74 6f 72 69 67 xtorig " ytorig
6860: 3a 20 22 20 79 74 6f 72 69 67 20 22 20 78 61 64 : " ytorig " xad
6870: 6a 3a 20 22 20 78 61 64 6a 20 22 20 79 61 64 6a j: " xadj " yadj
6880: 3a 20 22 20 79 61 64 6a 29 0a 09 28 69 66 20 28 : " yadj)..(if (
6890: 6e 6f 74 20 28 6e 75 6c 6c 3f 20 73 6f 72 74 65 not (null? sorte
68a0: 64 2d 74 65 73 74 6e 61 6d 65 73 29 29 0a 09 20 d-testnames))..
68b0: 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 68 (let loop ((h
68c0: 65 64 20 28 63 61 72 20 28 72 65 76 65 72 73 65 ed (car (reverse
68d0: 20 73 6f 72 74 65 64 2d 74 65 73 74 6e 61 6d 65 sorted-testname
68e0: 73 29 29 29 0a 09 09 20 20 20 20 20 20 20 28 74 s)))... (t
68f0: 61 6c 20 28 63 64 72 20 28 72 65 76 65 72 73 65 al (cdr (reverse
6900: 20 73 6f 72 74 65 64 2d 74 65 73 74 6e 61 6d 65 sorted-testname
6910: 73 29 29 29 0a 09 09 20 20 20 20 20 20 20 28 6c s)))... (l
6920: 6c 78 20 78 74 6f 72 69 67 29 0a 09 09 20 20 20 lx xtorig)...
6930: 20 20 20 20 28 6c 6c 79 20 79 74 6f 72 69 67 29 (lly ytorig)
6940: 0a 09 09 20 20 20 20 20 20 20 28 75 72 78 20 28 ... (urx (
6950: 2b 20 78 74 6f 72 69 67 20 62 6f 78 77 29 29 0a + xtorig boxw)).
6960: 09 09 20 20 20 20 20 20 20 28 75 72 79 20 28 2b .. (ury (+
6970: 20 79 74 6f 72 69 67 20 62 6f 78 68 29 29 29 0a ytorig boxh))).
6980: 09 09 09 09 09 3b 20 28 70 72 69 6e 74 20 22 68 .....; (print "h
6990: 65 64 20 22 20 68 65 64 20 22 20 6c 6c 78 20 22 ed " hed " llx "
69a0: 20 6c 6c 78 20 22 20 6c 6c 79 20 22 20 6c 6c 79 llx " lly " lly
69b0: 20 22 20 75 72 78 20 22 20 75 72 78 20 22 20 75 " urx " urx " u
69c0: 72 79 20 22 20 75 72 79 29 0a 09 20 20 20 20 20 ry " ury)..
69d0: 20 28 64 63 6f 6d 6d 6f 6e 3a 64 72 61 77 2d 74 (dcommon:draw-t
69e0: 65 73 74 20 63 6e 76 20 6c 6c 78 20 6c 6c 79 20 est cnv llx lly
69f0: 62 6f 78 77 20 62 6f 78 68 20 68 65 64 20 28 68 boxw boxh hed (h
6a00: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
6a10: 66 61 75 6c 74 20 73 65 6c 65 63 74 65 64 2d 74 fault selected-t
6a20: 65 73 74 73 20 68 65 64 20 23 66 29 29 0a 09 20 ests hed #f))..
6a30: 20 20 20 20 20 3b 3b 20 64 61 74 61 20 75 73 65 ;; data use
6a40: 64 20 62 79 20 6d 6f 75 73 65 20 63 6c 69 63 6b d by mouse click
6a50: 20 63 61 6c 63 2e 20 6b 65 65 70 20 74 68 65 20 calc. keep the
6a60: 77 61 63 6b 79 20 6f 72 64 65 72 20 66 6f 72 20 wacky order for
6a70: 6e 6f 77 2e 0a 09 20 20 20 20 20 20 28 68 61 73 now... (has
6a80: 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 74 65 73 h-table-set! tes
6a90: 74 73 2d 68 61 73 68 20 68 65 64 20 20 28 6c 69 ts-hash hed (li
6aa0: 73 74 20 6c 6c 78 20 75 72 78 20 28 2d 20 73 69 st llx urx (- si
6ab0: 7a 65 79 20 75 72 79 29 28 2d 20 73 69 7a 65 79 zey ury)(- sizey
6ac0: 20 6c 6c 79 29 20 6c 6c 79 20 62 6f 78 77 20 62 lly) lly boxw b
6ad0: 6f 78 68 29 29 20 0a 09 20 20 20 20 20 20 3b 3b oxh)) .. ;;
6ae0: 20 28 6c 69 73 74 20 6c 6c 78 20 6c 6c 79 20 62 (list llx lly b
6af0: 6f 78 77 20 62 6f 78 68 29 29 20 3b 3b 20 4e 42 oxw boxh)) ;; NB
6b00: 2f 2f 20 53 77 61 70 20 75 72 79 20 61 6e 64 20 // Swap ury and
6b10: 6c 6c 79 0a 09 20 20 20 20 20 20 28 69 66 20 28 lly.. (if (
6b20: 6e 6f 74 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 29 not (null? tal))
6b30: 0a 09 09 20 20 3b 3b 20 6c 65 61 76 65 20 61 20 ... ;; leave a
6b40: 63 6f 6c 75 6d 6e 20 6f 66 20 73 70 61 63 65 20 column of space
6b50: 74 6f 20 74 68 65 20 72 69 67 68 74 20 74 6f 20 to the right to
6b60: 6c 69 73 74 20 69 74 65 6d 73 0a 09 09 20 20 28 list items... (
6b70: 6c 65 74 20 28 28 68 61 76 65 2d 72 6f 6f 6d 20 let ((have-room
6b80: 0a 09 09 09 20 28 69 66 20 23 74 20 3b 3b 20 70 .... (if #t ;; p
6b90: 75 74 20 22 61 75 74 6f 22 20 68 65 72 65 20 77 ut "auto" here w
6ba0: 68 65 72 65 20 73 6f 6d 65 20 66 6f 72 6d 20 6f here some form o
6bb0: 66 20 61 75 74 6f 20 72 65 61 72 61 6e 67 69 6e f auto rearangin
6bc0: 67 20 63 61 6e 20 62 65 20 64 6f 6e 65 0a 09 09 g can be done...
6bd0: 09 20 20 20 20 20 28 3e 20 28 2a 20 33 20 28 2b . (> (* 3 (+
6be0: 20 62 6f 78 77 20 67 61 70 78 29 29 20 28 2d 20 boxw gapx)) (-
6bf0: 75 72 78 20 78 74 6f 72 69 67 29 29 0a 09 09 09 urx xtorig))....
6c00: 20 20 20 20 20 28 3c 20 75 72 78 20 28 2d 20 73 (< urx (- s
6c10: 69 7a 65 78 20 62 6f 78 77 20 67 61 70 78 20 62 izex boxw gapx b
6c20: 6f 78 77 29 29 29 29 29 20 20 3b 3b 20 69 73 20 oxw))))) ;; is
6c30: 74 68 65 72 65 20 72 6f 6f 6d 20 66 6f 72 20 61 there room for a
6c40: 6e 6f 74 68 65 72 20 63 6f 6c 75 6d 6e 3f 0a 09 nother column?..
6c50: 09 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 . (loop (car
6c60: 74 61 6c 29 0a 09 09 09 20 20 28 63 64 72 20 74 tal).... (cdr t
6c70: 61 6c 29 0a 09 09 09 20 20 28 69 66 20 68 61 76 al).... (if hav
6c80: 65 2d 72 6f 6f 6d 20 28 2b 20 6c 6c 78 20 62 6f e-room (+ llx bo
6c90: 78 77 20 67 61 70 78 29 20 78 74 6f 72 69 67 29 xw gapx) xtorig)
6ca0: 20 3b 3b 20 68 61 76 65 20 72 6f 6f 6d 2c 20 0a ;; have room, .
6cb0: 09 09 09 20 20 28 69 66 20 68 61 76 65 2d 72 6f ... (if have-ro
6cc0: 6f 6d 20 6c 6c 79 20 28 2b 20 6c 6c 79 20 62 6f om lly (+ lly bo
6cd0: 78 68 20 67 61 70 79 29 29 0a 09 09 09 20 20 28 xh gapy)).... (
6ce0: 69 66 20 68 61 76 65 2d 72 6f 6f 6d 20 28 2b 20 if have-room (+
6cf0: 75 72 78 20 62 6f 78 77 20 67 61 70 78 29 20 28 urx boxw gapx) (
6d00: 2b 20 78 74 6f 72 69 67 20 62 6f 78 77 29 29 0a + xtorig boxw)).
6d10: 09 09 09 20 20 28 69 66 20 68 61 76 65 2d 72 6f ... (if have-ro
6d20: 6f 6d 20 75 72 79 20 28 2b 20 75 72 79 20 62 6f om ury (+ ury bo
6d30: 78 68 20 67 61 70 79 29 29 29 29 29 29 29 29 29 xh gapy)))))))))
6d40: 0a 0a 28 64 65 66 69 6e 65 20 28 64 63 6f 6d 6d ..(define (dcomm
6d50: 6f 6e 3a 72 65 64 72 61 77 2d 74 65 73 74 73 20 on:redraw-tests
6d60: 63 6e 76 20 78 61 64 6a 20 79 61 64 6a 20 73 69 cnv xadj yadj si
6d70: 7a 65 78 20 73 69 7a 65 79 20 73 69 7a 65 78 6d zex sizey sizexm
6d80: 6d 20 73 69 7a 65 79 6d 6d 20 6f 72 69 67 69 6e m sizeymm origin
6d90: 78 20 6f 72 69 67 69 6e 79 20 74 65 73 74 73 2d x originy tests-
6da0: 64 72 61 77 2d 73 74 61 74 65 20 73 6f 72 74 65 draw-state sorte
6db0: 64 2d 74 65 73 74 6e 61 6d 65 73 29 0a 20 20 28 d-testnames). (
6dc0: 6c 65 74 2a 20 28 28 73 63 61 6c 65 66 20 28 68 let* ((scalef (h
6dd0: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
6de0: 66 61 75 6c 74 20 74 65 73 74 73 2d 64 72 61 77 fault tests-draw
6df0: 2d 73 74 61 74 65 20 27 73 63 61 6c 65 66 20 38 -state 'scalef 8
6e00: 29 29 0a 09 20 28 74 65 73 74 2d 62 72 6f 77 73 )).. (test-brows
6e10: 65 2d 78 6f 66 66 73 65 74 20 28 68 61 73 68 2d e-xoffset (hash-
6e20: 74 61 62 6c 65 2d 72 65 66 20 74 65 73 74 73 2d table-ref tests-
6e30: 64 72 61 77 2d 73 74 61 74 65 20 27 74 65 73 74 draw-state 'test
6e40: 2d 62 72 6f 77 73 65 2d 78 6f 66 66 73 65 74 29 -browse-xoffset)
6e50: 29 0a 09 20 28 74 65 73 74 2d 62 72 6f 77 73 65 ).. (test-browse
6e60: 2d 79 6f 66 66 73 65 74 20 28 68 61 73 68 2d 74 -yoffset (hash-t
6e70: 61 62 6c 65 2d 72 65 66 20 74 65 73 74 73 2d 64 able-ref tests-d
6e80: 72 61 77 2d 73 74 61 74 65 20 27 74 65 73 74 2d raw-state 'test-
6e90: 62 72 6f 77 73 65 2d 79 6f 66 66 73 65 74 29 29 browse-yoffset))
6ea0: 0a 09 20 28 78 74 6f 72 69 67 20 28 2b 20 74 65 .. (xtorig (+ te
6eb0: 73 74 2d 62 72 6f 77 73 65 2d 78 6f 66 66 73 65 st-browse-xoffse
6ec0: 74 20 28 2a 20 28 2f 20 73 69 7a 65 78 20 32 29 t (* (/ sizex 2)
6ed0: 20 73 63 61 6c 65 66 20 28 2d 20 30 2e 35 20 78 scalef (- 0.5 x
6ee0: 61 64 6a 29 29 29 29 20 3b 3b 20 20 28 2d 20 78 adj)))) ;; (- x
6ef0: 61 64 6a 20 31 29 29 29 29 0a 09 20 28 79 74 6f adj 1)))).. (yto
6f00: 72 69 67 20 28 2b 20 74 65 73 74 2d 62 72 6f 77 rig (+ test-brow
6f10: 73 65 2d 79 6f 66 66 73 65 74 20 28 2a 20 28 2f se-yoffset (* (/
6f20: 20 73 69 7a 65 79 20 32 29 20 73 63 61 6c 65 66 sizey 2) scalef
6f30: 20 28 2d 20 79 61 64 6a 20 30 2e 35 29 29 29 29 (- yadj 0.5))))
6f40: 0a 09 20 28 78 64 65 6c 74 61 20 28 2d 20 28 68 .. (xdelta (- (h
6f50: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 74 65 ash-table-ref te
6f60: 73 74 73 2d 64 72 61 77 2d 73 74 61 74 65 20 27 sts-draw-state '
6f70: 78 74 6f 72 69 67 29 20 78 74 6f 72 69 67 29 29 xtorig) xtorig))
6f80: 0a 09 20 28 79 64 65 6c 74 61 20 28 2d 20 28 68 .. (ydelta (- (h
6f90: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 74 65 ash-table-ref te
6fa0: 73 74 73 2d 64 72 61 77 2d 73 74 61 74 65 20 27 sts-draw-state '
6fb0: 79 74 6f 72 69 67 29 20 79 74 6f 72 69 67 29 29 ytorig) ytorig))
6fc0: 0a 09 20 28 74 65 73 74 73 2d 68 61 73 68 20 20 .. (tests-hash
6fd0: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 (hash-table-r
6fe0: 65 66 20 74 65 73 74 73 2d 64 72 61 77 2d 73 74 ef tests-draw-st
6ff0: 61 74 65 20 27 74 65 73 74 73 2d 69 6e 66 6f 29 ate 'tests-info)
7000: 29 0a 09 20 28 73 65 6c 65 63 74 65 64 2d 74 65 ).. (selected-te
7010: 73 74 73 20 28 68 61 73 68 2d 74 61 62 6c 65 2d sts (hash-table-
7020: 72 65 66 20 74 65 73 74 73 2d 64 72 61 77 2d 73 ref tests-draw-s
7030: 74 61 74 65 20 27 73 65 6c 65 63 74 65 64 2d 74 tate 'selected-t
7040: 65 73 74 73 20 29 29 29 0a 20 20 20 20 28 68 61 ests ))). (ha
7050: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 74 65 sh-table-set! te
7060: 73 74 73 2d 64 72 61 77 2d 73 74 61 74 65 20 27 sts-draw-state '
7070: 78 74 6f 72 69 67 20 78 74 6f 72 69 67 29 0a 20 xtorig xtorig).
7080: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 (hash-table-s
7090: 65 74 21 20 74 65 73 74 73 2d 64 72 61 77 2d 73 et! tests-draw-s
70a0: 74 61 74 65 20 27 79 74 6f 72 69 67 20 79 74 6f tate 'ytorig yto
70b0: 72 69 67 29 0a 20 20 20 20 28 69 66 20 28 6e 6f rig). (if (no
70c0: 74 20 28 6e 75 6c 6c 3f 20 73 6f 72 74 65 64 2d t (null? sorted-
70d0: 74 65 73 74 6e 61 6d 65 73 29 29 0a 09 28 6c 65 testnames))..(le
70e0: 74 20 6c 6f 6f 70 20 28 28 68 65 64 20 28 63 61 t loop ((hed (ca
70f0: 72 20 28 72 65 76 65 72 73 65 20 73 6f 72 74 65 r (reverse sorte
7100: 64 2d 74 65 73 74 6e 61 6d 65 73 29 29 29 0a 09 d-testnames)))..
7110: 09 20 20 20 28 74 61 6c 20 28 63 64 72 20 28 72 . (tal (cdr (r
7120: 65 76 65 72 73 65 20 73 6f 72 74 65 64 2d 74 65 everse sorted-te
7130: 73 74 6e 61 6d 65 73 29 29 29 29 0a 09 20 20 28 stnames)))).. (
7140: 6c 65 74 2a 20 28 28 74 76 61 6c 73 20 28 68 61 let* ((tvals (ha
7150: 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 74 65 73 sh-table-ref tes
7160: 74 73 2d 68 61 73 68 20 68 65 64 29 29 0a 09 09 ts-hash hed))...
7170: 20 28 6c 6c 78 20 20 20 28 2b 20 78 64 65 6c 74 (llx (+ xdelt
7180: 61 20 28 6c 69 73 74 2d 72 65 66 20 74 76 61 6c a (list-ref tval
7190: 73 20 30 29 29 29 0a 09 09 20 28 6c 6c 79 20 20 s 0)))... (lly
71a0: 20 28 2b 20 79 64 65 6c 74 61 20 28 6c 69 73 74 (+ ydelta (list
71b0: 2d 72 65 66 20 74 76 61 6c 73 20 34 29 29 29 0a -ref tvals 4))).
71c0: 09 09 20 28 62 6f 78 77 20 20 28 6c 69 73 74 2d .. (boxw (list-
71d0: 72 65 66 20 74 76 61 6c 73 20 35 29 29 0a 09 09 ref tvals 5))...
71e0: 20 28 62 6f 78 68 20 20 28 6c 69 73 74 2d 72 65 (boxh (list-re
71f0: 66 20 74 76 61 6c 73 20 36 29 29 0a 09 09 20 28 f tvals 6))... (
7200: 75 72 78 20 20 20 28 2b 20 6c 6c 78 20 62 6f 78 urx (+ llx box
7210: 77 29 29 0a 09 09 20 28 75 72 79 20 20 20 28 2b w))... (ury (+
7220: 20 6c 6c 79 20 62 6f 78 68 29 29 29 0a 09 20 20 lly boxh)))..
7230: 20 20 28 64 63 6f 6d 6d 6f 6e 3a 64 72 61 77 2d (dcommon:draw-
7240: 74 65 73 74 20 63 6e 76 20 6c 6c 78 20 6c 6c 79 test cnv llx lly
7250: 20 62 6f 78 77 20 62 6f 78 68 20 68 65 64 20 28 boxw boxh hed (
7260: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d
7270: 65 66 61 75 6c 74 20 73 65 6c 65 63 74 65 64 2d efault selected-
7280: 74 65 73 74 73 20 68 65 64 20 23 66 29 29 0a 09 tests hed #f))..
7290: 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (hash-table-
72a0: 73 65 74 21 20 74 65 73 74 73 2d 68 61 73 68 20 set! tests-hash
72b0: 68 65 64 20 28 6c 69 73 74 20 6c 6c 78 20 75 72 hed (list llx ur
72c0: 78 20 28 2d 20 73 69 7a 65 79 20 75 72 79 29 28 x (- sizey ury)(
72d0: 2d 20 73 69 7a 65 79 20 6c 6c 79 29 20 6c 6c 79 - sizey lly) lly
72e0: 20 62 6f 78 77 20 62 6f 78 68 29 29 0a 09 20 20 boxw boxh))..
72f0: 20 20 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c (if (not (null
7300: 3f 20 74 61 6c 29 29 0a 09 09 3b 3b 20 6c 65 61 ? tal))...;; lea
7310: 76 65 20 61 20 63 6f 6c 75 6d 6e 20 6f 66 20 73 ve a column of s
7320: 70 61 63 65 20 74 6f 20 74 68 65 20 72 69 67 68 pace to the righ
7330: 74 20 74 6f 20 6c 69 73 74 20 69 74 65 6d 73 0a t to list items.
7340: 09 09 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c ..(loop (car tal
7350: 29 0a 09 09 20 20 20 20 20 20 28 63 64 72 20 74 )... (cdr t
7360: 61 6c 29 29 29 29 29 29 29 29 0a 0a 3b 3b 3d 3d al))))))))..;;==
7370: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7380: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7390: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
73a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
73b0: 3d 3d 3d 3d 0a 3b 3b 20 20 53 20 54 20 45 20 50 ====.;; S T E P
73c0: 20 53 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d S.;;===========
73d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
73e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
73f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7400: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 ===========..;;
7410: 43 48 45 43 4b 20 2d 20 57 41 53 20 54 48 49 53 CHECK - WAS THIS
7420: 20 41 44 44 45 44 20 4f 52 20 52 45 4d 4f 56 45 ADDED OR REMOVE
7430: 44 3f 20 4d 41 4e 55 41 4c 20 4d 45 52 47 45 20 D? MANUAL MERGE
7440: 57 49 54 48 20 41 50 49 20 53 54 55 46 46 21 21 WITH API STUFF!!
7450: 21 0a 3b 3b 0a 3b 3b 20 67 65 74 20 61 20 70 72 !.;;.;; get a pr
7460: 65 74 74 79 20 74 61 62 6c 65 20 74 6f 20 73 75 etty table to su
7470: 6d 6d 61 72 69 7a 65 20 73 74 65 70 73 0a 3b 3b mmarize steps.;;
7480: 0a 28 64 65 66 69 6e 65 20 28 64 63 6f 6d 6d 6f .(define (dcommo
7490: 6e 3a 70 72 6f 63 65 73 73 2d 73 74 65 70 73 2d n:process-steps-
74a0: 74 61 62 6c 65 20 73 74 65 70 73 29 3b 3b 20 64 table steps);; d
74b0: 62 20 74 65 73 74 2d 69 64 20 23 21 6b 65 79 20 b test-id #!key
74c0: 28 77 6f 72 6b 2d 61 72 65 61 20 23 66 29 29 0a (work-area #f)).
74d0: 3b 3b 20 20 28 6c 65 74 20 28 28 73 74 65 70 73 ;; (let ((steps
74e0: 20 20 20 28 64 62 3a 67 65 74 2d 73 74 65 70 73 (db:get-steps
74f0: 2d 66 6f 72 2d 74 65 73 74 20 64 62 20 74 65 73 -for-test db tes
7500: 74 2d 69 64 20 77 6f 72 6b 2d 61 72 65 61 3a 20 t-id work-area:
7510: 77 6f 72 6b 2d 61 72 65 61 29 29 29 0a 20 20 20 work-area))).
7520: 20 3b 3b 20 6f 72 67 61 6e 69 73 65 20 74 68 65 ;; organise the
7530: 20 73 74 65 70 73 20 66 6f 72 20 62 65 74 74 65 steps for bette
7540: 72 20 72 65 61 64 61 62 69 6c 69 74 79 0a 20 20 r readability.
7550: 20 20 28 6c 65 74 20 28 28 72 65 73 20 28 6d 61 (let ((res (ma
7560: 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 29 ke-hash-table)))
7570: 0a 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 . (for-each
7580: 20 0a 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 . (lambda
7590: 20 28 73 74 65 70 29 0a 09 20 28 64 65 62 75 67 (step).. (debug
75a0: 3a 70 72 69 6e 74 20 36 20 22 73 74 65 70 3d 22 :print 6 "step="
75b0: 20 73 74 65 70 29 0a 09 20 28 6c 65 74 20 28 28 step).. (let ((
75c0: 72 65 63 6f 72 64 20 28 68 61 73 68 2d 74 61 62 record (hash-tab
75d0: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 0a le-ref/default .
75e0: 09 09 09 72 65 73 20 0a 09 09 09 28 74 64 62 3a ...res ....(tdb:
75f0: 73 74 65 70 2d 67 65 74 2d 73 74 65 70 6e 61 6d step-get-stepnam
7600: 65 20 73 74 65 70 29 20 0a 09 09 09 3b 3b 20 20 e step) ....;;
7610: 20 20 20 20 20 20 73 74 65 70 6e 61 6d 65 20 20 stepname
7620: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 74 st
7630: 61 72 74 20 65 6e 64 20 73 74 61 74 75 73 20 44 art end status D
7640: 75 72 61 74 69 6f 6e 20 20 4c 6f 67 66 69 6c 65 uration Logfile
7650: 20 0a 09 09 09 28 76 65 63 74 6f 72 20 28 74 64 ....(vector (td
7660: 62 3a 73 74 65 70 2d 67 65 74 2d 73 74 65 70 6e b:step-get-stepn
7670: 61 6d 65 20 73 74 65 70 29 20 22 22 20 20 20 22 ame step) "" "
7680: 22 20 22 22 20 20 20 20 20 22 22 20 20 20 20 20 " "" ""
7690: 20 20 20 22 22 29 29 29 29 0a 09 20 20 20 28 64 "")))).. (d
76a0: 65 62 75 67 3a 70 72 69 6e 74 20 36 20 22 72 65 ebug:print 6 "re
76b0: 63 6f 72 64 28 62 65 66 6f 72 65 29 20 3d 20 22 cord(before) = "
76c0: 20 72 65 63 6f 72 64 20 0a 09 09 09 22 5c 6e 69 record ...."\ni
76d0: 64 3a 20 20 20 20 20 20 20 22 20 28 74 64 62 3a d: " (tdb:
76e0: 73 74 65 70 2d 67 65 74 2d 69 64 20 73 74 65 70 step-get-id step
76f0: 29 0a 09 09 09 22 5c 6e 73 74 65 70 6e 61 6d 65 )...."\nstepname
7700: 3a 20 22 20 28 74 64 62 3a 73 74 65 70 2d 67 65 : " (tdb:step-ge
7710: 74 2d 73 74 65 70 6e 61 6d 65 20 73 74 65 70 29 t-stepname step)
7720: 0a 09 09 09 22 5c 6e 73 74 61 74 65 3a 20 20 20 ...."\nstate:
7730: 20 22 20 28 74 64 62 3a 73 74 65 70 2d 67 65 74 " (tdb:step-get
7740: 2d 73 74 61 74 65 20 73 74 65 70 29 0a 09 09 09 -state step)....
7750: 22 5c 6e 73 74 61 74 75 73 3a 20 20 20 22 20 28 "\nstatus: " (
7760: 74 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 74 61 tdb:step-get-sta
7770: 74 75 73 20 73 74 65 70 29 0a 09 09 09 22 5c 6e tus step)...."\n
7780: 74 69 6d 65 3a 20 20 20 20 20 22 20 28 74 64 62 time: " (tdb
7790: 3a 73 74 65 70 2d 67 65 74 2d 65 76 65 6e 74 5f :step-get-event_
77a0: 74 69 6d 65 20 73 74 65 70 29 29 0a 09 20 20 20 time step))..
77b0: 28 63 61 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 (case (string->s
77c0: 79 6d 62 6f 6c 20 28 74 64 62 3a 73 74 65 70 2d ymbol (tdb:step-
77d0: 67 65 74 2d 73 74 61 74 65 20 73 74 65 70 29 29 get-state step))
77e0: 0a 09 20 20 20 20 20 28 28 73 74 61 72 74 29 28 .. ((start)(
77f0: 76 65 63 74 6f 72 2d 73 65 74 21 20 72 65 63 6f vector-set! reco
7800: 72 64 20 31 20 28 74 64 62 3a 73 74 65 70 2d 67 rd 1 (tdb:step-g
7810: 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 73 74 et-event_time st
7820: 65 70 29 29 0a 09 20 20 20 20 20 20 28 76 65 63 ep)).. (vec
7830: 74 6f 72 2d 73 65 74 21 20 72 65 63 6f 72 64 20 tor-set! record
7840: 33 20 28 69 66 20 28 65 71 75 61 6c 3f 20 28 76 3 (if (equal? (v
7850: 65 63 74 6f 72 2d 72 65 66 20 72 65 63 6f 72 64 ector-ref record
7860: 20 33 29 20 22 22 29 0a 09 09 09 09 09 28 74 64 3) "")......(td
7870: 62 3a 73 74 65 70 2d 67 65 74 2d 73 74 61 74 75 b:step-get-statu
7880: 73 20 73 74 65 70 29 29 29 0a 09 20 20 20 20 20 s step)))..
7890: 20 28 69 66 20 28 3e 20 28 73 74 72 69 6e 67 2d (if (> (string-
78a0: 6c 65 6e 67 74 68 20 28 74 64 62 3a 73 74 65 70 length (tdb:step
78b0: 2d 67 65 74 2d 6c 6f 67 66 69 6c 65 20 73 74 65 -get-logfile ste
78c0: 70 29 29 0a 09 09 20 20 20 20 20 30 29 0a 09 09 p))... 0)...
78d0: 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 72 (vector-set! r
78e0: 65 63 6f 72 64 20 35 20 28 74 64 62 3a 73 74 65 ecord 5 (tdb:ste
78f0: 70 2d 67 65 74 2d 6c 6f 67 66 69 6c 65 20 73 74 p-get-logfile st
7900: 65 70 29 29 29 29 0a 09 20 20 20 20 20 28 28 65 ep)))).. ((e
7910: 6e 64 29 20 20 0a 09 20 20 20 20 20 20 28 76 65 nd) .. (ve
7920: 63 74 6f 72 2d 73 65 74 21 20 72 65 63 6f 72 64 ctor-set! record
7930: 20 32 20 28 61 6e 79 2d 3e 6e 75 6d 62 65 72 20 2 (any->number
7940: 28 74 64 62 3a 73 74 65 70 2d 67 65 74 2d 65 76 (tdb:step-get-ev
7950: 65 6e 74 5f 74 69 6d 65 20 73 74 65 70 29 29 29 ent_time step)))
7960: 0a 09 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d .. (vector-
7970: 73 65 74 21 20 72 65 63 6f 72 64 20 33 20 28 74 set! record 3 (t
7980: 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 74 61 74 db:step-get-stat
7990: 75 73 20 73 74 65 70 29 29 0a 09 20 20 20 20 20 us step))..
79a0: 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 72 65 (vector-set! re
79b0: 63 6f 72 64 20 34 20 28 6c 65 74 20 28 28 73 74 cord 4 (let ((st
79c0: 61 72 74 74 20 28 61 6e 79 2d 3e 6e 75 6d 62 65 artt (any->numbe
79d0: 72 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72 65 r (vector-ref re
79e0: 63 6f 72 64 20 31 29 29 29 0a 09 09 09 09 09 20 cord 1)))......
79f0: 20 28 65 6e 64 74 20 20 20 28 61 6e 79 2d 3e 6e (endt (any->n
7a00: 75 6d 62 65 72 20 28 76 65 63 74 6f 72 2d 72 65 umber (vector-re
7a10: 66 20 72 65 63 6f 72 64 20 32 29 29 29 29 0a 09 f record 2))))..
7a20: 09 09 09 20 20 20 20 20 20 28 64 65 62 75 67 3a ... (debug:
7a30: 70 72 69 6e 74 20 34 20 22 72 65 63 6f 72 64 5b print 4 "record[
7a40: 31 5d 3d 22 20 28 76 65 63 74 6f 72 2d 72 65 66 1]=" (vector-ref
7a50: 20 72 65 63 6f 72 64 20 31 29 20 0a 09 09 09 09 record 1) .....
7a60: 09 09 20 20 20 22 2c 20 73 74 61 72 74 74 3d 22 .. ", startt="
7a70: 20 73 74 61 72 74 74 20 22 2c 20 65 6e 64 74 3d startt ", endt=
7a80: 22 20 65 6e 64 74 0a 09 09 09 09 09 09 20 20 20 " endt.......
7a90: 22 2c 20 67 65 74 2d 73 74 61 74 75 73 3a 20 22 ", get-status: "
7aa0: 20 28 74 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 (tdb:step-get-s
7ab0: 74 61 74 75 73 20 73 74 65 70 29 29 0a 09 09 09 tatus step))....
7ac0: 09 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 . (if (and
7ad0: 28 6e 75 6d 62 65 72 3f 20 73 74 61 72 74 74 29 (number? startt)
7ae0: 28 6e 75 6d 62 65 72 3f 20 65 6e 64 74 29 29 0a (number? endt)).
7af0: 09 09 09 09 09 20 20 28 73 65 63 6f 6e 64 73 2d ..... (seconds-
7b00: 3e 68 72 2d 6d 69 6e 2d 73 65 63 20 28 2d 20 65 >hr-min-sec (- e
7b10: 6e 64 74 20 73 74 61 72 74 74 29 29 20 22 2d 31 ndt startt)) "-1
7b20: 22 29 29 29 0a 09 20 20 20 20 20 20 28 69 66 20 "))).. (if
7b30: 28 3e 20 28 73 74 72 69 6e 67 2d 6c 65 6e 67 74 (> (string-lengt
7b40: 68 20 28 74 64 62 3a 73 74 65 70 2d 67 65 74 2d h (tdb:step-get-
7b50: 6c 6f 67 66 69 6c 65 20 73 74 65 70 29 29 0a 09 logfile step))..
7b60: 09 20 20 20 20 20 30 29 0a 09 09 20 20 28 76 65 . 0)... (ve
7b70: 63 74 6f 72 2d 73 65 74 21 20 72 65 63 6f 72 64 ctor-set! record
7b80: 20 35 20 28 74 64 62 3a 73 74 65 70 2d 67 65 74 5 (tdb:step-get
7b90: 2d 6c 6f 67 66 69 6c 65 20 73 74 65 70 29 29 29 -logfile step)))
7ba0: 29 0a 09 20 20 20 20 20 28 65 6c 73 65 0a 09 20 ).. (else..
7bb0: 20 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 (vector-set
7bc0: 21 20 72 65 63 6f 72 64 20 32 20 28 74 64 62 3a ! record 2 (tdb:
7bd0: 73 74 65 70 2d 67 65 74 2d 73 74 61 74 65 20 73 step-get-state s
7be0: 74 65 70 29 29 0a 09 20 20 20 20 20 20 28 76 65 tep)).. (ve
7bf0: 63 74 6f 72 2d 73 65 74 21 20 72 65 63 6f 72 64 ctor-set! record
7c00: 20 33 20 28 74 64 62 3a 73 74 65 70 2d 67 65 74 3 (tdb:step-get
7c10: 2d 73 74 61 74 75 73 20 73 74 65 70 29 29 0a 09 -status step))..
7c20: 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 (vector-se
7c30: 74 21 20 72 65 63 6f 72 64 20 34 20 28 74 64 62 t! record 4 (tdb
7c40: 3a 73 74 65 70 2d 67 65 74 2d 65 76 65 6e 74 5f :step-get-event_
7c50: 74 69 6d 65 20 73 74 65 70 29 29 29 29 0a 09 20 time step))))..
7c60: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 (hash-table-se
7c70: 74 21 20 72 65 73 20 28 74 64 62 3a 73 74 65 70 t! res (tdb:step
7c80: 2d 67 65 74 2d 73 74 65 70 6e 61 6d 65 20 73 74 -get-stepname st
7c90: 65 70 29 20 72 65 63 6f 72 64 29 0a 09 20 20 20 ep) record)..
7ca0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 36 20 22 (debug:print 6 "
7cb0: 72 65 63 6f 72 64 28 61 66 74 65 72 29 20 20 3d record(after) =
7cc0: 20 22 20 72 65 63 6f 72 64 20 0a 09 09 09 22 5c " record ...."\
7cd0: 6e 69 64 3a 20 20 20 20 20 20 20 22 20 28 74 64 nid: " (td
7ce0: 62 3a 73 74 65 70 2d 67 65 74 2d 69 64 20 73 74 b:step-get-id st
7cf0: 65 70 29 0a 09 09 09 22 5c 6e 73 74 65 70 6e 61 ep)...."\nstepna
7d00: 6d 65 3a 20 22 20 28 74 64 62 3a 73 74 65 70 2d me: " (tdb:step-
7d10: 67 65 74 2d 73 74 65 70 6e 61 6d 65 20 73 74 65 get-stepname ste
7d20: 70 29 0a 09 09 09 22 5c 6e 73 74 61 74 65 3a 20 p)...."\nstate:
7d30: 20 20 20 22 20 28 74 64 62 3a 73 74 65 70 2d 67 " (tdb:step-g
7d40: 65 74 2d 73 74 61 74 65 20 73 74 65 70 29 0a 09 et-state step)..
7d50: 09 09 22 5c 6e 73 74 61 74 75 73 3a 20 20 20 22 .."\nstatus: "
7d60: 20 28 74 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 (tdb:step-get-s
7d70: 74 61 74 75 73 20 73 74 65 70 29 0a 09 09 09 22 tatus step)...."
7d80: 5c 6e 74 69 6d 65 3a 20 20 20 20 20 22 20 28 74 \ntime: " (t
7d90: 64 62 3a 73 74 65 70 2d 67 65 74 2d 65 76 65 6e db:step-get-even
7da0: 74 5f 74 69 6d 65 20 73 74 65 70 29 29 29 29 0a t_time step)))).
7db0: 20 20 20 20 20 20 20 3b 3b 20 28 65 6c 73 65 20 ;; (else
7dc0: 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 72 (vector-set! r
7dd0: 65 63 6f 72 64 20 31 20 28 74 64 62 3a 73 74 65 ecord 1 (tdb:ste
7de0: 70 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 p-get-event_time
7df0: 20 73 74 65 70 29 29 29 0a 20 20 20 20 20 20 20 step))).
7e00: 28 73 6f 72 74 20 73 74 65 70 73 20 28 6c 61 6d (sort steps (lam
7e10: 62 64 61 20 28 61 20 62 29 0a 09 09 20 20 20 20 bda (a b)...
7e20: 20 28 63 6f 6e 64 0a 09 09 20 20 20 20 20 20 28 (cond... (
7e30: 28 3c 20 20 20 28 74 64 62 3a 73 74 65 70 2d 67 (< (tdb:step-g
7e40: 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 61 29 et-event_time a)
7e50: 28 74 64 62 3a 73 74 65 70 2d 67 65 74 2d 65 76 (tdb:step-get-ev
7e60: 65 6e 74 5f 74 69 6d 65 20 62 29 29 20 23 74 29 ent_time b)) #t)
7e70: 0a 09 09 20 20 20 20 20 20 28 28 65 71 3f 20 28 ... ((eq? (
7e80: 74 64 62 3a 73 74 65 70 2d 67 65 74 2d 65 76 65 tdb:step-get-eve
7e90: 6e 74 5f 74 69 6d 65 20 61 29 28 74 64 62 3a 73 nt_time a)(tdb:s
7ea0: 74 65 70 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 tep-get-event_ti
7eb0: 6d 65 20 62 29 29 20 0a 09 09 20 20 20 20 20 20 me b)) ...
7ec0: 20 28 3c 20 20 20 28 74 64 62 3a 73 74 65 70 2d (< (tdb:step-
7ed0: 67 65 74 2d 69 64 20 61 29 20 20 20 20 20 20 20 get-id a)
7ee0: 20 28 74 64 62 3a 73 74 65 70 2d 67 65 74 2d 69 (tdb:step-get-i
7ef0: 64 20 62 29 29 29 0a 09 09 20 20 20 20 20 20 28 d b)))... (
7f00: 65 6c 73 65 20 23 66 29 29 29 29 29 0a 20 20 20 else #f))))).
7f10: 20 20 20 72 65 73 29 29 0a 0a 28 64 65 66 69 6e res))..(defin
7f20: 65 20 28 64 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 63 e (dcommon:get-c
7f30: 6f 6d 70 72 65 73 73 65 64 2d 73 74 65 70 73 20 ompressed-steps
7f40: 64 62 73 74 72 75 63 74 20 72 75 6e 2d 69 64 20 dbstruct run-id
7f50: 74 65 73 74 2d 69 64 29 0a 20 20 28 6c 65 74 2a test-id). (let*
7f60: 20 28 28 73 74 65 70 73 2d 64 61 74 61 20 20 28 ((steps-data (
7f70: 64 62 3a 67 65 74 2d 73 74 65 70 73 2d 66 6f 72 db:get-steps-for
7f80: 2d 74 65 73 74 20 64 62 73 74 72 75 63 74 20 72 -test dbstruct r
7f90: 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 29 0a un-id test-id)).
7fa0: 09 20 28 63 6f 6d 70 72 73 74 65 70 73 20 20 28 . (comprsteps (
7fb0: 64 63 6f 6d 6d 6f 6e 3a 70 72 6f 63 65 73 73 2d dcommon:process-
7fc0: 73 74 65 70 73 2d 74 61 62 6c 65 20 73 74 65 70 steps-table step
7fd0: 73 2d 64 61 74 61 29 29 29 20 3b 3b 20 28 6f 70 s-data))) ;; (op
7fe0: 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 64 62 3a en-run-close db:
7ff0: 67 65 74 2d 73 74 65 70 73 2d 74 61 62 6c 65 20 get-steps-table
8000: 23 66 20 74 65 73 74 2d 69 64 20 77 6f 72 6b 2d #f test-id work-
8010: 61 72 65 61 3a 20 77 6f 72 6b 2d 61 72 65 61 29 area: work-area)
8020: 29 29 0a 20 20 20 20 28 6d 61 70 20 28 6c 61 6d )). (map (lam
8030: 62 64 61 20 28 78 29 0a 09 20 20 20 3b 3b 20 74 bda (x).. ;; t
8040: 61 6b 65 20 61 64 76 61 6e 74 61 67 65 20 6f 66 ake advantage of
8050: 20 74 68 65 20 5c 6e 20 6f 6e 20 74 69 6d 65 2d the \n on time-
8060: 3e 73 74 72 69 6e 67 0a 09 20 20 20 28 76 65 63 >string.. (vec
8070: 74 6f 72 0a 09 20 20 20 20 28 76 65 63 74 6f 72 tor.. (vector
8080: 2d 72 65 66 20 78 20 30 29 0a 09 20 20 20 20 28 -ref x 0).. (
8090: 6c 65 74 20 28 28 73 20 28 76 65 63 74 6f 72 2d let ((s (vector-
80a0: 72 65 66 20 78 20 31 29 29 29 0a 09 20 20 20 20 ref x 1)))..
80b0: 20 20 28 69 66 20 28 6e 75 6d 62 65 72 3f 20 73 (if (number? s
80c0: 29 28 73 65 63 6f 6e 64 73 2d 3e 74 69 6d 65 2d )(seconds->time-
80d0: 73 74 72 69 6e 67 20 73 29 20 73 29 29 0a 09 20 string s) s))..
80e0: 20 20 20 28 6c 65 74 20 28 28 73 20 28 76 65 63 (let ((s (vec
80f0: 74 6f 72 2d 72 65 66 20 78 20 32 29 29 29 0a 09 tor-ref x 2)))..
8100: 20 20 20 20 20 20 28 69 66 20 28 6e 75 6d 62 65 (if (numbe
8110: 72 3f 20 73 29 28 73 65 63 6f 6e 64 73 2d 3e 74 r? s)(seconds->t
8120: 69 6d 65 2d 73 74 72 69 6e 67 20 73 29 20 73 29 ime-string s) s)
8130: 29 0a 09 20 20 20 20 28 76 65 63 74 6f 72 2d 72 ).. (vector-r
8140: 65 66 20 78 20 33 29 20 20 20 20 3b 3b 20 73 74 ef x 3) ;; st
8150: 61 74 75 73 0a 09 20 20 20 20 28 76 65 63 74 6f atus.. (vecto
8160: 72 2d 72 65 66 20 78 20 34 29 0a 09 20 20 20 20 r-ref x 4)..
8170: 28 76 65 63 74 6f 72 2d 72 65 66 20 78 20 35 29 (vector-ref x 5)
8180: 29 29 20 20 3b 3b 20 74 69 6d 65 20 64 65 6c 74 )) ;; time delt
8190: 61 0a 09 20 28 73 6f 72 74 20 28 68 61 73 68 2d a.. (sort (hash-
81a0: 74 61 62 6c 65 2d 76 61 6c 75 65 73 20 63 6f 6d table-values com
81b0: 70 72 73 74 65 70 73 29 0a 09 20 20 20 20 20 20 prsteps)..
81c0: 20 28 6c 61 6d 62 64 61 20 28 61 20 62 29 0a 09 (lambda (a b)..
81d0: 09 20 28 6c 65 74 20 28 28 74 69 6d 65 2d 61 20 . (let ((time-a
81e0: 28 76 65 63 74 6f 72 2d 72 65 66 20 61 20 31 29 (vector-ref a 1)
81f0: 29 0a 09 09 20 20 20 20 20 20 20 28 74 69 6d 65 )... (time
8200: 2d 62 20 28 76 65 63 74 6f 72 2d 72 65 66 20 62 -b (vector-ref b
8210: 20 31 29 29 29 0a 09 09 20 20 20 28 69 66 20 28 1)))... (if (
8220: 61 6e 64 20 28 6e 75 6d 62 65 72 3f 20 74 69 6d and (number? tim
8230: 65 2d 61 29 28 6e 75 6d 62 65 72 3f 20 74 69 6d e-a)(number? tim
8240: 65 2d 62 29 29 0a 09 09 20 20 20 20 20 20 20 28 e-b))... (
8250: 69 66 20 28 3c 20 74 69 6d 65 2d 61 20 74 69 6d if (< time-a tim
8260: 65 2d 62 29 0a 09 09 09 20 20 20 23 74 0a 09 09 e-b).... #t...
8270: 09 20 20 20 28 69 66 20 28 65 71 3f 20 74 69 6d . (if (eq? tim
8280: 65 2d 61 20 74 69 6d 65 2d 62 29 0a 09 09 09 20 e-a time-b)....
8290: 20 20 20 20 20 20 28 73 74 72 69 6e 67 3c 3f 20 (string<?
82a0: 28 63 6f 6e 63 20 28 76 65 63 74 6f 72 2d 72 65 (conc (vector-re
82b0: 66 20 61 20 32 29 29 0a 09 09 09 09 09 20 28 63 f a 2))...... (c
82c0: 6f 6e 63 20 28 76 65 63 74 6f 72 2d 72 65 66 20 onc (vector-ref
82d0: 62 20 32 29 29 29 0a 09 09 09 20 20 20 20 20 20 b 2)))....
82e0: 20 23 66 29 29 0a 09 09 20 20 20 20 20 20 20 28 #f))... (
82f0: 73 74 72 69 6e 67 3c 3f 20 28 63 6f 6e 63 20 74 string<? (conc t
8300: 69 6d 65 2d 61 29 28 63 6f 6e 63 20 74 69 6d 65 ime-a)(conc time
8310: 2d 62 29 29 29 29 29 29 29 29 29 0a 0a 28 64 65 -b)))))))))..(de
8320: 66 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a 70 6f fine (dcommon:po
8330: 70 75 6c 61 74 65 2d 73 74 65 70 73 20 74 65 73 pulate-steps tes
8340: 74 73 74 65 70 73 20 73 74 65 70 73 2d 6d 61 74 tsteps steps-mat
8350: 72 69 78 29 0a 20 20 28 6c 65 74 20 28 28 6d 61 rix). (let ((ma
8360: 78 2d 72 6f 77 20 30 29 29 0a 20 20 20 20 28 69 x-row 0)). (i
8370: 66 20 28 6e 75 6c 6c 3f 20 74 65 73 74 73 74 65 f (null? testste
8380: 70 73 29 0a 09 28 69 75 70 3a 61 74 74 72 69 62 ps)..(iup:attrib
8390: 75 74 65 2d 73 65 74 21 20 73 74 65 70 73 2d 6d ute-set! steps-m
83a0: 61 74 72 69 78 20 22 43 4c 45 41 52 56 41 4c 55 atrix "CLEARVALU
83b0: 45 22 20 22 43 4f 4e 54 45 4e 54 53 22 29 0a 09 E" "CONTENTS")..
83c0: 28 6c 65 74 20 6c 6f 6f 70 20 28 28 68 65 64 20 (let loop ((hed
83d0: 20 20 20 28 63 61 72 20 74 65 73 74 73 74 65 70 (car teststep
83e0: 73 29 29 0a 09 09 20 20 20 28 74 61 6c 20 20 20 s))... (tal
83f0: 20 28 63 64 72 20 74 65 73 74 73 74 65 70 73 29 (cdr teststeps)
8400: 29 0a 09 09 20 20 20 28 72 6f 77 6e 75 6d 20 31 )... (rownum 1
8410: 29 0a 09 09 20 20 20 28 63 6f 6c 6e 75 6d 20 31 )... (colnum 1
8420: 29 29 0a 09 20 20 28 69 66 20 28 3e 20 72 6f 77 )).. (if (> row
8430: 6e 75 6d 20 6d 61 78 2d 72 6f 77 29 28 73 65 74 num max-row)(set
8440: 21 20 6d 61 78 2d 72 6f 77 20 72 6f 77 6e 75 6d ! max-row rownum
8450: 29 29 0a 09 20 20 28 6c 65 74 20 28 28 76 61 6c )).. (let ((val
8460: 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 (vector-ref
8470: 20 68 65 64 20 28 2d 20 63 6f 6c 6e 75 6d 20 31 hed (- colnum 1
8480: 29 29 29 0a 09 09 28 6d 74 72 78 2d 72 63 20 28 )))...(mtrx-rc (
8490: 63 6f 6e 63 20 72 6f 77 6e 75 6d 20 22 3a 22 20 conc rownum ":"
84a0: 63 6f 6c 6e 75 6d 29 29 29 0a 09 20 20 20 20 28 colnum))).. (
84b0: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se
84c0: 74 21 20 73 74 65 70 73 2d 6d 61 74 72 69 78 20 t! steps-matrix
84d0: 20 6d 74 72 78 2d 72 63 20 28 69 66 20 76 61 6c mtrx-rc (if val
84e0: 20 28 63 6f 6e 63 20 76 61 6c 29 20 22 22 29 29 (conc val) ""))
84f0: 0a 09 20 20 20 20 28 69 66 20 28 3c 20 63 6f 6c .. (if (< col
8500: 6e 75 6d 20 36 29 0a 09 09 28 6c 6f 6f 70 20 68 num 6)...(loop h
8510: 65 64 20 74 61 6c 20 72 6f 77 6e 75 6d 20 28 2b ed tal rownum (+
8520: 20 63 6f 6c 6e 75 6d 20 31 29 29 0a 09 09 28 69 colnum 1))...(i
8530: 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 74 61 f (not (null? ta
8540: 6c 29 29 0a 09 09 20 20 20 20 28 6c 6f 6f 70 20 l))... (loop
8550: 28 63 61 72 20 74 61 6c 29 28 63 64 72 20 74 61 (car tal)(cdr ta
8560: 6c 29 28 2b 20 72 6f 77 6e 75 6d 20 31 29 20 31 l)(+ rownum 1) 1
8570: 29 29 29 29 29 29 0a 20 20 20 20 28 69 66 20 28 )))))). (if (
8580: 3e 20 6d 61 78 2d 72 6f 77 20 30 29 0a 09 28 62 > max-row 0)..(b
8590: 65 67 69 6e 0a 09 20 20 3b 3b 20 77 65 20 61 72 egin.. ;; we ar
85a0: 65 20 67 6f 69 6e 67 20 74 6f 20 73 70 65 63 75 e going to specu
85b0: 6c 61 74 69 76 65 6c 79 20 63 6c 65 61 72 20 72 latively clear r
85c0: 6f 77 73 20 75 6e 74 69 6c 20 77 65 20 66 69 6e ows until we fin
85d0: 64 20 61 20 72 6f 77 20 74 68 61 74 20 69 73 20 d a row that is
85e0: 61 6c 72 65 61 64 79 20 63 6c 65 61 72 65 64 0a already cleared.
85f0: 09 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 72 . (let loop ((r
8600: 6f 77 6e 75 6d 20 20 28 2b 20 6d 61 78 2d 72 6f ownum (+ max-ro
8610: 77 20 31 29 29 0a 09 09 20 20 20 20 20 28 63 6f w 1))... (co
8620: 6c 6e 75 6d 20 20 30 29 0a 09 09 20 20 20 20 20 lnum 0)...
8630: 28 64 65 6c 65 74 65 64 20 23 66 29 29 0a 09 20 (deleted #f))..
8640: 20 20 20 3b 3b 20 28 64 65 62 75 67 3a 70 72 69 ;; (debug:pri
8650: 6e 74 2d 69 6e 66 6f 20 30 20 22 63 6c 65 61 6e nt-info 0 "clean
8660: 69 6e 67 20 22 20 72 6f 77 6e 75 6d 20 22 3a 22 ing " rownum ":"
8670: 20 63 6f 6c 6e 75 6d 29 0a 09 20 20 20 20 28 6c colnum).. (l
8680: 65 74 2a 20 28 28 6e 65 78 74 2d 72 6f 77 20 28 et* ((next-row (
8690: 69 66 20 28 65 71 3f 20 63 6f 6c 6e 75 6d 20 36 if (eq? colnum 6
86a0: 29 20 28 2b 20 72 6f 77 6e 75 6d 20 31 29 20 72 ) (+ rownum 1) r
86b0: 6f 77 6e 75 6d 29 29 0a 09 09 20 20 20 28 6e 65 ownum))... (ne
86c0: 78 74 2d 63 6f 6c 20 28 69 66 20 28 65 71 3f 20 xt-col (if (eq?
86d0: 63 6f 6c 6e 75 6d 20 36 29 20 31 20 28 2b 20 63 colnum 6) 1 (+ c
86e0: 6f 6c 6e 75 6d 20 31 29 29 29 0a 09 09 20 20 20 olnum 1)))...
86f0: 28 6d 74 72 78 2d 72 63 20 20 28 63 6f 6e 63 20 (mtrx-rc (conc
8700: 72 6f 77 6e 75 6d 20 22 3a 22 20 63 6f 6c 6e 75 rownum ":" colnu
8710: 6d 29 29 0a 09 09 20 20 20 28 63 75 72 72 2d 76 m))... (curr-v
8720: 61 6c 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 al (iup:attribut
8730: 65 20 73 74 65 70 73 2d 6d 61 74 72 69 78 20 6d e steps-matrix m
8740: 74 72 78 2d 72 63 29 29 29 0a 09 20 20 20 20 20 trx-rc)))..
8750: 20 3b 3b 20 28 64 65 62 75 67 3a 70 72 69 6e 74 ;; (debug:print
8760: 2d 69 6e 66 6f 20 30 20 22 63 6c 65 61 6e 69 6e -info 0 "cleanin
8770: 67 20 22 20 72 6f 77 6e 75 6d 20 22 3a 22 20 63 g " rownum ":" c
8780: 6f 6c 6e 75 6d 20 22 20 63 75 72 72 76 61 6c 3d olnum " currval=
8790: 20 22 20 63 75 72 72 2d 76 61 6c 29 0a 09 20 20 " curr-val)..
87a0: 20 20 20 20 28 69 66 20 28 61 6e 64 20 28 73 74 (if (and (st
87b0: 72 69 6e 67 3f 20 63 75 72 72 2d 76 61 6c 29 0a ring? curr-val).
87c0: 09 09 20 20 20 20 20 20 20 28 6e 6f 74 20 28 65 .. (not (e
87d0: 71 75 61 6c 3f 20 63 75 72 72 2d 76 61 6c 20 22 qual? curr-val "
87e0: 22 29 29 29 0a 09 09 20 20 28 62 65 67 69 6e 0a ")))... (begin.
87f0: 09 09 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 .. (iup:attri
8800: 62 75 74 65 2d 73 65 74 21 20 73 74 65 70 73 2d bute-set! steps-
8810: 6d 61 74 72 69 78 20 6d 74 72 78 2d 72 63 20 22 matrix mtrx-rc "
8820: 22 29 0a 09 09 20 20 20 20 28 6c 6f 6f 70 20 6e ")... (loop n
8830: 65 78 74 2d 72 6f 77 20 6e 65 78 74 2d 63 6f 6c ext-row next-col
8840: 20 23 74 29 29 0a 09 09 20 20 28 69 66 20 28 65 #t))... (if (e
8850: 71 3f 20 63 6f 6c 6e 75 6d 20 36 29 20 3b 3b 20 q? colnum 6) ;;
8860: 6e 6f 74 20 64 6f 6e 65 2c 20 64 69 64 6e 27 74 not done, didn't
8870: 20 67 65 74 20 61 20 66 75 6c 6c 20 62 6c 61 6e get a full blan
8880: 6b 20 72 6f 77 0a 09 09 20 20 20 20 20 20 28 69 k row... (i
8890: 66 20 64 65 6c 65 74 65 64 20 28 6c 6f 6f 70 20 f deleted (loop
88a0: 6e 65 78 74 2d 72 6f 77 20 6e 65 78 74 2d 63 6f next-row next-co
88b0: 6c 20 23 66 29 29 20 3b 3b 20 65 78 69 74 20 6f l #f)) ;; exit o
88c0: 6e 20 74 68 69 73 20 6e 6f 74 20 6d 65 74 0a 09 n this not met..
88d0: 09 20 20 20 20 20 20 28 6c 6f 6f 70 20 6e 65 78 . (loop nex
88e0: 74 2d 72 6f 77 20 6e 65 78 74 2d 63 6f 6c 20 64 t-row next-col d
88f0: 65 6c 65 74 65 64 29 29 29 29 29 0a 09 20 20 28 eleted))))).. (
8900: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se
8910: 74 21 20 73 74 65 70 73 2d 6d 61 74 72 69 78 20 t! steps-matrix
8920: 22 52 45 44 52 41 57 22 20 22 41 4c 4c 22 29 29 "REDRAW" "ALL"))
8930: 29 29 29 0a ))).