Artifact
d6f34ee6f6eabd498df2554a1428a03d2943f146:
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 44 20 4f 20 54 20 46 20 49 20 4c 20 45 0a ; D O T F I L E.
13b0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
13c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 0a 28 64 65 66 69 6e ========..(defin
1400: 65 20 28 64 63 6f 6d 6d 6f 6e 3a 77 72 69 74 65 e (dcommon:write
1410: 2d 64 6f 74 66 69 6c 65 20 66 6e 61 6d 65 20 64 -dotfile fname d
1420: 61 74 29 0a 20 20 28 77 69 74 68 2d 6f 75 74 70 at). (with-outp
1430: 75 74 2d 74 6f 2d 66 69 6c 65 20 66 6e 61 6d 65 ut-to-file fname
1440: 0a 20 20 20 20 28 6c 61 6d 62 64 61 20 28 29 0a . (lambda ().
1450: 20 20 20 20 20 20 28 70 70 20 64 61 74 29 29 29 (pp dat)))
1460: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
1470: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1480: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1490: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 54 ===========.;; T
14b0: 41 52 47 45 54 20 41 4e 44 20 50 41 54 54 45 52 ARGET AND PATTER
14c0: 4e 20 4d 41 4e 49 50 55 4c 41 54 49 4f 4e 53 0a N MANIPULATIONS.
14d0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
14e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1500: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1510: 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 43 6f 6e ========..;; Con
1520: 76 65 72 74 20 74 6f 20 61 6e 64 20 66 72 6f 6d vert to and from
1530: 20 6c 69 73 74 20 6f 66 20 6c 69 6e 65 73 20 28 list of lines (
1540: 66 6f 72 20 61 20 74 65 78 74 20 62 6f 78 29 0a for a text box).
1550: 3b 3b 20 22 2c 22 20 3d 3e 20 22 5c 6e 22 0a 28 ;; "," => "\n".(
1560: 64 65 66 69 6e 65 20 28 64 62 6f 61 72 64 3a 74 define (dboard:t
1570: 65 73 74 2d 70 61 74 74 2d 3e 6c 69 6e 65 73 20 est-patt->lines
1580: 74 65 73 74 2d 70 61 74 74 29 0a 20 20 28 73 74 test-patt). (st
1590: 72 69 6e 67 2d 73 75 62 73 74 69 74 75 74 65 20 ring-substitute
15a0: 28 72 65 67 65 78 70 20 22 2c 22 29 20 22 5c 6e (regexp ",") "\n
15b0: 22 20 74 65 73 74 2d 70 61 74 74 29 29 0a 0a 28 " test-patt))..(
15c0: 64 65 66 69 6e 65 20 28 64 62 6f 61 72 64 3a 6c define (dboard:l
15d0: 69 6e 65 73 2d 3e 74 65 73 74 2d 70 61 74 74 20 ines->test-patt
15e0: 6c 69 6e 65 73 29 0a 20 20 28 73 74 72 69 6e 67 lines). (string
15f0: 2d 73 75 62 73 74 69 74 75 74 65 20 28 72 65 67 -substitute (reg
1600: 65 78 70 20 22 5c 6e 22 29 20 22 2c 22 20 6c 69 exp "\n") "," li
1610: 6e 65 73 20 23 74 29 29 0a 0a 0a 3b 3b 3d 3d 3d nes #t))...;;===
1620: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1630: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1640: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1650: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1660: 3d 3d 3d 0a 3b 3b 20 50 20 52 20 4f 20 43 20 45 ===.;; P R O C E
1670: 20 53 20 53 20 20 20 52 20 55 20 4e 20 53 0a 3b S S R U N S.;
1680: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
1690: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
16a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
16b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
16c0: 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 4d 4f 56 45 =======..;; MOVE
16d0: 20 54 48 49 53 20 49 4e 54 4f 20 2a 64 61 74 61 THIS INTO *data
16e0: 2a 0a 28 64 65 66 69 6e 65 20 2a 63 61 63 68 65 *.(define *cache
16f0: 64 61 74 61 2a 20 28 6d 61 6b 65 2d 68 61 73 68 data* (make-hash
1700: 2d 74 61 62 6c 65 29 29 0a 28 68 61 73 68 2d 74 -table)).(hash-t
1710: 61 62 6c 65 2d 73 65 74 21 20 2a 63 61 63 68 65 able-set! *cache
1720: 64 61 74 61 2a 20 22 72 75 6e 69 64 2d 74 6f 2d data* "runid-to-
1730: 63 6f 6c 22 20 20 20 20 28 6d 61 6b 65 2d 68 61 col" (make-ha
1740: 73 68 2d 74 61 62 6c 65 29 29 0a 28 68 61 73 68 sh-table)).(hash
1750: 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a 63 61 63 -table-set! *cac
1760: 68 65 64 61 74 61 2a 20 22 74 65 73 74 6e 61 6d hedata* "testnam
1770: 65 2d 74 6f 2d 72 6f 77 22 20 28 6d 61 6b 65 2d e-to-row" (make-
1780: 68 61 73 68 2d 74 61 62 6c 65 29 29 0a 0a 3b 3b hash-table))..;;
1790: 20 54 4f 2d 44 4f 0a 3b 3b 20 20 31 2e 20 4d 61 TO-DO.;; 1. Ma
17a0: 6b 65 20 22 64 61 74 61 22 20 68 61 73 68 2d 74 ke "data" hash-t
17b0: 61 62 6c 65 20 68 69 65 72 61 72 63 68 69 61 6c able hierarchial
17c0: 20 73 74 6f 72 65 20 6f 66 20 61 6c 6c 20 64 69 store of all di
17d0: 73 70 6c 61 79 65 64 20 64 61 74 61 0a 3b 3b 20 splayed data.;;
17e0: 20 32 2e 20 55 70 64 61 74 65 20 73 79 6e 63 68 2. Update synch
17f0: 61 73 68 20 74 6f 20 75 6e 64 65 72 73 74 61 6e ash to understan
1800: 64 20 22 67 65 74 2d 72 75 6e 73 22 2c 20 22 67 d "get-runs", "g
1810: 65 74 2d 74 65 73 74 73 22 20 65 74 63 2e 0a 3b et-tests" etc..;
1820: 3b 20 20 33 2e 20 41 64 64 20 65 78 74 72 61 63 ; 3. Add extrac
1830: 74 69 6f 6e 20 6f 66 20 66 69 6c 74 65 72 73 20 tion of filters
1840: 74 6f 20 73 79 6e 63 68 61 73 68 20 63 61 6c 6c to synchash call
1850: 73 0a 3b 3b 0a 3b 3b 20 4d 6f 64 65 20 69 73 20 s.;;.;; Mode is
1860: 27 66 75 6c 6c 20 6f 72 20 27 69 6e 63 72 65 6d 'full or 'increm
1870: 65 6e 74 61 6c 20 66 6f 72 20 66 75 6c 6c 20 72 ental for full r
1880: 65 66 72 65 73 68 20 6f 72 20 69 6e 63 72 65 6d efresh or increm
1890: 65 6e 74 61 6c 20 72 65 66 72 65 73 68 0a 28 64 ental refresh.(d
18a0: 65 66 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a 72 efine (dcommon:r
18b0: 75 6e 2d 75 70 64 61 74 65 20 6b 65 79 73 20 64 un-update keys d
18c0: 61 74 61 20 72 75 6e 6e 61 6d 65 20 6b 65 79 70 ata runname keyp
18d0: 61 74 74 73 20 74 65 73 74 70 61 74 74 20 73 74 atts testpatt st
18e0: 61 74 65 73 20 73 74 61 74 75 73 65 73 20 6d 6f ates statuses mo
18f0: 64 65 20 77 69 6e 64 6f 77 2d 69 64 29 0a 20 20 de window-id).
1900: 28 6c 65 74 2a 20 28 3b 3b 20 63 6f 75 6e 74 20 (let* (;; count
1910: 61 6e 64 20 6f 66 66 73 65 74 20 3d 3e 20 23 66 and offset => #f
1920: 20 73 6f 20 6e 6f 74 20 75 73 65 64 0a 09 20 3b so not used.. ;
1930: 3b 20 74 68 65 20 73 79 6e 63 68 61 73 68 20 63 ; the synchash c
1940: 61 6c 6c 73 20 6d 6f 64 69 66 79 20 74 68 65 20 alls modify the
1950: 22 64 61 74 61 22 20 68 61 73 68 0a 09 20 28 67 "data" hash.. (g
1960: 65 74 2d 72 75 6e 73 2d 73 69 67 20 20 20 20 28 et-runs-sig (
1970: 63 6f 6e 63 20 28 63 6c 69 65 6e 74 3a 67 65 74 conc (client:get
1980: 2d 73 69 67 6e 61 74 75 72 65 29 20 22 20 67 65 -signature) " ge
1990: 74 2d 72 75 6e 73 22 29 29 0a 09 20 28 67 65 74 t-runs")).. (get
19a0: 2d 74 65 73 74 73 2d 73 69 67 20 20 20 28 63 6f -tests-sig (co
19b0: 6e 63 20 28 63 6c 69 65 6e 74 3a 67 65 74 2d 73 nc (client:get-s
19c0: 69 67 6e 61 74 75 72 65 29 20 22 20 67 65 74 2d ignature) " get-
19d0: 74 65 73 74 73 22 29 29 0a 09 20 28 67 65 74 2d tests")).. (get-
19e0: 64 65 74 61 69 6c 73 2d 73 69 67 20 28 63 6f 6e details-sig (con
19f0: 63 20 28 63 6c 69 65 6e 74 3a 67 65 74 2d 73 69 c (client:get-si
1a00: 67 6e 61 74 75 72 65 29 20 22 20 67 65 74 2d 74 gnature) " get-t
1a10: 65 73 74 2d 64 65 74 61 69 6c 73 22 29 29 0a 0a est-details"))..
1a20: 09 20 3b 3b 20 74 65 73 74 2d 69 64 73 20 74 6f . ;; test-ids to
1a30: 20 67 65 74 20 61 6e 64 20 64 69 73 70 6c 61 79 get and display
1a40: 20 61 72 65 20 69 6e 64 65 78 65 64 20 6f 6e 20 are indexed on
1a50: 77 69 6e 64 6f 77 2d 69 64 20 69 6e 20 63 75 72 window-id in cur
1a60: 72 2d 74 65 73 74 2d 69 64 73 20 68 61 73 68 0a r-test-ids hash.
1a70: 09 20 28 74 65 73 74 2d 69 64 73 20 20 20 20 20 . (test-ids
1a80: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 76 (hash-table-v
1a90: 61 6c 75 65 73 20 28 64 62 6f 61 72 64 3a 64 61 alues (dboard:da
1aa0: 74 61 2d 67 65 74 2d 63 75 72 72 2d 74 65 73 74 ta-get-curr-test
1ab0: 2d 69 64 73 20 2a 64 61 74 61 2a 29 29 29 0a 09 -ids *data*)))..
1ac0: 20 3b 3b 20 72 75 6e 2d 69 64 20 69 73 20 23 66 ;; run-id is #f
1ad0: 20 69 6e 20 6e 65 78 74 20 6c 69 6e 65 20 74 6f in next line to
1ae0: 20 73 65 6e 64 20 74 68 65 20 71 75 65 72 79 20 send the query
1af0: 74 6f 20 73 65 72 76 65 72 20 30 0a 20 09 20 28 to server 0. . (
1b00: 72 75 6e 2d 63 68 61 6e 67 65 73 20 20 20 20 20 run-changes
1b10: 28 73 79 6e 63 68 61 73 68 3a 63 6c 69 65 6e 74 (synchash:client
1b20: 2d 67 65 74 20 27 64 62 3a 67 65 74 2d 72 75 6e -get 'db:get-run
1b30: 73 20 67 65 74 2d 72 75 6e 73 2d 73 69 67 20 28 s get-runs-sig (
1b40: 6c 65 6e 67 74 68 20 6b 65 79 70 61 74 74 73 29 length keypatts)
1b50: 20 64 61 74 61 20 23 66 20 72 75 6e 6e 61 6d 65 data #f runname
1b60: 20 23 66 20 23 66 20 6b 65 79 70 61 74 74 73 29 #f #f keypatts)
1b70: 29 0a 09 20 28 74 65 73 74 73 2d 64 65 74 61 69 ).. (tests-detai
1b80: 6c 2d 63 68 61 6e 67 65 73 20 28 69 66 20 28 6e l-changes (if (n
1b90: 6f 74 20 28 6e 75 6c 6c 3f 20 74 65 73 74 2d 69 ot (null? test-i
1ba0: 64 73 29 29 0a 09 09 09 09 20 20 20 28 73 79 6e ds))..... (syn
1bb0: 63 68 61 73 68 3a 63 6c 69 65 6e 74 2d 67 65 74 chash:client-get
1bc0: 20 27 64 62 3a 67 65 74 2d 74 65 73 74 2d 69 6e 'db:get-test-in
1bd0: 66 6f 2d 62 79 2d 69 64 73 20 67 65 74 2d 64 65 fo-by-ids get-de
1be0: 74 61 69 6c 73 2d 73 69 67 20 30 20 20 64 61 74 tails-sig 0 dat
1bf0: 61 20 23 66 20 74 65 73 74 2d 69 64 73 29 0a 09 a #f test-ids)..
1c00: 09 09 09 20 20 20 27 28 29 29 29 0a 0a 09 20 3b ... '()))... ;
1c10: 3b 20 4e 6f 77 20 63 61 6e 20 63 61 6c 63 75 6c ; Now can calcul
1c20: 61 74 65 20 74 68 65 20 72 75 6e 2d 69 64 73 0a ate the run-ids.
1c30: 09 20 28 72 75 6e 2d 68 61 73 68 20 20 20 20 28 . (run-hash (
1c40: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d
1c50: 65 66 61 75 6c 74 20 64 61 74 61 20 67 65 74 2d efault data get-
1c60: 72 75 6e 73 2d 73 69 67 20 23 66 29 29 0a 09 20 runs-sig #f))..
1c70: 28 72 75 6e 2d 69 64 73 20 20 20 20 20 28 69 66 (run-ids (if
1c80: 20 72 75 6e 2d 68 61 73 68 20 28 66 69 6c 74 65 run-hash (filte
1c90: 72 20 6e 75 6d 62 65 72 3f 20 28 68 61 73 68 2d r number? (hash-
1ca0: 74 61 62 6c 65 2d 6b 65 79 73 20 72 75 6e 2d 68 table-keys run-h
1cb0: 61 73 68 29 29 20 27 28 29 29 29 0a 0a 09 20 28 ash)) '()))... (
1cc0: 61 6c 6c 2d 74 65 73 74 2d 63 68 61 6e 67 65 73 all-test-changes
1cd0: 20 28 6c 65 74 20 28 28 72 65 73 20 28 6d 61 6b (let ((res (mak
1ce0: 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 29 0a e-hash-table))).
1cf0: 09 09 09 20 20 20 20 20 28 66 6f 72 2d 65 61 63 ... (for-eac
1d00: 68 20 28 6c 61 6d 62 64 61 20 28 72 75 6e 2d 69 h (lambda (run-i
1d10: 64 29 0a 09 09 09 09 09 20 28 69 66 20 28 3e 20 d)...... (if (>
1d20: 72 75 6e 2d 69 64 20 30 29 0a 09 09 09 09 09 20 run-id 0)......
1d30: 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (hash-table-
1d40: 73 65 74 21 20 72 65 73 20 72 75 6e 2d 69 64 20 set! res run-id
1d50: 28 73 79 6e 63 68 61 73 68 3a 63 6c 69 65 6e 74 (synchash:client
1d60: 2d 67 65 74 20 27 64 62 3a 67 65 74 2d 74 65 73 -get 'db:get-tes
1d70: 74 73 2d 66 6f 72 2d 72 75 6e 2d 6d 69 6e 64 61 ts-for-run-minda
1d80: 74 61 20 67 65 74 2d 74 65 73 74 73 2d 73 69 67 ta get-tests-sig
1d90: 20 30 20 64 61 74 61 20 72 75 6e 2d 69 64 20 31 0 data run-id 1
1da0: 20 74 65 73 74 70 61 74 74 20 73 74 61 74 65 73 testpatt states
1db0: 20 73 74 61 74 75 73 65 73 20 23 66 29 29 29 29 statuses #f))))
1dc0: 0a 09 09 09 09 20 20 20 20 20 20 20 72 75 6e 2d ..... run-
1dd0: 69 64 73 29 0a 09 09 09 20 20 20 20 20 72 65 73 ids).... res
1de0: 29 29 0a 09 20 28 72 75 6e 73 2d 68 61 73 68 20 )).. (runs-hash
1df0: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 (hash-table-r
1e00: 65 66 2f 64 65 66 61 75 6c 74 20 64 61 74 61 20 ef/default data
1e10: 67 65 74 2d 72 75 6e 73 2d 73 69 67 20 23 66 29 get-runs-sig #f)
1e20: 29 0a 09 20 28 68 65 61 64 65 72 20 20 20 20 20 ).. (header
1e30: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 (hash-table-re
1e40: 66 2f 64 65 66 61 75 6c 74 20 72 75 6e 73 2d 68 f/default runs-h
1e50: 61 73 68 20 22 68 65 61 64 65 72 22 20 23 66 29 ash "header" #f)
1e60: 29 0a 09 20 28 72 75 6e 2d 69 64 73 20 20 20 20 ).. (run-ids
1e70: 20 20 28 73 6f 72 74 20 28 66 69 6c 74 65 72 20 (sort (filter
1e80: 6e 75 6d 62 65 72 3f 20 28 68 61 73 68 2d 74 61 number? (hash-ta
1e90: 62 6c 65 2d 6b 65 79 73 20 72 75 6e 73 2d 68 61 ble-keys runs-ha
1ea0: 73 68 29 29 0a 09 09 09 20 20 20 20 20 28 6c 61 sh)).... (la
1eb0: 6d 62 64 61 20 28 61 20 62 29 0a 09 09 09 20 20 mbda (a b)....
1ec0: 20 20 20 20 20 28 6c 65 74 2a 20 28 28 72 65 63 (let* ((rec
1ed0: 6f 72 64 2d 61 20 28 68 61 73 68 2d 74 61 62 6c ord-a (hash-tabl
1ee0: 65 2d 72 65 66 20 72 75 6e 73 2d 68 61 73 68 20 e-ref runs-hash
1ef0: 61 29 29 0a 09 09 09 09 20 20 20 20 20 20 28 72 a))..... (r
1f00: 65 63 6f 72 64 2d 62 20 28 68 61 73 68 2d 74 61 ecord-b (hash-ta
1f10: 62 6c 65 2d 72 65 66 20 72 75 6e 73 2d 68 61 73 ble-ref runs-has
1f20: 68 20 62 29 29 0a 09 09 09 09 20 20 20 20 20 20 h b)).....
1f30: 28 74 69 6d 65 2d 61 20 20 20 28 64 62 3a 67 65 (time-a (db:ge
1f40: 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 t-value-by-heade
1f50: 72 20 72 65 63 6f 72 64 2d 61 20 68 65 61 64 65 r record-a heade
1f60: 72 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 29 29 r "event_time"))
1f70: 0a 09 09 09 09 20 20 20 20 20 20 28 74 69 6d 65 ..... (time
1f80: 2d 62 20 20 20 28 64 62 3a 67 65 74 2d 76 61 6c -b (db:get-val
1f90: 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 65 63 ue-by-header rec
1fa0: 6f 72 64 2d 62 20 68 65 61 64 65 72 20 22 65 76 ord-b header "ev
1fb0: 65 6e 74 5f 74 69 6d 65 22 29 29 29 0a 09 09 09 ent_time")))....
1fc0: 09 20 28 3e 20 74 69 6d 65 2d 61 20 74 69 6d 65 . (> time-a time
1fd0: 2d 62 29 29 29 0a 09 09 09 20 20 20 20 20 29 29 -b))).... ))
1fe0: 0a 09 20 28 72 75 6e 69 64 2d 74 6f 2d 63 6f 6c .. (runid-to-col
1ff0: 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (hash-table-
2000: 72 65 66 20 2a 63 61 63 68 65 64 61 74 61 2a 20 ref *cachedata*
2010: 22 72 75 6e 69 64 2d 74 6f 2d 63 6f 6c 22 29 29 "runid-to-col"))
2020: 0a 09 20 28 74 65 73 74 6e 61 6d 65 2d 74 6f 2d .. (testname-to-
2030: 72 6f 77 20 28 68 61 73 68 2d 74 61 62 6c 65 2d row (hash-table-
2040: 72 65 66 20 2a 63 61 63 68 65 64 61 74 61 2a 20 ref *cachedata*
2050: 22 74 65 73 74 6e 61 6d 65 2d 74 6f 2d 72 6f 77 "testname-to-row
2060: 22 29 29 20 0a 09 20 28 63 6f 6c 6e 75 6d 20 20 ")) .. (colnum
2070: 20 20 20 20 20 31 29 0a 09 20 28 72 6f 77 6e 75 1).. (rownu
2080: 6d 20 20 20 20 20 20 20 30 29 29 20 3b 3b 20 72 m 0)) ;; r
2090: 6f 77 6e 75 6d 20 3d 20 30 20 69 73 20 74 68 65 ownum = 0 is the
20a0: 20 68 65 61 64 65 72 0a 3b 3b 20 28 64 65 62 75 header.;; (debu
20b0: 67 3a 70 72 69 6e 74 20 30 20 22 74 65 73 74 2d g:print 0 "test-
20c0: 69 64 73 20 22 20 74 65 73 74 2d 69 64 73 20 22 ids " test-ids "
20d0: 2c 20 74 65 73 74 73 2d 64 65 74 61 69 6c 2d 63 , tests-detail-c
20e0: 68 61 6e 67 65 73 20 22 20 74 65 73 74 73 2d 64 hanges " tests-d
20f0: 65 74 61 69 6c 2d 63 68 61 6e 67 65 73 29 0a 20 etail-changes).
2100: 20 20 20 0a 09 20 3b 3b 20 74 65 73 74 73 20 72 .. ;; tests r
2110: 65 6c 61 74 65 64 20 73 74 75 66 66 0a 09 20 3b elated stuff.. ;
2120: 3b 20 28 61 6c 6c 2d 74 65 73 74 6e 61 6d 65 73 ; (all-testnames
2130: 20 28 64 65 6c 65 74 65 2d 64 75 70 6c 69 63 61 (delete-duplica
2140: 74 65 73 20 28 6d 61 70 20 64 62 3a 74 65 73 74 tes (map db:test
2150: 2d 67 65 74 2d 74 65 73 74 6e 61 6d 65 20 74 65 -get-testname te
2160: 73 74 2d 63 68 61 6e 67 65 73 29 29 29 29 0a 0a st-changes))))..
2170: 20 20 20 20 3b 3b 20 47 69 76 65 6e 20 61 20 72 ;; Given a r
2180: 75 6e 2d 69 64 20 61 6e 64 20 74 65 73 74 6e 61 un-id and testna
2190: 6d 65 2f 69 74 65 6d 5f 70 61 74 68 20 63 61 6c me/item_path cal
21a0: 63 75 6c 61 74 65 20 61 20 63 65 6c 6c 20 52 3a culate a cell R:
21b0: 43 0a 0a 20 20 20 20 3b 3b 20 4e 4f 54 45 3a 20 C.. ;; NOTE:
21c0: 41 6c 73 6f 20 62 75 69 6c 64 20 74 68 65 20 74 Also build the t
21d0: 65 73 74 20 74 72 65 65 20 62 72 6f 77 73 65 72 est tree browser
21e0: 20 61 6e 64 20 6c 6f 6f 6b 20 75 70 20 74 61 62 and look up tab
21f0: 6c 65 0a 20 20 20 20 3b 3b 0a 20 20 20 20 3b 3b le. ;;. ;;
2200: 20 45 61 63 68 20 72 75 6e 20 69 73 20 75 6e 69 Each run is uni
2210: 71 75 65 20 6f 6e 20 69 74 73 20 6b 65 79 73 20 que on its keys
2220: 61 6e 64 20 72 75 6e 6e 61 6d 65 20 6f 72 20 72 and runname or r
2230: 75 6e 2d 69 64 2c 20 73 74 6f 72 65 20 69 6e 20 un-id, store in
2240: 68 61 73 68 20 6f 6e 20 63 6f 6c 6e 75 6d 0a 20 hash on colnum.
2250: 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 (for-each (la
2260: 6d 62 64 61 20 28 72 75 6e 2d 69 64 29 0a 09 09 mbda (run-id)...
2270: 28 6c 65 74 2a 20 28 28 72 75 6e 2d 72 65 63 6f (let* ((run-reco
2280: 72 64 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 rd (hash-table-r
2290: 65 66 2f 64 65 66 61 75 6c 74 20 72 75 6e 73 2d ef/default runs-
22a0: 68 61 73 68 20 72 75 6e 2d 69 64 20 23 66 29 29 hash run-id #f))
22b0: 0a 09 09 20 20 20 20 20 20 20 28 6b 65 79 2d 76 ... (key-v
22c0: 61 6c 73 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 als (map (lamb
22d0: 64 61 20 28 6b 65 79 29 28 64 62 3a 67 65 74 2d da (key)(db:get-
22e0: 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 value-by-header
22f0: 72 75 6e 2d 72 65 63 6f 72 64 20 68 65 61 64 65 run-record heade
2300: 72 20 6b 65 79 29 29 0a 09 09 09 09 09 6b 65 79 r key))......key
2310: 73 29 29 0a 09 09 20 20 20 20 20 20 20 28 72 75 s))... (ru
2320: 6e 2d 6e 61 6d 65 20 20 20 28 64 62 3a 67 65 74 n-name (db:get
2330: 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 -value-by-header
2340: 20 72 75 6e 2d 72 65 63 6f 72 64 20 68 65 61 64 run-record head
2350: 65 72 20 22 72 75 6e 6e 61 6d 65 22 29 29 0a 09 er "runname"))..
2360: 09 20 20 20 20 20 20 20 28 63 6f 6c 2d 6e 61 6d . (col-nam
2370: 65 20 20 20 28 63 6f 6e 63 20 28 73 74 72 69 6e e (conc (strin
2380: 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 6b 65 g-intersperse ke
2390: 79 2d 76 61 6c 73 20 22 5c 6e 22 29 20 22 5c 6e y-vals "\n") "\n
23a0: 22 20 72 75 6e 2d 6e 61 6d 65 29 29 0a 09 09 20 " run-name))...
23b0: 20 20 20 20 20 20 28 72 75 6e 2d 70 61 74 68 20 (run-path
23c0: 20 20 28 61 70 70 65 6e 64 20 6b 65 79 2d 76 61 (append key-va
23d0: 6c 73 20 28 6c 69 73 74 20 72 75 6e 2d 6e 61 6d ls (list run-nam
23e0: 65 29 29 29 29 0a 09 09 20 20 28 68 61 73 68 2d e))))... (hash-
23f0: 74 61 62 6c 65 2d 73 65 74 21 20 28 64 62 6f 61 table-set! (dboa
2400: 72 64 3a 64 61 74 61 2d 67 65 74 2d 72 75 6e 2d rd:data-get-run-
2410: 6b 65 79 73 20 2a 64 61 74 61 2a 29 20 72 75 6e keys *data*) run
2420: 2d 69 64 20 72 75 6e 2d 70 61 74 68 29 0a 09 09 -id run-path)...
2430: 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 (iup:attribute
2440: 2d 73 65 74 21 20 28 64 62 6f 61 72 64 3a 64 61 -set! (dboard:da
2450: 74 61 2d 67 65 74 2d 72 75 6e 73 2d 6d 61 74 72 ta-get-runs-matr
2460: 69 78 20 2a 64 61 74 61 2a 29 0a 09 09 09 09 20 ix *data*).....
2470: 20 20 20 20 20 28 63 6f 6e 63 20 72 6f 77 6e 75 (conc rownu
2480: 6d 20 22 3a 22 20 63 6f 6c 6e 75 6d 29 20 63 6f m ":" colnum) co
2490: 6c 2d 6e 61 6d 65 29 0a 09 09 20 20 28 68 61 73 l-name)... (has
24a0: 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 72 75 6e h-table-set! run
24b0: 69 64 2d 74 6f 2d 63 6f 6c 20 72 75 6e 2d 69 64 id-to-col run-id
24c0: 20 28 6c 69 73 74 20 63 6f 6c 6e 75 6d 20 72 75 (list colnum ru
24d0: 6e 2d 72 65 63 6f 72 64 29 29 0a 09 09 20 20 3b n-record))... ;
24e0: 3b 20 48 65 72 65 20 77 65 20 75 70 64 61 74 65 ; Here we update
24f0: 20 74 68 65 20 74 65 73 74 73 20 74 72 65 65 62 the tests treeb
2500: 6f 78 20 61 6e 64 20 74 72 65 65 20 6b 65 79 73 ox and tree keys
2510: 0a 09 09 20 20 28 74 72 65 65 3a 61 64 64 2d 6e ... (tree:add-n
2520: 6f 64 65 20 28 64 62 6f 61 72 64 3a 64 61 74 61 ode (dboard:data
2530: 2d 67 65 74 2d 74 65 73 74 73 2d 74 72 65 65 20 -get-tests-tree
2540: 2a 64 61 74 61 2a 29 20 22 52 75 6e 73 22 20 28 *data*) "Runs" (
2550: 61 70 70 65 6e 64 20 6b 65 79 2d 76 61 6c 73 20 append key-vals
2560: 28 6c 69 73 74 20 72 75 6e 2d 6e 61 6d 65 29 29 (list run-name))
2570: 0a 09 09 09 09 20 75 73 65 72 64 61 74 61 3a 20 ..... userdata:
2580: 28 63 6f 6e 63 20 22 72 75 6e 2d 69 64 3a 20 22 (conc "run-id: "
2590: 20 72 75 6e 2d 69 64 29 29 0a 09 09 20 20 28 73 run-id))... (s
25a0: 65 74 21 20 63 6f 6c 6e 75 6d 20 28 2b 20 63 6f et! colnum (+ co
25b0: 6c 6e 75 6d 20 31 29 29 29 29 0a 09 20 20 20 20 lnum 1))))..
25c0: 20 20 72 75 6e 2d 69 64 73 29 0a 0a 20 20 20 20 run-ids)..
25d0: 3b 3b 20 53 63 61 6e 20 61 6c 6c 20 74 65 73 74 ;; Scan all test
25e0: 73 20 74 6f 20 62 65 20 64 69 73 70 6c 61 79 65 s to be displaye
25f0: 64 20 61 6e 64 20 6f 72 67 61 6e 69 73 65 20 61 d and organise a
2600: 6c 6c 20 74 68 65 20 74 65 73 74 20 6e 61 6d 65 ll the test name
2610: 73 2c 20 72 65 73 70 65 63 74 69 6e 67 20 77 68 s, respecting wh
2620: 61 74 20 69 73 20 69 6e 20 74 68 65 20 68 61 73 at is in the has
2630: 68 20 74 61 62 6c 65 0a 20 20 20 20 3b 3b 20 44 h table. ;; D
2640: 6f 20 74 68 69 73 20 61 6e 61 6c 79 73 69 73 20 o this analysis
2650: 69 6e 20 74 68 65 20 6f 72 64 65 72 20 6f 66 20 in the order of
2660: 74 68 65 20 72 75 6e 2d 69 64 73 2c 20 74 68 65 the run-ids, the
2670: 20 6d 6f 73 74 20 72 65 63 65 6e 74 20 72 75 6e most recent run
2680: 20 77 69 6e 73 0a 20 20 20 20 28 66 6f 72 2d 65 wins. (for-e
2690: 61 63 68 20 28 6c 61 6d 62 64 61 20 28 72 75 6e ach (lambda (run
26a0: 2d 69 64 29 0a 09 09 28 6c 65 74 2a 20 28 28 72 -id)...(let* ((r
26b0: 75 6e 2d 70 61 74 68 20 20 20 20 20 20 20 28 68 un-path (h
26c0: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 28 64 ash-table-ref (d
26d0: 62 6f 61 72 64 3a 64 61 74 61 2d 67 65 74 2d 72 board:data-get-r
26e0: 75 6e 2d 6b 65 79 73 20 2a 64 61 74 61 2a 29 20 un-keys *data*)
26f0: 72 75 6e 2d 69 64 29 29 0a 09 09 20 20 20 20 20 run-id))...
2700: 20 20 28 74 65 73 74 2d 63 68 61 6e 67 65 73 20 (test-changes
2710: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 (hash-table-re
2720: 66 20 61 6c 6c 2d 74 65 73 74 2d 63 68 61 6e 67 f all-test-chang
2730: 65 73 20 72 75 6e 2d 69 64 29 29 0a 09 09 20 20 es run-id))...
2740: 20 20 20 20 20 28 6e 65 77 2d 74 65 73 74 2d 64 (new-test-d
2750: 61 74 20 20 20 28 63 61 72 20 74 65 73 74 2d 63 at (car test-c
2760: 68 61 6e 67 65 73 29 29 0a 09 09 20 20 20 20 20 hanges))...
2770: 20 20 28 72 65 6d 6f 76 65 64 2d 74 65 73 74 73 (removed-tests
2780: 20 20 28 63 61 64 72 20 74 65 73 74 2d 63 68 61 (cadr test-cha
2790: 6e 67 65 73 29 29 0a 09 09 20 20 20 20 20 20 20 nges))...
27a0: 28 74 65 73 74 73 20 20 20 20 20 20 20 20 20 20 (tests
27b0: 28 73 6f 72 74 20 28 6d 61 70 20 63 61 64 72 20 (sort (map cadr
27c0: 28 66 69 6c 74 65 72 20 28 6c 61 6d 62 64 61 20 (filter (lambda
27d0: 28 74 65 73 74 72 65 63 29 0a 09 09 09 09 09 09 (testrec).......
27e0: 09 09 20 28 65 71 3f 20 72 75 6e 2d 69 64 20 28 .. (eq? run-id (
27f0: 64 62 3a 6d 69 6e 74 65 73 74 2d 67 65 74 2d 72 db:mintest-get-r
2800: 75 6e 5f 69 64 20 28 63 61 64 72 20 74 65 73 74 un_id (cadr test
2810: 72 65 63 29 29 29 29 0a 09 09 09 09 09 09 09 20 rec))))........
2820: 20 20 20 20 20 20 6e 65 77 2d 74 65 73 74 2d 64 new-test-d
2830: 61 74 29 29 0a 09 09 09 09 09 20 20 20 20 20 28 at))...... (
2840: 6c 61 6d 62 64 61 20 28 61 20 62 29 0a 09 09 09 lambda (a b)....
2850: 09 09 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 .. (let ((
2860: 74 69 6d 65 2d 61 20 28 64 62 3a 6d 69 6e 74 65 time-a (db:minte
2870: 73 74 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d st-get-event_tim
2880: 65 20 61 29 29 0a 09 09 09 09 09 09 20 20 20 20 e a)).......
2890: 20 28 74 69 6d 65 2d 62 20 28 64 62 3a 6d 69 6e (time-b (db:min
28a0: 74 65 73 74 2d 67 65 74 2d 65 76 65 6e 74 5f 74 test-get-event_t
28b0: 69 6d 65 20 62 29 29 29 0a 09 09 09 09 09 09 20 ime b))).......
28c0: 28 3e 20 74 69 6d 65 2d 61 20 74 69 6d 65 2d 62 (> time-a time-b
28d0: 29 29 29 29 29 0a 09 09 20 20 20 20 20 20 20 3b )))))... ;
28e0: 3b 20 74 65 73 74 2d 63 68 61 6e 67 65 73 20 69 ; test-changes i
28f0: 73 20 61 20 6c 69 73 74 20 6f 66 20 28 28 20 69 s a list of (( i
2900: 64 20 72 65 63 6f 72 64 20 29 20 2e 2e 2e 20 29 d record ) ... )
2910: 0a 09 09 20 20 20 20 20 20 20 3b 3b 20 47 65 74 ... ;; Get
2920: 20 6c 69 73 74 20 6f 66 20 74 65 73 74 20 6e 61 list of test na
2930: 6d 65 73 20 73 6f 72 74 65 64 20 62 79 20 74 69 mes sorted by ti
2940: 6d 65 2c 20 72 65 6d 6f 76 65 20 74 65 73 74 73 me, remove tests
2950: 0a 09 09 20 20 20 20 20 20 20 28 74 65 73 74 2d ... (test-
2960: 6e 61 6d 65 73 20 28 64 65 6c 65 74 65 2d 64 75 names (delete-du
2970: 70 6c 69 63 61 74 65 73 20 28 6d 61 70 20 28 6c plicates (map (l
2980: 61 6d 62 64 61 20 28 74 29 0a 09 09 09 09 09 09 ambda (t).......
2990: 09 20 20 20 20 20 28 6c 65 74 20 28 28 69 20 28 . (let ((i (
29a0: 64 62 3a 6d 69 6e 74 65 73 74 2d 67 65 74 2d 69 db:mintest-get-i
29b0: 74 65 6d 5f 70 61 74 68 20 74 29 29 0a 09 09 09 tem_path t))....
29c0: 09 09 09 09 09 20 20 20 28 6e 20 28 64 62 3a 6d ..... (n (db:m
29d0: 69 6e 74 65 73 74 2d 67 65 74 2d 74 65 73 74 6e intest-get-testn
29e0: 61 6d 65 20 20 74 29 29 29 0a 09 09 09 09 09 09 ame t))).......
29f0: 09 20 20 20 20 20 20 20 28 69 66 20 28 73 74 72 . (if (str
2a00: 69 6e 67 3d 3f 20 69 20 22 22 29 0a 09 09 09 09 ing=? i "").....
2a10: 09 09 09 09 20 20 20 28 63 6f 6e 63 20 22 20 20 .... (conc "
2a20: 20 22 20 69 29 0a 09 09 09 09 09 09 09 09 20 20 " i).........
2a30: 20 6e 29 29 29 0a 09 09 09 09 09 09 09 20 20 20 n)))........
2a40: 74 65 73 74 73 29 29 29 0a 09 09 20 20 20 20 20 tests)))...
2a50: 20 20 28 63 6f 6c 6e 75 6d 20 20 20 20 20 28 63 (colnum (c
2a60: 61 72 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 ar (hash-table-r
2a70: 65 66 20 72 75 6e 69 64 2d 74 6f 2d 63 6f 6c 20 ef runid-to-col
2a80: 72 75 6e 2d 69 64 29 29 29 29 0a 09 09 20 20 3b run-id))))... ;
2a90: 3b 20 66 6f 72 20 65 61 63 68 20 74 65 73 74 20 ; for each test
2aa0: 6e 61 6d 65 20 67 65 74 20 74 68 65 20 73 6c 6f name get the slo
2ab0: 74 20 69 66 20 69 74 20 65 78 69 73 74 73 20 61 t if it exists a
2ac0: 6e 64 20 66 69 6c 6c 20 69 6e 20 74 68 65 20 63 nd fill in the c
2ad0: 65 6c 6c 0a 09 09 20 20 3b 3b 20 6f 72 20 74 61 ell... ;; or ta
2ae0: 6b 65 20 74 68 65 20 6e 65 78 74 20 73 6c 6f 74 ke the next slot
2af0: 20 61 6e 64 20 66 69 6c 6c 20 69 6e 20 74 68 65 and fill in the
2b00: 20 63 65 6c 6c 2c 20 64 65 61 6c 20 77 69 74 68 cell, deal with
2b10: 20 69 74 65 6d 73 20 69 6e 20 74 68 65 0a 09 09 items in the...
2b20: 20 20 3b 3b 20 72 75 6e 20 76 69 65 77 20 70 61 ;; run view pa
2b30: 6e 65 6c 3f 20 54 68 65 20 72 75 6e 20 76 69 65 nel? The run vie
2b40: 77 20 70 61 6e 65 6c 20 63 61 6e 20 68 61 76 65 w panel can have
2b50: 20 61 20 74 72 65 65 20 73 65 6c 65 63 74 6f 72 a tree selector
2b60: 20 66 6f 72 0a 09 09 20 20 3b 3b 20 62 72 6f 77 for... ;; brow
2b70: 73 69 6e 67 20 74 68 65 20 74 65 73 74 73 2f 69 sing the tests/i
2b80: 74 65 6d 73 0a 0a 09 09 20 20 3b 3b 20 53 57 49 tems.... ;; SWI
2b90: 54 43 48 20 54 48 49 53 20 54 4f 20 55 53 49 4e TCH THIS TO USIN
2ba0: 47 20 43 48 41 4e 47 45 44 20 54 45 53 54 53 20 G CHANGED TESTS
2bb0: 4f 4e 4c 59 0a 09 09 20 20 28 66 6f 72 2d 65 61 ONLY... (for-ea
2bc0: 63 68 20 28 6c 61 6d 62 64 61 20 28 74 65 73 74 ch (lambda (test
2bd0: 29 0a 09 09 09 20 20 20 20 20 20 28 6c 65 74 2a ).... (let*
2be0: 20 28 28 74 65 73 74 2d 69 64 20 20 20 28 64 62 ((test-id (db
2bf0: 3a 6d 69 6e 74 65 73 74 2d 67 65 74 2d 69 64 20 :mintest-get-id
2c00: 74 65 73 74 29 29 0a 09 09 09 09 20 20 20 20 20 test)).....
2c10: 28 73 74 61 74 65 20 20 20 20 20 28 64 62 3a 6d (state (db:m
2c20: 69 6e 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 intest-get-state
2c30: 20 74 65 73 74 29 29 0a 09 09 09 09 20 20 20 20 test)).....
2c40: 20 28 73 74 61 74 75 73 20 20 20 20 28 64 62 3a (status (db:
2c50: 6d 69 6e 74 65 73 74 2d 67 65 74 2d 73 74 61 74 mintest-get-stat
2c60: 75 73 20 74 65 73 74 29 29 0a 09 09 09 09 20 20 us test)).....
2c70: 20 20 20 28 74 65 73 74 6e 61 6d 65 20 20 28 64 (testname (d
2c80: 62 3a 6d 69 6e 74 65 73 74 2d 67 65 74 2d 74 65 b:mintest-get-te
2c90: 73 74 6e 61 6d 65 20 74 65 73 74 29 29 0a 09 09 stname test))...
2ca0: 09 09 20 20 20 20 20 28 69 74 65 6d 70 61 74 68 .. (itempath
2cb0: 20 20 28 64 62 3a 6d 69 6e 74 65 73 74 2d 67 65 (db:mintest-ge
2cc0: 74 2d 69 74 65 6d 5f 70 61 74 68 20 74 65 73 74 t-item_path test
2cd0: 29 29 0a 09 09 09 09 20 20 20 20 20 28 66 75 6c ))..... (ful
2ce0: 6c 6e 61 6d 65 20 20 28 63 6f 6e 63 20 74 65 73 lname (conc tes
2cf0: 74 6e 61 6d 65 20 22 2f 22 20 69 74 65 6d 70 61 tname "/" itempa
2d00: 74 68 29 29 0a 09 09 09 09 20 20 20 20 20 28 64 th))..... (d
2d10: 69 73 70 6e 61 6d 65 20 20 28 69 66 20 28 73 74 ispname (if (st
2d20: 72 69 6e 67 3d 3f 20 69 74 65 6d 70 61 74 68 20 ring=? itempath
2d30: 22 22 29 20 74 65 73 74 6e 61 6d 65 20 28 63 6f "") testname (co
2d40: 6e 63 20 22 20 20 20 22 20 69 74 65 6d 70 61 74 nc " " itempat
2d50: 68 29 29 29 0a 09 09 09 09 20 20 20 20 20 28 72 h)))..... (r
2d60: 6f 77 6e 75 6d 20 20 20 20 28 68 61 73 68 2d 74 ownum (hash-t
2d70: 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 able-ref/default
2d80: 20 74 65 73 74 6e 61 6d 65 2d 74 6f 2d 72 6f 77 testname-to-row
2d90: 20 66 75 6c 6c 6e 61 6d 65 20 23 66 29 29 0a 09 fullname #f))..
2da0: 09 09 09 20 20 20 20 20 28 74 65 73 74 2d 70 61 ... (test-pa
2db0: 74 68 20 28 61 70 70 65 6e 64 20 72 75 6e 2d 70 th (append run-p
2dc0: 61 74 68 20 28 69 66 20 28 65 71 75 61 6c 3f 20 ath (if (equal?
2dd0: 69 74 65 6d 70 61 74 68 20 22 22 29 20 0a 09 09 itempath "") ...
2de0: 09 09 09 09 09 09 20 20 20 20 20 28 6c 69 73 74 ...... (list
2df0: 20 74 65 73 74 6e 61 6d 65 29 0a 09 09 09 09 09 testname)......
2e00: 09 09 09 20 20 20 20 20 28 6c 69 73 74 20 74 65 ... (list te
2e10: 73 74 6e 61 6d 65 20 69 74 65 6d 70 61 74 68 29 stname itempath)
2e20: 29 29 29 0a 09 09 09 09 20 20 20 20 20 28 74 62 )))..... (tb
2e30: 20 20 20 20 20 20 20 20 20 28 64 62 6f 61 72 64 (dboard
2e40: 3a 64 61 74 61 2d 67 65 74 2d 74 65 73 74 73 2d :data-get-tests-
2e50: 74 72 65 65 20 2a 64 61 74 61 2a 29 29 29 0a 09 tree *data*)))..
2e60: 09 09 09 28 70 72 69 6e 74 20 22 49 4e 46 4f 4e ...(print "INFON
2e70: 4f 54 45 3a 20 72 75 6e 2d 70 61 74 68 3a 20 22 OTE: run-path: "
2e80: 20 72 75 6e 2d 70 61 74 68 29 0a 09 09 09 09 28 run-path).....(
2e90: 74 72 65 65 3a 61 64 64 2d 6e 6f 64 65 20 28 64 tree:add-node (d
2ea0: 62 6f 61 72 64 3a 64 61 74 61 2d 67 65 74 2d 74 board:data-get-t
2eb0: 65 73 74 73 2d 74 72 65 65 20 2a 64 61 74 61 2a ests-tree *data*
2ec0: 29 20 22 52 75 6e 73 22 20 0a 09 09 09 09 09 20 ) "Runs" ......
2ed0: 20 20 20 20 20 20 74 65 73 74 2d 70 61 74 68 0a test-path.
2ee0: 09 09 09 09 09 20 20 20 20 20 20 20 75 73 65 72 ..... user
2ef0: 64 61 74 61 3a 20 28 63 6f 6e 63 20 22 74 65 73 data: (conc "tes
2f00: 74 2d 69 64 3a 20 22 20 74 65 73 74 2d 69 64 29 t-id: " test-id)
2f10: 29 0a 09 09 09 09 28 6c 65 74 20 28 28 6e 6f 64 ).....(let ((nod
2f20: 65 2d 6e 75 6d 20 28 74 72 65 65 3a 66 69 6e 64 e-num (tree:find
2f30: 2d 6e 6f 64 65 20 74 62 20 28 63 6f 6e 73 20 22 -node tb (cons "
2f40: 52 75 6e 73 22 20 74 65 73 74 2d 70 61 74 68 29 Runs" test-path)
2f50: 29 29 0a 09 09 09 09 20 20 20 20 20 20 28 63 6f ))..... (co
2f60: 6c 6f 72 20 20 20 20 28 63 61 72 20 28 67 75 74 lor (car (gut
2f70: 69 6c 73 3a 67 65 74 2d 63 6f 6c 6f 72 2d 66 6f ils:get-color-fo
2f80: 72 2d 73 74 61 74 65 2d 73 74 61 74 75 73 20 73 r-state-status s
2f90: 74 61 74 65 20 73 74 61 74 75 73 29 29 29 29 0a tate status)))).
2fa0: 09 09 09 09 20 20 28 64 65 62 75 67 3a 70 72 69 .... (debug:pri
2fb0: 6e 74 20 30 20 22 6e 6f 64 65 2d 6e 75 6d 3a 20 nt 0 "node-num:
2fc0: 22 20 6e 6f 64 65 2d 6e 75 6d 20 22 2c 20 63 6f " node-num ", co
2fd0: 6c 6f 72 3a 20 22 20 63 6f 6c 6f 72 29 0a 09 09 lor: " color)...
2fe0: 09 09 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 .. (iup:attribu
2ff0: 74 65 2d 73 65 74 21 20 74 62 20 28 63 6f 6e 63 te-set! tb (conc
3000: 20 22 43 4f 4c 4f 52 22 20 6e 6f 64 65 2d 6e 75 "COLOR" node-nu
3010: 6d 29 20 63 6f 6c 6f 72 29 29 0a 09 09 09 09 28 m) color)).....(
3020: 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 hash-table-set!
3030: 28 64 62 6f 61 72 64 3a 64 61 74 61 2d 67 65 74 (dboard:data-get
3040: 2d 70 61 74 68 2d 74 65 73 74 2d 69 64 73 20 2a -path-test-ids *
3050: 64 61 74 61 2a 29 20 74 65 73 74 2d 70 61 74 68 data*) test-path
3060: 20 74 65 73 74 2d 69 64 29 0a 09 09 09 09 28 69 test-id).....(i
3070: 66 20 28 6e 6f 74 20 72 6f 77 6e 75 6d 29 0a 09 f (not rownum)..
3080: 09 09 09 20 20 20 20 28 6c 65 74 20 28 28 72 6f ... (let ((ro
3090: 77 6e 75 6d 73 20 28 68 61 73 68 2d 74 61 62 6c wnums (hash-tabl
30a0: 65 2d 76 61 6c 75 65 73 20 74 65 73 74 6e 61 6d e-values testnam
30b0: 65 2d 74 6f 2d 72 6f 77 29 29 29 0a 09 09 09 09 e-to-row))).....
30c0: 20 20 20 20 20 20 28 73 65 74 21 20 72 6f 77 6e (set! rown
30d0: 75 6d 20 28 69 66 20 28 6e 75 6c 6c 3f 20 72 6f um (if (null? ro
30e0: 77 6e 75 6d 73 29 0a 09 09 09 09 09 09 20 20 20 wnums).......
30f0: 20 20 20 20 31 0a 09 09 09 09 09 09 20 20 20 20 1.......
3100: 20 20 20 28 2b 20 31 20 28 61 70 70 6c 79 20 6d (+ 1 (apply m
3110: 61 78 20 72 6f 77 6e 75 6d 73 29 29 29 29 0a 09 ax rownums))))..
3120: 09 09 09 20 20 20 20 20 20 28 68 61 73 68 2d 74 ... (hash-t
3130: 61 62 6c 65 2d 73 65 74 21 20 74 65 73 74 6e 61 able-set! testna
3140: 6d 65 2d 74 6f 2d 72 6f 77 20 66 75 6c 6c 6e 61 me-to-row fullna
3150: 6d 65 20 72 6f 77 6e 75 6d 29 0a 09 09 09 09 20 me rownum).....
3160: 20 20 20 20 20 3b 3b 20 63 72 65 61 74 65 20 74 ;; create t
3170: 68 65 20 6c 61 62 65 6c 0a 09 09 09 09 20 20 20 he label.....
3180: 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 (iup:attribut
3190: 65 2d 73 65 74 21 20 28 64 62 6f 61 72 64 3a 64 e-set! (dboard:d
31a0: 61 74 61 2d 67 65 74 2d 72 75 6e 73 2d 6d 61 74 ata-get-runs-mat
31b0: 72 69 78 20 2a 64 61 74 61 2a 29 0a 09 09 09 09 rix *data*).....
31c0: 09 09 09 20 20 28 63 6f 6e 63 20 72 6f 77 6e 75 ... (conc rownu
31d0: 6d 20 22 3a 22 20 30 29 20 64 69 73 70 6e 61 6d m ":" 0) dispnam
31e0: 65 29 0a 09 09 09 09 20 20 20 20 20 20 29 29 0a e)..... )).
31f0: 09 09 09 09 3b 3b 20 73 65 74 20 74 68 65 20 63 ....;; set the c
3200: 65 6c 6c 20 74 65 78 74 20 61 6e 64 20 63 6f 6c ell text and col
3210: 6f 72 0a 09 09 09 09 3b 3b 20 28 64 65 62 75 67 or.....;; (debug
3220: 3a 70 72 69 6e 74 20 32 20 22 72 6f 77 6e 75 6d :print 2 "rownum
3230: 3a 63 6f 6c 6e 75 6d 3d 22 20 72 6f 77 6e 75 6d :colnum=" rownum
3240: 20 22 3a 22 20 63 6f 6c 6e 75 6d 20 22 2c 20 73 ":" colnum ", s
3250: 74 61 74 65 3d 22 20 73 74 61 74 75 73 29 0a 09 tate=" status)..
3260: 09 09 09 28 69 75 70 3a 61 74 74 72 69 62 75 74 ...(iup:attribut
3270: 65 2d 73 65 74 21 20 28 64 62 6f 61 72 64 3a 64 e-set! (dboard:d
3280: 61 74 61 2d 67 65 74 2d 72 75 6e 73 2d 6d 61 74 ata-get-runs-mat
3290: 72 69 78 20 2a 64 61 74 61 2a 29 0a 09 09 09 09 rix *data*).....
32a0: 09 09 20 20 20 20 28 63 6f 6e 63 20 72 6f 77 6e .. (conc rown
32b0: 75 6d 20 22 3a 22 20 63 6f 6c 6e 75 6d 29 0a 09 um ":" colnum)..
32c0: 09 09 09 09 09 20 20 20 20 28 69 66 20 28 6d 65 ..... (if (me
32d0: 6d 62 65 72 20 73 74 61 74 65 20 27 28 22 41 52 mber state '("AR
32e0: 43 48 49 56 45 44 22 20 22 43 4f 4d 50 4c 45 54 CHIVED" "COMPLET
32f0: 45 44 22 29 29 0a 09 09 09 09 09 09 09 73 74 61 ED"))........sta
3300: 74 75 73 0a 09 09 09 09 09 09 09 73 74 61 74 65 tus........state
3310: 29 29 0a 09 09 09 09 28 69 75 70 3a 61 74 74 72 )).....(iup:attr
3320: 69 62 75 74 65 2d 73 65 74 21 20 28 64 62 6f 61 ibute-set! (dboa
3330: 72 64 3a 64 61 74 61 2d 67 65 74 2d 72 75 6e 73 rd:data-get-runs
3340: 2d 6d 61 74 72 69 78 20 2a 64 61 74 61 2a 29 0a -matrix *data*).
3350: 09 09 09 09 09 09 20 20 20 20 28 63 6f 6e 63 20 ...... (conc
3360: 22 42 47 43 4f 4c 4f 52 22 20 72 6f 77 6e 75 6d "BGCOLOR" rownum
3370: 20 22 3a 22 20 63 6f 6c 6e 75 6d 29 0a 09 09 09 ":" colnum)....
3380: 09 09 09 20 20 20 20 28 63 61 72 20 28 67 75 74 ... (car (gut
3390: 69 6c 73 3a 67 65 74 2d 63 6f 6c 6f 72 2d 66 6f ils:get-color-fo
33a0: 72 2d 73 74 61 74 65 2d 73 74 61 74 75 73 20 73 r-state-status s
33b0: 74 61 74 65 20 73 74 61 74 75 73 29 29 29 0a 09 tate status)))..
33c0: 09 09 09 29 29 0a 09 09 09 20 20 20 20 74 65 73 ...)).... tes
33d0: 74 73 29 29 29 0a 09 20 20 20 20 20 20 72 75 6e ts))).. run
33e0: 2d 69 64 73 29 0a 0a 20 20 20 20 28 6c 65 74 20 -ids).. (let
33f0: 28 28 75 70 64 61 74 65 72 20 28 68 61 73 68 2d ((updater (hash-
3400: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
3410: 74 20 20 28 64 62 6f 61 72 64 3a 64 61 74 61 2d t (dboard:data-
3420: 67 65 74 2d 75 70 64 61 74 65 72 73 20 2a 64 61 get-updaters *da
3430: 74 61 2a 29 20 77 69 6e 64 6f 77 2d 69 64 20 23 ta*) window-id #
3440: 66 29 29 29 0a 20 20 20 20 20 20 28 69 66 20 75 f))). (if u
3450: 70 64 61 74 65 72 20 28 75 70 64 61 74 65 72 20 pdater (updater
3460: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/
3470: 64 65 66 61 75 6c 74 20 64 61 74 61 20 67 65 74 default data get
3480: 2d 64 65 74 61 69 6c 73 2d 73 69 67 20 23 66 29 -details-sig #f)
3490: 29 29 29 0a 0a 20 20 20 20 28 69 75 70 3a 61 74 ))).. (iup:at
34a0: 74 72 69 62 75 74 65 2d 73 65 74 21 20 28 64 62 tribute-set! (db
34b0: 6f 61 72 64 3a 64 61 74 61 2d 67 65 74 2d 72 75 oard:data-get-ru
34c0: 6e 73 2d 6d 61 74 72 69 78 20 2a 64 61 74 61 2a ns-matrix *data*
34d0: 29 20 22 52 45 44 52 41 57 22 20 22 41 4c 4c 22 ) "REDRAW" "ALL"
34e0: 29 0a 20 20 20 20 3b 3b 20 28 64 65 62 75 67 3a ). ;; (debug:
34f0: 70 72 69 6e 74 20 32 20 22 72 75 6e 2d 63 68 61 print 2 "run-cha
3500: 6e 67 65 73 3a 20 22 20 72 75 6e 2d 63 68 61 6e nges: " run-chan
3510: 67 65 73 29 0a 20 20 20 20 3b 3b 20 28 64 65 62 ges). ;; (deb
3520: 75 67 3a 70 72 69 6e 74 20 32 20 22 74 65 73 74 ug:print 2 "test
3530: 2d 63 68 61 6e 67 65 73 3a 20 22 20 74 65 73 74 -changes: " test
3540: 2d 63 68 61 6e 67 65 73 29 0a 20 20 20 20 28 6c -changes). (l
3550: 69 73 74 20 72 75 6e 2d 63 68 61 6e 67 65 73 20 ist run-changes
3560: 61 6c 6c 2d 74 65 73 74 2d 63 68 61 6e 67 65 73 all-test-changes
3570: 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
3580: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3590: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
35a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
35b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
35c0: 20 54 45 53 54 53 20 44 41 54 41 0a 3b 3b 3d 3d TESTS DATA.;;==
35d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
35e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
35f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3600: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3610: 3d 3d 3d 3d 0a 0a 3b 3b 20 50 72 6f 64 75 63 65 ====..;; Produce
3620: 20 61 20 6c 69 73 74 20 6f 66 20 6c 69 73 74 73 a list of lists
3630: 20 72 65 61 64 79 20 66 6f 72 20 63 6f 6d 6d 6f ready for commo
3640: 6e 3a 73 70 61 72 73 65 2d 6c 69 73 74 2d 67 65 n:sparse-list-ge
3650: 6e 65 72 61 74 65 2d 69 6e 64 65 78 0a 3b 3b 0a nerate-index.;;.
3660: 28 64 65 66 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e (define (dcommon
3670: 3a 6d 69 6e 69 6d 69 7a 65 2d 74 65 73 74 2d 64 :minimize-test-d
3680: 61 74 61 20 74 65 73 74 73 2d 64 61 74 29 0a 20 ata tests-dat).
3690: 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 65 73 74 (if (null? test
36a0: 73 2d 64 61 74 29 20 0a 20 20 20 20 20 20 27 28 s-dat) . '(
36b0: 29 0a 20 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f ). (let loo
36c0: 70 20 28 28 68 65 64 20 28 63 61 72 20 74 65 73 p ((hed (car tes
36d0: 74 73 2d 64 61 74 29 29 0a 09 09 20 28 74 61 6c ts-dat))... (tal
36e0: 20 28 63 64 72 20 74 65 73 74 73 2d 64 61 74 29 (cdr tests-dat)
36f0: 29 0a 09 09 20 28 72 65 73 20 27 28 29 29 29 0a )... (res '())).
3700: 09 28 6c 65 74 2a 20 28 28 74 65 73 74 2d 69 64 .(let* ((test-id
3710: 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 (vector-ref
3720: 68 65 64 20 30 29 29 20 3b 3b 20 6c 6f 6f 6b 20 hed 0)) ;; look
3730: 61 74 20 74 68 65 20 74 65 73 74 73 2d 64 61 74 at the tests-dat
3740: 20 73 70 65 63 20 66 6f 72 20 6c 6f 63 61 74 69 spec for locati
3750: 6f 6e 73 0a 09 20 20 20 20 20 20 20 28 74 65 73 ons.. (tes
3760: 74 2d 6e 61 6d 65 20 20 28 76 65 63 74 6f 72 2d t-name (vector-
3770: 72 65 66 20 68 65 64 20 31 29 29 0a 09 20 20 20 ref hed 1))..
3780: 20 20 20 20 28 69 74 65 6d 2d 70 61 74 68 20 20 (item-path
3790: 28 76 65 63 74 6f 72 2d 72 65 66 20 68 65 64 20 (vector-ref hed
37a0: 32 29 29 0a 09 20 20 20 20 20 20 20 28 73 74 61 2)).. (sta
37b0: 74 65 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d te (vector-
37c0: 72 65 66 20 68 65 64 20 33 29 29 0a 09 20 20 20 ref hed 3))..
37d0: 20 20 20 20 28 73 74 61 74 75 73 20 20 20 20 20 (status
37e0: 28 76 65 63 74 6f 72 2d 72 65 66 20 68 65 64 20 (vector-ref hed
37f0: 34 29 29 0a 09 20 20 20 20 20 20 20 28 6e 65 77 4)).. (new
3800: 69 74 65 6d 20 20 20 20 28 6c 69 73 74 20 74 65 item (list te
3810: 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 st-name item-pat
3820: 68 20 28 6c 69 73 74 20 74 65 73 74 2d 69 64 20 h (list test-id
3830: 73 74 61 74 65 20 73 74 61 74 75 73 29 29 29 29 state status))))
3840: 0a 09 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 .. (if (null? t
3850: 61 6c 29 0a 09 20 20 20 20 20 20 28 72 65 76 65 al).. (reve
3860: 72 73 65 20 28 63 6f 6e 73 20 6e 65 77 69 74 65 rse (cons newite
3870: 6d 20 72 65 73 29 29 0a 09 20 20 20 20 20 20 28 m res)).. (
3880: 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 28 63 loop (car tal)(c
3890: 64 72 20 74 61 6c 29 28 63 6f 6e 73 20 6e 65 77 dr tal)(cons new
38a0: 69 74 65 6d 20 72 65 73 29 29 29 29 29 29 29 0a item res))))))).
38b0: 09 20 20 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d . ..;;=========
38c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
38d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
38e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
38f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
3900: 20 44 20 41 20 54 20 41 20 20 20 54 20 41 20 42 D A T A T A B
3910: 20 4c 20 45 20 53 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d L E S.;;=======
3920: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3930: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3940: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3950: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
3960: 0a 3b 3b 20 54 61 62 6c 65 20 6f 66 20 6b 65 79 .;; Table of key
3970: 73 0a 28 64 65 66 69 6e 65 20 28 64 63 6f 6d 6d s.(define (dcomm
3980: 6f 6e 3a 6b 65 79 73 2d 6d 61 74 72 69 78 20 72 on:keys-matrix r
3990: 61 77 63 6f 6e 66 69 67 29 0a 20 20 28 6c 65 74 awconfig). (let
39a0: 2a 20 28 28 63 75 72 72 2d 72 6f 77 2d 6e 75 6d * ((curr-row-num
39b0: 20 31 29 0a 09 20 28 6b 65 79 2d 76 61 6c 73 20 1).. (key-vals
39c0: 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 73 65 63 (configf:sec
39d0: 74 69 6f 6e 2d 76 61 72 73 20 72 61 77 63 6f 6e tion-vars rawcon
39e0: 66 69 67 20 22 66 69 65 6c 64 73 22 29 29 0a 09 fig "fields"))..
39f0: 20 28 6b 65 79 73 2d 6d 61 74 72 69 78 20 20 28 (keys-matrix (
3a00: 69 75 70 3a 6d 61 74 72 69 78 0a 09 09 09 23 3a iup:matrix....#:
3a10: 61 6c 69 67 6e 6d 65 6e 74 31 20 22 41 4c 45 46 alignment1 "ALEF
3a20: 54 22 0a 09 09 09 23 3a 65 78 70 61 6e 64 20 22 T"....#:expand "
3a30: 59 45 53 22 20 3b 3b 20 22 48 4f 52 49 5a 4f 4e YES" ;; "HORIZON
3a40: 54 41 4c 22 20 3b 3b 20 22 56 45 52 54 49 43 41 TAL" ;; "VERTICA
3a50: 4c 22 0a 09 09 09 3b 3b 20 23 3a 73 63 72 6f 6c L"....;; #:scrol
3a60: 6c 62 61 72 20 22 59 45 53 22 0a 09 09 09 23 3a lbar "YES"....#:
3a70: 6e 75 6d 63 6f 6c 20 31 0a 09 09 09 23 3a 6e 75 numcol 1....#:nu
3a80: 6d 6c 69 6e 20 28 6c 65 6e 67 74 68 20 6b 65 79 mlin (length key
3a90: 2d 76 61 6c 73 29 0a 09 09 09 23 3a 6e 75 6d 63 -vals)....#:numc
3aa0: 6f 6c 2d 76 69 73 69 62 6c 65 20 31 0a 09 09 09 ol-visible 1....
3ab0: 23 3a 6e 75 6d 6c 69 6e 2d 76 69 73 69 62 6c 65 #:numlin-visible
3ac0: 20 28 6c 65 6e 67 74 68 20 6b 65 79 2d 76 61 6c (length key-val
3ad0: 73 29 0a 09 09 09 23 3a 63 6c 69 63 6b 2d 63 62 s)....#:click-cb
3ae0: 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 20 6c 69 (lambda (obj li
3af0: 6e 20 63 6f 6c 20 73 74 61 74 75 73 29 0a 09 09 n col status)...
3b00: 09 09 20 20 20 20 20 28 70 72 69 6e 74 20 22 6f .. (print "o
3b10: 62 6a 3a 20 22 20 6f 62 6a 20 22 20 6c 69 6e 3a bj: " obj " lin:
3b20: 20 22 20 6c 69 6e 20 22 20 63 6f 6c 3a 20 22 20 " lin " col: "
3b30: 63 6f 6c 20 22 20 73 74 61 74 75 73 3a 20 22 20 col " status: "
3b40: 73 74 61 74 75 73 29 29 29 29 29 0a 20 20 20 20 status))))).
3b50: 3b 3b 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 ;; (iup:attribut
3b60: 65 2d 73 65 74 21 20 6b 65 79 73 2d 6d 61 74 72 e-set! keys-matr
3b70: 69 78 20 22 30 3a 30 22 20 22 52 75 6e 20 4b 65 ix "0:0" "Run Ke
3b80: 79 73 22 29 0a 20 20 20 20 28 69 75 70 3a 61 74 ys"). (iup:at
3b90: 74 72 69 62 75 74 65 2d 73 65 74 21 20 6b 65 79 tribute-set! key
3ba0: 73 2d 6d 61 74 72 69 78 20 22 57 49 44 54 48 30 s-matrix "WIDTH0
3bb0: 22 20 30 29 0a 20 20 20 20 28 69 75 70 3a 61 74 " 0). (iup:at
3bc0: 74 72 69 62 75 74 65 2d 73 65 74 21 20 6b 65 79 tribute-set! key
3bd0: 73 2d 6d 61 74 72 69 78 20 22 30 3a 31 22 20 22 s-matrix "0:1" "
3be0: 4b 65 79 20 4e 61 6d 65 22 29 0a 20 20 20 20 3b Key Name"). ;
3bf0: 3b 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 ; (iup:attribute
3c00: 2d 73 65 74 21 20 6b 65 79 73 2d 6d 61 74 72 69 -set! keys-matri
3c10: 78 20 22 57 49 44 54 48 31 22 20 22 31 30 30 22 x "WIDTH1" "100"
3c20: 29 0a 20 20 20 20 3b 3b 20 66 69 6c 6c 20 69 6e ). ;; fill in
3c30: 20 6b 65 79 73 0a 20 20 20 20 28 66 6f 72 2d 65 keys. (for-e
3c40: 61 63 68 20 0a 20 20 20 20 20 28 6c 61 6d 62 64 ach . (lambd
3c50: 61 20 28 76 61 72 29 0a 20 20 20 20 20 20 20 3b a (var). ;
3c60: 3b 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 ; (iup:attribute
3c70: 2d 73 65 74 21 20 6b 65 79 73 2d 6d 61 74 72 69 -set! keys-matri
3c80: 78 20 22 41 44 44 4c 49 4e 22 20 28 63 6f 6e 63 x "ADDLIN" (conc
3c90: 20 63 75 72 72 2d 72 6f 77 2d 6e 75 6d 29 29 0a curr-row-num)).
3ca0: 20 20 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 (iup:attr
3cb0: 69 62 75 74 65 2d 73 65 74 21 20 6b 65 79 73 2d ibute-set! keys-
3cc0: 6d 61 74 72 69 78 20 28 63 6f 6e 63 20 63 75 72 matrix (conc cur
3cd0: 72 2d 72 6f 77 2d 6e 75 6d 20 22 3a 30 22 29 20 r-row-num ":0")
3ce0: 63 75 72 72 2d 72 6f 77 2d 6e 75 6d 29 0a 20 20 curr-row-num).
3cf0: 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 (iup:attrib
3d00: 75 74 65 2d 73 65 74 21 20 6b 65 79 73 2d 6d 61 ute-set! keys-ma
3d10: 74 72 69 78 20 28 63 6f 6e 63 20 63 75 72 72 2d trix (conc curr-
3d20: 72 6f 77 2d 6e 75 6d 20 22 3a 31 22 29 20 76 61 row-num ":1") va
3d30: 72 29 0a 20 20 20 20 20 20 20 28 73 65 74 21 20 r). (set!
3d40: 63 75 72 72 2d 72 6f 77 2d 6e 75 6d 20 28 2b 20 curr-row-num (+
3d50: 31 20 63 75 72 72 2d 72 6f 77 2d 6e 75 6d 29 29 1 curr-row-num))
3d60: 29 20 3b 3b 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f ) ;; (config-loo
3d70: 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 kup *configdat*
3d80: 22 66 69 65 6c 64 73 22 20 76 61 72 29 29 29 0a "fields" var))).
3d90: 20 20 20 20 20 6b 65 79 2d 76 61 6c 73 29 0a 20 key-vals).
3da0: 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 (iup:attribut
3db0: 65 2d 73 65 74 21 20 6b 65 79 73 2d 6d 61 74 72 e-set! keys-matr
3dc0: 69 78 20 22 57 49 44 54 48 44 45 46 22 20 22 34 ix "WIDTHDEF" "4
3dd0: 30 22 29 0a 20 20 20 20 6b 65 79 73 2d 6d 61 74 0"). keys-mat
3de0: 72 69 78 29 29 0a 0a 3b 3b 20 53 65 63 74 69 6f rix))..;; Sectio
3df0: 6e 20 74 6f 20 74 61 62 6c 65 0a 28 64 65 66 69 n to table.(defi
3e00: 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a 73 65 63 74 ne (dcommon:sect
3e10: 69 6f 6e 2d 6d 61 74 72 69 78 20 72 61 77 63 6f ion-matrix rawco
3e20: 6e 66 69 67 20 73 65 63 74 69 6f 6e 6e 61 6d 65 nfig sectionname
3e30: 20 76 61 72 63 6f 6c 6e 61 6d 65 20 76 61 6c 63 varcolname valc
3e40: 6f 6c 6e 61 6d 65 20 23 21 6b 65 79 20 28 74 69 olname #!key (ti
3e50: 74 6c 65 20 23 66 29 29 0a 20 20 28 6c 65 74 2a tle #f)). (let*
3e60: 20 28 28 63 75 72 72 2d 72 6f 77 2d 6e 75 6d 20 ((curr-row-num
3e70: 20 20 20 31 29 0a 09 20 28 6b 65 79 2d 76 61 6c 1).. (key-val
3e80: 73 20 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 s (config
3e90: 66 3a 73 65 63 74 69 6f 6e 2d 76 61 72 73 20 72 f:section-vars r
3ea0: 61 77 63 6f 6e 66 69 67 20 73 65 63 74 69 6f 6e awconfig section
3eb0: 6e 61 6d 65 29 29 0a 09 20 28 73 65 63 74 69 6f name)).. (sectio
3ec0: 6e 2d 6d 61 74 72 69 78 20 20 28 69 75 70 3a 6d n-matrix (iup:m
3ed0: 61 74 72 69 78 0a 09 09 09 20 20 20 23 3a 61 6c atrix.... #:al
3ee0: 69 67 6e 6d 65 6e 74 31 20 22 41 4c 45 46 54 22 ignment1 "ALEFT"
3ef0: 0a 09 09 09 20 20 20 23 3a 65 78 70 61 6e 64 20 .... #:expand
3f00: 22 59 45 53 22 20 3b 3b 20 22 48 4f 52 49 5a 4f "YES" ;; "HORIZO
3f10: 4e 54 41 4c 22 0a 09 09 09 20 20 20 23 3a 6e 75 NTAL".... #:nu
3f20: 6d 63 6f 6c 20 31 0a 09 09 09 20 20 20 23 3a 6e mcol 1.... #:n
3f30: 75 6d 6c 69 6e 20 28 6c 65 6e 67 74 68 20 6b 65 umlin (length ke
3f40: 79 2d 76 61 6c 73 29 0a 09 09 09 20 20 20 23 3a y-vals).... #:
3f50: 6e 75 6d 63 6f 6c 2d 76 69 73 69 62 6c 65 20 31 numcol-visible 1
3f60: 0a 09 09 09 20 20 20 23 3a 6e 75 6d 6c 69 6e 2d .... #:numlin-
3f70: 76 69 73 69 62 6c 65 20 28 6c 65 6e 67 74 68 20 visible (length
3f80: 6b 65 79 2d 76 61 6c 73 29 0a 09 09 09 20 20 20 key-vals)....
3f90: 23 3a 73 63 72 6f 6c 6c 62 61 72 20 22 59 45 53 #:scrollbar "YES
3fa0: 22 29 29 29 0a 20 20 20 20 28 69 75 70 3a 61 74 "))). (iup:at
3fb0: 74 72 69 62 75 74 65 2d 73 65 74 21 20 73 65 63 tribute-set! sec
3fc0: 74 69 6f 6e 2d 6d 61 74 72 69 78 20 22 30 3a 30 tion-matrix "0:0
3fd0: 22 20 76 61 72 63 6f 6c 6e 61 6d 65 29 0a 20 20 " varcolname).
3fe0: 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 (iup:attribute
3ff0: 2d 73 65 74 21 20 73 65 63 74 69 6f 6e 2d 6d 61 -set! section-ma
4000: 74 72 69 78 20 22 30 3a 31 22 20 76 61 6c 63 6f trix "0:1" valco
4010: 6c 6e 61 6d 65 29 0a 20 20 20 20 28 69 75 70 3a lname). (iup:
4020: 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 73 attribute-set! s
4030: 65 63 74 69 6f 6e 2d 6d 61 74 72 69 78 20 22 57 ection-matrix "W
4040: 49 44 54 48 31 22 20 22 32 30 30 22 29 0a 20 20 IDTH1" "200").
4050: 20 20 3b 3b 20 66 69 6c 6c 20 69 6e 20 6b 65 79 ;; fill in key
4060: 73 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 s. (for-each
4070: 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 76 . (lambda (v
4080: 61 72 29 0a 20 20 20 20 20 20 20 3b 3b 20 28 69 ar). ;; (i
4090: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 up:attribute-set
40a0: 21 20 6b 65 79 73 2d 6d 61 74 72 69 78 20 22 41 ! keys-matrix "A
40b0: 44 44 4c 49 4e 22 20 28 63 6f 6e 63 20 63 75 72 DDLIN" (conc cur
40c0: 72 2d 72 6f 77 2d 6e 75 6d 29 29 0a 20 20 20 20 r-row-num)).
40d0: 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 (iup:attribut
40e0: 65 2d 73 65 74 21 20 73 65 63 74 69 6f 6e 2d 6d e-set! section-m
40f0: 61 74 72 69 78 20 28 63 6f 6e 63 20 63 75 72 72 atrix (conc curr
4100: 2d 72 6f 77 2d 6e 75 6d 20 22 3a 30 22 29 20 76 -row-num ":0") v
4110: 61 72 29 0a 20 20 20 20 20 20 20 28 69 75 70 3a ar). (iup:
4120: 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 73 attribute-set! s
4130: 65 63 74 69 6f 6e 2d 6d 61 74 72 69 78 20 28 63 ection-matrix (c
4140: 6f 6e 63 20 63 75 72 72 2d 72 6f 77 2d 6e 75 6d onc curr-row-num
4150: 20 22 3a 31 22 29 20 28 63 6f 6e 66 69 67 66 3a ":1") (configf:
4160: 6c 6f 6f 6b 75 70 20 72 61 77 63 6f 6e 66 69 67 lookup rawconfig
4170: 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20 76 61 72 sectionname var
4180: 29 29 0a 20 20 20 20 20 20 20 28 73 65 74 21 20 )). (set!
4190: 63 75 72 72 2d 72 6f 77 2d 6e 75 6d 20 28 2b 20 curr-row-num (+
41a0: 31 20 63 75 72 72 2d 72 6f 77 2d 6e 75 6d 29 29 1 curr-row-num))
41b0: 29 20 3b 3b 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f ) ;; (config-loo
41c0: 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 kup *configdat*
41d0: 22 66 69 65 6c 64 73 22 20 76 61 72 29 29 29 0a "fields" var))).
41e0: 20 20 20 20 20 6b 65 79 2d 76 61 6c 73 29 0a 20 key-vals).
41f0: 20 20 20 28 69 75 70 3a 76 62 6f 78 0a 20 20 20 (iup:vbox.
4200: 20 20 28 69 75 70 3a 6c 61 62 65 6c 20 28 69 66 (iup:label (if
4210: 20 74 69 74 6c 65 20 74 69 74 6c 65 20 28 63 6f title title (co
4220: 6e 63 20 22 53 65 74 74 69 6e 67 73 20 66 72 6f nc "Settings fro
4230: 6d 20 5b 22 20 73 65 63 74 69 6f 6e 6e 61 6d 65 m [" sectionname
4240: 20 22 5d 22 29 29 20 20 0a 20 20 20 20 20 20 20 "]")) .
4250: 20 20 09 3b 3b 20 23 3a 73 69 7a 65 20 20 20 22 .;; #:size "
4260: 35 78 22 0a 20 20 20 20 20 20 20 20 20 09 23 3a 5x". .#:
4270: 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 expand "HORIZONT
4280: 41 4c 22 0a 20 20 20 20 20 20 20 20 20 09 29 0a AL". .).
4290: 20 20 20 20 20 73 65 63 74 69 6f 6e 2d 6d 61 74 section-mat
42a0: 72 69 78 29 29 29 0a 20 20 20 20 0a 3b 3b 20 47 rix))). .;; G
42b0: 65 6e 65 72 61 6c 20 64 61 74 61 0a 3b 3b 0a 28 eneral data.;;.(
42c0: 64 65 66 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a define (dcommon:
42d0: 67 65 6e 65 72 61 6c 2d 69 6e 66 6f 29 0a 20 20 general-info).
42e0: 28 6c 65 74 20 28 28 67 65 6e 65 72 61 6c 2d 6d (let ((general-m
42f0: 61 74 72 69 78 20 28 69 75 70 3a 6d 61 74 72 69 atrix (iup:matri
4300: 78 0a 09 09 09 20 23 3a 61 6c 69 67 6e 6d 65 6e x.... #:alignmen
4310: 74 31 20 22 41 4c 45 46 54 22 0a 09 09 09 20 23 t1 "ALEFT".... #
4320: 3a 65 78 70 61 6e 64 20 22 59 45 53 22 20 3b 3b :expand "YES" ;;
4330: 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 09 "HORIZONTAL"...
4340: 09 20 23 3a 6e 75 6d 63 6f 6c 20 31 0a 09 09 09 . #:numcol 1....
4350: 20 23 3a 6e 75 6d 6c 69 6e 20 32 0a 09 09 09 20 #:numlin 2....
4360: 23 3a 6e 75 6d 63 6f 6c 2d 76 69 73 69 62 6c 65 #:numcol-visible
4370: 20 31 0a 09 09 09 20 23 3a 6e 75 6d 6c 69 6e 2d 1.... #:numlin-
4380: 76 69 73 69 62 6c 65 20 32 29 29 29 0a 20 20 20 visible 2))).
4390: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d (iup:attribute-
43a0: 73 65 74 21 20 67 65 6e 65 72 61 6c 2d 6d 61 74 set! general-mat
43b0: 72 69 78 20 22 57 49 44 54 48 31 22 20 22 31 35 rix "WIDTH1" "15
43c0: 30 22 29 0a 20 20 20 20 28 69 75 70 3a 61 74 74 0"). (iup:att
43d0: 72 69 62 75 74 65 2d 73 65 74 21 20 67 65 6e 65 ribute-set! gene
43e0: 72 61 6c 2d 6d 61 74 72 69 78 20 22 30 3a 31 22 ral-matrix "0:1"
43f0: 20 22 41 62 6f 75 74 20 74 68 69 73 20 4d 65 67 "About this Meg
4400: 61 74 65 73 74 20 61 72 65 61 22 29 20 0a 20 20 atest area") .
4410: 20 20 3b 3b 20 55 73 65 72 20 28 74 68 69 73 20 ;; User (this
4420: 69 73 20 6e 6f 74 20 61 6c 77 61 79 73 20 6f 62 is not always ob
4430: 76 69 6f 75 73 20 2d 20 69 74 20 69 73 20 63 6f vious - it is co
4440: 6d 6d 6f 6e 20 74 6f 20 72 75 6e 20 61 73 20 61 mmon to run as a
4450: 20 64 69 66 66 65 72 65 6e 74 20 75 73 65 72 0a different user.
4460: 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 (iup:attribu
4470: 74 65 2d 73 65 74 21 20 67 65 6e 65 72 61 6c 2d te-set! general-
4480: 6d 61 74 72 69 78 20 22 31 3a 30 22 20 22 55 73 matrix "1:0" "Us
4490: 65 72 22 29 0a 20 20 20 20 28 69 75 70 3a 61 74 er"). (iup:at
44a0: 74 72 69 62 75 74 65 2d 73 65 74 21 20 67 65 6e tribute-set! gen
44b0: 65 72 61 6c 2d 6d 61 74 72 69 78 20 22 31 3a 31 eral-matrix "1:1
44c0: 22 20 28 63 75 72 72 65 6e 74 2d 75 73 65 72 2d " (current-user-
44d0: 6e 61 6d 65 29 29 0a 20 20 20 20 3b 3b 20 4d 65 name)). ;; Me
44e0: 67 61 74 65 73 74 20 61 72 65 61 0a 20 20 20 20 gatest area.
44f0: 3b 3b 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 ;; (iup:attribut
4500: 65 2d 73 65 74 21 20 67 65 6e 65 72 61 6c 2d 6d e-set! general-m
4510: 61 74 72 69 78 20 22 32 3a 30 22 20 22 41 72 65 atrix "2:0" "Are
4520: 61 22 29 0a 20 20 20 20 3b 3b 20 28 69 75 70 3a a"). ;; (iup:
4530: 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 67 attribute-set! g
4540: 65 6e 65 72 61 6c 2d 6d 61 74 72 69 78 20 22 32 eneral-matrix "2
4550: 3a 31 22 20 2a 74 6f 70 70 61 74 68 2a 29 0a 20 :1" *toppath*).
4560: 20 20 20 3b 3b 20 4d 65 67 61 74 65 73 74 20 76 ;; Megatest v
4570: 65 72 73 69 6f 6e 0a 20 20 20 20 28 69 75 70 3a ersion. (iup:
4580: 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 67 attribute-set! g
4590: 65 6e 65 72 61 6c 2d 6d 61 74 72 69 78 20 22 32 eneral-matrix "2
45a0: 3a 30 22 20 22 56 65 72 73 69 6f 6e 22 29 0a 20 :0" "Version").
45b0: 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 (iup:attribut
45c0: 65 2d 73 65 74 21 20 67 65 6e 65 72 61 6c 2d 6d e-set! general-m
45d0: 61 74 72 69 78 20 22 32 3a 31 22 20 28 63 6f 6e atrix "2:1" (con
45e0: 63 20 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 c megatest-versi
45f0: 6f 6e 20 22 2d 22 20 28 73 75 62 73 74 72 69 6e on "-" (substrin
4600: 67 20 6d 65 67 61 74 65 73 74 2d 66 6f 73 73 69 g megatest-fossi
4610: 6c 2d 68 61 73 68 20 30 20 34 29 29 29 0a 0a 20 l-hash 0 4)))..
4620: 20 20 20 67 65 6e 65 72 61 6c 2d 6d 61 74 72 69 general-matri
4630: 78 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 63 x))..(define (dc
4640: 6f 6d 6d 6f 6e 3a 72 75 6e 2d 73 74 61 74 73 20 ommon:run-stats
4650: 64 62 73 74 72 75 63 74 29 0a 20 20 28 6c 65 74 dbstruct). (let
4660: 2a 20 28 28 73 74 61 74 73 2d 6d 61 74 72 69 78 * ((stats-matrix
4670: 20 28 69 75 70 3a 6d 61 74 72 69 78 20 65 78 70 (iup:matrix exp
4680: 61 6e 64 3a 20 22 59 45 53 22 29 29 0a 09 20 28 and: "YES")).. (
4690: 63 68 61 6e 67 65 64 20 20 20 20 20 20 23 66 29 changed #f)
46a0: 0a 09 20 28 75 70 64 61 74 65 72 20 20 20 20 20 .. (updater
46b0: 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 20 (lambda ()....
46c0: 28 6c 65 74 2a 20 28 28 72 75 6e 2d 73 74 61 74 (let* ((run-stat
46d0: 73 20 20 20 20 28 64 62 3a 67 65 74 2d 72 75 6e s (db:get-run
46e0: 2d 73 74 61 74 73 20 64 62 73 74 72 75 63 74 29 -stats dbstruct)
46f0: 29 0a 09 09 09 09 28 69 6e 64 69 63 65 73 20 20 ).....(indices
4700: 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 73 70 61 72 (common:spar
4710: 73 65 2d 6c 69 73 74 2d 67 65 6e 65 72 61 74 65 se-list-generate
4720: 2d 69 6e 64 65 78 20 72 75 6e 2d 73 74 61 74 73 -index run-stats
4730: 29 29 20 3b 3b 20 20 70 72 6f 63 3a 20 73 65 74 )) ;; proc: set
4740: 2d 63 65 6c 6c 29 29 0a 09 09 09 09 28 72 6f 77 -cell)).....(row
4750: 2d 69 6e 64 69 63 65 73 20 20 28 63 61 72 20 69 -indices (car i
4760: 6e 64 69 63 65 73 29 29 0a 09 09 09 09 28 63 6f ndices)).....(co
4770: 6c 2d 69 6e 64 69 63 65 73 20 20 28 63 61 64 72 l-indices (cadr
4780: 20 69 6e 64 69 63 65 73 29 29 0a 09 09 09 09 28 indices)).....(
4790: 6d 61 78 2d 72 6f 77 20 20 20 20 20 20 28 69 66 max-row (if
47a0: 20 28 6e 75 6c 6c 3f 20 72 6f 77 2d 69 6e 64 69 (null? row-indi
47b0: 63 65 73 29 20 31 20 28 61 70 70 6c 79 20 6d 61 ces) 1 (apply ma
47c0: 78 20 28 6d 61 70 20 63 61 64 72 20 72 6f 77 2d x (map cadr row-
47d0: 69 6e 64 69 63 65 73 29 29 29 29 0a 09 09 09 09 indices)))).....
47e0: 28 6d 61 78 2d 63 6f 6c 20 20 20 20 20 20 28 69 (max-col (i
47f0: 66 20 28 6e 75 6c 6c 3f 20 63 6f 6c 2d 69 6e 64 f (null? col-ind
4800: 69 63 65 73 29 20 31 20 0a 09 09 09 09 09 09 20 ices) 1 .......
4810: 20 28 61 70 70 6c 79 20 6d 61 78 20 28 6d 61 70 (apply max (map
4820: 20 63 61 64 72 20 63 6f 6c 2d 69 6e 64 69 63 65 cadr col-indice
4830: 73 29 29 29 29 0a 09 09 09 09 28 6d 61 78 2d 76 s)))).....(max-v
4840: 69 73 69 62 6c 65 20 20 28 6d 61 78 20 28 2d 20 isible (max (-
4850: 2a 6e 75 6d 2d 74 65 73 74 73 2a 20 31 35 29 20 *num-tests* 15)
4860: 33 29 29 0a 09 09 09 09 28 6d 61 78 2d 63 6f 6c 3)).....(max-col
4870: 2d 76 69 73 20 20 28 69 66 20 28 3e 20 6d 61 78 -vis (if (> max
4880: 2d 63 6f 6c 20 31 30 29 20 31 30 20 6d 61 78 2d -col 10) 10 max-
4890: 63 6f 6c 29 29 0a 09 09 09 09 28 6e 75 6d 72 6f col)).....(numro
48a0: 77 73 20 20 20 20 20 20 31 29 0a 09 09 09 09 28 ws 1).....(
48b0: 6e 75 6d 63 6f 6c 73 20 20 20 20 20 20 31 29 29 numcols 1))
48c0: 0a 09 09 09 20 20 20 28 69 75 70 3a 61 74 74 72 .... (iup:attr
48d0: 69 62 75 74 65 2d 73 65 74 21 20 73 74 61 74 73 ibute-set! stats
48e0: 2d 6d 61 74 72 69 78 20 22 43 4c 45 41 52 56 41 -matrix "CLEARVA
48f0: 4c 55 45 22 20 22 43 4f 4e 54 45 4e 54 53 22 29 LUE" "CONTENTS")
4900: 0a 09 09 09 20 20 20 28 69 75 70 3a 61 74 74 72 .... (iup:attr
4910: 69 62 75 74 65 2d 73 65 74 21 20 73 74 61 74 73 ibute-set! stats
4920: 2d 6d 61 74 72 69 78 20 22 4e 55 4d 43 4f 4c 22 -matrix "NUMCOL"
4930: 20 6d 61 78 2d 63 6f 6c 20 29 0a 09 09 09 20 20 max-col )....
4940: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d (iup:attribute-
4950: 73 65 74 21 20 73 74 61 74 73 2d 6d 61 74 72 69 set! stats-matri
4960: 78 20 22 4e 55 4d 4c 49 4e 22 20 28 69 66 20 28 x "NUMLIN" (if (
4970: 3c 20 6d 61 78 2d 72 6f 77 20 6d 61 78 2d 76 69 < max-row max-vi
4980: 73 69 62 6c 65 29 20 6d 61 78 2d 76 69 73 69 62 sible) max-visib
4990: 6c 65 20 6d 61 78 2d 72 6f 77 29 29 20 3b 3b 20 le max-row)) ;;
49a0: 6d 69 6e 20 6f 66 20 32 30 0a 09 09 09 20 20 20 min of 20....
49b0: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 (iup:attribute-s
49c0: 65 74 21 20 73 74 61 74 73 2d 6d 61 74 72 69 78 et! stats-matrix
49d0: 20 22 4e 55 4d 43 4f 4c 5f 56 49 53 49 42 4c 45 "NUMCOL_VISIBLE
49e0: 22 20 6d 61 78 2d 63 6f 6c 2d 76 69 73 29 0a 09 " max-col-vis)..
49f0: 09 09 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 .. (iup:attrib
4a00: 75 74 65 2d 73 65 74 21 20 73 74 61 74 73 2d 6d ute-set! stats-m
4a10: 61 74 72 69 78 20 22 4e 55 4d 4c 49 4e 5f 56 49 atrix "NUMLIN_VI
4a20: 53 49 42 4c 45 22 20 28 69 66 20 28 3e 20 6d 61 SIBLE" (if (> ma
4a30: 78 2d 72 6f 77 20 6d 61 78 2d 76 69 73 69 62 6c x-row max-visibl
4a40: 65 29 20 6d 61 78 2d 76 69 73 69 62 6c 65 20 6d e) max-visible m
4a50: 61 78 2d 72 6f 77 29 29 0a 0a 09 09 09 20 20 20 ax-row)).....
4a60: 3b 3b 20 52 6f 77 20 6c 61 62 65 6c 73 0a 09 09 ;; Row labels...
4a70: 09 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c . (for-each (l
4a80: 61 6d 62 64 61 20 28 69 6e 64 29 0a 09 09 09 09 ambda (ind).....
4a90: 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 6e (let* ((n
4aa0: 61 6d 65 20 28 63 61 72 20 69 6e 64 29 29 0a 09 ame (car ind))..
4ab0: 09 09 09 09 20 20 20 20 20 20 28 6e 75 6d 20 20 .... (num
4ac0: 28 63 61 64 72 20 69 6e 64 29 29 0a 09 09 09 09 (cadr ind)).....
4ad0: 09 20 20 20 20 20 20 28 6b 65 79 20 20 28 63 6f . (key (co
4ae0: 6e 63 20 6e 75 6d 20 22 3a 30 22 29 29 29 0a 09 nc num ":0")))..
4af0: 09 09 09 09 20 28 69 66 20 28 6e 6f 74 20 28 65 .... (if (not (e
4b00: 71 75 61 6c 3f 20 28 69 75 70 3a 61 74 74 72 69 qual? (iup:attri
4b10: 62 75 74 65 20 73 74 61 74 73 2d 6d 61 74 72 69 bute stats-matri
4b20: 78 20 6b 65 79 29 20 6e 61 6d 65 29 29 0a 09 09 x key) name))...
4b30: 09 09 09 20 20 20 20 20 28 62 65 67 69 6e 0a 09 ... (begin..
4b40: 09 09 09 09 20 20 20 20 20 20 20 28 73 65 74 21 .... (set!
4b50: 20 63 68 61 6e 67 65 64 20 23 74 29 0a 09 09 09 changed #t)....
4b60: 09 09 20 20 20 20 20 20 20 28 69 75 70 3a 61 74 .. (iup:at
4b70: 74 72 69 62 75 74 65 2d 73 65 74 21 20 73 74 61 tribute-set! sta
4b80: 74 73 2d 6d 61 74 72 69 78 20 6b 65 79 20 6e 61 ts-matrix key na
4b90: 6d 65 29 29 29 29 29 0a 09 09 09 09 20 20 20 20 me))))).....
4ba0: 20 72 6f 77 2d 69 6e 64 69 63 65 73 29 0a 0a 09 row-indices)...
4bb0: 09 09 20 20 20 3b 3b 20 43 6f 6c 20 6c 61 62 65 .. ;; Col labe
4bc0: 6c 73 0a 09 09 09 20 20 20 28 66 6f 72 2d 65 61 ls.... (for-ea
4bd0: 63 68 20 28 6c 61 6d 62 64 61 20 28 69 6e 64 29 ch (lambda (ind)
4be0: 0a 09 09 09 09 20 20 20 20 20 20 20 28 6c 65 74 ..... (let
4bf0: 2a 20 28 28 6e 61 6d 65 20 28 63 61 72 20 69 6e * ((name (car in
4c00: 64 29 29 0a 09 09 09 09 09 20 20 20 20 20 20 28 d))...... (
4c10: 6e 75 6d 20 20 28 63 61 64 72 20 69 6e 64 29 29 num (cadr ind))
4c20: 0a 09 09 09 09 09 20 20 20 20 20 20 28 6b 65 79 ...... (key
4c30: 20 20 28 63 6f 6e 63 20 22 30 3a 22 20 6e 75 6d (conc "0:" num
4c40: 29 29 29 0a 09 09 09 09 09 20 28 69 66 20 28 6e )))...... (if (n
4c50: 6f 74 20 28 65 71 75 61 6c 3f 20 28 69 75 70 3a ot (equal? (iup:
4c60: 61 74 74 72 69 62 75 74 65 20 73 74 61 74 73 2d attribute stats-
4c70: 6d 61 74 72 69 78 20 6b 65 79 29 20 6e 61 6d 65 matrix key) name
4c80: 29 29 0a 09 09 09 09 09 20 20 20 20 20 28 62 65 ))...... (be
4c90: 67 69 6e 0a 09 09 09 09 09 20 20 20 20 20 20 20 gin......
4ca0: 28 73 65 74 21 20 63 68 61 6e 67 65 64 20 23 74 (set! changed #t
4cb0: 29 0a 09 09 09 09 09 20 20 20 20 20 20 20 28 69 )...... (i
4cc0: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 up:attribute-set
4cd0: 21 20 73 74 61 74 73 2d 6d 61 74 72 69 78 20 6b ! stats-matrix k
4ce0: 65 79 20 6e 61 6d 65 29 29 29 29 29 0a 09 09 09 ey name)))))....
4cf0: 09 20 20 20 20 20 63 6f 6c 2d 69 6e 64 69 63 65 . col-indice
4d00: 73 29 0a 0a 09 09 09 20 20 20 3b 3b 20 43 65 6c s)..... ;; Cel
4d10: 6c 20 63 6f 6e 74 65 6e 74 73 0a 09 09 09 20 20 l contents....
4d20: 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 (for-each (lamb
4d30: 64 61 20 28 65 6e 74 72 79 29 0a 09 09 09 09 20 da (entry).....
4d40: 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 72 6f (let* ((ro
4d50: 77 2d 6e 61 6d 65 20 28 63 61 72 20 65 6e 74 72 w-name (car entr
4d60: 79 29 29 0a 09 09 09 09 09 20 20 20 20 20 20 28 y))...... (
4d70: 63 6f 6c 2d 6e 61 6d 65 20 28 63 61 64 72 20 65 col-name (cadr e
4d80: 6e 74 72 79 29 29 0a 09 09 09 09 09 20 20 20 20 ntry))......
4d90: 20 20 28 76 61 6c 75 65 20 20 20 20 28 63 61 64 (value (cad
4da0: 64 72 20 65 6e 74 72 79 29 29 0a 09 09 09 09 09 dr entry))......
4db0: 20 20 20 20 20 20 28 72 6f 77 2d 6e 75 6d 20 20 (row-num
4dc0: 28 63 61 64 72 20 28 61 73 73 6f 63 20 72 6f 77 (cadr (assoc row
4dd0: 2d 6e 61 6d 65 20 72 6f 77 2d 69 6e 64 69 63 65 -name row-indice
4de0: 73 29 29 29 0a 09 09 09 09 09 20 20 20 20 20 20 s)))......
4df0: 28 63 6f 6c 2d 6e 75 6d 20 20 28 63 61 64 72 20 (col-num (cadr
4e00: 28 61 73 73 6f 63 20 63 6f 6c 2d 6e 61 6d 65 20 (assoc col-name
4e10: 63 6f 6c 2d 69 6e 64 69 63 65 73 29 29 29 0a 09 col-indices)))..
4e20: 09 09 09 09 20 20 20 20 20 20 28 6b 65 79 20 20 .... (key
4e30: 20 20 20 20 28 63 6f 6e 63 20 72 6f 77 2d 6e 75 (conc row-nu
4e40: 6d 20 22 3a 22 20 63 6f 6c 2d 6e 75 6d 29 29 29 m ":" col-num)))
4e50: 0a 09 09 09 09 09 20 28 69 66 20 28 6e 6f 74 20 ...... (if (not
4e60: 28 65 71 75 61 6c 3f 20 28 69 75 70 3a 61 74 74 (equal? (iup:att
4e70: 72 69 62 75 74 65 20 73 74 61 74 73 2d 6d 61 74 ribute stats-mat
4e80: 72 69 78 20 6b 65 79 29 20 76 61 6c 75 65 29 29 rix key) value))
4e90: 0a 09 09 09 09 09 20 20 20 20 20 28 62 65 67 69 ...... (begi
4ea0: 6e 0a 09 09 09 09 09 20 20 20 20 20 20 20 28 73 n...... (s
4eb0: 65 74 21 20 63 68 61 6e 67 65 64 20 23 74 29 0a et! changed #t).
4ec0: 09 09 09 09 09 20 20 20 20 20 20 20 28 69 75 70 ..... (iup
4ed0: 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 :attribute-set!
4ee0: 73 74 61 74 73 2d 6d 61 74 72 69 78 20 6b 65 79 stats-matrix key
4ef0: 20 76 61 6c 75 65 29 29 29 29 29 0a 09 09 09 09 value))))).....
4f00: 20 20 20 20 20 72 75 6e 2d 73 74 61 74 73 29 0a run-stats).
4f10: 09 09 09 20 20 20 28 69 66 20 63 68 61 6e 67 65 ... (if change
4f20: 64 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 d (iup:attribute
4f30: 2d 73 65 74 21 20 73 74 61 74 73 2d 6d 61 74 72 -set! stats-matr
4f40: 69 78 20 22 52 45 44 52 41 57 22 20 22 41 4c 4c ix "REDRAW" "ALL
4f50: 22 29 29 29 29 29 29 0a 20 20 20 20 28 75 70 64 ")))))). (upd
4f60: 61 74 65 72 29 0a 20 20 20 20 28 73 65 74 21 20 ater). (set!
4f70: 64 61 73 68 62 6f 61 72 64 3a 75 70 64 61 74 65 dashboard:update
4f80: 2d 73 75 6d 6d 61 72 79 2d 74 61 62 20 75 70 64 -summary-tab upd
4f90: 61 74 65 72 29 0a 20 20 20 20 28 69 75 70 3a 61 ater). (iup:a
4fa0: 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 73 74 ttribute-set! st
4fb0: 61 74 73 2d 6d 61 74 72 69 78 20 22 57 49 44 54 ats-matrix "WIDT
4fc0: 48 44 45 46 22 20 22 34 30 22 29 0a 20 20 20 20 HDEF" "40").
4fd0: 28 69 75 70 3a 76 62 6f 78 0a 20 20 20 20 20 3b (iup:vbox. ;
4fe0: 3b 20 28 69 75 70 3a 6c 61 62 65 6c 20 22 52 75 ; (iup:label "Ru
4ff0: 6e 20 73 74 61 74 69 73 74 69 63 73 22 20 20 23 n statistics" #
5000: 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e :expand "HORIZON
5010: 54 41 4c 22 29 0a 20 20 20 20 20 73 74 61 74 73 TAL"). stats
5020: 2d 6d 61 74 72 69 78 29 29 29 0a 0a 28 64 65 66 -matrix)))..(def
5030: 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a 73 65 72 ine (dcommon:ser
5040: 76 65 72 73 2d 74 61 62 6c 65 29 0a 20 20 28 6c vers-table). (l
5050: 65 74 2a 20 28 28 74 64 62 64 61 74 20 20 20 20 et* ((tdbdat
5060: 20 20 20 20 20 28 74 61 73 6b 73 3a 6f 70 65 6e (tasks:open
5070: 2d 64 62 29 29 0a 09 20 28 63 6f 6c 6e 75 6d 20 -db)).. (colnum
5080: 20 20 20 20 20 20 20 20 30 29 0a 09 20 28 72 6f 0).. (ro
5090: 77 6e 75 6d 20 20 20 20 20 20 20 20 20 30 29 0a wnum 0).
50a0: 09 20 28 73 65 72 76 65 72 73 2d 6d 61 74 72 69 . (servers-matri
50b0: 78 20 28 69 75 70 3a 6d 61 74 72 69 78 20 23 3a x (iup:matrix #:
50c0: 65 78 70 61 6e 64 20 22 59 45 53 22 0a 09 09 09 expand "YES"....
50d0: 09 20 20 20 20 20 23 3a 6e 75 6d 63 6f 6c 20 37 . #:numcol 7
50e0: 0a 09 09 09 09 20 20 20 20 20 23 3a 6e 75 6d 63 ..... #:numc
50f0: 6f 6c 2d 76 69 73 69 62 6c 65 20 37 0a 09 09 09 ol-visible 7....
5100: 09 20 20 20 20 20 23 3a 6e 75 6d 6c 69 6e 2d 76 . #:numlin-v
5110: 69 73 69 62 6c 65 20 35 0a 09 09 09 09 20 20 20 isible 5.....
5120: 20 20 29 29 0a 09 20 28 63 6f 6c 6e 61 6d 65 73 )).. (colnames
5130: 20 20 20 20 20 20 20 28 6c 69 73 74 20 22 49 64 (list "Id
5140: 22 20 22 4d 54 76 65 72 22 20 22 50 69 64 22 20 " "MTver" "Pid"
5150: 22 48 6f 73 74 22 20 22 49 6e 74 65 72 66 61 63 "Host" "Interfac
5160: 65 3a 4f 75 74 50 6f 72 74 22 20 22 52 75 6e 54 e:OutPort" "RunT
5170: 69 6d 65 22 20 22 53 74 61 74 65 22 20 22 52 75 ime" "State" "Ru
5180: 6e 49 64 22 29 29 0a 09 20 28 75 70 64 61 74 65 nId")).. (update
5190: 72 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 r (lambda
51a0: 20 28 29 0a 09 09 09 20 20 20 28 6c 65 74 20 28 ().... (let (
51b0: 28 73 65 72 76 65 72 73 20 28 74 61 73 6b 73 3a (servers (tasks:
51c0: 67 65 74 2d 61 6c 6c 2d 73 65 72 76 65 72 73 20 get-all-servers
51d0: 28 64 62 3a 64 65 6c 61 79 2d 69 66 2d 62 75 73 (db:delay-if-bus
51e0: 79 20 74 64 62 64 61 74 29 29 29 29 0a 09 09 09 y tdbdat))))....
51f0: 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 (iup:attrib
5200: 75 74 65 2d 73 65 74 21 20 73 65 72 76 65 72 73 ute-set! servers
5210: 2d 6d 61 74 72 69 78 20 22 4e 55 4d 4c 49 4e 22 -matrix "NUMLIN"
5220: 20 28 6c 65 6e 67 74 68 20 73 65 72 76 65 72 73 (length servers
5230: 29 29 0a 09 09 09 20 20 20 20 20 3b 3b 20 28 73 )).... ;; (s
5240: 65 74 21 20 63 6f 6c 6e 75 6d 20 30 29 0a 09 09 et! colnum 0)...
5250: 09 20 20 20 20 20 3b 3b 20 28 66 6f 72 2d 65 61 . ;; (for-ea
5260: 63 68 20 28 6c 61 6d 62 64 61 20 28 63 6f 6c 6e ch (lambda (coln
5270: 61 6d 65 29 0a 09 09 09 20 20 20 20 20 3b 3b 20 ame).... ;;
5280: 20 20 20 09 20 3b 3b 20 28 70 72 69 6e 74 20 22 . ;; (print "
5290: 63 6f 6c 6e 75 6d 3a 20 22 20 63 6f 6c 6e 75 6d colnum: " colnum
52a0: 20 22 20 63 6f 6c 6e 61 6d 65 3a 20 22 20 63 6f " colname: " co
52b0: 6c 6e 61 6d 65 29 0a 09 09 09 20 20 20 20 20 3b lname).... ;
52c0: 3b 20 20 20 20 09 20 28 69 75 70 3a 61 74 74 72 ; . (iup:attr
52d0: 69 62 75 74 65 2d 73 65 74 21 20 73 65 72 76 65 ibute-set! serve
52e0: 72 73 2d 6d 61 74 72 69 78 20 28 63 6f 6e 63 20 rs-matrix (conc
52f0: 22 30 3a 22 20 63 6f 6c 6e 75 6d 29 20 63 6f 6c "0:" colnum) col
5300: 6e 61 6d 65 29 0a 09 09 09 20 20 20 20 20 3b 3b name).... ;;
5310: 20 20 20 20 09 20 28 73 65 74 21 20 63 6f 6c 6e . (set! coln
5320: 75 6d 20 28 2b 20 31 20 63 6f 6c 6e 75 6d 29 29 um (+ 1 colnum))
5330: 29 0a 09 09 09 20 20 20 20 20 3b 3b 20 20 20 20 ).... ;;
5340: 20 20 20 20 20 20 20 63 6f 6c 6e 61 6d 65 73 29 colnames)
5350: 0a 09 09 09 20 20 20 20 20 28 73 65 74 21 20 72 .... (set! r
5360: 6f 77 6e 75 6d 20 31 29 0a 09 09 09 20 20 20 20 ownum 1)....
5370: 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 09 09 20 (for-each ....
5380: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 73 65 (lambda (se
5390: 72 76 65 72 29 0a 09 09 09 09 28 73 65 74 21 20 rver).....(set!
53a0: 63 6f 6c 6e 75 6d 20 30 29 0a 09 09 09 09 28 6c colnum 0).....(l
53b0: 65 74 2a 20 28 28 76 61 6c 73 20 28 6c 69 73 74 et* ((vals (list
53c0: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 (vector-ref ser
53d0: 76 65 72 20 30 29 20 3b 3b 20 49 64 0a 09 09 09 ver 0) ;; Id....
53e0: 09 09 09 20 20 20 28 76 65 63 74 6f 72 2d 72 65 ... (vector-re
53f0: 66 20 73 65 72 76 65 72 20 39 29 20 3b 3b 20 4d f server 9) ;; M
5400: 54 2d 56 65 72 0a 09 09 09 09 09 09 20 20 20 28 T-Ver....... (
5410: 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 vector-ref serve
5420: 72 20 31 29 20 3b 3b 20 50 69 64 0a 09 09 09 09 r 1) ;; Pid.....
5430: 09 09 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 .. (vector-ref
5440: 20 73 65 72 76 65 72 20 32 29 20 3b 3b 20 48 6f server 2) ;; Ho
5450: 73 74 6e 61 6d 65 0a 09 09 09 09 09 09 20 20 20 stname.......
5460: 28 63 6f 6e 63 20 28 76 65 63 74 6f 72 2d 72 65 (conc (vector-re
5470: 66 20 73 65 72 76 65 72 20 33 29 20 22 3a 22 20 f server 3) ":"
5480: 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 76 (vector-ref serv
5490: 65 72 20 34 29 29 20 3b 3b 20 49 50 3a 50 6f 72 er 4)) ;; IP:Por
54a0: 74 0a 09 09 09 09 09 09 20 20 20 28 73 65 63 6f t....... (seco
54b0: 6e 64 73 2d 3e 68 72 2d 6d 69 6e 2d 73 65 63 20 nds->hr-min-sec
54c0: 28 2d 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f (- (current-seco
54d0: 6e 64 73 29 28 76 65 63 74 6f 72 2d 72 65 66 20 nds)(vector-ref
54e0: 73 65 72 76 65 72 20 36 29 29 29 0a 09 09 09 09 server 6))).....
54f0: 09 09 20 20 20 3b 3b 20 28 76 65 63 74 6f 72 2d .. ;; (vector-
5500: 72 65 66 20 73 65 72 76 65 72 20 35 29 20 3b 3b ref server 5) ;;
5510: 20 50 75 62 70 6f 72 74 0a 09 09 09 09 09 09 20 Pubport.......
5520: 20 20 3b 3b 20 28 76 65 63 74 6f 72 2d 72 65 66 ;; (vector-ref
5530: 20 73 65 72 76 65 72 20 31 30 29 20 3b 3b 20 4c server 10) ;; L
5540: 61 73 74 20 62 65 61 74 0a 09 09 09 09 09 09 20 ast beat.......
5550: 20 20 3b 3b 20 28 76 65 63 74 6f 72 2d 72 65 66 ;; (vector-ref
5560: 20 73 65 72 76 65 72 20 36 29 20 3b 3b 20 53 74 server 6) ;; St
5570: 61 72 74 20 74 69 6d 65 0a 09 09 09 09 09 09 20 art time.......
5580: 20 20 3b 3b 20 28 76 65 63 74 6f 72 2d 72 65 66 ;; (vector-ref
5590: 20 73 65 72 76 65 72 20 37 29 20 3b 3b 20 50 72 server 7) ;; Pr
55a0: 69 6f 72 69 74 79 0a 09 09 09 09 09 09 20 20 20 iority.......
55b0: 3b 3b 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 ;; (vector-ref s
55c0: 65 72 76 65 72 20 38 29 20 3b 3b 20 53 74 61 74 erver 8) ;; Stat
55d0: 65 0a 09 09 09 09 09 09 20 20 20 28 76 65 63 74 e....... (vect
55e0: 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 38 29 or-ref server 8)
55f0: 20 3b 3b 20 53 74 61 74 65 0a 09 09 09 09 09 09 ;; State.......
5600: 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 (vector-ref s
5610: 65 72 76 65 72 20 31 32 29 20 20 3b 3b 20 52 75 erver 12) ;; Ru
5620: 6e 49 64 0a 09 09 09 09 09 09 20 20 20 29 29 29 nId....... )))
5630: 0a 09 09 09 09 20 20 28 66 6f 72 2d 65 61 63 68 ..... (for-each
5640: 20 28 6c 61 6d 62 64 61 20 28 76 61 6c 29 0a 09 (lambda (val)..
5650: 09 09 09 09 20 20 20 20 20 20 28 6c 65 74 2a 20 .... (let*
5660: 28 28 72 6f 77 2d 63 6f 6c 20 28 63 6f 6e 63 20 ((row-col (conc
5670: 72 6f 77 6e 75 6d 20 22 3a 22 20 63 6f 6c 6e 75 rownum ":" colnu
5680: 6d 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 28 m))....... (
5690: 63 75 72 72 2d 76 61 6c 20 28 69 75 70 3a 61 74 curr-val (iup:at
56a0: 74 72 69 62 75 74 65 20 73 65 72 76 65 72 73 2d tribute servers-
56b0: 6d 61 74 72 69 78 20 72 6f 77 2d 63 6f 6c 29 29 matrix row-col))
56c0: 29 0a 09 09 09 09 09 09 28 69 66 20 28 6e 6f 74 ).......(if (not
56d0: 20 28 65 71 75 61 6c 3f 20 28 63 6f 6e 63 20 76 (equal? (conc v
56e0: 61 6c 29 20 63 75 72 72 2d 76 61 6c 29 29 0a 09 al) curr-val))..
56f0: 09 09 09 09 09 20 20 20 20 28 62 65 67 69 6e 0a ..... (begin.
5700: 09 09 09 09 09 09 20 20 20 20 20 20 28 69 75 70 ...... (iup
5710: 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 :attribute-set!
5720: 73 65 72 76 65 72 73 2d 6d 61 74 72 69 78 20 72 servers-matrix r
5730: 6f 77 2d 63 6f 6c 20 76 61 6c 29 0a 09 09 09 09 ow-col val).....
5740: 09 09 20 20 20 20 20 20 28 69 75 70 3a 61 74 74 .. (iup:att
5750: 72 69 62 75 74 65 2d 73 65 74 21 20 73 65 72 76 ribute-set! serv
5760: 65 72 73 2d 6d 61 74 72 69 78 20 22 46 49 54 54 ers-matrix "FITT
5770: 4f 54 45 58 54 22 20 28 63 6f 6e 63 20 22 43 22 OTEXT" (conc "C"
5780: 20 63 6f 6c 6e 75 6d 29 29 29 29 0a 09 09 09 09 colnum)))).....
5790: 09 09 28 73 65 74 21 20 63 6f 6c 6e 75 6d 20 28 ..(set! colnum (
57a0: 2b 20 31 20 63 6f 6c 6e 75 6d 29 29 29 29 0a 09 + 1 colnum))))..
57b0: 09 09 09 09 20 20 20 20 76 61 6c 73 29 0a 09 09 .... vals)...
57c0: 09 09 20 20 28 73 65 74 21 20 72 6f 77 6e 75 6d .. (set! rownum
57d0: 20 28 2b 20 72 6f 77 6e 75 6d 20 31 29 29 29 0a (+ rownum 1))).
57e0: 09 09 09 09 20 28 69 75 70 3a 61 74 74 72 69 62 .... (iup:attrib
57f0: 75 74 65 2d 73 65 74 21 20 73 65 72 76 65 72 73 ute-set! servers
5800: 2d 6d 61 74 72 69 78 20 22 52 45 44 52 41 57 22 -matrix "REDRAW"
5810: 20 22 41 4c 4c 22 29 29 0a 09 09 09 20 20 20 20 "ALL"))....
5820: 20 20 73 65 72 76 65 72 73 29 29 29 29 29 0a 20 servers))))).
5830: 20 20 20 28 73 65 74 21 20 63 6f 6c 6e 75 6d 20 (set! colnum
5840: 30 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 68 0). (for-each
5850: 20 28 6c 61 6d 62 64 61 20 28 63 6f 6c 6e 61 6d (lambda (colnam
5860: 65 29 0a 09 09 28 69 75 70 3a 61 74 74 72 69 62 e)...(iup:attrib
5870: 75 74 65 2d 73 65 74 21 20 73 65 72 76 65 72 73 ute-set! servers
5880: 2d 6d 61 74 72 69 78 20 28 63 6f 6e 63 20 22 30 -matrix (conc "0
5890: 3a 22 20 63 6f 6c 6e 75 6d 29 20 63 6f 6c 6e 61 :" colnum) colna
58a0: 6d 65 29 0a 09 09 28 69 75 70 3a 61 74 74 72 69 me)...(iup:attri
58b0: 62 75 74 65 2d 73 65 74 21 20 73 65 72 76 65 72 bute-set! server
58c0: 73 2d 6d 61 74 72 69 78 20 22 46 49 54 54 4f 54 s-matrix "FITTOT
58d0: 45 58 54 22 20 28 63 6f 6e 63 20 22 43 22 20 63 EXT" (conc "C" c
58e0: 6f 6c 6e 75 6d 29 29 0a 09 09 28 73 65 74 21 20 olnum))...(set!
58f0: 63 6f 6c 6e 75 6d 20 28 2b 20 63 6f 6c 6e 75 6d colnum (+ colnum
5900: 20 31 29 29 29 0a 09 20 20 20 20 20 20 63 6f 6c 1))).. col
5910: 6e 61 6d 65 73 29 0a 20 20 20 20 28 73 65 74 21 names). (set!
5920: 20 64 61 73 68 62 6f 61 72 64 3a 75 70 64 61 74 dashboard:updat
5930: 65 2d 73 65 72 76 65 72 73 2d 74 61 62 6c 65 20 e-servers-table
5940: 75 70 64 61 74 65 72 29 20 0a 20 20 20 20 3b 3b updater) . ;;
5950: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d (iup:attribute-
5960: 73 65 74 21 20 73 65 72 76 65 72 73 2d 6d 61 74 set! servers-mat
5970: 72 69 78 20 22 57 49 44 54 48 44 45 46 22 20 22 rix "WIDTHDEF" "
5980: 34 30 22 29 0a 20 20 20 3b 3b 20 20 28 69 75 70 40"). ;; (iup
5990: 3a 68 62 6f 78 0a 20 20 20 3b 3b 20 20 20 28 69 :hbox. ;; (i
59a0: 75 70 3a 76 62 6f 78 0a 20 20 20 3b 3b 20 20 20 up:vbox. ;;
59b0: 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 53 74 (iup:button "St
59c0: 61 72 74 22 0a 20 20 20 3b 3b 20 20 20 20 20 20 art". ;;
59d0: 09 20 20 3b 3b 20 23 3a 73 69 7a 65 20 22 35 30 . ;; #:size "50
59e0: 78 22 0a 20 20 20 3b 3b 20 20 20 20 20 20 09 20 x". ;; .
59f0: 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 0a #:expand "YES".
5a00: 20 20 20 3b 3b 20 20 20 20 20 20 09 20 20 23 3a ;; . #:
5a10: 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 action (lambda (
5a20: 6f 62 6a 29 0a 20 20 20 3b 3b 20 20 20 20 20 20 obj). ;;
5a30: 09 09 20 20 20 20 20 28 6c 65 74 20 28 28 63 6d .. (let ((cm
5a40: 64 20 28 63 6f 6e 63 20 3b 3b 20 22 78 74 65 72 d (conc ;; "xter
5a50: 6d 20 2d 67 65 6f 6d 65 74 72 79 20 31 38 30 78 m -geometry 180x
5a60: 32 30 20 2d 65 20 5c 22 22 0a 20 20 20 3b 3b 20 20 -e \"". ;;
5a70: 20 20 20 20 20 09 09 09 09 20 20 20 20 20 20 22 .... "
5a80: 6d 65 67 61 74 65 73 74 20 2d 73 65 72 76 65 72 megatest -server
5a90: 20 2d 20 26 22 29 29 29 0a 20 20 20 3b 3b 20 20 - &"))). ;;
5aa0: 20 20 20 20 09 09 09 09 20 20 20 20 20 20 3b 3b .... ;;
5ab0: 20 22 3b 65 63 68 6f 20 50 72 65 73 73 20 61 6e ";echo Press an
5ac0: 79 20 6b 65 79 20 74 6f 20 63 6f 6e 74 69 6e 75 y key to continu
5ad0: 65 3b 62 61 73 68 20 2d 63 20 27 72 65 61 64 20 e;bash -c 'read
5ae0: 2d 6e 20 31 20 2d 73 27 5c 22 20 26 22 29 29 29 -n 1 -s'\" &")))
5af0: 0a 20 20 20 3b 3b 20 20 20 20 20 20 09 09 20 20 . ;; ..
5b00: 20 20 20 20 20 28 73 79 73 74 65 6d 20 63 6d 64 (system cmd
5b10: 29 29 29 29 0a 20 20 20 3b 3b 20 20 20 20 28 69 )))). ;; (i
5b20: 75 70 3a 62 75 74 74 6f 6e 20 22 53 74 6f 70 22 up:button "Stop"
5b30: 0a 20 20 20 3b 3b 20 20 20 20 20 20 09 20 20 23 . ;; . #
5b40: 3a 65 78 70 61 6e 64 20 22 59 45 53 22 0a 20 20 :expand "YES".
5b50: 20 3b 3b 20 20 20 20 20 20 09 20 20 3b 3b 20 23 ;; . ;; #
5b60: 3a 73 69 7a 65 20 22 35 30 78 22 0a 20 20 20 3b :size "50x". ;
5b70: 3b 20 20 20 20 20 20 09 20 20 23 3a 61 63 74 69 ; . #:acti
5b80: 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 on (lambda (obj)
5b90: 0a 20 20 20 3b 3b 20 20 20 20 20 20 09 09 20 20 . ;; ..
5ba0: 20 20 20 28 6c 65 74 20 28 28 63 6d 64 20 28 63 (let ((cmd (c
5bb0: 6f 6e 63 20 3b 3b 20 22 78 74 65 72 6d 20 2d 67 onc ;; "xterm -g
5bc0: 65 6f 6d 65 74 72 79 20 31 38 30 78 32 30 20 2d eometry 180x20 -
5bd0: 65 20 5c 22 22 0a 20 20 20 3b 3b 20 20 20 20 20 e \"". ;;
5be0: 20 09 09 09 09 20 20 20 20 20 20 22 6d 65 67 61 .... "mega
5bf0: 74 65 73 74 20 2d 73 74 6f 70 2d 73 65 72 76 65 test -stop-serve
5c00: 72 20 30 20 26 22 29 29 29 0a 20 20 20 3b 3b 20 r 0 &"))). ;;
5c10: 20 20 20 20 20 09 09 09 09 20 20 20 20 20 20 3b .... ;
5c20: 3b 20 22 3b 65 63 68 6f 20 50 72 65 73 73 20 61 ; ";echo Press a
5c30: 6e 79 20 6b 65 79 20 74 6f 20 63 6f 6e 74 69 6e ny key to contin
5c40: 75 65 3b 62 61 73 68 20 2d 63 20 27 72 65 61 64 ue;bash -c 'read
5c50: 20 2d 6e 20 31 20 2d 73 27 5c 22 20 26 22 29 29 -n 1 -s'\" &"))
5c60: 29 0a 20 20 20 3b 3b 20 20 20 20 20 20 09 09 20 ). ;; ..
5c70: 20 20 20 20 20 20 28 73 79 73 74 65 6d 20 63 6d (system cm
5c80: 64 29 29 29 29 0a 20 20 20 3b 3b 20 20 20 20 28 d)))). ;; (
5c90: 69 75 70 3a 62 75 74 74 6f 6e 20 22 52 65 73 74 iup:button "Rest
5ca0: 61 72 74 22 0a 20 20 20 3b 3b 20 20 20 20 20 20 art". ;;
5cb0: 09 20 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 . #:expand "YES
5cc0: 22 0a 20 20 20 3b 3b 20 20 20 20 20 20 09 20 20 ". ;; .
5cd0: 3b 3b 20 23 3a 73 69 7a 65 20 22 35 30 78 22 0a ;; #:size "50x".
5ce0: 20 20 20 3b 3b 20 20 20 20 20 20 09 20 20 23 3a ;; . #:
5cf0: 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 action (lambda (
5d00: 6f 62 6a 29 0a 20 20 20 3b 3b 20 20 20 20 20 20 obj). ;;
5d10: 09 09 20 20 20 20 20 28 6c 65 74 20 28 28 63 6d .. (let ((cm
5d20: 64 20 28 63 6f 6e 63 20 3b 3b 20 22 78 74 65 72 d (conc ;; "xter
5d30: 6d 20 2d 67 65 6f 6d 65 74 72 79 20 31 38 30 78 m -geometry 180x
5d40: 32 30 20 2d 65 20 5c 22 22 0a 20 20 20 3b 3b 20 20 -e \"". ;;
5d50: 20 20 20 20 20 09 09 09 09 20 20 20 20 20 20 22 .... "
5d60: 6d 65 67 61 74 65 73 74 20 2d 73 74 6f 70 2d 73 megatest -stop-s
5d70: 65 72 76 65 72 20 30 3b 6d 65 67 61 74 65 73 74 erver 0;megatest
5d80: 20 2d 73 65 72 76 65 72 20 2d 20 26 22 29 29 29 -server - &")))
5d90: 0a 20 20 20 3b 3b 20 20 20 20 20 20 09 09 09 09 . ;; ....
5da0: 20 20 20 20 20 20 3b 3b 20 22 3b 65 63 68 6f 20 ;; ";echo
5db0: 50 72 65 73 73 20 61 6e 79 20 6b 65 79 20 74 6f Press any key to
5dc0: 20 63 6f 6e 74 69 6e 75 65 3b 62 61 73 68 20 2d continue;bash -
5dd0: 63 20 27 72 65 61 64 20 2d 6e 20 31 20 2d 73 27 c 'read -n 1 -s'
5de0: 5c 22 20 26 22 29 29 29 0a 20 20 20 3b 3b 20 20 \" &"))). ;;
5df0: 20 20 20 20 09 09 20 20 20 20 20 20 20 28 73 79 .. (sy
5e00: 73 74 65 6d 20 63 6d 64 29 29 29 29 29 0a 20 20 stem cmd))))).
5e10: 20 3b 3b 20 20 20 20 73 65 72 76 65 72 73 2d 6d ;; servers-m
5e20: 61 74 72 69 78 0a 20 20 20 3b 3b 20 20 20 29 29 atrix. ;; ))
5e30: 29 0a 20 20 20 20 73 65 72 76 65 72 73 2d 6d 61 ). servers-ma
5e40: 74 72 69 78 0a 20 20 20 20 29 29 0a 0a 3b 3b 20 trix. ))..;;
5e50: 54 68 65 20 6d 61 69 6e 20 6d 65 6e 75 0a 28 64 The main menu.(d
5e60: 65 66 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a 6d efine (dcommon:m
5e70: 61 69 6e 2d 6d 65 6e 75 29 0a 20 20 28 69 75 70 ain-menu). (iup
5e80: 3a 6d 65 6e 75 20 3b 3b 20 61 20 6d 65 6e 75 20 :menu ;; a menu
5e90: 69 73 20 61 20 73 70 65 63 69 61 6c 20 61 74 74 is a special att
5ea0: 72 69 62 75 74 65 20 74 6f 20 61 20 64 69 61 6c ribute to a dial
5eb0: 6f 67 20 28 74 68 69 6e 6b 20 47 6e 6f 6d 65 20 og (think Gnome
5ec0: 70 75 74 74 69 6e 67 20 74 68 65 20 6d 65 6e 75 putting the menu
5ed0: 20 61 74 20 73 63 72 65 65 6e 20 74 6f 70 29 0a at screen top).
5ee0: 20 20 20 28 69 75 70 3a 6d 65 6e 75 2d 69 74 65 (iup:menu-ite
5ef0: 6d 20 22 46 69 6c 65 73 22 20 28 69 75 70 3a 6d m "Files" (iup:m
5f00: 65 6e 75 20 20 20 3b 3b 20 4e 6f 74 65 20 74 68 enu ;; Note th
5f10: 61 74 20 79 6f 75 20 63 61 6e 20 75 73 65 20 65 at you can use e
5f20: 69 74 68 65 72 20 23 3a 61 63 74 69 6f 6e 20 6f ither #:action o
5f30: 72 20 61 63 74 69 6f 6e 3a 20 66 6f 72 20 6f 70 r action: for op
5f40: 74 69 6f 6e 73 0a 09 09 09 20 20 20 28 69 75 70 tions.... (iup
5f50: 3a 6d 65 6e 75 2d 69 74 65 6d 20 22 4f 70 65 6e :menu-item "Open
5f60: 22 20 20 61 63 74 69 6f 6e 3a 20 28 6c 61 6d 62 " action: (lamb
5f70: 64 61 20 28 6f 62 6a 29 0a 09 09 09 09 09 09 09 da (obj)........
5f80: 20 20 20 20 28 6c 65 74 2a 20 28 28 61 72 65 61 (let* ((area
5f90: 2d 6e 61 6d 65 20 28 69 75 70 3a 74 65 78 74 62 -name (iup:textb
5fa0: 6f 78 20 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 ox #:expand "HOR
5fb0: 49 5a 4f 4e 54 41 4c 22 29 29 0a 09 09 09 09 09 IZONTAL"))......
5fc0: 09 09 09 20 20 20 28 66 64 20 20 20 20 20 20 20 ... (fd
5fd0: 20 28 69 75 70 3a 66 69 6c 65 2d 64 69 61 6c 6f (iup:file-dialo
5fe0: 67 20 23 3a 64 69 61 6c 6f 67 74 79 70 65 20 22 g #:dialogtype "
5ff0: 44 49 52 22 29 29 0a 09 09 09 09 09 09 09 09 20 DIR")).........
6000: 20 20 28 74 6f 70 20 20 20 20 20 20 20 28 69 75 (top (iu
6010: 70 3a 73 68 6f 77 20 66 64 20 23 3a 6d 6f 64 61 p:show fd #:moda
6020: 6c 3f 20 22 59 45 53 22 29 29 29 0a 09 09 09 09 l? "YES"))).....
6030: 09 09 09 20 20 20 20 20 20 28 69 75 70 3a 61 74 ... (iup:at
6040: 74 72 69 62 75 74 65 2d 73 65 74 21 20 73 6f 75 tribute-set! sou
6050: 72 63 65 2d 74 62 20 22 56 41 4c 55 45 22 0a 09 rce-tb "VALUE"..
6060: 09 09 09 09 09 09 09 09 09 20 20 28 69 75 70 3a ......... (iup:
6070: 61 74 74 72 69 62 75 74 65 20 66 64 20 22 56 41 attribute fd "VA
6080: 4c 55 45 22 29 29 0a 09 09 09 09 09 09 09 20 20 LUE"))........
6090: 20 20 20 20 28 69 75 70 3a 64 65 73 74 72 6f 79 (iup:destroy
60a0: 21 20 66 64 29 29 29 29 0a 09 09 09 20 20 20 3b ! fd)))).... ;
60b0: 3b 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 0a ; (lambda (obj).
60c0: 09 09 09 20 20 20 3b 3b 20 20 28 69 75 70 3a 73 ... ;; (iup:s
60d0: 68 6f 77 20 28 69 75 70 3a 66 69 6c 65 2d 64 69 how (iup:file-di
60e0: 61 6c 6f 67 29 29 0a 09 09 09 20 20 20 3b 3b 20 alog)).... ;;
60f0: 20 28 70 72 69 6e 74 20 22 46 69 6c 65 2d 3e 6f (print "File->o
6100: 70 65 6e 20 22 20 6f 62 6a 29 29 29 0a 09 09 09 pen " obj)))....
6110: 20 20 20 28 69 75 70 3a 6d 65 6e 75 2d 69 74 65 (iup:menu-ite
6120: 6d 20 22 53 61 76 65 22 20 20 23 3a 61 63 74 69 m "Save" #:acti
6130: 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 on (lambda (obj)
6140: 28 70 72 69 6e 74 20 22 46 69 6c 65 2d 3e 73 61 (print "File->sa
6150: 76 65 20 22 20 6f 62 6a 29 29 29 0a 09 09 09 20 ve " obj)))....
6160: 20 20 28 69 75 70 3a 6d 65 6e 75 2d 69 74 65 6d (iup:menu-item
6170: 20 22 45 78 69 74 22 20 20 23 3a 61 63 74 69 6f "Exit" #:actio
6180: 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 28 n (lambda (obj)(
6190: 65 78 69 74 29 29 29 29 29 0a 20 20 20 28 69 75 exit))))). (iu
61a0: 70 3a 6d 65 6e 75 2d 69 74 65 6d 20 22 54 6f 6f p:menu-item "Too
61b0: 6c 73 22 20 28 69 75 70 3a 6d 65 6e 75 0a 09 09 ls" (iup:menu...
61c0: 09 20 20 20 28 69 75 70 3a 6d 65 6e 75 2d 69 74 . (iup:menu-it
61d0: 65 6d 20 22 43 72 65 61 74 65 20 6e 65 77 20 62 em "Create new b
61e0: 6c 61 68 22 20 23 3a 61 63 74 69 6f 6e 20 28 6c lah" #:action (l
61f0: 61 6d 62 64 61 20 28 6f 62 6a 29 28 70 72 69 6e ambda (obj)(prin
6200: 74 20 22 54 6f 6f 6c 73 2d 3e 6e 65 77 20 62 6c t "Tools->new bl
6210: 61 68 22 29 29 29 0a 09 09 09 20 20 20 3b 3b 20 ah"))).... ;;
6220: 28 69 75 70 3a 6d 65 6e 75 2d 69 74 65 6d 20 22 (iup:menu-item "
6230: 53 68 6f 77 20 64 69 61 6c 6f 67 22 20 20 20 20 Show dialog"
6240: 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 #:action (lambd
6250: 61 20 28 6f 62 6a 29 0a 09 09 09 20 20 20 3b 3b a (obj).... ;;
6260: 20 20 09 09 09 09 09 20 20 20 28 73 68 6f 77 20 ..... (show
6270: 6d 65 73 73 61 67 65 2d 77 69 6e 64 6f 77 0a 09 message-window..
6280: 09 09 20 20 20 3b 3b 20 20 09 09 09 09 09 20 20 .. ;; .....
6290: 20 20 20 23 3a 6d 6f 64 61 6c 3f 20 23 74 0a 09 #:modal? #t..
62a0: 09 09 20 20 20 3b 3b 20 20 09 09 09 09 09 20 20 .. ;; .....
62b0: 20 20 20 3b 3b 20 73 65 74 20 70 6f 73 69 74 6f ;; set posito
62c0: 6e 20 75 73 69 6e 67 20 63 6f 6f 72 64 69 6e 61 n using coordina
62d0: 74 65 73 20 6f 72 20 63 65 6e 74 65 72 2c 20 73 tes or center, s
62e0: 74 61 72 74 2c 20 74 6f 70 2c 20 6c 65 66 74 2c tart, top, left,
62f0: 20 65 6e 64 2c 20 62 6f 74 74 6f 6d 2c 20 72 69 end, bottom, ri
6300: 67 68 74 2c 20 70 61 72 65 6e 74 2d 63 65 6e 74 ght, parent-cent
6310: 65 72 2c 20 63 75 72 72 65 6e 74 0a 09 09 09 20 er, current....
6320: 20 20 3b 3b 20 20 09 09 09 09 09 20 20 20 20 20 ;; .....
6330: 3b 3b 20 23 3a 78 20 27 6d 6f 75 73 65 0a 09 09 ;; #:x 'mouse...
6340: 09 20 20 20 3b 3b 20 20 09 09 09 09 09 20 20 20 . ;; .....
6350: 20 20 3b 3b 20 23 3a 79 20 27 6d 6f 75 73 65 0a ;; #:y 'mouse.
6360: 09 09 09 20 20 20 3b 3b 20 20 29 09 09 09 09 09 ... ;; ).....
6370: 20 20 20 20 20 0a 09 09 09 20 20 20 29 29 29 29 .... ))))
6380: 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
6390: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
63a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
63b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
63c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 43 41 ==========.;; CA
63d0: 4e 56 41 53 20 53 54 55 46 46 20 46 4f 52 20 54 NVAS STUFF FOR T
63e0: 45 53 54 53 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d ESTS.;;=========
63f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6400: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6410: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6420: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 =============..(
6430: 64 65 66 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a define (dcommon:
6440: 64 72 61 77 2d 74 65 73 74 20 63 6e 76 20 78 20 draw-test cnv x
6450: 79 20 77 20 68 20 6e 61 6d 65 20 73 65 6c 65 63 y w h name selec
6460: 74 65 64 29 0a 20 20 28 6c 65 74 2a 20 28 28 6c ted). (let* ((l
6470: 6c 78 20 78 29 0a 09 20 28 6c 6c 79 20 79 29 0a lx x).. (lly y).
6480: 09 20 28 75 72 78 20 28 2b 20 78 20 77 29 29 0a . (urx (+ x w)).
6490: 09 20 28 75 72 79 20 28 2b 20 79 20 68 29 29 29 . (ury (+ y h)))
64a0: 0a 20 20 20 20 28 63 61 6e 76 61 73 2d 74 65 78 . (canvas-tex
64b0: 74 21 20 63 6e 76 20 28 2b 20 6c 6c 78 20 35 29 t! cnv (+ llx 5)
64c0: 28 2b 20 6c 6c 79 20 35 29 20 6e 61 6d 65 29 20 (+ lly 5) name)
64d0: 3b 3b 20 28 63 6f 6e 63 20 74 65 73 74 6e 61 6d ;; (conc testnam
64e0: 65 20 22 20 28 22 20 78 74 6f 72 69 67 20 22 2c e " (" xtorig ",
64f0: 22 20 79 74 6f 72 69 67 20 22 29 22 29 29 0a 20 " ytorig ")")).
6500: 20 20 20 28 63 61 6e 76 61 73 2d 72 65 63 74 61 (canvas-recta
6510: 6e 67 6c 65 21 20 63 6e 76 20 6c 6c 78 20 75 72 ngle! cnv llx ur
6520: 78 20 6c 6c 79 20 75 72 79 29 0a 20 20 20 20 28 x lly ury). (
6530: 69 66 20 73 65 6c 65 63 74 65 64 20 28 63 61 6e if selected (can
6540: 76 61 73 2d 62 6f 78 21 20 63 6e 76 20 6c 6c 78 vas-box! cnv llx
6550: 20 28 2b 20 6c 6c 78 20 35 29 20 6c 6c 79 20 28 (+ llx 5) lly (
6560: 2b 20 6c 6c 79 20 35 29 29 29 29 29 0a 0a 28 64 + lly 5)))))..(d
6570: 65 66 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a 64 efine (dcommon:d
6580: 72 61 77 2d 61 72 72 6f 77 20 63 6e 76 20 74 65 raw-arrow cnv te
6590: 73 74 2d 62 6f 78 2d 63 65 6e 74 65 72 20 77 61 st-box-center wa
65a0: 69 74 6f 6e 2d 63 65 6e 74 65 72 29 0a 20 20 28 iton-center). (
65b0: 6c 65 74 2a 20 28 28 74 65 73 74 2d 62 6f 78 2d let* ((test-box-
65c0: 63 65 6e 74 65 72 2d 78 20 28 76 65 63 74 6f 72 center-x (vector
65d0: 2d 72 65 66 20 74 65 73 74 2d 62 6f 78 2d 63 65 -ref test-box-ce
65e0: 6e 74 65 72 20 30 29 29 0a 09 20 28 74 65 73 74 nter 0)).. (test
65f0: 2d 62 6f 78 2d 63 65 6e 74 65 72 2d 79 20 28 76 -box-center-y (v
6600: 65 63 74 6f 72 2d 72 65 66 20 74 65 73 74 2d 62 ector-ref test-b
6610: 6f 78 2d 63 65 6e 74 65 72 20 31 29 29 0a 09 20 ox-center 1))..
6620: 28 77 61 69 74 6f 6e 2d 63 65 6e 74 65 72 2d 78 (waiton-center-x
6630: 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 77 (vector-ref w
6640: 61 69 74 6f 6e 2d 63 65 6e 74 65 72 20 20 20 30 aiton-center 0
6650: 29 29 0a 09 20 28 77 61 69 74 6f 6e 2d 63 65 6e )).. (waiton-cen
6660: 74 65 72 2d 79 20 20 20 28 76 65 63 74 6f 72 2d ter-y (vector-
6670: 72 65 66 20 77 61 69 74 6f 6e 2d 63 65 6e 74 65 ref waiton-cente
6680: 72 20 20 20 31 29 29 0a 09 20 28 64 65 6c 74 61 r 1)).. (delta
6690: 2d 79 20 20 20 20 20 20 20 20 20 20 20 28 2d 20 -y (-
66a0: 77 61 69 74 6f 6e 2d 63 65 6e 74 65 72 2d 79 20 waiton-center-y
66b0: 74 65 73 74 2d 62 6f 78 2d 63 65 6e 74 65 72 2d test-box-center-
66c0: 79 29 29 0a 09 20 28 64 65 6c 74 61 2d 78 20 20 y)).. (delta-x
66d0: 20 20 20 20 20 20 20 20 20 28 2d 20 77 61 69 74 (- wait
66e0: 6f 6e 2d 63 65 6e 74 65 72 2d 78 20 74 65 73 74 on-center-x test
66f0: 2d 62 6f 78 2d 63 65 6e 74 65 72 2d 78 29 29 0a -box-center-x)).
6700: 09 20 28 61 62 73 2d 64 65 6c 74 61 2d 78 20 20 . (abs-delta-x
6710: 20 20 20 20 20 28 61 62 73 20 64 65 6c 74 61 2d (abs delta-
6720: 78 29 29 0a 09 20 28 61 62 73 2d 64 65 6c 74 61 x)).. (abs-delta
6730: 2d 79 20 20 20 20 20 20 20 28 61 62 73 20 64 65 -y (abs de
6740: 6c 74 61 2d 79 29 29 0a 09 20 28 75 73 65 2d 64 lta-y)).. (use-d
6750: 65 6c 74 61 2d 78 20 20 20 20 20 20 20 28 3e 20 elta-x (>
6760: 61 62 73 2d 64 65 6c 74 61 2d 78 20 61 62 73 2d abs-delta-x abs-
6770: 64 65 6c 74 61 2d 79 29 29 20 3b 3b 20 75 73 65 delta-y)) ;; use
6780: 20 74 68 65 20 6c 61 72 67 65 72 20 6f 6e 65 0a the larger one.
6790: 09 20 28 64 65 6c 74 61 2d 72 61 74 69 6f 20 20 . (delta-ratio
67a0: 20 20 20 20 20 28 69 66 20 75 73 65 2d 64 65 6c (if use-del
67b0: 74 61 2d 78 0a 09 09 09 09 28 69 66 20 28 3e 20 ta-x.....(if (>
67c0: 61 62 73 2d 64 65 6c 74 61 2d 78 20 30 29 0a 09 abs-delta-x 0)..
67d0: 09 09 09 20 20 20 20 28 2f 20 61 62 73 2d 64 65 ... (/ abs-de
67e0: 6c 74 61 2d 79 20 61 62 73 2d 64 65 6c 74 61 2d lta-y abs-delta-
67f0: 78 29 0a 09 09 09 09 20 20 20 20 31 29 0a 09 09 x)..... 1)...
6800: 09 09 28 69 66 20 28 3e 20 61 62 73 2d 64 65 6c ..(if (> abs-del
6810: 74 61 2d 79 20 30 29 0a 09 09 09 09 20 20 20 20 ta-y 0).....
6820: 28 2f 20 61 62 73 2d 64 65 6c 74 61 2d 78 20 61 (/ abs-delta-x a
6830: 62 73 2d 64 65 6c 74 61 2d 79 29 0a 09 09 09 09 bs-delta-y).....
6840: 20 20 20 20 31 29 29 29 0a 09 20 28 78 2d 61 64 1))).. (x-ad
6850: 6a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 j (i
6860: 66 20 75 73 65 2d 64 65 6c 74 61 2d 78 0a 09 09 f use-delta-x...
6870: 09 09 38 0a 09 09 09 09 28 2a 20 64 65 6c 74 61 ..8.....(* delta
6880: 2d 72 61 74 69 6f 20 38 29 29 29 0a 09 20 28 79 -ratio 8))).. (y
6890: 2d 61 64 6a 20 20 20 20 20 20 20 20 20 20 20 20 -adj
68a0: 20 28 69 66 20 75 73 65 2d 64 65 6c 74 61 2d 78 (if use-delta-x
68b0: 0a 09 09 09 09 28 2a 20 78 2d 61 64 6a 20 64 65 .....(* x-adj de
68c0: 6c 74 61 2d 72 61 74 69 6f 29 0a 09 09 09 09 38 lta-ratio).....8
68d0: 29 29 0a 09 20 28 6e 65 77 2d 77 61 69 74 6f 6e )).. (new-waiton
68e0: 2d 78 20 20 20 20 20 20 28 69 6e 65 78 61 63 74 -x (inexact
68f0: 2d 3e 65 78 61 63 74 0a 09 09 09 20 20 20 20 20 ->exact....
6900: 28 72 6f 75 6e 64 20 28 69 66 20 28 3e 20 64 65 (round (if (> de
6910: 6c 74 61 2d 78 20 30 29 20 3b 3b 20 68 61 76 65 lta-x 0) ;; have
6920: 20 70 6f 73 69 74 69 76 65 20 78 0a 09 09 09 09 positive x.....
6930: 09 28 2d 20 77 61 69 74 6f 6e 2d 63 65 6e 74 65 .(- waiton-cente
6940: 72 2d 78 20 78 2d 61 64 6a 29 0a 09 09 09 09 09 r-x x-adj)......
6950: 28 2b 20 77 61 69 74 6f 6e 2d 63 65 6e 74 65 72 (+ waiton-center
6960: 2d 78 20 78 2d 61 64 6a 29 29 29 29 29 0a 09 20 -x x-adj)))))..
6970: 28 6e 65 77 2d 77 61 69 74 6f 6e 2d 79 20 20 20 (new-waiton-y
6980: 20 20 20 28 69 6e 65 78 61 63 74 2d 3e 65 78 61 (inexact->exa
6990: 63 74 0a 09 09 09 20 20 20 20 20 28 72 6f 75 6e ct.... (roun
69a0: 64 20 28 69 66 20 28 3e 20 64 65 6c 74 61 2d 79 d (if (> delta-y
69b0: 20 30 29 0a 09 09 09 09 09 28 2d 20 77 61 69 74 0)......(- wait
69c0: 6f 6e 2d 63 65 6e 74 65 72 2d 79 20 79 2d 61 64 on-center-y y-ad
69d0: 6a 29 0a 09 09 09 09 09 28 2b 20 77 61 69 74 6f j)......(+ waito
69e0: 6e 2d 63 65 6e 74 65 72 2d 79 20 79 2d 61 64 6a n-center-y y-adj
69f0: 29 29 29 29 29 29 0a 20 20 3b 3b 20 28 63 61 6e )))))). ;; (can
6a00: 76 61 73 2d 6c 69 6e 65 2d 77 69 64 74 68 2d 73 vas-line-width-s
6a10: 65 74 21 20 63 6e 76 20 35 29 0a 20 20 28 63 61 et! cnv 5). (ca
6a20: 6e 76 61 73 2d 6c 69 6e 65 21 20 63 6e 76 0a 09 nvas-line! cnv..
6a30: 09 74 65 73 74 2d 62 6f 78 2d 63 65 6e 74 65 72 .test-box-center
6a40: 2d 78 0a 09 09 74 65 73 74 2d 62 6f 78 2d 63 65 -x...test-box-ce
6a50: 6e 74 65 72 2d 79 0a 09 09 6e 65 77 2d 77 61 69 nter-y...new-wai
6a60: 74 6f 6e 2d 78 0a 09 09 6e 65 77 2d 77 61 69 74 ton-x...new-wait
6a70: 6f 6e 2d 79 0a 09 09 29 0a 20 20 28 63 61 6e 76 on-y...). (canv
6a80: 61 73 2d 6d 61 72 6b 21 20 63 6e 76 20 6e 65 77 as-mark! cnv new
6a90: 2d 77 61 69 74 6f 6e 2d 78 20 6e 65 77 2d 77 61 -waiton-x new-wa
6aa0: 69 74 6f 6e 2d 79 29 29 29 0a 0a 28 64 65 66 69 iton-y)))..(defi
6ab0: 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a 67 65 74 2d ne (dcommon:get-
6ac0: 62 6f 78 2d 63 65 6e 74 65 72 20 62 6f 78 29 0a box-center box).
6ad0: 20 20 28 6c 65 74 2a 20 28 28 6c 6c 78 20 20 28 (let* ((llx (
6ae0: 6c 69 73 74 2d 72 65 66 20 62 6f 78 20 30 29 29 list-ref box 0))
6af0: 0a 09 20 28 6c 6c 79 20 20 28 6c 69 73 74 2d 72 .. (lly (list-r
6b00: 65 66 20 62 6f 78 20 34 29 29 0a 09 20 28 62 6f ef box 4)).. (bo
6b10: 78 77 20 28 6c 69 73 74 2d 72 65 66 20 62 6f 78 xw (list-ref box
6b20: 20 35 29 29 0a 09 20 28 62 6f 78 68 20 28 6c 69 5)).. (boxh (li
6b30: 73 74 2d 72 65 66 20 62 6f 78 20 36 29 29 29 0a st-ref box 6))).
6b40: 20 20 20 20 28 76 65 63 74 6f 72 20 28 2b 20 6c (vector (+ l
6b50: 6c 78 20 28 2f 20 62 6f 78 77 20 32 29 29 0a 09 lx (/ boxw 2))..
6b60: 20 20 20 20 28 2b 20 6c 6c 79 20 28 2f 20 62 6f (+ lly (/ bo
6b70: 78 68 20 32 29 29 29 29 29 0a 0a 28 64 65 66 69 xh 2)))))..(defi
6b80: 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a 64 72 61 77 ne (dcommon:draw
6b90: 2d 61 72 72 6f 77 73 20 63 6e 76 20 74 65 73 74 -arrows cnv test
6ba0: 6e 61 6d 65 20 74 65 73 74 73 2d 68 61 73 68 20 name tests-hash
6bb0: 74 65 73 74 2d 72 65 63 6f 72 64 73 29 0a 20 20 test-records).
6bc0: 28 6c 65 74 2a 20 28 28 74 65 73 74 2d 62 6f 78 (let* ((test-box
6bd0: 2d 69 6e 66 6f 20 20 20 28 68 61 73 68 2d 74 61 -info (hash-ta
6be0: 62 6c 65 2d 72 65 66 20 74 65 73 74 73 2d 68 61 ble-ref tests-ha
6bf0: 73 68 20 74 65 73 74 6e 61 6d 65 29 29 0a 09 20 sh testname))..
6c00: 28 74 65 73 74 2d 62 6f 78 2d 63 65 6e 74 65 72 (test-box-center
6c10: 20 28 64 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 62 6f (dcommon:get-bo
6c20: 78 2d 63 65 6e 74 65 72 20 74 65 73 74 2d 62 6f x-center test-bo
6c30: 78 2d 69 6e 66 6f 29 29 0a 09 20 28 74 65 73 74 x-info)).. (test
6c40: 2d 72 65 63 6f 72 64 20 20 20 20 20 28 68 61 73 -record (has
6c50: 68 2d 74 61 62 6c 65 2d 72 65 66 20 74 65 73 74 h-table-ref test
6c60: 2d 72 65 63 6f 72 64 73 20 74 65 73 74 6e 61 6d -records testnam
6c70: 65 29 29 0a 09 20 28 77 61 69 74 6f 6e 73 20 20 e)).. (waitons
6c80: 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 (vector-r
6c90: 65 66 20 74 65 73 74 2d 72 65 63 6f 72 64 20 32 ef test-record 2
6ca0: 29 29 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 ))). (for-eac
6cb0: 68 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 h. (lambda (
6cc0: 77 61 69 74 6f 6e 29 0a 20 20 20 20 20 20 20 28 waiton). (
6cd0: 6c 65 74 2a 20 28 28 77 61 69 74 6f 6e 2d 62 6f let* ((waiton-bo
6ce0: 78 2d 69 6e 66 6f 20 28 68 61 73 68 2d 74 61 62 x-info (hash-tab
6cf0: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 74 le-ref/default t
6d00: 65 73 74 73 2d 68 61 73 68 20 77 61 69 74 6f 6e ests-hash waiton
6d10: 20 23 66 29 29 0a 09 20 20 20 20 20 20 28 77 61 #f)).. (wa
6d20: 69 74 6f 6e 2d 63 65 6e 74 65 72 20 20 20 28 64 iton-center (d
6d30: 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 62 6f 78 2d 63 common:get-box-c
6d40: 65 6e 74 65 72 20 28 6f 72 20 77 61 69 74 6f 6e enter (or waiton
6d50: 2d 62 6f 78 2d 69 6e 66 6f 20 74 65 73 74 2d 62 -box-info test-b
6d60: 6f 78 2d 69 6e 66 6f 29 29 29 29 0a 09 20 28 64 ox-info)))).. (d
6d70: 63 6f 6d 6d 6f 6e 3a 64 72 61 77 2d 61 72 72 6f common:draw-arro
6d80: 77 20 63 6e 76 20 74 65 73 74 2d 62 6f 78 2d 63 w cnv test-box-c
6d90: 65 6e 74 65 72 20 77 61 69 74 6f 6e 2d 63 65 6e enter waiton-cen
6da0: 74 65 72 29 29 29 0a 20 20 20 20 20 77 61 69 74 ter))). wait
6db0: 6f 6e 73 29 0a 20 20 20 20 3b 3b 20 28 64 65 62 ons). ;; (deb
6dc0: 75 67 3a 70 72 69 6e 74 20 30 20 22 74 65 73 74 ug:print 0 "test
6dd0: 2d 62 6f 78 2d 69 6e 66 6f 3d 22 20 74 65 73 74 -box-info=" test
6de0: 2d 62 6f 78 2d 69 6e 66 6f 29 0a 20 20 20 20 3b -box-info). ;
6df0: 3b 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 ; (debug:print 0
6e00: 20 22 74 65 73 74 2d 72 65 63 6f 72 64 3d 22 20 "test-record="
6e10: 74 65 73 74 2d 72 65 63 6f 72 64 29 0a 20 20 20 test-record).
6e20: 20 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 63 ))..(define (dc
6e30: 6f 6d 6d 6f 6e 3a 69 6e 69 74 69 61 6c 2d 64 72 ommon:initial-dr
6e40: 61 77 2d 74 65 73 74 73 20 63 6e 76 20 78 61 64 aw-tests cnv xad
6e50: 6a 20 79 61 64 6a 20 73 69 7a 65 78 20 73 69 7a j yadj sizex siz
6e60: 65 79 20 73 69 7a 65 78 6d 6d 20 73 69 7a 65 79 ey sizexmm sizey
6e70: 6d 6d 20 6f 72 69 67 69 6e 78 20 6f 72 69 67 69 mm originx origi
6e80: 6e 79 20 74 65 73 74 73 2d 64 72 61 77 2d 73 74 ny tests-draw-st
6e90: 61 74 65 20 73 6f 72 74 65 64 2d 74 65 73 74 6e ate sorted-testn
6ea0: 61 6d 65 73 20 74 65 73 74 2d 72 65 63 6f 72 64 ames test-record
6eb0: 73 29 0a 20 20 28 6c 65 74 2a 20 28 28 64 6f 74 s). (let* ((dot
6ec0: 2d 64 61 74 61 20 3b 3b 20 28 6d 61 70 20 63 64 -data ;; (map cd
6ed0: 72 20 28 66 69 6c 74 65 72 0a 09 09 20 20 20 3b r (filter... ;
6ee0: 3b 20 09 20 20 28 6c 61 6d 62 64 61 20 28 78 29 ; . (lambda (x)
6ef0: 28 65 71 75 61 6c 3f 20 22 6e 6f 64 65 22 20 28 (equal? "node" (
6f00: 63 61 72 20 78 29 29 29 0a 09 20 20 28 6d 61 70 car x))).. (map
6f10: 20 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 28 74 string-split (t
6f20: 65 73 74 73 3a 65 61 73 79 2d 64 6f 74 20 74 65 ests:easy-dot te
6f30: 73 74 2d 72 65 63 6f 72 64 73 20 22 70 6c 61 69 st-records "plai
6f40: 6e 22 29 29 29 0a 09 20 28 73 63 61 6c 65 66 20 n"))).. (scalef
6f50: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/
6f60: 64 65 66 61 75 6c 74 20 74 65 73 74 73 2d 64 72 default tests-dr
6f70: 61 77 2d 73 74 61 74 65 20 27 73 63 61 6c 65 66 aw-state 'scalef
6f80: 20 38 29 29 0a 09 20 28 74 65 73 74 2d 62 72 6f 8)).. (test-bro
6f90: 77 73 65 2d 78 6f 66 66 73 65 74 20 28 68 61 73 wse-xoffset (has
6fa0: 68 2d 74 61 62 6c 65 2d 72 65 66 20 74 65 73 74 h-table-ref test
6fb0: 73 2d 64 72 61 77 2d 73 74 61 74 65 20 27 74 65 s-draw-state 'te
6fc0: 73 74 2d 62 72 6f 77 73 65 2d 78 6f 66 66 73 65 st-browse-xoffse
6fd0: 74 29 29 0a 09 20 28 74 65 73 74 2d 62 72 6f 77 t)).. (test-brow
6fe0: 73 65 2d 79 6f 66 66 73 65 74 20 28 68 61 73 68 se-yoffset (hash
6ff0: 2d 74 61 62 6c 65 2d 72 65 66 20 74 65 73 74 73 -table-ref tests
7000: 2d 64 72 61 77 2d 73 74 61 74 65 20 27 74 65 73 -draw-state 'tes
7010: 74 2d 62 72 6f 77 73 65 2d 79 6f 66 66 73 65 74 t-browse-yoffset
7020: 29 29 0a 09 20 28 78 74 6f 72 69 67 20 28 2b 20 )).. (xtorig (+
7030: 74 65 73 74 2d 62 72 6f 77 73 65 2d 78 6f 66 66 test-browse-xoff
7040: 73 65 74 20 28 2a 20 28 2f 20 73 69 7a 65 78 20 set (* (/ sizex
7050: 32 29 20 73 63 61 6c 65 66 20 28 2d 20 30 2e 35 2) scalef (- 0.5
7060: 20 78 61 64 6a 29 29 29 29 20 3b 3b 20 20 28 2d xadj)))) ;; (-
7070: 20 78 61 64 6a 20 31 29 29 29 29 0a 09 20 28 79 xadj 1)))).. (y
7080: 74 6f 72 69 67 20 28 2b 20 74 65 73 74 2d 62 72 torig (+ test-br
7090: 6f 77 73 65 2d 79 6f 66 66 73 65 74 20 28 2a 20 owse-yoffset (*
70a0: 28 2f 20 73 69 7a 65 79 20 32 29 20 73 63 61 6c (/ sizey 2) scal
70b0: 65 66 20 28 2d 20 79 61 64 6a 20 30 2e 35 29 29 ef (- yadj 0.5))
70c0: 29 29 0a 09 20 28 62 6f 78 77 20 20 20 31 30 29 )).. (boxw 10)
70d0: 0a 09 20 28 74 65 73 74 73 2d 68 61 73 68 20 20 .. (tests-hash
70e0: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 (hash-table-r
70f0: 65 66 20 74 65 73 74 73 2d 64 72 61 77 2d 73 74 ef tests-draw-st
7100: 61 74 65 20 27 74 65 73 74 73 2d 69 6e 66 6f 29 ate 'tests-info)
7110: 29 0a 09 20 28 73 65 6c 65 63 74 65 64 2d 74 65 ).. (selected-te
7120: 73 74 73 20 28 68 61 73 68 2d 74 61 62 6c 65 2d sts (hash-table-
7130: 72 65 66 20 74 65 73 74 73 2d 64 72 61 77 2d 73 ref tests-draw-s
7140: 74 61 74 65 20 27 73 65 6c 65 63 74 65 64 2d 74 tate 'selected-t
7150: 65 73 74 73 20 29 29 29 0a 20 20 20 20 28 70 72 ests ))). (pr
7160: 69 6e 74 20 22 64 6f 74 2d 64 61 74 61 3d 22 20 int "dot-data="
7170: 64 6f 74 2d 64 61 74 61 29 0a 20 20 20 20 28 68 dot-data). (h
7180: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 74 ash-table-set! t
7190: 65 73 74 73 2d 64 72 61 77 2d 73 74 61 74 65 20 ests-draw-state
71a0: 27 78 74 6f 72 69 67 20 78 74 6f 72 69 67 29 0a 'xtorig xtorig).
71b0: 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (hash-table-
71c0: 73 65 74 21 20 74 65 73 74 73 2d 64 72 61 77 2d set! tests-draw-
71d0: 73 74 61 74 65 20 27 79 74 6f 72 69 67 20 79 74 state 'ytorig yt
71e0: 6f 72 69 67 29 0a 20 20 20 20 28 6c 65 74 20 28 orig). (let (
71f0: 28 6c 6f 6e 67 65 73 74 2d 73 74 72 20 20 20 28 (longest-str (
7200: 69 66 20 28 6e 75 6c 6c 3f 20 73 6f 72 74 65 64 if (null? sorted
7210: 2d 74 65 73 74 6e 61 6d 65 73 29 20 22 20 20 20 -testnames) "
7220: 20 20 20 20 20 20 22 20 28 63 61 72 20 28 73 6f " (car (so
7230: 72 74 20 73 6f 72 74 65 64 2d 74 65 73 74 6e 61 rt sorted-testna
7240: 6d 65 73 20 28 6c 61 6d 62 64 61 20 28 61 20 62 mes (lambda (a b
7250: 29 28 3e 3d 20 28 73 74 72 69 6e 67 2d 6c 65 6e )(>= (string-len
7260: 67 74 68 20 61 29 28 73 74 72 69 6e 67 2d 6c 65 gth a)(string-le
7270: 6e 67 74 68 20 62 29 29 29 29 29 29 29 29 0a 20 ngth b)))))))).
7280: 20 20 20 20 20 28 6c 65 74 2d 76 61 6c 75 65 73 (let-values
7290: 20 28 28 28 78 2d 6d 61 78 20 79 2d 6d 61 78 29 (((x-max y-max)
72a0: 20 28 63 61 6e 76 61 73 2d 74 65 78 74 2d 73 69 (canvas-text-si
72b0: 7a 65 20 63 6e 76 20 6c 6f 6e 67 65 73 74 2d 73 ze cnv longest-s
72c0: 74 72 29 29 29 0a 09 28 69 66 20 28 3e 20 78 2d tr)))..(if (> x-
72d0: 6d 61 78 20 62 6f 78 77 29 28 73 65 74 21 20 62 max boxw)(set! b
72e0: 6f 78 77 20 28 2b 20 31 30 20 78 2d 6d 61 78 29 oxw (+ 10 x-max)
72f0: 29 29 29 29 0a 20 20 20 20 3b 3b 20 28 70 72 69 )))). ;; (pri
7300: 6e 74 20 22 73 69 7a 65 78 3a 20 22 20 73 69 7a nt "sizex: " siz
7310: 65 78 20 22 20 73 69 7a 65 79 3a 20 22 20 73 69 ex " sizey: " si
7320: 7a 65 79 20 22 20 66 6f 6e 74 3a 20 22 20 28 63 zey " font: " (c
7330: 61 6e 76 61 73 2d 66 6f 6e 74 20 63 6e 76 29 20 anvas-font cnv)
7340: 22 20 6f 72 69 67 69 6e 78 3a 20 22 20 6f 72 69 " originx: " ori
7350: 67 69 6e 78 20 22 20 6f 72 69 67 69 6e 79 3a 20 ginx " originy:
7360: 22 20 6f 72 69 67 69 6e 79 20 22 20 78 74 6f 72 " originy " xtor
7370: 69 67 3a 20 22 20 78 74 6f 72 69 67 20 22 20 79 ig: " xtorig " y
7380: 74 6f 72 69 67 3a 20 22 20 79 74 6f 72 69 67 20 torig: " ytorig
7390: 22 20 78 61 64 6a 3a 20 22 20 78 61 64 6a 20 22 " xadj: " xadj "
73a0: 20 79 61 64 6a 3a 20 22 20 79 61 64 6a 29 0a 20 yadj: " yadj).
73b0: 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c (if (not (nul
73c0: 6c 3f 20 73 6f 72 74 65 64 2d 74 65 73 74 6e 61 l? sorted-testna
73d0: 6d 65 73 29 29 0a 09 28 6c 65 74 20 6c 6f 6f 70 mes))..(let loop
73e0: 20 28 28 68 65 64 20 28 63 61 72 20 28 72 65 76 ((hed (car (rev
73f0: 65 72 73 65 20 73 6f 72 74 65 64 2d 74 65 73 74 erse sorted-test
7400: 6e 61 6d 65 73 29 29 29 0a 09 09 20 20 20 28 74 names)))... (t
7410: 61 6c 20 28 63 64 72 20 28 72 65 76 65 72 73 65 al (cdr (reverse
7420: 20 73 6f 72 74 65 64 2d 74 65 73 74 6e 61 6d 65 sorted-testname
7430: 73 29 29 29 29 0a 09 20 20 28 6c 65 74 2a 20 28 s)))).. (let* (
7440: 28 6e 6f 64 65 64 61 74 20 28 66 69 6c 74 65 72 (nodedat (filter
7450: 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 (lambda (x)....
7460: 09 20 20 20 20 28 69 66 20 28 65 71 75 61 6c 3f . (if (equal?
7470: 20 28 63 61 72 20 78 29 20 22 6e 6f 64 65 22 29 (car x) "node")
7480: 0a 09 09 09 09 09 28 65 71 75 61 6c 3f 20 68 65 ......(equal? he
7490: 64 20 28 63 61 64 72 20 78 29 29 0a 09 09 09 09 d (cadr x)).....
74a0: 09 23 66 29 29 0a 09 09 09 09 20 20 64 6f 74 2d .#f))..... dot-
74b0: 64 61 74 61 29 29 0a 09 09 20 28 6c 6c 78 20 20 data))... (llx
74c0: 28 2a 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 (* (string->numb
74d0: 65 72 20 28 6c 69 73 74 2d 72 65 66 20 6e 6f 64 er (list-ref nod
74e0: 65 64 61 74 20 32 29 29 20 73 63 61 6c 65 66 29 edat 2)) scalef)
74f0: 29 0a 09 09 20 28 6c 6c 79 20 20 28 2a 20 28 73 )... (lly (* (s
7500: 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 6c tring->number (l
7510: 69 73 74 2d 72 65 66 20 6e 6f 64 65 64 61 74 20 ist-ref nodedat
7520: 33 29 29 20 73 63 61 6c 65 66 29 29 0a 09 09 20 3)) scalef))...
7530: 28 62 6f 78 77 20 28 2a 20 28 73 74 72 69 6e 67 (boxw (* (string
7540: 2d 3e 6e 75 6d 62 65 72 20 28 6c 69 73 74 2d 72 ->number (list-r
7550: 65 66 20 6e 6f 64 65 64 61 74 20 34 29 29 20 73 ef nodedat 4)) s
7560: 63 61 6c 65 66 29 29 0a 09 09 20 28 62 6f 78 68 calef))... (boxh
7570: 20 28 2a 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d (* (string->num
7580: 62 65 72 20 28 6c 69 73 74 2d 72 65 66 20 6e 6f ber (list-ref no
7590: 64 65 64 61 74 20 35 29 29 20 73 63 61 6c 65 66 dedat 5)) scalef
75a0: 29 29 29 0a 09 09 09 09 09 3b 20 28 70 72 69 6e )))......; (prin
75b0: 74 20 22 68 65 64 20 22 20 68 65 64 20 22 20 6c t "hed " hed " l
75c0: 6c 78 20 22 20 6c 6c 78 20 22 20 6c 6c 79 20 22 lx " llx " lly "
75d0: 20 6c 6c 79 20 22 20 75 72 78 20 22 20 75 72 78 lly " urx " urx
75e0: 20 22 20 75 72 79 20 22 20 75 72 79 29 0a 09 20 " ury " ury)..
75f0: 20 28 64 63 6f 6d 6d 6f 6e 3a 64 72 61 77 2d 74 (dcommon:draw-t
7600: 65 73 74 20 63 6e 76 20 6c 6c 78 20 6c 6c 79 20 est cnv llx lly
7610: 62 6f 78 77 20 62 6f 78 68 20 68 65 64 20 28 68 boxw boxh hed (h
7620: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
7630: 66 61 75 6c 74 20 73 65 6c 65 63 74 65 64 2d 74 fault selected-t
7640: 65 73 74 73 20 68 65 64 20 23 66 29 29 0a 09 20 ests hed #f))..
7650: 20 3b 3b 20 64 61 74 61 20 75 73 65 64 20 62 79 ;; data used by
7660: 20 6d 6f 75 73 65 20 63 6c 69 63 6b 20 63 61 6c mouse click cal
7670: 63 2e 20 6b 65 65 70 20 74 68 65 20 77 61 63 6b c. keep the wack
7680: 79 20 6f 72 64 65 72 20 66 6f 72 20 6e 6f 77 2e y order for now.
7690: 0a 09 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d .. (hash-table-
76a0: 73 65 74 21 20 74 65 73 74 73 2d 68 61 73 68 20 set! tests-hash
76b0: 68 65 64 20 20 28 6c 69 73 74 20 6c 6c 78 20 75 hed (list llx u
76c0: 72 78 20 28 2d 20 73 69 7a 65 79 20 75 72 79 29 rx (- sizey ury)
76d0: 28 2d 20 73 69 7a 65 79 20 6c 6c 79 29 20 6c 6c (- sizey lly) ll
76e0: 79 20 62 6f 78 77 20 62 6f 78 68 29 29 20 0a 09 y boxw boxh)) ..
76f0: 20 20 3b 3b 20 28 6c 69 73 74 20 6c 6c 78 20 6c ;; (list llx l
7700: 6c 79 20 62 6f 78 77 20 62 6f 78 68 29 29 20 3b ly boxw boxh)) ;
7710: 3b 20 4e 42 2f 2f 20 53 77 61 70 20 75 72 79 20 ; NB// Swap ury
7720: 61 6e 64 20 6c 6c 79 0a 09 20 20 28 69 66 20 28 and lly.. (if (
7730: 6e 6f 74 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 29 not (null? tal))
7740: 0a 09 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 .. (loop (c
7750: 61 72 20 74 61 6c 29 0a 09 09 20 20 20 20 28 63 ar tal)... (c
7760: 64 72 20 74 61 6c 29 29 29 29 29 29 0a 20 20 20 dr tal)))))).
7770: 20 28 66 6f 72 2d 65 61 63 68 0a 20 20 20 20 20 (for-each.
7780: 28 6c 61 6d 62 64 61 20 28 74 65 73 74 6e 61 6d (lambda (testnam
7790: 65 29 0a 20 20 20 20 20 20 20 28 64 63 6f 6d 6d e). (dcomm
77a0: 6f 6e 3a 64 72 61 77 2d 61 72 72 6f 77 73 20 63 on:draw-arrows c
77b0: 6e 76 20 74 65 73 74 6e 61 6d 65 20 74 65 73 74 nv testname test
77c0: 73 2d 68 61 73 68 20 74 65 73 74 2d 72 65 63 6f s-hash test-reco
77d0: 72 64 73 29 29 0a 20 20 20 20 20 73 6f 72 74 65 rds)). sorte
77e0: 64 2d 74 65 73 74 6e 61 6d 65 73 29 29 29 0a 0a d-testnames)))..
77f0: 28 64 65 66 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e (define (dcommon
7800: 3a 72 65 64 72 61 77 2d 74 65 73 74 73 20 63 6e :redraw-tests cn
7810: 76 20 78 61 64 6a 20 79 61 64 6a 20 73 69 7a 65 v xadj yadj size
7820: 78 20 73 69 7a 65 79 20 73 69 7a 65 78 6d 6d 20 x sizey sizexmm
7830: 73 69 7a 65 79 6d 6d 20 6f 72 69 67 69 6e 78 20 sizeymm originx
7840: 6f 72 69 67 69 6e 79 20 74 65 73 74 73 2d 64 72 originy tests-dr
7850: 61 77 2d 73 74 61 74 65 20 73 6f 72 74 65 64 2d aw-state sorted-
7860: 74 65 73 74 6e 61 6d 65 73 20 74 65 73 74 2d 72 testnames test-r
7870: 65 63 6f 72 64 73 29 0a 20 20 28 6c 65 74 2a 20 ecords). (let*
7880: 28 28 73 63 61 6c 65 66 20 28 68 61 73 68 2d 74 ((scalef (hash-t
7890: 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 able-ref/default
78a0: 20 74 65 73 74 73 2d 64 72 61 77 2d 73 74 61 74 tests-draw-stat
78b0: 65 20 27 73 63 61 6c 65 66 20 38 29 29 0a 09 20 e 'scalef 8))..
78c0: 28 74 65 73 74 2d 62 72 6f 77 73 65 2d 78 6f 66 (test-browse-xof
78d0: 66 73 65 74 20 28 68 61 73 68 2d 74 61 62 6c 65 fset (hash-table
78e0: 2d 72 65 66 20 74 65 73 74 73 2d 64 72 61 77 2d -ref tests-draw-
78f0: 73 74 61 74 65 20 27 74 65 73 74 2d 62 72 6f 77 state 'test-brow
7900: 73 65 2d 78 6f 66 66 73 65 74 29 29 0a 09 20 28 se-xoffset)).. (
7910: 74 65 73 74 2d 62 72 6f 77 73 65 2d 79 6f 66 66 test-browse-yoff
7920: 73 65 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d set (hash-table-
7930: 72 65 66 20 74 65 73 74 73 2d 64 72 61 77 2d 73 ref tests-draw-s
7940: 74 61 74 65 20 27 74 65 73 74 2d 62 72 6f 77 73 tate 'test-brows
7950: 65 2d 79 6f 66 66 73 65 74 29 29 0a 09 20 28 78 e-yoffset)).. (x
7960: 74 6f 72 69 67 20 28 2b 20 74 65 73 74 2d 62 72 torig (+ test-br
7970: 6f 77 73 65 2d 78 6f 66 66 73 65 74 20 28 2a 20 owse-xoffset (*
7980: 28 2f 20 73 69 7a 65 78 20 32 29 20 73 63 61 6c (/ sizex 2) scal
7990: 65 66 20 28 2d 20 78 61 64 6a 20 30 2e 35 29 29 ef (- xadj 0.5))
79a0: 29 29 20 3b 3b 20 20 28 2d 20 78 61 64 6a 20 31 )) ;; (- xadj 1
79b0: 29 29 29 29 0a 09 20 28 79 74 6f 72 69 67 20 28 )))).. (ytorig (
79c0: 2b 20 74 65 73 74 2d 62 72 6f 77 73 65 2d 79 6f + test-browse-yo
79d0: 66 66 73 65 74 20 28 2a 20 28 2f 20 73 69 7a 65 ffset (* (/ size
79e0: 79 20 32 29 20 73 63 61 6c 65 66 20 28 2d 20 30 y 2) scalef (- 0
79f0: 2e 35 20 79 61 64 6a 29 29 29 29 0a 09 20 28 78 .5 yadj)))).. (x
7a00: 64 65 6c 74 61 20 28 2d 20 28 68 61 73 68 2d 74 delta (- (hash-t
7a10: 61 62 6c 65 2d 72 65 66 20 74 65 73 74 73 2d 64 able-ref tests-d
7a20: 72 61 77 2d 73 74 61 74 65 20 27 78 74 6f 72 69 raw-state 'xtori
7a30: 67 29 20 78 74 6f 72 69 67 29 29 0a 09 20 28 79 g) xtorig)).. (y
7a40: 64 65 6c 74 61 20 28 2d 20 28 68 61 73 68 2d 74 delta (- (hash-t
7a50: 61 62 6c 65 2d 72 65 66 20 74 65 73 74 73 2d 64 able-ref tests-d
7a60: 72 61 77 2d 73 74 61 74 65 20 27 79 74 6f 72 69 raw-state 'ytori
7a70: 67 29 20 79 74 6f 72 69 67 29 29 0a 09 20 28 74 g) ytorig)).. (t
7a80: 65 73 74 73 2d 68 61 73 68 20 20 20 20 20 28 68 ests-hash (h
7a90: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 74 65 ash-table-ref te
7aa0: 73 74 73 2d 64 72 61 77 2d 73 74 61 74 65 20 27 sts-draw-state '
7ab0: 74 65 73 74 73 2d 69 6e 66 6f 29 29 0a 09 20 28 tests-info)).. (
7ac0: 73 65 6c 65 63 74 65 64 2d 74 65 73 74 73 20 28 selected-tests (
7ad0: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 74 hash-table-ref t
7ae0: 65 73 74 73 2d 64 72 61 77 2d 73 74 61 74 65 20 ests-draw-state
7af0: 27 73 65 6c 65 63 74 65 64 2d 74 65 73 74 73 20 'selected-tests
7b00: 29 29 29 0a 20 20 20 20 28 68 61 73 68 2d 74 61 ))). (hash-ta
7b10: 62 6c 65 2d 73 65 74 21 20 74 65 73 74 73 2d 64 ble-set! tests-d
7b20: 72 61 77 2d 73 74 61 74 65 20 27 78 74 6f 72 69 raw-state 'xtori
7b30: 67 20 78 74 6f 72 69 67 29 0a 20 20 20 20 28 68 g xtorig). (h
7b40: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 74 ash-table-set! t
7b50: 65 73 74 73 2d 64 72 61 77 2d 73 74 61 74 65 20 ests-draw-state
7b60: 27 79 74 6f 72 69 67 20 79 74 6f 72 69 67 29 0a 'ytorig ytorig).
7b70: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6e 75 (if (not (nu
7b80: 6c 6c 3f 20 73 6f 72 74 65 64 2d 74 65 73 74 6e ll? sorted-testn
7b90: 61 6d 65 73 29 29 0a 09 28 6c 65 74 20 6c 6f 6f ames))..(let loo
7ba0: 70 20 28 28 68 65 64 20 28 63 61 72 20 28 72 65 p ((hed (car (re
7bb0: 76 65 72 73 65 20 73 6f 72 74 65 64 2d 74 65 73 verse sorted-tes
7bc0: 74 6e 61 6d 65 73 29 29 29 0a 09 09 20 20 20 28 tnames)))... (
7bd0: 74 61 6c 20 28 63 64 72 20 28 72 65 76 65 72 73 tal (cdr (revers
7be0: 65 20 73 6f 72 74 65 64 2d 74 65 73 74 6e 61 6d e sorted-testnam
7bf0: 65 73 29 29 29 29 0a 09 20 20 28 6c 65 74 2a 20 es)))).. (let*
7c00: 28 28 74 76 61 6c 73 20 28 68 61 73 68 2d 74 61 ((tvals (hash-ta
7c10: 62 6c 65 2d 72 65 66 20 74 65 73 74 73 2d 68 61 ble-ref tests-ha
7c20: 73 68 20 68 65 64 29 29 0a 09 09 20 28 6c 6c 78 sh hed))... (llx
7c30: 20 20 20 28 2b 20 78 64 65 6c 74 61 20 28 6c 69 (+ xdelta (li
7c40: 73 74 2d 72 65 66 20 74 76 61 6c 73 20 30 29 29 st-ref tvals 0))
7c50: 29 0a 09 09 20 28 6c 6c 79 20 20 20 28 2b 20 79 )... (lly (+ y
7c60: 64 65 6c 74 61 20 28 6c 69 73 74 2d 72 65 66 20 delta (list-ref
7c70: 74 76 61 6c 73 20 34 29 29 29 0a 09 09 20 28 62 tvals 4)))... (b
7c80: 6f 78 77 20 20 28 6c 69 73 74 2d 72 65 66 20 74 oxw (list-ref t
7c90: 76 61 6c 73 20 35 29 29 0a 09 09 20 28 62 6f 78 vals 5))... (box
7ca0: 68 20 20 28 6c 69 73 74 2d 72 65 66 20 74 76 61 h (list-ref tva
7cb0: 6c 73 20 36 29 29 0a 09 09 20 28 75 72 78 20 20 ls 6))... (urx
7cc0: 20 28 2b 20 6c 6c 78 20 62 6f 78 77 29 29 0a 09 (+ llx boxw))..
7cd0: 09 20 28 75 72 79 20 20 20 28 2b 20 6c 6c 79 20 . (ury (+ lly
7ce0: 62 6f 78 68 29 29 29 0a 09 20 20 20 20 28 64 63 boxh))).. (dc
7cf0: 6f 6d 6d 6f 6e 3a 64 72 61 77 2d 74 65 73 74 20 ommon:draw-test
7d00: 63 6e 76 20 6c 6c 78 20 6c 6c 79 20 62 6f 78 77 cnv llx lly boxw
7d10: 20 62 6f 78 68 20 68 65 64 20 28 68 61 73 68 2d boxh hed (hash-
7d20: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
7d30: 74 20 73 65 6c 65 63 74 65 64 2d 74 65 73 74 73 t selected-tests
7d40: 20 68 65 64 20 23 66 29 29 0a 09 20 20 20 20 28 hed #f)).. (
7d50: 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 hash-table-set!
7d60: 74 65 73 74 73 2d 68 61 73 68 20 68 65 64 20 28 tests-hash hed (
7d70: 6c 69 73 74 20 6c 6c 78 20 75 72 78 20 28 2d 20 list llx urx (-
7d80: 73 69 7a 65 79 20 75 72 79 29 28 2d 20 73 69 7a sizey ury)(- siz
7d90: 65 79 20 6c 6c 79 29 20 6c 6c 79 20 62 6f 78 77 ey lly) lly boxw
7da0: 20 62 6f 78 68 29 29 0a 09 20 20 20 20 28 69 66 boxh)).. (if
7db0: 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 74 61 6c (not (null? tal
7dc0: 29 29 0a 09 09 3b 3b 20 6c 65 61 76 65 20 61 20 ))...;; leave a
7dd0: 63 6f 6c 75 6d 6e 20 6f 66 20 73 70 61 63 65 20 column of space
7de0: 74 6f 20 74 68 65 20 72 69 67 68 74 20 74 6f 20 to the right to
7df0: 6c 69 73 74 20 69 74 65 6d 73 0a 09 09 28 6c 6f list items...(lo
7e00: 6f 70 20 28 63 61 72 20 74 61 6c 29 0a 09 09 20 op (car tal)...
7e10: 20 20 20 20 20 28 63 64 72 20 74 61 6c 29 29 29 (cdr tal)))
7e20: 29 29 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 ))). (for-eac
7e30: 68 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 h. (lambda (
7e40: 74 65 73 74 6e 61 6d 65 29 0a 20 20 20 20 20 20 testname).
7e50: 20 28 64 63 6f 6d 6d 6f 6e 3a 64 72 61 77 2d 61 (dcommon:draw-a
7e60: 72 72 6f 77 73 20 63 6e 76 20 74 65 73 74 6e 61 rrows cnv testna
7e70: 6d 65 20 74 65 73 74 73 2d 68 61 73 68 20 74 65 me tests-hash te
7e80: 73 74 2d 72 65 63 6f 72 64 73 29 29 0a 20 20 20 st-records)).
7e90: 20 20 73 6f 72 74 65 64 2d 74 65 73 74 6e 61 6d sorted-testnam
7ea0: 65 73 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d es)))..;;=======
7eb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7ec0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7ed0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7ee0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
7ef0: 3b 3b 20 20 53 20 54 20 45 20 50 20 53 0a 3b 3b ;; S T E P S.;;
7f00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7f10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7f20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7f30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7f40: 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 ======..(define
7f50: 28 64 63 6f 6d 6d 6f 6e 3a 70 6f 70 75 6c 61 74 (dcommon:populat
7f60: 65 2d 73 74 65 70 73 20 74 65 73 74 73 74 65 70 e-steps teststep
7f70: 73 20 73 74 65 70 73 2d 6d 61 74 72 69 78 29 0a s steps-matrix).
7f80: 20 20 28 6c 65 74 20 28 28 6d 61 78 2d 72 6f 77 (let ((max-row
7f90: 20 30 29 29 0a 20 20 20 20 28 69 66 20 28 6e 75 0)). (if (nu
7fa0: 6c 6c 3f 20 74 65 73 74 73 74 65 70 73 29 0a 09 ll? teststeps)..
7fb0: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 (iup:attribute-s
7fc0: 65 74 21 20 73 74 65 70 73 2d 6d 61 74 72 69 78 et! steps-matrix
7fd0: 20 22 43 4c 45 41 52 56 41 4c 55 45 22 20 22 43 "CLEARVALUE" "C
7fe0: 4f 4e 54 45 4e 54 53 22 29 0a 09 28 6c 65 74 20 ONTENTS")..(let
7ff0: 6c 6f 6f 70 20 28 28 68 65 64 20 20 20 20 28 63 loop ((hed (c
8000: 61 72 20 74 65 73 74 73 74 65 70 73 29 29 0a 09 ar teststeps))..
8010: 09 20 20 20 28 74 61 6c 20 20 20 20 28 63 64 72 . (tal (cdr
8020: 20 74 65 73 74 73 74 65 70 73 29 29 0a 09 09 20 teststeps))...
8030: 20 20 28 72 6f 77 6e 75 6d 20 31 29 0a 09 09 20 (rownum 1)...
8040: 20 20 28 63 6f 6c 6e 75 6d 20 31 29 29 0a 09 20 (colnum 1))..
8050: 20 28 69 66 20 28 3e 20 72 6f 77 6e 75 6d 20 6d (if (> rownum m
8060: 61 78 2d 72 6f 77 29 28 73 65 74 21 20 6d 61 78 ax-row)(set! max
8070: 2d 72 6f 77 20 72 6f 77 6e 75 6d 29 29 0a 09 20 -row rownum))..
8080: 20 28 6c 65 74 20 28 28 76 61 6c 20 20 20 20 20 (let ((val
8090: 28 76 65 63 74 6f 72 2d 72 65 66 20 68 65 64 20 (vector-ref hed
80a0: 28 2d 20 63 6f 6c 6e 75 6d 20 31 29 29 29 0a 09 (- colnum 1)))..
80b0: 09 28 6d 74 72 78 2d 72 63 20 28 63 6f 6e 63 20 .(mtrx-rc (conc
80c0: 72 6f 77 6e 75 6d 20 22 3a 22 20 63 6f 6c 6e 75 rownum ":" colnu
80d0: 6d 29 29 29 0a 09 20 20 20 20 28 69 75 70 3a 61 m))).. (iup:a
80e0: 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 73 74 ttribute-set! st
80f0: 65 70 73 2d 6d 61 74 72 69 78 20 20 6d 74 72 78 eps-matrix mtrx
8100: 2d 72 63 20 28 69 66 20 76 61 6c 20 28 63 6f 6e -rc (if val (con
8110: 63 20 76 61 6c 29 20 22 22 29 29 0a 09 20 20 20 c val) ""))..
8120: 20 28 69 66 20 28 3c 20 63 6f 6c 6e 75 6d 20 36 (if (< colnum 6
8130: 29 0a 09 09 28 6c 6f 6f 70 20 68 65 64 20 74 61 )...(loop hed ta
8140: 6c 20 72 6f 77 6e 75 6d 20 28 2b 20 63 6f 6c 6e l rownum (+ coln
8150: 75 6d 20 31 29 29 0a 09 09 28 69 66 20 28 6e 6f um 1))...(if (no
8160: 74 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 29 0a 09 t (null? tal))..
8170: 09 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 . (loop (car
8180: 74 61 6c 29 28 63 64 72 20 74 61 6c 29 28 2b 20 tal)(cdr tal)(+
8190: 72 6f 77 6e 75 6d 20 31 29 20 31 29 29 29 29 29 rownum 1) 1)))))
81a0: 29 0a 20 20 20 20 28 69 66 20 28 3e 20 6d 61 78 ). (if (> max
81b0: 2d 72 6f 77 20 30 29 0a 09 28 62 65 67 69 6e 0a -row 0)..(begin.
81c0: 09 20 20 3b 3b 20 77 65 20 61 72 65 20 67 6f 69 . ;; we are goi
81d0: 6e 67 20 74 6f 20 73 70 65 63 75 6c 61 74 69 76 ng to speculativ
81e0: 65 6c 79 20 63 6c 65 61 72 20 72 6f 77 73 20 75 ely clear rows u
81f0: 6e 74 69 6c 20 77 65 20 66 69 6e 64 20 61 20 72 ntil we find a r
8200: 6f 77 20 74 68 61 74 20 69 73 20 61 6c 72 65 61 ow that is alrea
8210: 64 79 20 63 6c 65 61 72 65 64 0a 09 20 20 28 6c dy cleared.. (l
8220: 65 74 20 6c 6f 6f 70 20 28 28 72 6f 77 6e 75 6d et loop ((rownum
8230: 20 20 28 2b 20 6d 61 78 2d 72 6f 77 20 31 29 29 (+ max-row 1))
8240: 0a 09 09 20 20 20 20 20 28 63 6f 6c 6e 75 6d 20 ... (colnum
8250: 20 30 29 0a 09 09 20 20 20 20 20 28 64 65 6c 65 0)... (dele
8260: 74 65 64 20 23 66 29 29 0a 09 20 20 20 20 3b 3b ted #f)).. ;;
8270: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
8280: 66 6f 20 30 20 22 63 6c 65 61 6e 69 6e 67 20 22 fo 0 "cleaning "
8290: 20 72 6f 77 6e 75 6d 20 22 3a 22 20 63 6f 6c 6e rownum ":" coln
82a0: 75 6d 29 0a 09 20 20 20 20 28 6c 65 74 2a 20 28 um).. (let* (
82b0: 28 6e 65 78 74 2d 72 6f 77 20 28 69 66 20 28 65 (next-row (if (e
82c0: 71 3f 20 63 6f 6c 6e 75 6d 20 36 29 20 28 2b 20 q? colnum 6) (+
82d0: 72 6f 77 6e 75 6d 20 31 29 20 72 6f 77 6e 75 6d rownum 1) rownum
82e0: 29 29 0a 09 09 20 20 20 28 6e 65 78 74 2d 63 6f ))... (next-co
82f0: 6c 20 28 69 66 20 28 65 71 3f 20 63 6f 6c 6e 75 l (if (eq? colnu
8300: 6d 20 36 29 20 31 20 28 2b 20 63 6f 6c 6e 75 6d m 6) 1 (+ colnum
8310: 20 31 29 29 29 0a 09 09 20 20 20 28 6d 74 72 78 1)))... (mtrx
8320: 2d 72 63 20 20 28 63 6f 6e 63 20 72 6f 77 6e 75 -rc (conc rownu
8330: 6d 20 22 3a 22 20 63 6f 6c 6e 75 6d 29 29 0a 09 m ":" colnum))..
8340: 09 20 20 20 28 63 75 72 72 2d 76 61 6c 20 28 69 . (curr-val (i
8350: 75 70 3a 61 74 74 72 69 62 75 74 65 20 73 74 65 up:attribute ste
8360: 70 73 2d 6d 61 74 72 69 78 20 6d 74 72 78 2d 72 ps-matrix mtrx-r
8370: 63 29 29 29 0a 09 20 20 20 20 20 20 3b 3b 20 28 c))).. ;; (
8380: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
8390: 20 30 20 22 63 6c 65 61 6e 69 6e 67 20 22 20 72 0 "cleaning " r
83a0: 6f 77 6e 75 6d 20 22 3a 22 20 63 6f 6c 6e 75 6d ownum ":" colnum
83b0: 20 22 20 63 75 72 72 76 61 6c 3d 20 22 20 63 75 " currval= " cu
83c0: 72 72 2d 76 61 6c 29 0a 09 20 20 20 20 20 20 28 rr-val).. (
83d0: 69 66 20 28 61 6e 64 20 28 73 74 72 69 6e 67 3f if (and (string?
83e0: 20 63 75 72 72 2d 76 61 6c 29 0a 09 09 20 20 20 curr-val)...
83f0: 20 20 20 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f (not (equal?
8400: 20 63 75 72 72 2d 76 61 6c 20 22 22 29 29 29 0a curr-val ""))).
8410: 09 09 20 20 28 62 65 67 69 6e 0a 09 09 20 20 20 .. (begin...
8420: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d (iup:attribute-
8430: 73 65 74 21 20 73 74 65 70 73 2d 6d 61 74 72 69 set! steps-matri
8440: 78 20 6d 74 72 78 2d 72 63 20 22 22 29 0a 09 09 x mtrx-rc "")...
8450: 20 20 20 20 28 6c 6f 6f 70 20 6e 65 78 74 2d 72 (loop next-r
8460: 6f 77 20 6e 65 78 74 2d 63 6f 6c 20 23 74 29 29 ow next-col #t))
8470: 0a 09 09 20 20 28 69 66 20 28 65 71 3f 20 63 6f ... (if (eq? co
8480: 6c 6e 75 6d 20 36 29 20 3b 3b 20 6e 6f 74 20 64 lnum 6) ;; not d
8490: 6f 6e 65 2c 20 64 69 64 6e 27 74 20 67 65 74 20 one, didn't get
84a0: 61 20 66 75 6c 6c 20 62 6c 61 6e 6b 20 72 6f 77 a full blank row
84b0: 0a 09 09 20 20 20 20 20 20 28 69 66 20 64 65 6c ... (if del
84c0: 65 74 65 64 20 28 6c 6f 6f 70 20 6e 65 78 74 2d eted (loop next-
84d0: 72 6f 77 20 6e 65 78 74 2d 63 6f 6c 20 23 66 29 row next-col #f)
84e0: 29 20 3b 3b 20 65 78 69 74 20 6f 6e 20 74 68 69 ) ;; exit on thi
84f0: 73 20 6e 6f 74 20 6d 65 74 0a 09 09 20 20 20 20 s not met...
8500: 20 20 28 6c 6f 6f 70 20 6e 65 78 74 2d 72 6f 77 (loop next-row
8510: 20 6e 65 78 74 2d 63 6f 6c 20 64 65 6c 65 74 65 next-col delete
8520: 64 29 29 29 29 29 0a 09 20 20 28 69 75 70 3a 61 d))))).. (iup:a
8530: 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 73 74 ttribute-set! st
8540: 65 70 73 2d 6d 61 74 72 69 78 20 22 52 45 44 52 eps-matrix "REDR
8550: 41 57 22 20 22 41 4c 4c 22 29 29 29 29 29 0a AW" "ALL"))))).